Show
Ignore:
Timestamp:
2005年10月02日 09時47分43秒 (3 years ago)
Author:
miyoshi
Message:

Sync up with Emacs CVS HEAD.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/lisp/calendar/calendar.el

    r3809 r3894  
    165165 
    166166;;;###autoload 
    167 (defcustom number-of-diary-entries 1 
    168   "*Specifies how many days of diary entries are to be displayed initially. 
    169 This variable affects the diary display when the command \\[diary] is used, 
    170 or if the value of the variable `view-diary-entries-initially' is t.  For 
    171 example, if the default value 1 is used, then only the current day's diary 
    172 entries will be displayed.  If the value 2 is used, then both the current 
    173 day's and the next day's entries will be displayed. 
    174  
    175 The value can also be a vector such as [0 2 2 2 2 4 1]; this value 
    176 says to display no diary entries on Sunday, the display the entries 
    177 for the current date and the day after on Monday through Thursday, 
    178 display Friday through Monday's entries on Friday, and display only 
    179 Saturday's entries on Saturday. 
    180  
    181 This variable does not affect the diary display with the `d' command 
    182 from the calendar; in that case, the prefix argument controls the 
    183 number of days of diary entries displayed." 
    184   :type '(choice (integer :tag "Entries") 
    185                  (vector :value [0 0 0 0 0 0 0] 
    186                          (integer :tag "Sunday") 
    187                          (integer :tag "Monday") 
    188                          (integer :tag "Tuesday") 
    189                          (integer :tag "Wednesday") 
    190                          (integer :tag "Thursday") 
    191                          (integer :tag "Friday") 
    192                          (integer :tag "Saturday"))) 
    193   :group 'diary) 
    194  
    195 ;;;###autoload 
    196167(defcustom mark-diary-entries-in-calendar nil 
    197168  "*Non-nil means mark dates with diary entries, in the calendar window. 
    …… 
    394365For example, 
    395366 
    396   (add-hook 'calendar-move-hook (lambda () (view-diary-entries 1))) 
     367  (add-hook 'calendar-move-hook (lambda () (diary-view-entries 1))) 
    397368 
    398369redisplays the diary for whatever date the cursor is moved to." 
    …… 
    13361307(defmacro calendar-for-loop (var from init to final do &rest body) 
    13371308  "Execute a for loop." 
     1309  (declare (debug (symbolp "from" form "to" form "do" body))) 
    13381310  `(let ((,var (1- ,init))) 
    13391311    (while (>= ,final (setq ,var (1+ ,var))) 
    …… 
    16521624    (generate-calendar-window month year) 
    16531625    (if (and view-diary-entries-initially (calendar-date-is-visible-p date)) 
    1654         (view-diary-entries 
    1655          (if (vectorp number-of-diary-entries) 
    1656              (aref number-of-diary-entries (calendar-day-of-week date)) 
    1657            number-of-diary-entries)))) 
     1626        (diary-view-entries))) 
    16581627  (let* ((diary-buffer (get-file-buffer diary-file)) 
    16591628         (diary-window (if diary-buffer (get-buffer-window diary-buffer))) 
    …… 
    16631632  (run-hooks 'initial-calendar-window-hook)) 
    16641633 
    1665 (autoload 'view-diary-entries "diary-lib" 
     1634(autoload 'diary-view-entries "diary-lib" 
    16661635  "Prepare and display a buffer with diary entries. 
    16671636Searches your diary file for entries that match ARG days starting with 
    …… 
    22732242  (define-key calendar-mode-map "u"   'calendar-unmark) 
    22742243  (define-key calendar-mode-map "m"   'mark-diary-entries) 
    2275   (define-key calendar-mode-map "d"   'view-diary-entries) 
     2244  (define-key calendar-mode-map "d"   'diary-view-entries) 
    22762245  (define-key calendar-mode-map "D"   'view-other-diary-entries) 
    22772246  (define-key calendar-mode-map "s"   'show-all-diary-entries) 
    …… 
    24942463  "Update the calendar mode line with the current date and date style." 
    24952464  (if (bufferp (get-buffer calendar-buffer)) 
    2496       (save-excursion 
    2497         (set-buffer calendar-buffer) 
     2465      (with-current-buffer calendar-buffer 
    24982466        (setq mode-line-format 
    24992467              (calendar-string-spread 
    …… 
    25902558                (string-to-number (buffer-substring (1+ (point)) (+ 4 (point)))) 
    25912559                year)) 
    2592       (if (looking-at "\\*") 
    2593           (save-excursion 
    2594             (re-search-backward "[^*]") 
    2595             (if (looking-at ".\\*\\*") 
    2596                 (list month calendar-starred-day year) 
    2597               (if error (error "Not on a date!")))) 
     2560      (if (and (looking-at "\\*") 
     2561               (save-excursion 
     2562                 (re-search-backward "[^*]") 
     2563                 (looking-at ".\\*\\*"))) 
     2564          (list month calendar-starred-day year) 
    25982565        (if error (error "Not on a date!")))))) 
     2566 
     2567(add-to-list 'debug-ignored-errors "Not on a date!") 
    25992568 
    26002569;; The following version of calendar-gregorian-from-absolute is preferred for 
    …… 
    29322901MARK defaults to `diary-entry-marker'." 
    29332902  (if (calendar-date-is-legal-p date) 
    2934       (save-excursion 
    2935         (set-buffer calendar-buffer) 
    2936         (calendar-cursor-to-visible-date date) 
    2937         (let ((mark (or (and (stringp mark) (= (length mark) 1) mark) ; single-char 
    2938                         (and (listp mark) (> (length mark) 0) mark) ; attr list 
    2939                         (and (facep mark) mark) ; face-name 
    2940                         diary-entry-marker))) 
    2941           (if (facep mark) 
    2942               (progn      ; face or an attr-list that contained a face 
    2943                 (overlay-put 
    2944                  (make-overlay (1- (point)) (1+ (point))) 'face mark)) 
    2945             (if (and (stringp mark) 
    2946                      (= (length mark) 1)) ; single-char 
    2947                 (let ((buffer-read-only nil)) 
    2948                   (forward-char 1) 
    2949                   (delete-char 1) 
    2950                   (insert mark) 
    2951                   (forward-char -2)) 
    2952               (let                      ; attr list 
    2953                   ((temp-face 
    2954                     (make-symbol (apply 'concat "temp-" 
    2955                                         (mapcar '(lambda (sym) 
    2956                                                    (cond ((symbolp sym) (symbol-name sym)) 
    2957                                                          ((numberp sym) (int-to-string sym)) 
    2958                                                          (t sym))) mark)))) 
    2959                    (faceinfo mark)) 
    2960                 (make-face temp-face) 
    2961                 ;; Remove :face info from the mark, copy the face info into temp-face 
    2962                 (while (setq faceinfo (memq :face faceinfo)) 
    2963                   (copy-face (read (nth 1 faceinfo)) temp-face) 
    2964                   (setcar faceinfo nil) 
    2965                   (setcar (cdr faceinfo) nil)) 
    2966                 (setq mark (delq nil mark)) 
    2967                 ;; Apply the font aspects 
    2968                 (apply 'set-face-attribute temp-face nil mark) 
    2969                 (overlay-put 
    2970                  (make-overlay (1- (point)) (1+ (point))) 'face temp-face)))))))) 
     2903      (with-current-buffer calendar-buffer 
     2904        (save-excursion 
     2905          (calendar-cursor-to-visible-date date) 
     2906          (setq mark 
     2907                (or (and (stringp mark) (= (length mark) 1) mark) ; single-char 
     2908                    (and (listp mark) (> (length mark) 0) mark)   ; attr list 
     2909                    (and (facep mark) mark)                       ; face-name 
     2910                    diary-entry-marker)) 
     2911          (cond 
     2912           ;; face or an attr-list that contained a face 
     2913           ((facep mark) 
     2914            (overlay-put 
     2915             (make-overlay (1- (point)) (1+ (point))) 'face mark)) 
     2916           ;; single-char 
     2917           ((and (stringp mark) (= (length mark) 1)) 
     2918            (let ((inhibit-read-only t)) 
     2919              (forward-char 1) 
     2920              ;; Insert before delete so as to better preserve markers. 
     2921              (insert mark) 
     2922              (delete-char 1) 
     2923              (forward-char -2))) 
     2924           (t ;; attr list 
     2925            (let ((temp-face 
     2926                   (make-symbol 
     2927                    (apply 'concat "temp-" 
     2928                           (mapcar (lambda (sym) 
     2929                                     (cond 
     2930                                      ((symbolp sym) (symbol-name sym)) 
     2931                                      ((numberp sym) (number-to-string sym)) 
     2932                                      (t sym))) 
     2933                                   mark)))) 
     2934                  (faceinfo mark)) 
     2935              (make-face temp-face) 
     2936              ;; Remove :face info from the mark, copy the face info into 
     2937              ;; temp-face 
     2938              (while (setq faceinfo (memq :face faceinfo)) 
     2939                (copy-face (read (nth 1 faceinfo)) temp-face) 
     2940                (setcar faceinfo nil) 
     2941                (setcar (cdr faceinfo) nil)) 
     2942              (setq mark (delq nil mark)) 
     2943              ;; Apply the font aspects 
     2944              (apply 'set-face-attribute temp-face nil mark) 
     2945              (overlay-put 
     2946               (make-overlay (1- (point)) (1+ (point))) 'face temp-face)))))))) 
    29712947 
    29722948(defun calendar-star-date () 
    …… 
    30723048  (interactive) 
    30733049  (let* ((date (calendar-cursor-to-date t))) 
    3074     (save-excursion 
    3075       (set-buffer (get-buffer-create other-calendars-buffer)) 
     3050    (with-current-buffer (get-buffer-create other-calendars-buffer) 
    30763051      (setq buffer-read-only nil) 
    30773052      (calendar-set-mode-line 
    …… 
    31393114(provide 'calendar) 
    31403115 
    3141 ;;; Local variables: 
    3142 ;;; byte-compile-dynamic: t 
    3143 ;;; End: 
    3144  
    3145 ;;; arch-tag: 19c61596-c8fb-4c69-bcf1-7dd739919cd8 
     3116;; Local variables: 
     3117;; byte-compile-dynamic: t 
     3118;; End: 
     3119 
     3120;; arch-tag: 19c61596-c8fb-4c69-bcf1-7dd739919cd8 
    31463121;;; calendar.el ends here