Commit f09cfd28 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

(mark-visible-calendar-date): Save excursion.

Re-indent within 80 columns.  Use inhibit-read-only.
parent 12b8cf53
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> 2005-09-19 Romain Francoise <romain@orebokech.com>
   
* calendar/diary-lib.el (mark-diary-entries): Revert last change. * calendar/diary-lib.el (mark-diary-entries): Revert last change.
......
...@@ -2900,43 +2900,50 @@ interpreted as BC; -1 being 1 BC, and so on." ...@@ -2900,43 +2900,50 @@ interpreted as BC; -1 being 1 BC, and so on."
MARK is a single-character string, a list of face attributes/values, or a face. MARK is a single-character string, a list of face attributes/values, or a face.
MARK defaults to `diary-entry-marker'." MARK defaults to `diary-entry-marker'."
(if (calendar-date-is-legal-p date) (if (calendar-date-is-legal-p date)
(save-excursion (with-current-buffer calendar-buffer
(set-buffer calendar-buffer) (save-excursion
(calendar-cursor-to-visible-date date) (calendar-cursor-to-visible-date date)
(let ((mark (or (and (stringp mark) (= (length mark) 1) mark) ; single-char (setq mark
(and (listp mark) (> (length mark) 0) mark) ; attr list (or (and (stringp mark) (= (length mark) 1) mark) ; single-char
(and (facep mark) mark) ; face-name (and (listp mark) (> (length mark) 0) mark) ; attr list
diary-entry-marker))) (and (facep mark) mark) ; face-name
(if (facep mark) diary-entry-marker))
(progn ; face or an attr-list that contained a face (cond
(overlay-put ;; face or an attr-list that contained a face
(make-overlay (1- (point)) (1+ (point))) 'face mark)) ((facep mark)
(if (and (stringp mark) (overlay-put
(= (length mark) 1)) ; single-char (make-overlay (1- (point)) (1+ (point))) 'face mark))
(let ((buffer-read-only nil)) ;; single-char
(forward-char 1) ((and (stringp mark) (= (length mark) 1))
(delete-char 1) (let ((inhibit-read-only t))
(insert mark) (forward-char 1)
(forward-char -2)) ;; Insert before delete so as to better preserve markers.
(let ; attr list (insert mark)
((temp-face (delete-char 1)
(make-symbol (apply 'concat "temp-" (forward-char -2)))
(mapcar '(lambda (sym) (t ;; attr list
(cond ((symbolp sym) (symbol-name sym)) (let ((temp-face
((numberp sym) (int-to-string sym)) (make-symbol
(t sym))) mark)))) (apply 'concat "temp-"
(faceinfo mark)) (mapcar (lambda (sym)
(make-face temp-face) (cond
;; Remove :face info from the mark, copy the face info into temp-face ((symbolp sym) (symbol-name sym))
(while (setq faceinfo (memq :face faceinfo)) ((numberp sym) (number-to-string sym))
(copy-face (read (nth 1 faceinfo)) temp-face) (t sym)))
(setcar faceinfo nil) mark))))
(setcar (cdr faceinfo) nil)) (faceinfo mark))
(setq mark (delq nil mark)) (make-face temp-face)
;; Apply the font aspects ;; Remove :face info from the mark, copy the face info into
(apply 'set-face-attribute temp-face nil mark) ;; temp-face
(overlay-put (while (setq faceinfo (memq :face faceinfo))
(make-overlay (1- (point)) (1+ (point))) 'face temp-face)))))))) (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 () (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.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment