Mercurial > emacs
comparison lisp/calendar/calendar.el @ 93510:343109876a78
(calendar-make-temp-face): Fix previous change. Use the last :face if
more than one. Don't ignore any attributes before :face. Fallback to
'default face if necessary.
| author | Glenn Morris <rgm@gnu.org> |
|---|---|
| date | Tue, 01 Apr 2008 07:25:42 +0000 |
| parents | 9105df157c3a |
| children | 6fb229e96593 |
comparison
equal
deleted
inserted
replaced
| 93509:367250b2af54 | 93510:343109876a78 |
|---|---|
| 2388 (= (extract-calendar-year date1) (extract-calendar-year date2)))) | 2388 (= (extract-calendar-year date1) (extract-calendar-year date2)))) |
| 2389 | 2389 |
| 2390 (defun calendar-make-temp-face (attrlist) | 2390 (defun calendar-make-temp-face (attrlist) |
| 2391 "Return a temporary face based on the attributes in ATTRLIST. | 2391 "Return a temporary face based on the attributes in ATTRLIST. |
| 2392 ATTRLIST is a list with elements of the form :face face :foreground color." | 2392 ATTRLIST is a list with elements of the form :face face :foreground color." |
| 2393 (let ((temp-face (make-symbol | 2393 (let ((attrs attrlist) |
| 2394 (mapconcat (lambda (sym) | 2394 faceinfo face temp-face) |
| 2395 (cond | 2395 ;; Separate :face from the other attributes. Use the last :face |
| 2396 ((symbolp sym) (symbol-name sym)) | 2396 ;; if there are more than one. FIXME is merging meaningful? |
| 2397 ((numberp sym) (number-to-string sym)) | 2397 (while attrs |
| 2398 (t sym))) | 2398 (if (eq (car attrs) :face) |
| 2399 attrlist ""))) | 2399 (setq face (intern-soft (cadr attrs)) |
| 2400 (faceinfo attrlist)) | 2400 attrs (cddr attrs)) |
| 2401 (make-face temp-face) | 2401 (push (car attrs) faceinfo) |
| 2402 ;; Remove :face info, copy into temp-face. | 2402 (setq attrs (cdr attrs)))) |
| 2403 (while (setq faceinfo (memq :face faceinfo)) | 2403 (or (facep face) (setq face 'default)) |
| 2404 ;; FIXME is there any point doing this multiple times, or could we | 2404 (if (not faceinfo) |
| 2405 ;; just take the last? | 2405 ;; No attributes to apply, so just use an existing-face. |
| 2406 (condition-case nil | 2406 face |
| 2407 (copy-face (intern-soft (cadr faceinfo)) temp-face) | 2407 ;; FIXME should we be using numbered temp-faces, re-using where poss? |
| 2408 (error nil)) | 2408 (setq temp-face |
| 2409 (setq faceinfo (cddr faceinfo))) | 2409 (make-symbol |
| 2410 (setq attrlist (delq nil attrlist)) | 2410 (concat ":caltemp" |
| 2411 ;; Apply the font aspects. | 2411 (mapconcat (lambda (sym) |
| 2412 (apply 'set-face-attribute temp-face nil attrlist) | 2412 (cond |
| 2413 temp-face)) | 2413 ((symbolp sym) (symbol-name sym)) |
| 2414 ((numberp sym) (number-to-string sym)) | |
| 2415 (t sym))) | |
| 2416 attrlist "")))) | |
| 2417 (make-face temp-face) | |
| 2418 (copy-face face temp-face) | |
| 2419 ;; Apply the font aspects. | |
| 2420 (apply 'set-face-attribute temp-face nil (nreverse faceinfo)) | |
| 2421 temp-face))) | |
| 2414 | 2422 |
| 2415 (defun mark-visible-calendar-date (date &optional mark) | 2423 (defun mark-visible-calendar-date (date &optional mark) |
| 2416 "Mark DATE in the calendar window with MARK. | 2424 "Mark DATE in the calendar window with MARK. |
| 2417 MARK is a single-character string, a list of face attributes/values, or a face. | 2425 MARK is a single-character string, a list of face attributes/values, or a face. |
| 2418 MARK defaults to `diary-entry-marker'." | 2426 MARK defaults to `diary-entry-marker'." |