mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-06 08:54:05 +00:00
Code Issues Releases Activity

(calendar-redrawing): New internal variable.

Browse Source 
(redraw-calendar): Remove bogus save-excursion from previous
change.  Bind calendar-redrawing to t for mark-diary-entries.
This commit is contained in:
Glenn Morris 2005-03-11 21:44:42 +00:00
parent 4b1523ac4a
commit 3ee0c967ef
1 changed files with 38 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
lisp/calendar/calendar.el
View File

@ -2150,15 +2150,18 @@ the inserted text. Value is always t."
(forward-line 1)))) (forward-line 1))))
t) t)
(defvar calendar-redrawing nil
"Internal calendar variable, non-nil if inside redraw-calendar.")
(defun redraw-calendar () (defun redraw-calendar ()
"Redraw the calendar display, if `calendar-buffer' is live." "Redraw the calendar display, if `calendar-buffer' is live."
(interactive) (interactive)
(if (get-buffer calendar-buffer) (if (get-buffer calendar-buffer)
(save-excursion (with-current-buffer calendar-buffer
(with-current-buffer calendar-buffer (let ((cursor-date (calendar-cursor-to-nearest-date))
(let ((cursor-date (calendar-cursor-to-nearest-date))) (calendar-redrawing t))
(generate-calendar-window displayed-month displayed-year) (generate-calendar-window displayed-month displayed-year)
(calendar-cursor-to-visible-date cursor-date)))))) (calendar-cursor-to-visible-date cursor-date)))))
;;;###autoload ;;;###autoload
(defcustom calendar-week-start-day 0 (defcustom calendar-week-start-day 0
@ -2918,40 +2921,40 @@ MARK defaults to `diary-entry-marker'."
(save-excursion (save-excursion
(set-buffer calendar-buffer) (set-buffer calendar-buffer)
(calendar-cursor-to-visible-date date) (calendar-cursor-to-visible-date date)
(let ((mark (or (and (stringp mark) (= (length mark) 1) mark) ; single-char (let ((mark (or (and (stringp mark) (= (length mark) 1) mark) ; single-char
(and (listp mark) (> (length mark) 0) mark) ; attr list (and (listp mark) (> (length mark) 0) mark) ; attr list
(and (facep mark) mark) ; face-name (and (facep mark) mark) ; face-name
diary-entry-marker))) diary-entry-marker)))
(if (facep mark) (if (facep mark)
(progn ; face or an attr-list that contained a face (progn ; face or an attr-list that contained a face
(overlay-put (overlay-put
(make-overlay (1- (point)) (1+ (point))) 'face mark)) (make-overlay (1- (point)) (1+ (point))) 'face mark))
(if (and (stringp mark) (if (and (stringp mark)
(= (length mark) 1)) ; single-char (= (length mark) 1)) ; single-char
(let ((buffer-read-only nil)) (let ((buffer-read-only nil))
(forward-char 1) (forward-char 1)
(delete-char 1) (delete-char 1)
(insert mark) (insert mark)
(forward-char -2)) (forward-char -2))
(let ; attr list (let ; attr list
((temp-face ((temp-face
(make-symbol (apply 'concat "temp-face-" (make-symbol (apply 'concat "temp-face-"
(mapcar '(lambda (sym) (mapcar '(lambda (sym)
(cond ((symbolp sym) (symbol-name sym)) (cond ((symbolp sym) (symbol-name sym))
((numberp sym) (int-to-string sym)) ((numberp sym) (int-to-string sym))
(t sym))) mark)))) (t sym))) mark))))
(faceinfo mark)) (faceinfo mark))
(make-face temp-face) (make-face temp-face)
;; Remove :face info from the mark, copy the face info into temp-face ;; Remove :face info from the mark, copy the face info into temp-face
(while (setq faceinfo (memq :face faceinfo)) (while (setq faceinfo (memq :face faceinfo))
(copy-face (read (nth 1 faceinfo)) temp-face) (copy-face (read (nth 1 faceinfo)) temp-face)
(setcar faceinfo nil) (setcar faceinfo nil)
(setcar (cdr faceinfo) nil)) (setcar (cdr faceinfo) nil))
(setq mark (delq nil mark)) (setq mark (delq nil mark))
;; Apply the font aspects ;; Apply the font aspects
(apply 'set-face-attribute temp-face nil mark) (apply 'set-face-attribute temp-face nil mark)
(overlay-put (overlay-put
(make-overlay (1- (point)) (1+ (point))) 'face temp-face)))))))) (make-overlay (1- (point)) (1+ (point))) 'face temp-face))))))))
(defun calendar-star-date () (defun calendar-star-date ()
"Replace the date under the cursor in the calendar window with asterisks. "Replace the date under the cursor in the calendar window with asterisks.