/[emacs]/emacs/lisp/calendar/calendar.el
ViewVC logotype

Diff of /emacs/lisp/calendar/calendar.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.145 by gm, Mon Jan 20 21:25:29 2003 UTC revision 1.146 by lektu, Tue Feb 11 23:23:10 2003 UTC
# Line 310  calendar." Line 310  calendar."
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 'string
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.
# Line 497  See the documentation for the function ` Line 502  See the documentation for the function `
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'.
# Line 1816  Or, for optional MON, YR." Line 1851  Or, for optional MON, YR."
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 font-lock-mode      (if (and (boundp 'font-lock-mode)
1855                 font-lock-mode)
1856          (font-lock-fontify-buffer))          (font-lock-fontify-buffer))
1857      (and mark-holidays-in-calendar      (and mark-holidays-in-calendar
1858           (mark-calendar-holidays)           (mark-calendar-holidays)
# Line 2556  If WIDTH is non-nil, return just the fir Line 2592  If WIDTH is non-nil, return just the fir
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.

Legend:
Removed from v.1.145  
changed lines
  Added in v.1.146

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26