Mercurial > emacs
comparison lisp/calendar/calendar.el @ 60568:e2cd8a11381a
(calendar-redrawing): New internal variable.
(redraw-calendar): Remove bogus save-excursion from previous
change. Bind calendar-redrawing to t for mark-diary-entries.
| author | Glenn Morris <rgm@gnu.org> |
|---|---|
| date | Fri, 11 Mar 2005 21:44:42 +0000 |
| parents | 952103a61e35 |
| children | 3a754b1548d3 8395880305fe |
comparison
equal
deleted
inserted
replaced
| 60567:46c9ccd1e7a5 | 60568:e2cd8a11381a |
|---|---|
| 2148 (if (eobp) | 2148 (if (eobp) |
| 2149 (newline) | 2149 (newline) |
| 2150 (forward-line 1)))) | 2150 (forward-line 1)))) |
| 2151 t) | 2151 t) |
| 2152 | 2152 |
| 2153 (defvar calendar-redrawing nil | |
| 2154 "Internal calendar variable, non-nil if inside redraw-calendar.") | |
| 2155 | |
| 2153 (defun redraw-calendar () | 2156 (defun redraw-calendar () |
| 2154 "Redraw the calendar display, if `calendar-buffer' is live." | 2157 "Redraw the calendar display, if `calendar-buffer' is live." |
| 2155 (interactive) | 2158 (interactive) |
| 2156 (if (get-buffer calendar-buffer) | 2159 (if (get-buffer calendar-buffer) |
| 2157 (save-excursion | 2160 (with-current-buffer calendar-buffer |
| 2158 (with-current-buffer calendar-buffer | 2161 (let ((cursor-date (calendar-cursor-to-nearest-date)) |
| 2159 (let ((cursor-date (calendar-cursor-to-nearest-date))) | 2162 (calendar-redrawing t)) |
| 2160 (generate-calendar-window displayed-month displayed-year) | 2163 (generate-calendar-window displayed-month displayed-year) |
| 2161 (calendar-cursor-to-visible-date cursor-date)))))) | 2164 (calendar-cursor-to-visible-date cursor-date))))) |
| 2162 | 2165 |
| 2163 ;;;###autoload | 2166 ;;;###autoload |
| 2164 (defcustom calendar-week-start-day 0 | 2167 (defcustom calendar-week-start-day 0 |
| 2165 "*The day of the week on which a week in the calendar begins. | 2168 "*The day of the week on which a week in the calendar begins. |
| 2166 0 means Sunday (default), 1 means Monday, and so on. | 2169 0 means Sunday (default), 1 means Monday, and so on. |
| 2916 MARK defaults to `diary-entry-marker'." | 2919 MARK defaults to `diary-entry-marker'." |
| 2917 (if (calendar-date-is-legal-p date) | 2920 (if (calendar-date-is-legal-p date) |
| 2918 (save-excursion | 2921 (save-excursion |
| 2919 (set-buffer calendar-buffer) | 2922 (set-buffer calendar-buffer) |
| 2920 (calendar-cursor-to-visible-date date) | 2923 (calendar-cursor-to-visible-date date) |
| 2921 (let ((mark (or (and (stringp mark) (= (length mark) 1) mark) ; single-char | 2924 (let ((mark (or (and (stringp mark) (= (length mark) 1) mark) ; single-char |
| 2922 (and (listp mark) (> (length mark) 0) mark) ; attr list | 2925 (and (listp mark) (> (length mark) 0) mark) ; attr list |
| 2923 (and (facep mark) mark) ; face-name | 2926 (and (facep mark) mark) ; face-name |
| 2924 diary-entry-marker))) | 2927 diary-entry-marker))) |
| 2925 (if (facep mark) | 2928 (if (facep mark) |
| 2926 (progn ; face or an attr-list that contained a face | 2929 (progn ; face or an attr-list that contained a face |
| 2927 (overlay-put | 2930 (overlay-put |
| 2928 (make-overlay (1- (point)) (1+ (point))) 'face mark)) | 2931 (make-overlay (1- (point)) (1+ (point))) 'face mark)) |
| 2929 (if (and (stringp mark) | 2932 (if (and (stringp mark) |
| 2930 (= (length mark) 1)) ; single-char | 2933 (= (length mark) 1)) ; single-char |
| 2931 (let ((buffer-read-only nil)) | 2934 (let ((buffer-read-only nil)) |
| 2932 (forward-char 1) | 2935 (forward-char 1) |
| 2933 (delete-char 1) | 2936 (delete-char 1) |
| 2934 (insert mark) | 2937 (insert mark) |
| 2935 (forward-char -2)) | 2938 (forward-char -2)) |
| 2936 (let ; attr list | 2939 (let ; attr list |
| 2937 ((temp-face | 2940 ((temp-face |
| 2938 (make-symbol (apply 'concat "temp-face-" | 2941 (make-symbol (apply 'concat "temp-face-" |
| 2939 (mapcar '(lambda (sym) | 2942 (mapcar '(lambda (sym) |
| 2940 (cond ((symbolp sym) (symbol-name sym)) | 2943 (cond ((symbolp sym) (symbol-name sym)) |
| 2941 ((numberp sym) (int-to-string sym)) | 2944 ((numberp sym) (int-to-string sym)) |
| 2942 (t sym))) mark)))) | 2945 (t sym))) mark)))) |
| 2943 (faceinfo mark)) | 2946 (faceinfo mark)) |
| 2944 (make-face temp-face) | 2947 (make-face temp-face) |
| 2945 ;; Remove :face info from the mark, copy the face info into temp-face | 2948 ;; Remove :face info from the mark, copy the face info into temp-face |
| 2946 (while (setq faceinfo (memq :face faceinfo)) | 2949 (while (setq faceinfo (memq :face faceinfo)) |
| 2947 (copy-face (read (nth 1 faceinfo)) temp-face) | 2950 (copy-face (read (nth 1 faceinfo)) temp-face) |
| 2948 (setcar faceinfo nil) | 2951 (setcar faceinfo nil) |
| 2949 (setcar (cdr faceinfo) nil)) | 2952 (setcar (cdr faceinfo) nil)) |
| 2950 (setq mark (delq nil mark)) | 2953 (setq mark (delq nil mark)) |
| 2951 ;; Apply the font aspects | 2954 ;; Apply the font aspects |
| 2952 (apply 'set-face-attribute temp-face nil mark) | 2955 (apply 'set-face-attribute temp-face nil mark) |
| 2953 (overlay-put | 2956 (overlay-put |
| 2954 (make-overlay (1- (point)) (1+ (point))) 'face temp-face)))))))) | 2957 (make-overlay (1- (point)) (1+ (point))) 'face temp-face)))))))) |
| 2955 | 2958 |
| 2956 (defun calendar-star-date () | 2959 (defun calendar-star-date () |
| 2957 "Replace the date under the cursor in the calendar window with asterisks. | 2960 "Replace the date under the cursor in the calendar window with asterisks. |
| 2958 This function can be used with the `today-visible-calendar-hook' run after the | 2961 This function can be used with the `today-visible-calendar-hook' run after the |
| 2959 calendar window has been prepared." | 2962 calendar window has been prepared." |