Mercurial > emacs
changeset 65620:eae4a82ba77a
(mark-visible-calendar-date): Save excursion.
Re-indent within 80 columns. Use inhibit-read-only.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Mon, 19 Sep 2005 17:41:22 +0000 |
| parents | e09cff91900a |
| children | e1327485f073 |
| files | lisp/ChangeLog lisp/calendar/calendar.el |
| diffstat | 2 files changed, 49 insertions(+), 37 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Mon Sep 19 16:03:51 2005 +0000 +++ b/lisp/ChangeLog Mon Sep 19 17:41:22 2005 +0000 @@ -1,3 +1,8 @@ +2005-09-19 Stefan Monnier <monnier@iro.umontreal.ca> + + * calendar/calendar.el (mark-visible-calendar-date): Save excursion. + Re-indent within 80 columns. Use inhibit-read-only. + 2005-09-19 Romain Francoise <romain@orebokech.com> * calendar/diary-lib.el (mark-diary-entries): Revert last change.
--- a/lisp/calendar/calendar.el Mon Sep 19 16:03:51 2005 +0000 +++ b/lisp/calendar/calendar.el Mon Sep 19 17:41:22 2005 +0000 @@ -2900,43 +2900,50 @@ MARK is a single-character string, a list of face attributes/values, or a face. MARK defaults to `diary-entry-marker'." (if (calendar-date-is-legal-p date) - (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-" - (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)))))))) + (with-current-buffer calendar-buffer + (save-excursion + (calendar-cursor-to-visible-date date) + (setq 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)) + (cond + ;; face or an attr-list that contained a face + ((facep mark) + (overlay-put + (make-overlay (1- (point)) (1+ (point))) 'face mark)) + ;; single-char + ((and (stringp mark) (= (length mark) 1)) + (let ((inhibit-read-only t)) + (forward-char 1) + ;; Insert before delete so as to better preserve markers. + (insert mark) + (delete-char 1) + (forward-char -2))) + (t ;; attr list + (let ((temp-face + (make-symbol + (apply 'concat "temp-" + (mapcar (lambda (sym) + (cond + ((symbolp sym) (symbol-name sym)) + ((numberp sym) (number-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.