204 |
:type 'boolean |
:type 'boolean |
205 |
:group 'view) |
:group 'view) |
206 |
|
|
207 |
(add-to-list 'facemenu-unlisted-faces 'diary-face) |
(defvar diary-face 'diary-face |
208 |
|
"Face name to use for diary entries.") |
209 |
(defface diary-face |
(defface diary-face |
210 |
'((((class color) (background light)) |
'((((class color) (background light)) |
211 |
:foreground "red") |
:foreground "red") |
216 |
"Face for highlighting diary entries." |
"Face for highlighting diary entries." |
217 |
:group 'diary) |
:group 'diary) |
218 |
|
|
|
(add-to-list 'facemenu-unlisted-faces 'calendar-today-face) |
|
219 |
(defface calendar-today-face |
(defface calendar-today-face |
220 |
'((t (:underline t))) |
'((t (:underline t))) |
221 |
"Face for indicating today's date." |
"Face for indicating today's date." |
222 |
:group 'diary) |
:group 'diary) |
223 |
|
|
|
(add-to-list 'facemenu-unlisted-faces 'holiday-face) |
|
224 |
(defface holiday-face |
(defface holiday-face |
225 |
'((((class color) (background light)) |
'((((class color) (background light)) |
226 |
:background "pink") |
:background "pink") |
231 |
"Face for indicating dates that have holidays." |
"Face for indicating dates that have holidays." |
232 |
:group 'diary) |
:group 'diary) |
233 |
|
|
234 |
|
(eval-after-load "facemenu" |
235 |
|
'(progn |
236 |
|
(add-to-list 'facemenu-unlisted-faces 'diary-face) |
237 |
|
(add-to-list 'facemenu-unlisted-faces 'calendar-today-face) |
238 |
|
(add-to-list 'facemenu-unlisted-faces 'holiday-face))) |
239 |
|
|
240 |
(defcustom diary-entry-marker |
(defcustom diary-entry-marker |
241 |
(if (not (display-color-p)) |
(if (not (display-color-p)) |
242 |
"+" |
"+" |
310 |
:type 'boolean |
:type 'boolean |
311 |
:group 'holidays) |
:group 'holidays) |
312 |
|
|
313 |
|
(defcustom diary-file-name-prefix-function (function (lambda (str) str)) |
314 |
|
"*The function that will take a diary file name and return the desired prefix." |
315 |
|
:type 'function |
316 |
|
:group 'diary) |
317 |
|
|
318 |
;;;###autoload |
;;;###autoload |
319 |
(defcustom calendar-load-hook nil |
(defcustom calendar-load-hook nil |
320 |
"*List of functions to be called after the calendar is first loaded. |
"*List of functions to be called after the calendar is first loaded. |
502 |
:type 'string |
:type 'string |
503 |
:group 'diary) |
:group 'diary) |
504 |
|
|
505 |
|
(defcustom diary-glob-file-regexp-prefix "^\\#" |
506 |
|
"*The regular expression that gets pre-pended to each of the attribute-regexp's for file-wide specifiers." |
507 |
|
:type 'regexp |
508 |
|
:group 'diary) |
509 |
|
|
510 |
|
(defcustom diary-face-attrs '( |
511 |
|
(" *\\[foreground:\\([-a-z]+\\)\\]$" 1 :foreground string) |
512 |
|
(" *\\[background:\\([-a-z]+\\)\\]$" 1 :background string) |
513 |
|
(" *\\[width:\\([-a-z]+\\)\\]$" 1 :width symbol) |
514 |
|
(" *\\[height:\\([-0-9a-z]+\\)\\]$" 1 :height int) |
515 |
|
(" *\\[weight:\\([-a-z]+\\)\\]$" 1 :weight symbol) |
516 |
|
(" *\\[slant:\\([-a-z]+\\)\\]$" 1 :slant symbol) |
517 |
|
(" *\\[underline:\\([-a-z]+\\)\\]$" 1 :underline stringtnil) |
518 |
|
(" *\\[overline:\\([-a-z]+\\)\\]$" 1 :overline stringtnil) |
519 |
|
(" *\\[strike-through:\\([-a-z]+\\)\\]$" 1 :strike-through stringtnil) |
520 |
|
(" *\\[inverse-video:\\([-a-z]+\\)\\]$" 1 :inverse-video tnil) |
521 |
|
(" *\\[face:\\([-0-9a-z]+\\)\\]$" 1 :face string) |
522 |
|
(" *\\[font:\\([-a-z0-9]+\\)\\]$" 1 :font string) |
523 |
|
;Unsupported (" *\\[box:\\([-a-z]+\\)\\]$" 1 :box) |
524 |
|
;Unsupported (" *\\[stipple:\\([-a-z]+\\)\\]$" 1 :stipple) |
525 |
|
) |
526 |
|
"*A list of (regexp regnum attr attrtype) lists where the regexp says how to find the tag, the regnum says which parenthetical sub-regexp this regexp looks for, and the attr says which attribute of the face (or that this _is_ a face) is being modified." |
527 |
|
:type 'sexp |
528 |
|
:group 'diary) |
529 |
|
|
530 |
|
(defcustom diary-file-name-prefix nil |
531 |
|
"If non-nil then each entry in the diary list will be prefixed with the name of the file in which it was defined." |
532 |
|
:type 'boolean |
533 |
|
:group 'diary) |
534 |
|
|
535 |
;;;###autoload |
;;;###autoload |
536 |
(defcustom sexp-diary-entry-symbol "%%" |
(defcustom sexp-diary-entry-symbol "%%" |
537 |
"*The string used to indicate a sexp diary entry in `diary-file'. |
"*The string used to indicate a sexp diary entry in `diary-file'. |
645 |
(defcustom european-calendar-display-form |
(defcustom european-calendar-display-form |
646 |
'((if dayname (concat dayname ", ")) day " " monthname " " year) |
'((if dayname (concat dayname ", ")) day " " monthname " " year) |
647 |
"*Pseudo-pattern governing the way a date appears in the European style. |
"*Pseudo-pattern governing the way a date appears in the European style. |
648 |
See the documentation of calendar-date-display-form for an explanation." |
See the documentation of `calendar-date-display-form' for an explanation." |
649 |
:type 'sexp |
:type 'sexp |
650 |
:group 'calendar) |
:group 'calendar) |
651 |
|
|
1386 |
"Move cursor to DATE." |
"Move cursor to DATE." |
1387 |
t) |
t) |
1388 |
|
|
1389 |
|
(autoload 'calendar-only-one-frame-setup "cal-x" |
1390 |
|
"Start calendar and display it in a dedicated frame.") |
1391 |
|
|
1392 |
(autoload 'calendar-one-frame-setup "cal-x" |
(autoload 'calendar-one-frame-setup "cal-x" |
1393 |
"Start calendar and display it in a dedicated frame together with the diary.") |
"Start calendar and display it in a dedicated frame together with the diary.") |
1394 |
|
|
1851 |
;; Adjust the window to exactly fit the displayed calendar |
;; Adjust the window to exactly fit the displayed calendar |
1852 |
(fit-window-to-buffer)) |
(fit-window-to-buffer)) |
1853 |
(sit-for 0) |
(sit-for 0) |
1854 |
|
(if (and (boundp 'font-lock-mode) |
1855 |
|
font-lock-mode) |
1856 |
|
(font-lock-fontify-buffer)) |
1857 |
(and mark-holidays-in-calendar |
(and mark-holidays-in-calendar |
1858 |
(mark-calendar-holidays) |
(mark-calendar-holidays) |
1859 |
(sit-for 0)) |
(sit-for 0)) |
2067 |
(define-key calendar-mode-map "tY" 'cal-tex-cursor-year-landscape)) |
(define-key calendar-mode-map "tY" 'cal-tex-cursor-year-landscape)) |
2068 |
|
|
2069 |
(defun describe-calendar-mode () |
(defun describe-calendar-mode () |
2070 |
"Create a help buffer with a brief description of the calendar-mode." |
"Create a help buffer with a brief description of the `calendar-mode'." |
2071 |
(interactive) |
(interactive) |
2072 |
(with-output-to-temp-buffer "*Help*" |
(with-output-to-temp-buffer "*Help*" |
2073 |
(princ |
(princ |
2090 |
"\\<calendar-mode-map>\\[scroll-calendar-left]") |
"\\<calendar-mode-map>\\[scroll-calendar-left]") |
2091 |
'help-echo "mouse-2: scroll left" |
'help-echo "mouse-2: scroll left" |
2092 |
'keymap (make-mode-line-mouse-map 'mouse-2 |
'keymap (make-mode-line-mouse-map 'mouse-2 |
2093 |
#'scroll-calendar-left)) |
'mouse-scroll-calendar-left)) |
2094 |
"Calendar" |
"Calendar" |
2095 |
(concat |
(concat |
2096 |
(propertize |
(propertize |
2104 |
"\\<calendar-mode-map>\\[calendar-other-month] other") |
"\\<calendar-mode-map>\\[calendar-other-month] other") |
2105 |
'help-echo "mouse-2: choose another month" |
'help-echo "mouse-2: choose another month" |
2106 |
'keymap (make-mode-line-mouse-map |
'keymap (make-mode-line-mouse-map |
2107 |
'mouse-2 |
'mouse-2 'mouse-calendar-other-month)) |
|
(lambda () |
|
|
(interactive) |
|
|
(call-interactively |
|
|
'calendar-other-month)))) |
|
2108 |
"/" |
"/" |
2109 |
(propertize |
(propertize |
2110 |
(substitute-command-keys |
(substitute-command-keys |
2116 |
"\\<calendar-mode-map>\\[scroll-calendar-right]") |
"\\<calendar-mode-map>\\[scroll-calendar-right]") |
2117 |
'help-echo "mouse-2: scroll right" |
'help-echo "mouse-2: scroll right" |
2118 |
'keymap (make-mode-line-mouse-map |
'keymap (make-mode-line-mouse-map |
2119 |
'mouse-2 #'scroll-calendar-right))) |
'mouse-2 'mouse-scroll-calendar-right))) |
2120 |
"The mode line of the calendar buffer. |
"The mode line of the calendar buffer. |
2121 |
|
|
2122 |
This must be a list of items that evaluate to strings--those strings are |
This must be a list of items that evaluate to strings--those strings are |
2144 |
\"\")) |
\"\")) |
2145 |
") |
") |
2146 |
|
|
2147 |
|
(defun mouse-scroll-calendar-left (event) |
2148 |
|
"Scroll the displayed calendar left by one month. |
2149 |
|
Maintains the relative position of the cursor |
2150 |
|
with respect to the calendar as well as possible." |
2151 |
|
(interactive "e") |
2152 |
|
(save-selected-window |
2153 |
|
(select-window (posn-window (event-start event))) |
2154 |
|
(scroll-calendar-left 1))) |
2155 |
|
|
2156 |
|
(defun mouse-scroll-calendar-right (event) |
2157 |
|
"Scroll the displayed calendar right by one month. |
2158 |
|
Maintains the relative position of the cursor |
2159 |
|
with respect to the calendar as well as possible." |
2160 |
|
(interactive "e") |
2161 |
|
(save-selected-window |
2162 |
|
(select-window (posn-window (event-start event))) |
2163 |
|
(scroll-calendar-right 1))) |
2164 |
|
|
2165 |
|
(defun mouse-calendar-other-month (event) |
2166 |
|
"Display a three-month calendar centered around a specified month and year." |
2167 |
|
(interactive "e") |
2168 |
|
(save-selected-window |
2169 |
|
(select-window (posn-window (event-start event))) |
2170 |
|
(call-interactively 'calendar-other-month))) |
2171 |
|
|
2172 |
(defun calendar-goto-info-node () |
(defun calendar-goto-info-node () |
2173 |
"Go to the info node for the calendar." |
"Go to the info node for the calendar." |
2174 |
(interactive) |
(interactive) |
2181 |
(info)) |
(info)) |
2182 |
(Info-find-node (car (car where)) (car (cdr (car where))))))) |
(Info-find-node (car (car where)) (car (cdr (car where))))))) |
2183 |
|
|
2184 |
|
|
2185 |
|
|
2186 |
(defun calendar-mode () |
(defun calendar-mode () |
2187 |
"A major mode for the calendar window. |
"A major mode for the calendar window. |
2188 |
|
|
2201 |
(add-hook 'activate-menubar-hook 'cal-menu-update nil t) |
(add-hook 'activate-menubar-hook 'cal-menu-update nil t) |
2202 |
(make-local-variable 'calendar-mark-ring) |
(make-local-variable 'calendar-mark-ring) |
2203 |
(make-local-variable 'displayed-month);; Month in middle of window. |
(make-local-variable 'displayed-month);; Month in middle of window. |
2204 |
(make-local-variable 'displayed-year));; Year in middle of window. |
(make-local-variable 'displayed-year) ;; Year in middle of window. |
2205 |
|
(set (make-local-variable 'font-lock-defaults) |
2206 |
|
'(calendar-font-lock-keywords t))) |
2207 |
|
|
2208 |
(defun calendar-string-spread (strings char length) |
(defun calendar-string-spread (strings char length) |
2209 |
"Concatenate list of STRINGS separated with copies of CHAR to fill LENGTH. |
"Concatenate list of STRINGS separated with copies of CHAR to fill LENGTH. |
2497 |
(+ (* 12 (- yr2 yr1)) |
(+ (* 12 (- yr2 yr1)) |
2498 |
(- mon2 mon1))) |
(- mon2 mon1))) |
2499 |
|
|
2500 |
|
(defvar calendar-day-name-array |
2501 |
|
["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"] |
2502 |
|
"Array of capitalized strings giving, in order, the day names.") |
2503 |
|
|
2504 |
|
(defvar calendar-month-name-array |
2505 |
|
["January" "February" "March" "April" "May" "June" |
2506 |
|
"July" "August" "September" "October" "November" "December"] |
2507 |
|
"Array of capitalized strings giving, in order, the month names.") |
2508 |
|
|
2509 |
|
(defvar calendar-font-lock-keywords |
2510 |
|
`((,(concat (regexp-opt (mapcar 'identity calendar-month-name-array) t) |
2511 |
|
" -?[0-9]+") |
2512 |
|
. font-lock-function-name-face) ; month and year |
2513 |
|
(,(regexp-opt |
2514 |
|
(list (substring (aref calendar-day-name-array 6) 0 2) |
2515 |
|
(substring (aref calendar-day-name-array 0) 0 2))) |
2516 |
|
;; Saturdays and Sundays are hilited differently. |
2517 |
|
. font-lock-comment-face) |
2518 |
|
(,(regexp-opt (mapcar (lambda (x) (substring x 0 2)) calendar-day-name-array)) |
2519 |
|
. font-lock-reference-face)) |
2520 |
|
"Default keywords to highlight in Calendar mode.") |
2521 |
|
|
2522 |
(defun calendar-day-name (date &optional width absolute) |
(defun calendar-day-name (date &optional width absolute) |
2523 |
"Return a string with the name of the day of the week of DATE. |
"Return a string with the name of the day of the week of DATE. |
2524 |
If WIDTH is non-nil, return just the first WIDTH characters of the name. |
If WIDTH is non-nil, return just the first WIDTH characters of the name. |
2530 |
(enable-multibyte-characters (truncate-string-to-width string width)) |
(enable-multibyte-characters (truncate-string-to-width string width)) |
2531 |
(t (substring string 0 width))))) |
(t (substring string 0 width))))) |
2532 |
|
|
|
(defvar calendar-day-name-array |
|
|
["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"] |
|
|
"Array of capitalized strings giving, in order, the day names.") |
|
|
|
|
|
(defvar calendar-month-name-array |
|
|
["January" "February" "March" "April" "May" "June" |
|
|
"July" "August" "September" "October" "November" "December"] |
|
|
"Array of capitalized strings giving, in order, the month names.") |
|
|
|
|
2533 |
(defun calendar-make-alist (sequence &optional start-index filter) |
(defun calendar-make-alist (sequence &optional start-index filter) |
2534 |
"Make an assoc list corresponding to SEQUENCE. |
"Make an assoc list corresponding to SEQUENCE. |
2535 |
Start at index 1, unless optional START-INDEX is provided. |
Start at index 1, unless optional START-INDEX is provided. |
2592 |
|
|
2593 |
(defun mark-visible-calendar-date (date &optional mark) |
(defun mark-visible-calendar-date (date &optional mark) |
2594 |
"Mark DATE in the calendar window with MARK. |
"Mark DATE in the calendar window with MARK. |
2595 |
MARK is either a single-character string or a face. |
MARK is a single-character string, a list of face attributes/values, or a face. |
2596 |
MARK defaults to diary-entry-marker." |
MARK defaults to `diary-entry-marker'." |
2597 |
(if (calendar-date-is-legal-p date) |
(if (calendar-date-is-legal-p date) |
2598 |
(save-excursion |
(save-excursion |
2599 |
(set-buffer calendar-buffer) |
(set-buffer calendar-buffer) |
2600 |
(calendar-cursor-to-visible-date date) |
(calendar-cursor-to-visible-date date) |
2601 |
(let ((mark (or mark diary-entry-marker))) |
(let ((mark (or (and (stringp mark) (= (length mark) 1) mark) ; single-char |
2602 |
(if (stringp mark) |
(and (listp mark) (> (length mark) 0) mark) ; attr list |
2603 |
(let ((buffer-read-only nil)) |
(and (facep mark) mark) ; face-name |
2604 |
(forward-char 1) |
diary-entry-marker))) |
2605 |
(delete-char 1) |
(if (facep mark) |
2606 |
(insert mark) |
(progn ; face or an attr-list that contained a face |
2607 |
(forward-char -2)) |
(overlay-put |
2608 |
(overlay-put |
(make-overlay (1- (point)) (1+ (point))) 'face mark)) |
2609 |
(make-overlay (1- (point)) (1+ (point))) 'face mark)))))) |
(if (and (stringp mark) |
2610 |
|
(= (length mark) 1)) ; single-char |
2611 |
|
(let ((buffer-read-only nil)) |
2612 |
|
(forward-char 1) |
2613 |
|
(delete-char 1) |
2614 |
|
(insert mark) |
2615 |
|
(forward-char -2)) |
2616 |
|
(progn ; attr list |
2617 |
|
(setq temp-face |
2618 |
|
(make-symbol (apply 'concat "temp-face-" |
2619 |
|
(mapcar '(lambda (sym) |
2620 |
|
(cond ((symbolp sym) (symbol-name sym)) |
2621 |
|
((numberp sym) (int-to-string sym)) |
2622 |
|
(t sym))) mark)))) |
2623 |
|
(make-face temp-face) |
2624 |
|
;; Remove :face info from the mark, copy the face info into temp-face |
2625 |
|
(setq faceinfo mark) |
2626 |
|
(while (setq faceinfo (memq :face faceinfo)) |
2627 |
|
(copy-face (read (nth 1 faceinfo)) temp-face) |
2628 |
|
(setcar faceinfo nil) |
2629 |
|
(setcar (cdr faceinfo) nil)) |
2630 |
|
(setq mark (delq nil mark)) |
2631 |
|
;; Apply the font aspects |
2632 |
|
(apply 'set-face-attribute temp-face nil mark) |
2633 |
|
(overlay-put |
2634 |
|
(make-overlay (1- (point)) (1+ (point))) 'face temp-face)))))))) |
2635 |
|
|
2636 |
(defun calendar-star-date () |
(defun calendar-star-date () |
2637 |
"Replace the date under the cursor in the calendar window with asterisks. |
"Replace the date under the cursor in the calendar window with asterisks. |
2650 |
|
|
2651 |
(defun calendar-mark-today () |
(defun calendar-mark-today () |
2652 |
"Mark the date under the cursor in the calendar window. |
"Mark the date under the cursor in the calendar window. |
2653 |
The date is marked with calendar-today-marker. This function can be used with |
The date is marked with `calendar-today-marker'. This function can be used with |
2654 |
the `today-visible-calendar-hook' run after the calendar window has been |
the `today-visible-calendar-hook' run after the calendar window has been |
2655 |
prepared." |
prepared." |
2656 |
(mark-visible-calendar-date |
(mark-visible-calendar-date |