[Emacs-diffs] Changes to emacs/lisp/calendar/calendar.el

[Glenn Morris]

Index: emacs/lisp/calendar/calendar.el
diff -c emacs/lisp/calendar/calendar.el:1.163 
emacs/lisp/calendar/calendar.el:1.164
*** emacs/lisp/calendar/calendar.el:1.163       Wed Mar  9 00:28:22 2005
--- emacs/lisp/calendar/calendar.el     Fri Mar 11 21:44:42 2005
***************
*** 2150,2164 ****
          (forward-line 1))))
    t)
  
  (defun redraw-calendar ()
    "Redraw the calendar display, if `calendar-buffer' is live."
    (interactive)
    (if (get-buffer calendar-buffer)
!       (save-excursion
!         (with-current-buffer calendar-buffer
!           (let ((cursor-date (calendar-cursor-to-nearest-date)))
!             (generate-calendar-window displayed-month displayed-year)
!             (calendar-cursor-to-visible-date cursor-date))))))
  
  ;;;###autoload
  (defcustom calendar-week-start-day 0
--- 2150,2167 ----
          (forward-line 1))))
    t)
  
+ (defvar calendar-redrawing nil
+   "Internal calendar variable, non-nil if inside redraw-calendar.")
+ 
  (defun redraw-calendar ()
    "Redraw the calendar display, if `calendar-buffer' is live."
    (interactive)
    (if (get-buffer calendar-buffer)
!       (with-current-buffer calendar-buffer
!         (let ((cursor-date (calendar-cursor-to-nearest-date))
!               (calendar-redrawing t))
!           (generate-calendar-window displayed-month displayed-year)
!           (calendar-cursor-to-visible-date cursor-date)))))
  
  ;;;###autoload
  (defcustom calendar-week-start-day 0
***************
*** 2918,2957 ****
        (save-excursion
          (set-buffer calendar-buffer)
          (calendar-cursor-to-visible-date date)
!       (let ((mark (or (and (stringp mark) (= (length mark) 1) mark) ; 
single-char
!                       (and (listp mark) (> (length mark) 0) mark) ; attr list
!                       (and (facep mark) mark) ; face-name
!                       diary-entry-marker)))
!         (if (facep mark)
!             (progn ; face or an attr-list that contained a face
!               (overlay-put
!                (make-overlay (1- (point)) (1+ (point))) 'face mark))
!           (if (and (stringp mark)
!                    (= (length mark) 1)) ; single-char
!               (let ((buffer-read-only nil))
!                 (forward-char 1)
!                 (delete-char 1)
!                 (insert mark)
!                 (forward-char -2))
!               (let ; attr list 
!                   ((temp-face 
!                     (make-symbol (apply 'concat "temp-face-" 
!                                         (mapcar '(lambda (sym) 
                                                     (cond ((symbolp sym) 
(symbol-name sym))
                                                           ((numberp sym) 
(int-to-string sym))
                                                           (t sym))) mark))))
                     (faceinfo mark))
!               (make-face temp-face)
!               ;; Remove :face info from the mark, copy the face info into 
temp-face
!               (while (setq faceinfo (memq :face faceinfo))
!                 (copy-face (read (nth 1 faceinfo)) temp-face)
!                 (setcar faceinfo nil)
!                 (setcar (cdr faceinfo) nil))
!               (setq mark (delq nil mark))
!               ;; Apply the font aspects
!               (apply 'set-face-attribute temp-face nil mark)
!               (overlay-put
!                (make-overlay (1- (point)) (1+ (point))) 'face 
temp-face))))))))
  
  (defun calendar-star-date ()
    "Replace the date under the cursor in the calendar window with asterisks.
--- 2921,2960 ----
        (save-excursion
          (set-buffer calendar-buffer)
          (calendar-cursor-to-visible-date date)
!         (let ((mark (or (and (stringp mark) (= (length mark) 1) mark) ; 
single-char
!                         (and (listp mark) (> (length mark) 0) mark) ; attr 
list
!                         (and (facep mark) mark) ; face-name
!                         diary-entry-marker)))
!           (if (facep mark)
!               (progn      ; face or an attr-list that contained a face
!                 (overlay-put
!                  (make-overlay (1- (point)) (1+ (point))) 'face mark))
!             (if (and (stringp mark)
!                      (= (length mark) 1)) ; single-char
!                 (let ((buffer-read-only nil))
!                   (forward-char 1)
!                   (delete-char 1)
!                   (insert mark)
!                   (forward-char -2))
!               (let                      ; attr list
!                   ((temp-face
!                     (make-symbol (apply 'concat "temp-face-"
!                                         (mapcar '(lambda (sym)
                                                     (cond ((symbolp sym) 
(symbol-name sym))
                                                           ((numberp sym) 
(int-to-string sym))
                                                           (t sym))) mark))))
                     (faceinfo mark))
!                 (make-face temp-face)
!                 ;; Remove :face info from the mark, copy the face info into 
temp-face
!                 (while (setq faceinfo (memq :face faceinfo))
!                   (copy-face (read (nth 1 faceinfo)) temp-face)
!                   (setcar faceinfo nil)
!                   (setcar (cdr faceinfo) nil))
!                 (setq mark (delq nil mark))
!                 ;; Apply the font aspects
!                 (apply 'set-face-attribute temp-face nil mark)
!                 (overlay-put
!                  (make-overlay (1- (point)) (1+ (point))) 'face 
temp-face))))))))
  
  (defun calendar-star-date ()
    "Replace the date under the cursor in the calendar window with asterisks.