* specific coloring of diary calendar entries
@ 2002-12-11 23:58 Ami Fischman
2002-12-12 1:02 ` Alan Shutko
2002-12-13 22:22 ` Richard Stallman
0 siblings, 2 replies; 24+ messages in thread
From: Ami Fischman @ 2002-12-11 23:58 UTC (permalink / raw)
[-- Attachment #1: Type: text/plain, Size: 2114 bytes --]
[apologies if this appears twice; attempted posting two days ago, but the
post never appeared on the list]
Attached are two patches that make it possible to specify a color for a
diary entry in the entry itself. This is done via "color tags" -- a string
that looks like "[color:blue]" (without the quotes, and blue can be any
standard X color). This color comes out both in the calendar display
(dates are colored according to the events in them) and in the fancy diary
display (entries are colored according to their specifications).
The first entry matching a date is the one that determines the color for
that date (so order DOES matter in ~/.diary files now). The color tag MUST
appear at the end of a line (nothing other than a newline may follow it),
and if one has a multi-line non-sexp entry, the color tag may appear on the
first line of the entry. On multi-line sexp entries, the color tag may
appear on any line in the sexp, at the end of the line.
To tag all entries that don't have their own color tags, one may have a
"global file color" specified: the first line in a file consisting of the
string "# [color:lightgrey]" (without the double quotes) determines the
color, and the entries in that file will default to that color.
If a date matches more than one entry, the FIRST matching entry's color is
used for the date. Regular entries get marked before sexp ones, so their
colors always show up instead of sexp ones (which jives with the notion
that sexp events are "generic" whereas regular entries are "specific" and
so more attention-deserving).
This solves a long-time wish of mine to be able to give "subtler" colors to
less important events and glaring colors to events that demand my attention.
It also solves a request of Kai Grossjohann for #include'd entry coloring,
and hopefully makes diary/calendar modes a more attractive alternative for
group-wide #include'd diary files.
If there are no objections to the code (there may be; my lisp is very
rusty), I'd like to see it committed to CVS. Any comments happily accepted.
Cheers,
--
Ami Fischman
usenet@fischman.org
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: col-cal.patch --]
[-- Type: text/x-patch, Size: 2196 bytes --]
*** calendar.el 2002-12-09 16:14:14.000000000 -0800
--- /usr/local/emacs/share/emacs/21.2.50/lisp/calendar/calendar.el 2002-04-16 15:10:10.000000000 -0700
***************
*** 2507,2536 ****
(= (extract-calendar-year date1) (extract-calendar-year date2))))
(defun mark-visible-calendar-date (date &optional mark)
"Mark DATE in the calendar window with MARK.
! MARK is either a single-character string, a color-name string (such as \"green\"), 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) 0) mark)
! (and (not (stringp mark)) mark)
! diary-entry-marker)))
(if (stringp mark)
! (if (= (length mark) 1)
! (let ((buffer-read-only nil))
! (forward-char 1)
! (delete-char 1)
! (insert mark)
! (forward-char -2))
! (progn
! (setq temp-face (make-symbol (concat "cal-col-face-" mark)))
! (make-face temp-face)
! (set-face-foreground temp-face mark)
! (overlay-put
! (make-overlay (1- (point)) (1+ (point))) 'face temp-face)))
(overlay-put
(make-overlay (1- (point)) (1+ (point))) 'face mark))))))
(defun calendar-star-date ()
--- 2507,2527 ----
(= (extract-calendar-year date1) (extract-calendar-year date2))))
(defun mark-visible-calendar-date (date &optional mark)
"Mark DATE in the calendar window with MARK.
! MARK is either a single-character string 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 mark diary-entry-marker)))
(if (stringp mark)
! (let ((buffer-read-only nil))
! (forward-char 1)
! (delete-char 1)
! (insert mark)
! (forward-char -2))
(overlay-put
(make-overlay (1- (point)) (1+ (point))) 'face mark))))))
(defun calendar-star-date ()
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: col-dia.patch --]
[-- Type: text/x-patch, Size: 18776 bytes --]
*** diary-lib.el 2002-12-10 09:16:11.000000000 -0800
--- /usr/local/emacs/share/emacs/21.2.50/lisp/calendar/diary-lib.el 2002-08-28 08:16:15.000000000 -0700
***************
*** 246,261 ****
(set-buffer (find-file-noselect d-file t))
(set-buffer diary-buffer)
(or (verify-visited-file-modtime diary-buffer)
(revert-buffer t t))))
- ;; AMI -- Figure out the file-glob-color
- (setq file-glob-color "")
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward "^#[ \t]*\\[color:\\([a-z]+\\)\\]$" (point-max) t)
- (setq file-glob-color (buffer-substring-no-properties
- (match-beginning 1)
- (match-end 1)))))
(setq selective-display t)
(setq selective-display-ellipses nil)
(setq old-diary-syntax-table (syntax-table))
(set-syntax-table diary-syntax-table)
--- 246,253 ----
***************
*** 334,349 ****
date
(buffer-substring
entry-start (point))
(buffer-substring
! (1+ date-start) (1- entry-start)) file-glob-color)))))
(setq d (cdr d)))
(or entry-found
(not diary-list-include-blanks)
(setq diary-entries-list
(append diary-entries-list
! ;; AMI -- added a fourth element to a diary-entries-list element
! (list (list date "" "" "")))))
(setq date
(calendar-gregorian-from-absolute
(1+ (calendar-absolute-from-gregorian date))))
(setq entry-found nil)))
--- 326,340 ----
date
(buffer-substring
entry-start (point))
(buffer-substring
! (1+ date-start) (1- entry-start)))))))
(setq d (cdr d)))
(or entry-found
(not diary-list-include-blanks)
(setq diary-entries-list
(append diary-entries-list
! (list (list date "" "")))))
(setq date
(calendar-gregorian-from-absolute
(1+ (calendar-absolute-from-gregorian date))))
(setq entry-found nil)))
***************
*** 518,548 ****
x)
date-holiday-list
(concat "\n" (make-string l ? ))))
(insert ?\n (make-string (+ l longest) ?=) ?\n)))))
! (setq entry (car (cdr (car entry-list))))
! (if (< 0 (length entry))
! (progn
! (insert entry ?\n)
! ;; AMI -- pick off the color that was the global file color for this entry when it was read in
! (setq file-glob-color (fourth (car entry-list)))
! ;; AMI - find color for this diary entry if one is present
! (setq color file-glob-color)
! (save-excursion
! (if (string-match "\\[color:\\([a-z]+\\)\\]$" entry)
! (setq color (substring-no-properties entry
! (match-beginning 1)
! (match-end 1))))
! (if (not (string= color ""))
! (progn
! (search-backward entry)
! (setq temp-face (make-symbol (concat "cal-col-face-" color)))
! (make-face temp-face)
! (set-face-foreground temp-face color)
! (overlay-put
! (make-overlay (match-beginning 0) (match-end 0)) 'face temp-face)))
! )))
! (setq entry-list (cdr entry-list))))
(set-buffer-modified-p nil)
(goto-char (point-min))
(setq buffer-read-only t)
(display-buffer fancy-diary-buffer)
--- 509,519 ----
x)
date-holiday-list
(concat "\n" (make-string l ? ))))
(insert ?\n (make-string (+ l longest) ?=) ?\n)))))
! (if (< 0 (length (car (cdr (car entry-list)))))
! (insert (car (cdr (car entry-list))) ?\n))
! (setq entry-list (cdr entry-list))))
(set-buffer-modified-p nil)
(goto-char (point-min))
(setq buffer-read-only t)
(display-buffer fancy-diary-buffer)
***************
*** 664,674 ****
0 1 * * * diary-rem.sh
to run it every morning at 1am."
(interactive "P")
(let* ((diary-display-hook 'fancy-diary-display)
! ; AMI
! ; Do this so that I have a chance to NOT include blanks in the email
! ; (diary-list-include-blanks t)
(text (progn (list-diary-entries (calendar-current-date)
(if ndays ndays diary-mail-days))
(set-buffer fancy-diary-buffer)
(buffer-substring (point-min) (point-max)))))
--- 635,643 ----
0 1 * * * diary-rem.sh
to run it every morning at 1am."
(interactive "P")
(let* ((diary-display-hook 'fancy-diary-display)
! (diary-list-include-blanks t)
(text (progn (list-diary-entries (calendar-current-date)
(if ndays ndays diary-mail-days))
(set-buffer fancy-diary-buffer)
(buffer-substring (point-min) (point-max)))))
***************
*** 719,734 ****
(if (file-readable-p d-file)
(save-excursion
(message "Marking diary entries...")
(set-buffer (find-file-noselect d-file t))
- ;; AMI - find global color for this file
- (setq file-glob-color "")
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward "^#[ \t]*\\[color:\\([a-z]+\\)\\]$" (point-max) t)
- (setq file-glob-color (buffer-substring-no-properties
- (match-beginning 1)
- (match-end 1)))))
(let ((d diary-date-forms)
(old-diary-syntax-table))
(setq old-diary-syntax-table (syntax-table))
(set-syntax-table diary-syntax-table)
--- 688,695 ----
***************
*** 805,827 ****
(if (> (- current-y y) 50)
(+ y 100)
y)))
(string-to-int y-str)))))
- ;; AMI - find color for this diary entry
- (setq color file-glob-color)
- (save-excursion
- (if (re-search-forward "\\[color:\\([a-z]+\\)\\]$" (line-end-position) t)
- (setq color (buffer-substring-no-properties
- (match-beginning 1)
- (match-end 1)))))
(if dd-name
(mark-calendar-days-named
(cdr (assoc-ignore-case
(substring dd-name 0 3)
(calendar-make-alist
calendar-day-name-array
0
! (lambda (x) (substring x 0 3))))) color)
(if mm-name
(if (string-equal mm-name "*")
(setq mm 0)
(setq mm
--- 766,781 ----
(if (> (- current-y y) 50)
(+ y 100)
y)))
(string-to-int y-str)))))
(if dd-name
(mark-calendar-days-named
(cdr (assoc-ignore-case
(substring dd-name 0 3)
(calendar-make-alist
calendar-day-name-array
0
! (lambda (x) (substring x 0 3))))))
(if mm-name
(if (string-equal mm-name "*")
(setq mm 0)
(setq mm
***************
*** 831,839 ****
calendar-month-name-array
1
(lambda (x) (substring x 0 3)))
)))))
! (mark-calendar-date-pattern mm dd yy color))))
(setq d (cdr d))))
(mark-sexp-diary-entries)
(run-hooks 'nongregorian-diary-marking-hook
'mark-diary-entries-hook)
--- 785,793 ----
calendar-month-name-array
1
(lambda (x) (substring x 0 3)))
)))))
! (mark-calendar-date-pattern mm dd yy))))
(setq d (cdr d))))
(mark-sexp-diary-entries)
(run-hooks 'nongregorian-diary-marking-hook
'mark-diary-entries-hook)
***************
*** 887,895 ****
(char-equal (preceding-char) ?\n))
(not (looking-at " \\|\^I")))
(progn;; Diary entry consists only of the sexp
(backward-char 1)
! (setq entry "" color nil))
(setq entry-start (point))
;; Find end of entry
(re-search-forward "\^M\\|\n" nil t)
(while (looking-at " \\|\^I")
--- 841,849 ----
(char-equal (preceding-char) ?\n))
(not (looking-at " \\|\^I")))
(progn;; Diary entry consists only of the sexp
(backward-char 1)
! (setq entry ""))
(setq entry-start (point))
;; Find end of entry
(re-search-forward "\^M\\|\n" nil t)
(while (looking-at " \\|\^I")
***************
*** 903,920 ****
(aset entry (match-beginning 0) ?\n )))
(calendar-for-loop date from first-date to last-date do
(if (diary-sexp-entry sexp entry
(calendar-gregorian-from-absolute date))
! ;; AMI - find color for this diary entry
! (progn
! (setq color "")
! (save-excursion
! (if (string-match "\\[color:\\([a-z]+\\)\\]$" entry)
! (setq color (substring-no-properties entry
! (match-beginning 1)
! (match-end 1)))))
! (mark-visible-calendar-date
! (calendar-gregorian-from-absolute date) color))))))))
(defun mark-included-diary-files ()
"Mark the diary entries from other diary files with those of the diary file.
This function is suitable for use as the `mark-diary-entries-hook'; it enables
--- 857,866 ----
(aset entry (match-beginning 0) ?\n )))
(calendar-for-loop date from first-date to last-date do
(if (diary-sexp-entry sexp entry
(calendar-gregorian-from-absolute date))
! (mark-visible-calendar-date
! (calendar-gregorian-from-absolute date))))))))
(defun mark-included-diary-files ()
"Mark the diary entries from other diary files with those of the diary file.
This function is suitable for use as the `mark-diary-entries-hook'; it enables
***************
*** 947,955 ****
(message "Can't find included diary file %s" diary-file)
(sleep-for 2))))
(goto-char (point-min)))
! (defun mark-calendar-days-named (dayname color)
"Mark all dates in the calendar window that are day DAYNAME of the week.
0 means all Sundays, 1 means all Mondays, and so on."
(save-excursion
(set-buffer calendar-buffer)
--- 893,901 ----
(message "Can't find included diary file %s" diary-file)
(sleep-for 2))))
(goto-char (point-min)))
! (defun mark-calendar-days-named (dayname)
"Mark all dates in the calendar window that are day DAYNAME of the week.
0 means all Sundays, 1 means all Mondays, and so on."
(save-excursion
(set-buffer calendar-buffer)
***************
*** 965,989 ****
(calendar-nth-named-day 1 dayname prev-month prev-year)))
(setq last-day (calendar-absolute-from-gregorian
(calendar-nth-named-day -1 dayname succ-month succ-year)))
(while (<= day last-day)
! (mark-visible-calendar-date (calendar-gregorian-from-absolute day) color)
(setq day (+ day 7))))))
! (defun mark-calendar-date-pattern (month day year color)
"Mark all dates in the calendar window that conform to MONTH/DAY/YEAR.
A value of 0 in any position is a wildcard."
(save-excursion
(set-buffer calendar-buffer)
(let ((m displayed-month)
(y displayed-year))
(increment-calendar-month m y -1)
(calendar-for-loop i from 0 to 2 do
! (mark-calendar-month m y month day year color)
(increment-calendar-month m y 1)))))
!
! (defun mark-calendar-month (month year p-month p-day p-year color)
"Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR.
A value of 0 in any position of the pattern is a wildcard."
(if (or (and (= month p-month)
(or (= p-year 0) (= year p-year)))
--- 911,934 ----
(calendar-nth-named-day 1 dayname prev-month prev-year)))
(setq last-day (calendar-absolute-from-gregorian
(calendar-nth-named-day -1 dayname succ-month succ-year)))
(while (<= day last-day)
! (mark-visible-calendar-date (calendar-gregorian-from-absolute day))
(setq day (+ day 7))))))
! (defun mark-calendar-date-pattern (month day year)
"Mark all dates in the calendar window that conform to MONTH/DAY/YEAR.
A value of 0 in any position is a wildcard."
(save-excursion
(set-buffer calendar-buffer)
(let ((m displayed-month)
(y displayed-year))
(increment-calendar-month m y -1)
(calendar-for-loop i from 0 to 2 do
! (mark-calendar-month m y month day year)
(increment-calendar-month m y 1)))))
! (defun mark-calendar-month (month year p-month p-day p-year)
"Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR.
A value of 0 in any position of the pattern is a wildcard."
(if (or (and (= month p-month)
(or (= p-year 0) (= year p-year)))
***************
*** 991,1000 ****
(or (= p-year 0) (= year p-year))))
(if (= p-day 0)
(calendar-for-loop
i from 1 to (calendar-last-day-of-month month year) do
! (mark-visible-calendar-date (list month i year) color))
! (mark-visible-calendar-date (list month p-day year) color))))
(defun sort-diary-entries ()
"Sort the list of diary entries by time of day."
(setq diary-entries-list (sort diary-entries-list 'diary-entry-compare)))
--- 936,945 ----
(or (= p-year 0) (= year p-year))))
(if (= p-day 0)
(calendar-for-loop
i from 1 to (calendar-last-day-of-month month year) do
! (mark-visible-calendar-date (list month i year)))
! (mark-visible-calendar-date (list month p-day year)))))
(defun sort-diary-entries ()
"Sort the list of diary entries by time of day."
(setq diary-entries-list (sort diary-entries-list 'diary-entry-compare)))
***************
*** 1205,1217 ****
(sexp-mark (regexp-quote sexp-diary-entry-symbol))
(s-entry (concat "\\(\\`\\|\^M\\|\n\\)" mark "?" sexp-mark "("))
(entry-found))
(goto-char (point-min))
- (save-excursion
- (if (re-search-forward "^#[ \t]*\\[color:\\([a-z]+\\)\\]$" (point-max) t)
- (setq file-glob-color (buffer-substring-no-properties
- (match-beginning 1)
- (match-end 1)))))
(while (re-search-forward s-entry nil t)
(backward-char 1)
(let ((sexp-start (point))
(sexp)
--- 1150,1157 ----
***************
*** 1243,1251 ****
(aset entry (match-beginning 0) ?\n )))
(let ((diary-entry (diary-sexp-entry sexp entry date)))
(if diary-entry
(subst-char-in-region line-start (point) ?\^M ?\n t))
! (add-to-diary-list date diary-entry specifier file-glob-color)
(setq entry-found (or entry-found diary-entry)))))
entry-found))
(defun diary-sexp-entry (sexp entry date)
--- 1183,1191 ----
(aset entry (match-beginning 0) ?\n )))
(let ((diary-entry (diary-sexp-entry sexp entry date)))
(if diary-entry
(subst-char-in-region line-start (point) ?\^M ?\n t))
! (add-to-diary-list date diary-entry specifier)
(setq entry-found (or entry-found diary-entry)))))
entry-found))
(defun diary-sexp-entry (sexp entry date)
***************
*** 1486,1499 ****
((and (listp days) days)
(or (diary-remind sexp (car days) marking)
(diary-remind sexp (cdr days) marking))))))
! (defun add-to-diary-list (date string specifier globcolor)
! "Add the entry (DATE STRING SPECIFIER GLOBCOLOR) to `diary-entries-list'.
Do nothing if DATE or STRING is nil."
(and date string
(setq diary-entries-list
! (append diary-entries-list (list (list date string specifier globcolor))))))
(defun make-diary-entry (string &optional nonmarking file)
"Insert a diary entry STRING which may be NONMARKING in FILE.
If omitted, NONMARKING defaults to nil and FILE defaults to diary-file."
--- 1426,1439 ----
((and (listp days) days)
(or (diary-remind sexp (car days) marking)
(diary-remind sexp (cdr days) marking))))))
! (defun add-to-diary-list (date string specifier)
! "Add the entry (DATE STRING SPECIFIER) to `diary-entries-list'.
Do nothing if DATE or STRING is nil."
(and date string
(setq diary-entries-list
! (append diary-entries-list (list (list date string specifier))))))
(defun make-diary-entry (string &optional nonmarking file)
"Insert a diary entry STRING which may be NONMARKING in FILE.
If omitted, NONMARKING defaults to nil and FILE defaults to diary-file."
[-- Attachment #4: Type: text/plain, Size: 142 bytes --]
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 24+ messages in thread* Re: specific coloring of diary calendar entries 2002-12-11 23:58 specific coloring of diary calendar entries Ami Fischman @ 2002-12-12 1:02 ` Alan Shutko 2002-12-12 18:24 ` Ami Fischman 2002-12-13 22:22 ` Richard Stallman 1 sibling, 1 reply; 24+ messages in thread From: Alan Shutko @ 2002-12-12 1:02 UTC (permalink / raw) Cc: emacs-devel Ami Fischman <usenet@fischman.org> writes: > Attached are two patches that make it possible to specify a color for a > diary entry in the entry itself. First, some general comments. Your diff is reversed. Next time, specify the files in the opposite order: old file first, new file next. Second, those files have changes a bit since the version you're looking at. You should update to the latest CVS and redo your changes against it. In particular, things have been changed to allow specification of colors for sexp diary entries (currently, only in the calendar display), and font-lock has been enabled. The way the sexp entry coloration works is that you specify a face in the sexp. This lets you specify not only foreground color, but also slants, under or overline, inverse video, background, etc. Personally, I think it would be better if your feature did things the same way. That way, you could apply all the faces you find for a day, not just the first. If the different faces don't specify the same attributes, the overlays will automatically combine them. You added arguments to a number of functions, but you didn't change other files that use them. (For example, both mark-calendar-days-named and add-to-diary-list are used in cal-hebrew and cal-islam.) Unless you absolutely have to, could you avoid making incompatible changes to the interface? Calendar has been around for quite a while, and it's quite possible someone else is depending on the behavior of the old functions. If you need to add a parameter, make it optional, and make sure the function works correctly if it's not passed. I don't think it's very helpful to have the file glob color in the diary-entries-list. Instead, I'd recommend putting the face that should be used for that entry. That way, appt.el won't have to reparse things to display the right color/face in its popups. So, that means I suggest you parse out the entry color when reading the entry, and remove that text before putting it into diary-entries-list. That way, without changes appt.el will work, and it can eventually be extended to use the colors. Also, the sexp entries can place _their_ face into the same place and get the same display. I'd disagree that sexps are necessarily less important than regular entries, btw. If you don't see your anniversary on the calendar because the color to pick your kid up after school overrode it, you're in for a heap of trouble.... I'm also not sure about the specific syntax in the diary file, but I'd leave that decision to Ed Reingold. (He's the maintainer of the Calendar, and since I'm not sure he reads emacs-devel, I'm going to forward your message to him after I send this one.) Thanks for your work. Coloring things in the fancy-diary-display was on my todo list, and I do see a need to color regular entries. -- Alan Shutko <ats@acm.org> - In a variety of flavors! My opinions may have changed, but not the fact that I am right. ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: specific coloring of diary calendar entries 2002-12-12 1:02 ` Alan Shutko @ 2002-12-12 18:24 ` Ami Fischman 2002-12-12 18:56 ` Ami Fischman ` (2 more replies) 0 siblings, 3 replies; 24+ messages in thread From: Ami Fischman @ 2002-12-12 18:24 UTC (permalink / raw) Cc: emacs-devel [-- Attachment #1: Type: text/plain, Size: 3147 bytes --] [missive contains replies to Alan Shutko, Ed Reingold; quotes are attributed by initials] Alan Shutko <ats@acm.org> writes: AS> First, some general comments. Your diff is reversed. Next time, Doh! Sorry :) AS> Second, those files have changes a bit since the version you're True. For some reason I was under the impression that the calendar mode was frozen for a long time. Not sure why I thought that. AS> specification of colors for sexp diary entries (currently, only in the AS> calendar display), and font-lock has been enabled. Perty! AS> The way the sexp entry coloration works is that you specify a face in AS> the sexp. This lets you specify not only foreground color, but also AS> slants, under or overline, inverse video, background, etc. Interesting. I don't like this approach, because it forces the user of calendar mode to define faces himself. I know that for me, at least, it is much more useful to just say "[color:green]" than to create a face dedicated to having a green fg. My new patches keep my approach (of just specifying a fg color), but still use the sexp face marking if it is specified by the user. AS> You added arguments to a number of functions, but you didn't change AS> other files that use them. Guilty as charged. Meant to make the args &optional, but apparently forgot. Fixed now. AS> I don't think it's very helpful to have the file glob color in the AS> diary-entries-list. Hmm. The reason I did it as I did, was that I wanted to keep a notion of which file an entry came from. I agree that re-parsing for the colors is silly, so made the change you suggest. AS> I'd disagree that sexps are necessarily less important than regular AS> entries, btw. If you don't see your anniversary on the calendar because AS> the color to pick your kid up after school overrode it, you're in for AS> a heap of trouble.... I disagree. An irritated spouse is much better than a kid stranded for 8 hours after school ;) I refer you to one of the early episodes of _Malcolm in the Middle_ for proof. However, even if I wanted to change this, I don't think it would be an easy change to make. sexp's get parsed for completely separately from non-sexp's, so it would require a priority system that I just don't think is worth it. Then Ed Reingold <reingold@emr.cs.iit.edu> wrote: ER> I like the idea, but the characters used to set off the colors (square ER> brackets and the colon) should be user-definable, just like the non-marking ER> symbol, sexp-expression symbol, etc. I often use square brackets and colons ER> in my diary entries! Good point. Added defcustoms for diary-color-regexp and diary-glob-file-color-regexp. One other feature I added (at the request of Kai Grossjohann) is the prefixing of diary entries with the filename from which they came. This is controlled by the defcustom diary-file-name-prefix which defaults to nil since I don't like it :) Please check out the attached patches (against current CVS, and in the right order this time :)) and let me know of any comments, suggestions, questions, or flames. Cheers, -- Ami Fischman usenet@fischman.org [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: col-cal.patch --] [-- Type: text/x-patch, Size: 3455 bytes --] *** /home/fischman/cvs/emacs/lisp/calendar/calendar.el 2002-12-07 13:30:57.000000000 -0800 --- calendar.el 2002-12-12 09:57:10.000000000 -0800 *************** *** 496,503 **** --- 496,520 ---- See the documentation for the function `include-other-diary-files'." :type 'string :group 'diary) + (defcustom diary-glob-file-color-regexp "^#[ \t]*\\[color:\\([a-z]+\\)\\]$" + "*The regular expression that picks off the global file color for + colored diary/calendar displays." + :type 'string + :group 'diary) + + (defcustom diary-color-regexp "\\[color:\\([a-z]+\\)\\]$" + "*The regular expression that picks off the entry's color for + colored diary/calendar displays." + :type 'string + :group 'diary) + + (defcustom diary-file-name-prefix nil + "If non-nil then each entry in the diary list will be prefixed with the name of the file in which it was defined." + :type 'boolean + :group 'diary) + ;;;###autoload (defcustom sexp-diary-entry-symbol "%%" "*The string used to indicate a sexp diary entry in `diary-file'. See the documentation for the function `list-sexp-diary-entries'." *************** *** 2552,2574 **** (= (extract-calendar-year date1) (extract-calendar-year date2)))) (defun mark-visible-calendar-date (date &optional mark) "Mark DATE in the calendar window with MARK. ! MARK is either a single-character string 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 mark diary-entry-marker))) ! (if (stringp mark) ! (let ((buffer-read-only nil)) ! (forward-char 1) ! (delete-char 1) ! (insert mark) ! (forward-char -2)) ! (overlay-put ! (make-overlay (1- (point)) (1+ (point))) 'face mark)))))) (defun calendar-star-date () "Replace the date under the cursor in the calendar window with asterisks. This function can be used with the `today-visible-calendar-hook' run after the --- 2569,2600 ---- (= (extract-calendar-year date1) (extract-calendar-year date2)))) (defun mark-visible-calendar-date (date &optional mark) "Mark DATE in the calendar window with MARK. ! MARK is a single-character string, an x-color-name string, 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) 0) mark) ! (and (not (stringp mark)) mark) ! diary-entry-marker))) ! (if (stringp mark) ! (if (= (length mark) 1) ! (let ((buffer-read-only nil)) ! (forward-char 1) ! (delete-char 1) ! (insert mark) ! (forward-char -2)) ! (progn ! (setq temp-face (make-symbol (concat "cal-col-face-" mark))) ! (make-face temp-face) ! (set-face-foreground temp-face mark) ! (overlay-put ! (make-overlay (1- (point)) (1+ (point))) 'face temp-face))) ! (overlay-put ! (make-overlay (1- (point)) (1+ (point))) 'face mark)))))) (defun calendar-star-date () "Replace the date under the cursor in the calendar window with asterisks. This function can be used with the `today-visible-calendar-hook' run after the [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: col-dia.patch --] [-- Type: text/x-patch, Size: 19946 bytes --] *** /home/fischman/cvs/emacs/lisp/calendar/diary-lib.el 2002-11-18 01:05:22.000000000 -0800 --- diary-lib.el 2002-12-12 09:58:25.000000000 -0800 *************** *** 232,239 **** --- 232,247 ---- (set-buffer (find-file-noselect d-file t)) (set-buffer diary-buffer) (or (verify-visited-file-modtime diary-buffer) (revert-buffer t t)))) + ;; AMI -- Figure out the file-glob-color + (setq file-glob-color "") + (save-excursion + (goto-char (point-min)) + (if (re-search-forward diary-glob-file-color-regexp (point-max) t) + (setq file-glob-color (buffer-substring-no-properties + (match-beginning 1) + (match-end 1))))) (setq selective-display t) (setq selective-display-ellipses nil) (setq old-diary-syntax-table (syntax-table)) (set-syntax-table diary-syntax-table) *************** *** 307,327 **** (re-search-forward "\^M\\|\n" nil t)) (backward-char 1) (subst-char-in-region date-start (point) ?\^M ?\n t) (add-to-diary-list date ! (buffer-substring ! entry-start (point)) (buffer-substring (1+ date-start) (1- entry-start)) ! (copy-marker entry-start)))))) (setq d (cdr d))) (or entry-found (not diary-list-include-blanks) (setq diary-entries-list (append diary-entries-list ! (list (list date "" ""))))) (setq date (calendar-gregorian-from-absolute (1+ (calendar-absolute-from-gregorian date)))) (setq entry-found nil))) --- 315,341 ---- (re-search-forward "\^M\\|\n" nil t)) (backward-char 1) (subst-char-in-region date-start (point) ?\^M ?\n t) + (setq color file-glob-color) + (setq entry (buffer-substring entry-start (point))) + (save-excursion + (if (string-match diary-color-regexp entry) + (setq color (substring-no-properties entry + (match-beginning 1) + (match-end 1))))) (add-to-diary-list date ! entry (buffer-substring (1+ date-start) (1- entry-start)) ! (copy-marker entry-start) color))))) (setq d (cdr d))) (or entry-found (not diary-list-include-blanks) (setq diary-entries-list (append diary-entries-list ! (list (list date "" "" "" ""))))) (setq date (calendar-gregorian-from-absolute (1+ (calendar-absolute-from-gregorian date)))) (setq entry-found nil))) *************** *** 512,526 **** x) date-holiday-list (concat "\n" (make-string l ? )))) (insert ?\n (make-string (+ l longest) ?=) ?\n))))) ! (if (< 0 (length (car (cdr (car entry-list))))) ! (if (nth 3 (car entry-list)) ! (insert-button (concat (car (cdr (car entry-list))) "\n") ! 'marker (nth 3 (car entry-list)) ! :type 'diary-entry) ! (insert (car (cdr (car entry-list))) ?\n))) ! (setq entry-list (cdr entry-list)))) (set-buffer-modified-p nil) (goto-char (point-min)) (setq buffer-read-only t) (display-buffer fancy-diary-buffer) --- 526,558 ---- x) date-holiday-list (concat "\n" (make-string l ? )))) (insert ?\n (make-string (+ l longest) ?=) ?\n))))) ! ! (setq entry (car (cdr (car entry-list)))) ! (if (< 0 (length entry)) ! (progn ! (if (nth 3 (car entry-list)) ! (insert-button (concat entry "\n") ! 'marker (nth 3 (car entry-list)) ! :type 'diary-entry) ! (insert entry ?\n)) ! ;; AMI -- pick off the color that was the global file ! ;; color for this entry when it was read in ! ; (setq file-glob-color (fifth (car entry-list))) ! ;; AMI - find color for this diary entry if one is present ! (setq color (fifth (car entry-list))) ! (save-excursion ! (if (not (string= color "")) ! (progn ! (search-backward entry) ! (setq temp-face (make-symbol (concat "cal-col-face-" color))) ! (make-face temp-face) ! (set-face-foreground temp-face color) ! (overlay-put ! (make-overlay (match-beginning 0) (match-end 0)) 'face temp-face))) ! ))) ! (setq entry-list (cdr entry-list)))) (set-buffer-modified-p nil) (goto-char (point-min)) (setq buffer-read-only t) (display-buffer fancy-diary-buffer) *************** *** 696,703 **** --- 728,743 ---- (if (file-readable-p d-file) (save-excursion (message "Marking diary entries...") (set-buffer (find-file-noselect d-file t)) + ;; AMI - find global color for this file + (setq file-glob-color "") + (save-excursion + (goto-char (point-min)) + (if (re-search-forward diary-glob-file-color-regexp (point-max) t) + (setq file-glob-color (buffer-substring-no-properties + (match-beginning 1) + (match-end 1))))) (let ((d diary-date-forms) (old-diary-syntax-table)) (setq old-diary-syntax-table (syntax-table)) (set-syntax-table diary-syntax-table) *************** *** 774,789 **** (if (> (- current-y y) 50) (+ y 100) y))) (string-to-int y-str))))) (if dd-name (mark-calendar-days-named (cdr (assoc-ignore-case (substring dd-name 0 3) (calendar-make-alist calendar-day-name-array 0 ! (lambda (x) (substring x 0 3)))))) (if mm-name (if (string-equal mm-name "*") (setq mm 0) (setq mm --- 814,836 ---- (if (> (- current-y y) 50) (+ y 100) y))) (string-to-int y-str))))) + ;; AMI - find color for this diary entry + (setq color file-glob-color) + (save-excursion + (if (re-search-forward diary-color-regexp (line-end-position) t) + (setq color (buffer-substring-no-properties + (match-beginning 1) + (match-end 1))))) (if dd-name (mark-calendar-days-named (cdr (assoc-ignore-case (substring dd-name 0 3) (calendar-make-alist calendar-day-name-array 0 ! (lambda (x) (substring x 0 3))))) color) (if mm-name (if (string-equal mm-name "*") (setq mm 0) (setq mm *************** *** 793,801 **** calendar-month-name-array 1 (lambda (x) (substring x 0 3))) ))))) ! (mark-calendar-date-pattern mm dd yy)))) (setq d (cdr d)))) (mark-sexp-diary-entries) (run-hooks 'nongregorian-diary-marking-hook 'mark-diary-entries-hook) --- 840,848 ---- calendar-month-name-array 1 (lambda (x) (substring x 0 3))) ))))) ! (mark-calendar-date-pattern mm dd yy color)))) (setq d (cdr d)))) (mark-sexp-diary-entries) (run-hooks 'nongregorian-diary-marking-hook 'mark-diary-entries-hook) *************** *** 850,858 **** (char-equal (preceding-char) ?\n)) (not (looking-at " \\|\^I"))) (progn;; Diary entry consists only of the sexp (backward-char 1) ! (setq entry "")) (setq entry-start (point)) ;; Find end of entry (re-search-forward "\^M\\|\n" nil t) (while (looking-at " \\|\^I") --- 897,905 ---- (char-equal (preceding-char) ?\n)) (not (looking-at " \\|\^I"))) (progn;; Diary entry consists only of the sexp (backward-char 1) ! (setq entry "" color nil)) (setq entry-start (point)) ;; Find end of entry (re-search-forward "\^M\\|\n" nil t) (while (looking-at " \\|\^I") *************** *** 866,877 **** (aset entry (match-beginning 0) ?\n ))) (calendar-for-loop date from first-date to last-date do (if (setq mark (diary-sexp-entry sexp entry (calendar-gregorian-from-absolute date))) ! (mark-visible-calendar-date ! (calendar-gregorian-from-absolute date) ! (if (consp mark) ! (car mark))))))))) (defun mark-included-diary-files () "Mark the diary entries from other diary files with those of the diary file. This function is suitable for use as the `mark-diary-entries-hook'; it enables --- 913,934 ---- (aset entry (match-beginning 0) ?\n ))) (calendar-for-loop date from first-date to last-date do (if (setq mark (diary-sexp-entry sexp entry (calendar-gregorian-from-absolute date))) ! ;; AMI - find color for this diary entry ! (progn ! (setq color "") ! (save-excursion ! (if (string-match diary-color-regexp entry) ! (setq color (substring-no-properties entry ! (match-beginning 1) ! (match-end 1))))) ! (mark-visible-calendar-date ! (calendar-gregorian-from-absolute date) ! (if (< 0 (length color)) ! color ! (if (consp mark) ! (car mark))))))))))) (defun mark-included-diary-files () "Mark the diary entries from other diary files with those of the diary file. This function is suitable for use as the `mark-diary-entries-hook'; it enables *************** *** 904,912 **** (message "Can't find included diary file %s" diary-file) (sleep-for 2)))) (goto-char (point-min))) ! (defun mark-calendar-days-named (dayname) "Mark all dates in the calendar window that are day DAYNAME of the week. 0 means all Sundays, 1 means all Mondays, and so on." (save-excursion (set-buffer calendar-buffer) --- 961,969 ---- (message "Can't find included diary file %s" diary-file) (sleep-for 2)))) (goto-char (point-min))) ! (defun mark-calendar-days-named (dayname &optional color) "Mark all dates in the calendar window that are day DAYNAME of the week. 0 means all Sundays, 1 means all Mondays, and so on." (save-excursion (set-buffer calendar-buffer) *************** *** 922,945 **** (calendar-nth-named-day 1 dayname prev-month prev-year))) (setq last-day (calendar-absolute-from-gregorian (calendar-nth-named-day -1 dayname succ-month succ-year))) (while (<= day last-day) ! (mark-visible-calendar-date (calendar-gregorian-from-absolute day)) (setq day (+ day 7)))))) ! (defun mark-calendar-date-pattern (month day year) "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR. A value of 0 in any position is a wildcard." (save-excursion (set-buffer calendar-buffer) (let ((m displayed-month) (y displayed-year)) (increment-calendar-month m y -1) (calendar-for-loop i from 0 to 2 do ! (mark-calendar-month m y month day year) (increment-calendar-month m y 1))))) ! (defun mark-calendar-month (month year p-month p-day p-year) "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR. A value of 0 in any position of the pattern is a wildcard." (if (or (and (= month p-month) (or (= p-year 0) (= year p-year))) --- 979,1002 ---- (calendar-nth-named-day 1 dayname prev-month prev-year))) (setq last-day (calendar-absolute-from-gregorian (calendar-nth-named-day -1 dayname succ-month succ-year))) (while (<= day last-day) ! (mark-visible-calendar-date (calendar-gregorian-from-absolute day) color) (setq day (+ day 7)))))) ! (defun mark-calendar-date-pattern (month day year &optional color) "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR. A value of 0 in any position is a wildcard." (save-excursion (set-buffer calendar-buffer) (let ((m displayed-month) (y displayed-year)) (increment-calendar-month m y -1) (calendar-for-loop i from 0 to 2 do ! (mark-calendar-month m y month day year color) (increment-calendar-month m y 1))))) ! (defun mark-calendar-month (month year p-month p-day p-year &optional color) "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR. A value of 0 in any position of the pattern is a wildcard." (if (or (and (= month p-month) (or (= p-year 0) (= year p-year))) *************** *** 947,956 **** (or (= p-year 0) (= year p-year)))) (if (= p-day 0) (calendar-for-loop i from 1 to (calendar-last-day-of-month month year) do ! (mark-visible-calendar-date (list month i year))) ! (mark-visible-calendar-date (list month p-day year))))) (defun sort-diary-entries () "Sort the list of diary entries by time of day." (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare))) --- 1004,1013 ---- (or (= p-year 0) (= year p-year)))) (if (= p-day 0) (calendar-for-loop i from 1 to (calendar-last-day-of-month month year) do ! (mark-visible-calendar-date (list month i year) color)) ! (mark-visible-calendar-date (list month p-day year) color)))) (defun sort-diary-entries () "Sort the list of diary entries by time of day." (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare))) *************** *** 1171,1178 **** --- 1228,1240 ---- (sexp-mark (regexp-quote sexp-diary-entry-symbol)) (s-entry (concat "\\(\\`\\|\^M\\|\n\\)" mark "?" sexp-mark "(")) (entry-found)) (goto-char (point-min)) + (save-excursion + (if (re-search-forward diary-glob-file-color-regexp (point-max) t) + (setq file-glob-color (buffer-substring-no-properties + (match-beginning 1) + (match-end 1))))) (while (re-search-forward s-entry nil t) (backward-char 1) (let ((sexp-start (point)) (sexp) *************** *** 1203,1219 **** (setq entry (buffer-substring-no-properties entry-start (point))) (while (string-match "[\^M]" entry) (aset entry (match-beginning 0) ?\n ))) (let ((diary-entry (diary-sexp-entry sexp entry date))) (if diary-entry ! (subst-char-in-region line-start (point) ?\^M ?\n t)) ! (add-to-diary-list date ! (if (consp diary-entry) ! (cdr diary-entry) ! diary-entry) specifier (if entry-start (copy-marker entry-start) ! nil)) (setq entry-found (or entry-found diary-entry))))) entry-found)) (defun diary-sexp-entry (sexp entry date) --- 1265,1291 ---- (setq entry (buffer-substring-no-properties entry-start (point))) (while (string-match "[\^M]" entry) (aset entry (match-beginning 0) ?\n ))) (let ((diary-entry (diary-sexp-entry sexp entry date))) + (setq entry (if (consp diary-entry) + (cdr diary-entry) + diary-entry)) (if diary-entry ! (progn ! (subst-char-in-region line-start (point) ?\^M ?\n t) ! (setq color file-glob-color) ! (if (< 0 (length entry)) ! (save-excursion ! (if (string-match diary-color-regexp entry) ! (setq color (substring-no-properties entry ! (match-beginning 1) ! (match-end 1)))))))) ! (add-to-diary-list date ! entry specifier (if entry-start (copy-marker entry-start) ! nil) ! color) (setq entry-found (or entry-found diary-entry))))) entry-found)) (defun diary-sexp-entry (sexp entry date) *************** *** 1469,1483 **** ((and (listp days) days) (or (diary-remind sexp (car days) marking) (diary-remind sexp (cdr days) marking)))))) ! (defun add-to-diary-list (date string specifier marker) ! "Add the entry (DATE STRING SPECIFIER) to `diary-entries-list'. Do nothing if DATE or STRING is nil." (and date string (setq diary-entries-list (append diary-entries-list ! (list (list date string specifier marker)))))) (defun make-diary-entry (string &optional nonmarking file) "Insert a diary entry STRING which may be NONMARKING in FILE. If omitted, NONMARKING defaults to nil and FILE defaults to diary-file." --- 1541,1558 ---- ((and (listp days) days) (or (diary-remind sexp (car days) marking) (diary-remind sexp (cdr days) marking)))))) ! (defun add-to-diary-list (date string specifier marker &optional globcolor) ! "Add the entry (DATE STRING SPECIFIER MARKER GLOBCOLOR) to `diary-entries-list'. Do nothing if DATE or STRING is nil." (and date string + (if diary-file-name-prefix + (setq string (concat "[" (buffer-file-name) "] " string)) + t) (setq diary-entries-list (append diary-entries-list ! (list (list date string specifier marker globcolor)))))) (defun make-diary-entry (string &optional nonmarking file) "Insert a diary entry STRING which may be NONMARKING in FILE. If omitted, NONMARKING defaults to nil and FILE defaults to diary-file." [-- Attachment #4: Type: text/plain, Size: 142 bytes --] _______________________________________________ Emacs-devel mailing list Emacs-devel@gnu.org http://mail.gnu.org/mailman/listinfo/emacs-devel ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: specific coloring of diary calendar entries 2002-12-12 18:24 ` Ami Fischman @ 2002-12-12 18:56 ` Ami Fischman 2002-12-12 19:31 ` Alan Shutko 2002-12-14 1:05 ` Alan Shutko 2 siblings, 0 replies; 24+ messages in thread From: Ami Fischman @ 2002-12-12 18:56 UTC (permalink / raw) [-- Attachment #1: Type: text/plain, Size: 713 bytes --] I made one more change to the file-name-prefixing of diary entries using a defcustom to define a "transformation function." I now have in my .emacs: (setq diary-file-name-prefix-function (function (lambda (str) (replace-in-string str (substitute-in-file-name "$HOME/.diary\.?") ""))) (setq diary-file-name-prefix t) and with the patch below, this yields no prefix for entries from ~/.diary, and a "[birthdays] " prefix for entries from my ~/.diary.birthdays file. The default for diary-file-name-prefix is still nil, since if a person doesn't know enough to define diary-file-name-prefix-function, s/he probably doesn't want the prefixes in the first place. Cheers, -- Ami Fischman usenet@fischman.org [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: col-cal.patch --] [-- Type: text/x-patch, Size: 3952 bytes --] *** /home/fischman/cvs/emacs/lisp/calendar/calendar.el 2002-12-07 13:30:57.000000000 -0800 --- calendar.el 2002-12-12 10:40:24.000000000 -0800 *************** *** 309,316 **** --- 309,321 ---- calendar." :type 'boolean :group 'holidays) + (defcustom diary-file-name-prefix-function (function (lambda (str) str)) + "*The function that will take a diary file name and return the desired prefix." + :type 'string + :group 'diary) + ;;;###autoload (defcustom calendar-load-hook nil "*List of functions to be called after the calendar is first loaded. This is the place to add key bindings to `calendar-mode-map'." *************** *** 496,503 **** --- 501,525 ---- See the documentation for the function `include-other-diary-files'." :type 'string :group 'diary) + (defcustom diary-glob-file-color-regexp "^#[ \t]*\\[color:\\([a-z]+\\)\\]$" + "*The regular expression that picks off the global file color for + colored diary/calendar displays." + :type 'string + :group 'diary) + + (defcustom diary-color-regexp "\\[color:\\([a-z]+\\)\\]$" + "*The regular expression that picks off the entry's color for + colored diary/calendar displays." + :type 'string + :group 'diary) + + (defcustom diary-file-name-prefix nil + "If non-nil then each entry in the diary list will be prefixed with the name of the file in which it was defined." + :type 'boolean + :group 'diary) + ;;;###autoload (defcustom sexp-diary-entry-symbol "%%" "*The string used to indicate a sexp diary entry in `diary-file'. See the documentation for the function `list-sexp-diary-entries'." *************** *** 2552,2574 **** (= (extract-calendar-year date1) (extract-calendar-year date2)))) (defun mark-visible-calendar-date (date &optional mark) "Mark DATE in the calendar window with MARK. ! MARK is either a single-character string 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 mark diary-entry-marker))) ! (if (stringp mark) ! (let ((buffer-read-only nil)) ! (forward-char 1) ! (delete-char 1) ! (insert mark) ! (forward-char -2)) ! (overlay-put ! (make-overlay (1- (point)) (1+ (point))) 'face mark)))))) (defun calendar-star-date () "Replace the date under the cursor in the calendar window with asterisks. This function can be used with the `today-visible-calendar-hook' run after the --- 2574,2605 ---- (= (extract-calendar-year date1) (extract-calendar-year date2)))) (defun mark-visible-calendar-date (date &optional mark) "Mark DATE in the calendar window with MARK. ! MARK is a single-character string, an x-color-name string, 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) 0) mark) ! (and (not (stringp mark)) mark) ! diary-entry-marker))) ! (if (stringp mark) ! (if (= (length mark) 1) ! (let ((buffer-read-only nil)) ! (forward-char 1) ! (delete-char 1) ! (insert mark) ! (forward-char -2)) ! (progn ! (setq temp-face (make-symbol (concat "cal-col-face-" mark))) ! (make-face temp-face) ! (set-face-foreground temp-face mark) ! (overlay-put ! (make-overlay (1- (point)) (1+ (point))) 'face temp-face))) ! (overlay-put ! (make-overlay (1- (point)) (1+ (point))) 'face mark)))))) (defun calendar-star-date () "Replace the date under the cursor in the calendar window with asterisks. This function can be used with the `today-visible-calendar-hook' run after the [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: col-dia.patch --] [-- Type: text/x-patch, Size: 20061 bytes --] *** /home/fischman/cvs/emacs/lisp/calendar/diary-lib.el 2002-11-18 01:05:22.000000000 -0800 --- diary-lib.el 2002-12-12 10:43:03.000000000 -0800 *************** *** 232,239 **** --- 232,247 ---- (set-buffer (find-file-noselect d-file t)) (set-buffer diary-buffer) (or (verify-visited-file-modtime diary-buffer) (revert-buffer t t)))) + ;; AMI -- Figure out the file-glob-color + (setq file-glob-color "") + (save-excursion + (goto-char (point-min)) + (if (re-search-forward diary-glob-file-color-regexp (point-max) t) + (setq file-glob-color (buffer-substring-no-properties + (match-beginning 1) + (match-end 1))))) (setq selective-display t) (setq selective-display-ellipses nil) (setq old-diary-syntax-table (syntax-table)) (set-syntax-table diary-syntax-table) *************** *** 307,327 **** (re-search-forward "\^M\\|\n" nil t)) (backward-char 1) (subst-char-in-region date-start (point) ?\^M ?\n t) (add-to-diary-list date ! (buffer-substring ! entry-start (point)) (buffer-substring (1+ date-start) (1- entry-start)) ! (copy-marker entry-start)))))) (setq d (cdr d))) (or entry-found (not diary-list-include-blanks) (setq diary-entries-list (append diary-entries-list ! (list (list date "" ""))))) (setq date (calendar-gregorian-from-absolute (1+ (calendar-absolute-from-gregorian date)))) (setq entry-found nil))) --- 315,341 ---- (re-search-forward "\^M\\|\n" nil t)) (backward-char 1) (subst-char-in-region date-start (point) ?\^M ?\n t) + (setq color file-glob-color) + (setq entry (buffer-substring entry-start (point))) + (save-excursion + (if (string-match diary-color-regexp entry) + (setq color (substring-no-properties entry + (match-beginning 1) + (match-end 1))))) (add-to-diary-list date ! entry (buffer-substring (1+ date-start) (1- entry-start)) ! (copy-marker entry-start) color))))) (setq d (cdr d))) (or entry-found (not diary-list-include-blanks) (setq diary-entries-list (append diary-entries-list ! (list (list date "" "" "" ""))))) (setq date (calendar-gregorian-from-absolute (1+ (calendar-absolute-from-gregorian date)))) (setq entry-found nil))) *************** *** 512,526 **** x) date-holiday-list (concat "\n" (make-string l ? )))) (insert ?\n (make-string (+ l longest) ?=) ?\n))))) ! (if (< 0 (length (car (cdr (car entry-list))))) ! (if (nth 3 (car entry-list)) ! (insert-button (concat (car (cdr (car entry-list))) "\n") ! 'marker (nth 3 (car entry-list)) ! :type 'diary-entry) ! (insert (car (cdr (car entry-list))) ?\n))) ! (setq entry-list (cdr entry-list)))) (set-buffer-modified-p nil) (goto-char (point-min)) (setq buffer-read-only t) (display-buffer fancy-diary-buffer) --- 526,558 ---- x) date-holiday-list (concat "\n" (make-string l ? )))) (insert ?\n (make-string (+ l longest) ?=) ?\n))))) ! ! (setq entry (car (cdr (car entry-list)))) ! (if (< 0 (length entry)) ! (progn ! (if (nth 3 (car entry-list)) ! (insert-button (concat entry "\n") ! 'marker (nth 3 (car entry-list)) ! :type 'diary-entry) ! (insert entry ?\n)) ! ;; AMI -- pick off the color that was the global file ! ;; color for this entry when it was read in ! ; (setq file-glob-color (fifth (car entry-list))) ! ;; AMI - find color for this diary entry if one is present ! (setq color (fifth (car entry-list))) ! (save-excursion ! (if (not (string= color "")) ! (progn ! (search-backward entry) ! (setq temp-face (make-symbol (concat "cal-col-face-" color))) ! (make-face temp-face) ! (set-face-foreground temp-face color) ! (overlay-put ! (make-overlay (match-beginning 0) (match-end 0)) 'face temp-face))) ! ))) ! (setq entry-list (cdr entry-list)))) (set-buffer-modified-p nil) (goto-char (point-min)) (setq buffer-read-only t) (display-buffer fancy-diary-buffer) *************** *** 696,703 **** --- 728,743 ---- (if (file-readable-p d-file) (save-excursion (message "Marking diary entries...") (set-buffer (find-file-noselect d-file t)) + ;; AMI - find global color for this file + (setq file-glob-color "") + (save-excursion + (goto-char (point-min)) + (if (re-search-forward diary-glob-file-color-regexp (point-max) t) + (setq file-glob-color (buffer-substring-no-properties + (match-beginning 1) + (match-end 1))))) (let ((d diary-date-forms) (old-diary-syntax-table)) (setq old-diary-syntax-table (syntax-table)) (set-syntax-table diary-syntax-table) *************** *** 774,789 **** (if (> (- current-y y) 50) (+ y 100) y))) (string-to-int y-str))))) (if dd-name (mark-calendar-days-named (cdr (assoc-ignore-case (substring dd-name 0 3) (calendar-make-alist calendar-day-name-array 0 ! (lambda (x) (substring x 0 3)))))) (if mm-name (if (string-equal mm-name "*") (setq mm 0) (setq mm --- 814,836 ---- (if (> (- current-y y) 50) (+ y 100) y))) (string-to-int y-str))))) + ;; AMI - find color for this diary entry + (setq color file-glob-color) + (save-excursion + (if (re-search-forward diary-color-regexp (line-end-position) t) + (setq color (buffer-substring-no-properties + (match-beginning 1) + (match-end 1))))) (if dd-name (mark-calendar-days-named (cdr (assoc-ignore-case (substring dd-name 0 3) (calendar-make-alist calendar-day-name-array 0 ! (lambda (x) (substring x 0 3))))) color) (if mm-name (if (string-equal mm-name "*") (setq mm 0) (setq mm *************** *** 793,801 **** calendar-month-name-array 1 (lambda (x) (substring x 0 3))) ))))) ! (mark-calendar-date-pattern mm dd yy)))) (setq d (cdr d)))) (mark-sexp-diary-entries) (run-hooks 'nongregorian-diary-marking-hook 'mark-diary-entries-hook) --- 840,848 ---- calendar-month-name-array 1 (lambda (x) (substring x 0 3))) ))))) ! (mark-calendar-date-pattern mm dd yy color)))) (setq d (cdr d)))) (mark-sexp-diary-entries) (run-hooks 'nongregorian-diary-marking-hook 'mark-diary-entries-hook) *************** *** 850,858 **** (char-equal (preceding-char) ?\n)) (not (looking-at " \\|\^I"))) (progn;; Diary entry consists only of the sexp (backward-char 1) ! (setq entry "")) (setq entry-start (point)) ;; Find end of entry (re-search-forward "\^M\\|\n" nil t) (while (looking-at " \\|\^I") --- 897,905 ---- (char-equal (preceding-char) ?\n)) (not (looking-at " \\|\^I"))) (progn;; Diary entry consists only of the sexp (backward-char 1) ! (setq entry "" color nil)) (setq entry-start (point)) ;; Find end of entry (re-search-forward "\^M\\|\n" nil t) (while (looking-at " \\|\^I") *************** *** 866,877 **** (aset entry (match-beginning 0) ?\n ))) (calendar-for-loop date from first-date to last-date do (if (setq mark (diary-sexp-entry sexp entry (calendar-gregorian-from-absolute date))) ! (mark-visible-calendar-date ! (calendar-gregorian-from-absolute date) ! (if (consp mark) ! (car mark))))))))) (defun mark-included-diary-files () "Mark the diary entries from other diary files with those of the diary file. This function is suitable for use as the `mark-diary-entries-hook'; it enables --- 913,934 ---- (aset entry (match-beginning 0) ?\n ))) (calendar-for-loop date from first-date to last-date do (if (setq mark (diary-sexp-entry sexp entry (calendar-gregorian-from-absolute date))) ! ;; AMI - find color for this diary entry ! (progn ! (setq color "") ! (save-excursion ! (if (string-match diary-color-regexp entry) ! (setq color (substring-no-properties entry ! (match-beginning 1) ! (match-end 1))))) ! (mark-visible-calendar-date ! (calendar-gregorian-from-absolute date) ! (if (< 0 (length color)) ! color ! (if (consp mark) ! (car mark))))))))))) (defun mark-included-diary-files () "Mark the diary entries from other diary files with those of the diary file. This function is suitable for use as the `mark-diary-entries-hook'; it enables *************** *** 904,912 **** (message "Can't find included diary file %s" diary-file) (sleep-for 2)))) (goto-char (point-min))) ! (defun mark-calendar-days-named (dayname) "Mark all dates in the calendar window that are day DAYNAME of the week. 0 means all Sundays, 1 means all Mondays, and so on." (save-excursion (set-buffer calendar-buffer) --- 961,969 ---- (message "Can't find included diary file %s" diary-file) (sleep-for 2)))) (goto-char (point-min))) ! (defun mark-calendar-days-named (dayname &optional color) "Mark all dates in the calendar window that are day DAYNAME of the week. 0 means all Sundays, 1 means all Mondays, and so on." (save-excursion (set-buffer calendar-buffer) *************** *** 922,945 **** (calendar-nth-named-day 1 dayname prev-month prev-year))) (setq last-day (calendar-absolute-from-gregorian (calendar-nth-named-day -1 dayname succ-month succ-year))) (while (<= day last-day) ! (mark-visible-calendar-date (calendar-gregorian-from-absolute day)) (setq day (+ day 7)))))) ! (defun mark-calendar-date-pattern (month day year) "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR. A value of 0 in any position is a wildcard." (save-excursion (set-buffer calendar-buffer) (let ((m displayed-month) (y displayed-year)) (increment-calendar-month m y -1) (calendar-for-loop i from 0 to 2 do ! (mark-calendar-month m y month day year) (increment-calendar-month m y 1))))) ! (defun mark-calendar-month (month year p-month p-day p-year) "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR. A value of 0 in any position of the pattern is a wildcard." (if (or (and (= month p-month) (or (= p-year 0) (= year p-year))) --- 979,1002 ---- (calendar-nth-named-day 1 dayname prev-month prev-year))) (setq last-day (calendar-absolute-from-gregorian (calendar-nth-named-day -1 dayname succ-month succ-year))) (while (<= day last-day) ! (mark-visible-calendar-date (calendar-gregorian-from-absolute day) color) (setq day (+ day 7)))))) ! (defun mark-calendar-date-pattern (month day year &optional color) "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR. A value of 0 in any position is a wildcard." (save-excursion (set-buffer calendar-buffer) (let ((m displayed-month) (y displayed-year)) (increment-calendar-month m y -1) (calendar-for-loop i from 0 to 2 do ! (mark-calendar-month m y month day year color) (increment-calendar-month m y 1))))) ! (defun mark-calendar-month (month year p-month p-day p-year &optional color) "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR. A value of 0 in any position of the pattern is a wildcard." (if (or (and (= month p-month) (or (= p-year 0) (= year p-year))) *************** *** 947,956 **** (or (= p-year 0) (= year p-year)))) (if (= p-day 0) (calendar-for-loop i from 1 to (calendar-last-day-of-month month year) do ! (mark-visible-calendar-date (list month i year))) ! (mark-visible-calendar-date (list month p-day year))))) (defun sort-diary-entries () "Sort the list of diary entries by time of day." (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare))) --- 1004,1013 ---- (or (= p-year 0) (= year p-year)))) (if (= p-day 0) (calendar-for-loop i from 1 to (calendar-last-day-of-month month year) do ! (mark-visible-calendar-date (list month i year) color)) ! (mark-visible-calendar-date (list month p-day year) color)))) (defun sort-diary-entries () "Sort the list of diary entries by time of day." (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare))) *************** *** 1171,1178 **** --- 1228,1240 ---- (sexp-mark (regexp-quote sexp-diary-entry-symbol)) (s-entry (concat "\\(\\`\\|\^M\\|\n\\)" mark "?" sexp-mark "(")) (entry-found)) (goto-char (point-min)) + (save-excursion + (if (re-search-forward diary-glob-file-color-regexp (point-max) t) + (setq file-glob-color (buffer-substring-no-properties + (match-beginning 1) + (match-end 1))))) (while (re-search-forward s-entry nil t) (backward-char 1) (let ((sexp-start (point)) (sexp) *************** *** 1203,1219 **** (setq entry (buffer-substring-no-properties entry-start (point))) (while (string-match "[\^M]" entry) (aset entry (match-beginning 0) ?\n ))) (let ((diary-entry (diary-sexp-entry sexp entry date))) (if diary-entry ! (subst-char-in-region line-start (point) ?\^M ?\n t)) ! (add-to-diary-list date ! (if (consp diary-entry) ! (cdr diary-entry) ! diary-entry) specifier (if entry-start (copy-marker entry-start) ! nil)) (setq entry-found (or entry-found diary-entry))))) entry-found)) (defun diary-sexp-entry (sexp entry date) --- 1265,1291 ---- (setq entry (buffer-substring-no-properties entry-start (point))) (while (string-match "[\^M]" entry) (aset entry (match-beginning 0) ?\n ))) (let ((diary-entry (diary-sexp-entry sexp entry date))) + (setq entry (if (consp diary-entry) + (cdr diary-entry) + diary-entry)) (if diary-entry ! (progn ! (subst-char-in-region line-start (point) ?\^M ?\n t) ! (setq color file-glob-color) ! (if (< 0 (length entry)) ! (save-excursion ! (if (string-match diary-color-regexp entry) ! (setq color (substring-no-properties entry ! (match-beginning 1) ! (match-end 1)))))))) ! (add-to-diary-list date ! entry specifier (if entry-start (copy-marker entry-start) ! nil) ! color) (setq entry-found (or entry-found diary-entry))))) entry-found)) (defun diary-sexp-entry (sexp entry date) *************** *** 1469,1483 **** ((and (listp days) days) (or (diary-remind sexp (car days) marking) (diary-remind sexp (cdr days) marking)))))) ! (defun add-to-diary-list (date string specifier marker) ! "Add the entry (DATE STRING SPECIFIER) to `diary-entries-list'. Do nothing if DATE or STRING is nil." (and date string (setq diary-entries-list (append diary-entries-list ! (list (list date string specifier marker)))))) (defun make-diary-entry (string &optional nonmarking file) "Insert a diary entry STRING which may be NONMARKING in FILE. If omitted, NONMARKING defaults to nil and FILE defaults to diary-file." --- 1541,1560 ---- ((and (listp days) days) (or (diary-remind sexp (car days) marking) (diary-remind sexp (cdr days) marking)))))) ! (defun add-to-diary-list (date string specifier marker &optional globcolor) ! "Add the entry (DATE STRING SPECIFIER MARKER GLOBCOLOR) to `diary-entries-list'. Do nothing if DATE or STRING is nil." (and date string + (if (and diary-file-name-prefix + (setq prefix (concat "[" (funcall diary-file-name-prefix-function (buffer-file-name)) "] ")) + (not (string= prefix "[] "))) + (setq string (concat prefix string)) + t) (setq diary-entries-list (append diary-entries-list ! (list (list date string specifier marker globcolor)))))) (defun make-diary-entry (string &optional nonmarking file) "Insert a diary entry STRING which may be NONMARKING in FILE. If omitted, NONMARKING defaults to nil and FILE defaults to diary-file." [-- Attachment #4: Type: text/plain, Size: 142 bytes --] _______________________________________________ Emacs-devel mailing list Emacs-devel@gnu.org http://mail.gnu.org/mailman/listinfo/emacs-devel ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: specific coloring of diary calendar entries 2002-12-12 18:24 ` Ami Fischman 2002-12-12 18:56 ` Ami Fischman @ 2002-12-12 19:31 ` Alan Shutko 2002-12-13 10:14 ` Kai Großjohann 2002-12-14 1:05 ` Alan Shutko 2 siblings, 1 reply; 24+ messages in thread From: Alan Shutko @ 2002-12-12 19:31 UTC (permalink / raw) Cc: emacs-devel Ami Fischman <usenet@fischman.org> writes: > One other feature I added (at the request of Kai Grossjohann) is the > prefixing of diary entries with the filename from which they came. I'll look at the rest later tonight, but I wonder why Kai wanted the prefixing. If you just want to know where the entry came from, you can middle-click on the entry. 8^) -- Alan Shutko <ats@acm.org> - In a variety of flavors! Princess of Sorrow, Wilderness Angel--Jim Morrison ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: specific coloring of diary calendar entries 2002-12-12 19:31 ` Alan Shutko @ 2002-12-13 10:14 ` Kai Großjohann 0 siblings, 0 replies; 24+ messages in thread From: Kai Großjohann @ 2002-12-13 10:14 UTC (permalink / raw) Alan Shutko <ats@acm.org> writes: > I'll look at the rest later tonight, but I wonder why Kai wanted the > prefixing. If you just want to know where the entry came from, you > can middle-click on the entry. 8^) I like to have the overview. It's like doing `30 d' to show the diary entries of the next month. Sure you can do `1 d' on 30 different days, but the overview is not as nice. -- ~/.signature is: umop ap!sdn (Frank Nobis) ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: specific coloring of diary calendar entries 2002-12-12 18:24 ` Ami Fischman 2002-12-12 18:56 ` Ami Fischman 2002-12-12 19:31 ` Alan Shutko @ 2002-12-14 1:05 ` Alan Shutko 2002-12-14 1:42 ` Miles Bader 2 siblings, 1 reply; 24+ messages in thread From: Alan Shutko @ 2002-12-14 1:05 UTC (permalink / raw) Cc: emacs-devel Ami Fischman <usenet@fischman.org> writes: > True. For some reason I was under the impression that the calendar mode > was frozen for a long time. Not sure why I thought that. Well, it was... just had gotten changed recently. > I know that for me, at least, it is much more useful to just say > "[color:green]" than to create a face dedicated to having a green > fg. Ok. Maybe you should use "fgcolor" in case someone wants to specify a bgcolor sometime? > I disagree. An irritated spouse is much better than a kid stranded for > 8 hours after school ;) I refer you to one of the early episodes of > _Malcolm in the Middle_ for proof. Actually, leaving the _Malcolm_ kids in school for 8 hours is probably a good thing.... > + (defcustom diary-glob-file-color-regexp "^#[ \t]*\\[color:\\([a-z]+\\)\\]$" > + "*The regular expression that picks off the global file color for > + colored diary/calendar displays." > + :type 'string > + :group 'diary) These should probably be :type regexp. Other than that, I think things look good to me. -- Alan Shutko <ats@acm.org> - In a variety of flavors! Crystal Gravy - Now you can SEE your meat. ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: specific coloring of diary calendar entries 2002-12-14 1:05 ` Alan Shutko @ 2002-12-14 1:42 ` Miles Bader 0 siblings, 0 replies; 24+ messages in thread From: Miles Bader @ 2002-12-14 1:42 UTC (permalink / raw) Cc: emacs-devel On Fri, Dec 13, 2002 at 08:05:30PM -0500, Alan Shutko wrote: > > I know that for me, at least, it is much more useful to just say > > "[color:green]" than to create a face dedicated to having a green > > fg. > > Ok. Maybe you should use "fgcolor" in case someone wants to specify a > bgcolor sometime? In the emacs nomenclature, these are usually just `foreground' and `background'. -Miles -- I'm beginning to think that life is just one long Yoko Ono album; no rhyme or reason, just a lot of incoherent shrieks and then it's over. --Ian Wolff ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: specific coloring of diary calendar entries 2002-12-11 23:58 specific coloring of diary calendar entries Ami Fischman 2002-12-12 1:02 ` Alan Shutko @ 2002-12-13 22:22 ` Richard Stallman 2002-12-13 23:37 ` Ami Fischman 1 sibling, 1 reply; 24+ messages in thread From: Richard Stallman @ 2002-12-13 22:22 UTC (permalink / raw) Cc: emacs-devel This is done via "color tags" -- a string that looks like "[color:blue]" (without the quotes, and blue can be any standard X color). This is an ok feature, but it would be more useful if these tags can specify a semantic category whose visual presentation is defined elsewhere. If a date matches more than one entry, the FIRST matching entry's color is used for the date. For explicit color tags, that's the best you can do. But when using semantic categories, you can do better. You could pick the "most important" semantic category according to a specified priority list, from among those specified for the given date, and use its color. ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: specific coloring of diary calendar entries 2002-12-13 22:22 ` Richard Stallman @ 2002-12-13 23:37 ` Ami Fischman 2002-12-14 0:07 ` Alan Shutko 2002-12-15 23:39 ` Richard Stallman 0 siblings, 2 replies; 24+ messages in thread From: Ami Fischman @ 2002-12-13 23:37 UTC (permalink / raw) Cc: emacs-devel > This is an ok feature, but it would be more useful if these tags > can specify a semantic category whose visual presentation is > defined elsewhere. That might be more useful indeed, but I personally don't see using such an extended system. The calendar display is too crowded for underlines, italics, boldface, or different fonts to be useful in quick visual recognition. If someone else wants such a feature and wants to code it, of course, I would have no objection. Such a system would obviously obviate the need for my patches. However, I conjecture that people are simply not that interested in having such fine-grained calendar displays... Cheers, -- Ami Fischman usenet@fischman.org ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: specific coloring of diary calendar entries 2002-12-13 23:37 ` Ami Fischman @ 2002-12-14 0:07 ` Alan Shutko 2002-12-15 23:39 ` Richard Stallman 1 sibling, 0 replies; 24+ messages in thread From: Alan Shutko @ 2002-12-14 0:07 UTC (permalink / raw) Cc: rms Ami Fischman <usenet@fischman.org> writes: > The calendar display is too crowded for underlines, italics, > boldface, or different fonts to be useful in quick visual > recognition. Actually, since I am currently using them, I'd disagree. 8^) With the markup you are proposing, we could certainly add face:, which could add more semantics, or something else entirely. And for now, people who want them can use sexp entries to get it. -- Alan Shutko <ats@acm.org> - In a variety of flavors! "Damn It Jim!! I'm not a Doctor, just a bad actor on a canceled show" ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: specific coloring of diary calendar entries 2002-12-13 23:37 ` Ami Fischman 2002-12-14 0:07 ` Alan Shutko @ 2002-12-15 23:39 ` Richard Stallman 2002-12-16 0:31 ` Alex Schroeder 2002-12-17 6:18 ` Ami Fischman 1 sibling, 2 replies; 24+ messages in thread From: Richard Stallman @ 2002-12-15 23:39 UTC (permalink / raw) Cc: emacs-devel That might be more useful indeed, but I personally don't see using such an extended system. The calendar display is too crowded for underlines, italics, boldface, or different fonts to be useful in quick visual recognition. If someone else wants such a feature and wants to code it, of course, I would have no objection. Such a system would obviously obviate the need for my patches. I think it would be a simple extension of your patches--so why not do it? You just have to allow a simple name with no colon and treat it as a symbol which is a syntactic category. Some property of the symbol can specify the face property to use for display. Even if people use only colors, it would still be cleaner to specify them with syntactic categories rather than putting the colors directly into the diary files. The categories may someday be useful for other purposes. And they allow the priority handling that I suggested when one date has two events. Would you give it a try? ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: specific coloring of diary calendar entries 2002-12-15 23:39 ` Richard Stallman @ 2002-12-16 0:31 ` Alex Schroeder 2002-12-17 18:44 ` Richard Stallman 2002-12-17 6:18 ` Ami Fischman 1 sibling, 1 reply; 24+ messages in thread From: Alex Schroeder @ 2002-12-16 0:31 UTC (permalink / raw) Richard Stallman <rms@gnu.org> writes: > Even if people use only colors, it would still be cleaner to specify > them with syntactic categories rather than putting the colors directly > into the diary files. The categories may someday be useful for other > purposes. And they allow the priority handling that I suggested > when one date has two events. > > Would you give it a try? As a start, we could do this as follows: The word after the colon is checked for facep. If so, this face is used, if not, and it is a valid color name, then the color is used. Later, if somebody feels like implementing categories, that can be added easily. I really like the simplicity of the original approach. Having faces is one level of indirection, but having categories mapping to faces or colors is even harder to use by a casual user. Alex. ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: specific coloring of diary calendar entries 2002-12-16 0:31 ` Alex Schroeder @ 2002-12-17 18:44 ` Richard Stallman 0 siblings, 0 replies; 24+ messages in thread From: Richard Stallman @ 2002-12-17 18:44 UTC (permalink / raw) Cc: emacs-devel The word after the colon is checked for facep. If so, this face is used, if not, and it is a valid color name, then the color is used. Later, if somebody feels like implementing categories, that can be added easily. I don't think it is a good idea to let one name be either a face or a color. I recommend these alternatives instead: * a face name * a category name * foreground:COLOR * background:COLOR ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: specific coloring of diary calendar entries 2002-12-15 23:39 ` Richard Stallman 2002-12-16 0:31 ` Alex Schroeder @ 2002-12-17 6:18 ` Ami Fischman 2002-12-17 9:42 ` Alex Schroeder ` (3 more replies) 1 sibling, 4 replies; 24+ messages in thread From: Ami Fischman @ 2002-12-17 6:18 UTC (permalink / raw) Cc: emacs-devel I misread your previous post on this subject. Specifically, I thought you were asking for the tags to allow different attributes from color (so there'd be [bgcolor:blah], [underline:blah], [bold:blah], etc tags). Doing that much work would just be silly, as someone who knows enough to define the attributes of an emacs face can just create the face and use an sexp. Upon re-reading your suggestion, I think what you are saying is you want the ability to say [work] or [home] and have `work' and `home' be "categories" -- presumably a conglomerate of face attributes that apply to the entry. But how is this simpler than defining a "work" or "home" face and having an sexp entry invoke it? I guess I'm looking at two situations: the emacs expert and the emacs novice. The former knows how to create a face and attach it to an entry even without my patches (using sexp's); the latter will now be able to define f/g colors for his/her diary entries. Is the difference between defining/using "semantic categories" and defining/using emacs faces+sexp entries really as large as the gap between expert and novice? I think the answer is no. If you disagree, please let me know. I'm not morally opposed to adding features to these patches. I just don't think there is an elegant way to add them to the code (the color patches are already somewhat "glued on") and so would rather not do so unless there's a demonstrated need or demand for them. If others would like to see some form of semantic categorization (going beyond f/g color, which can be achieved with file-glob-color), please speak up :) Cheers, -- Ami Fischman usenet@fischman.org ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: specific coloring of diary calendar entries 2002-12-17 6:18 ` Ami Fischman @ 2002-12-17 9:42 ` Alex Schroeder 2002-12-17 16:03 ` Alan Shutko 2002-12-17 11:05 ` Kai Großjohann ` (2 subsequent siblings) 3 siblings, 1 reply; 24+ messages in thread From: Alex Schroeder @ 2002-12-17 9:42 UTC (permalink / raw) Cc: emacs-devel Ami Fischman <usenet@fischman.org> writes: > I'm not morally opposed to adding features to these patches. I just don't > think there is an elegant way to add them to the code (the color patches are > already somewhat "glued on") and so would rather not do so unless there's a > demonstrated need or demand for them. If others would like to see some form > of semantic categorization (going beyond f/g color, which can be achieved > with file-glob-color), please speak up :) I actually like the very simple color-name idea of yours. I am not sure what the current manual situation is, but in the released 21.2, some of the very interesting Calendar stuff is in the elisp manual. Maybe that has to be rethought; and maybe some example using faces (the expert solution you talk about) needs to be added to the manual. I just read through the node "Sexp Entries and the Fancy Diary Display" in the old elisp manual and it says nothing about faces. But perhaps I just missed the beginning of the thread. :) Alex. ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: specific coloring of diary calendar entries 2002-12-17 9:42 ` Alex Schroeder @ 2002-12-17 16:03 ` Alan Shutko 0 siblings, 0 replies; 24+ messages in thread From: Alan Shutko @ 2002-12-17 16:03 UTC (permalink / raw) Cc: emacs-devel Alex Schroeder <alex@emacswiki.org> writes: > I just read through the node "Sexp Entries and the Fancy Diary > Display" in the old elisp manual and it says nothing about faces. It's new in CVS. It'll be in 21.4 (or whatever the next non-bug release is). -- Alan Shutko <ats@acm.org> - In a variety of flavors! There goes the bursar again, who's got the dried frog pills? ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: specific coloring of diary calendar entries 2002-12-17 6:18 ` Ami Fischman 2002-12-17 9:42 ` Alex Schroeder @ 2002-12-17 11:05 ` Kai Großjohann 2002-12-17 16:02 ` Alan Shutko 2002-12-17 11:07 ` Kai Großjohann 2002-12-18 2:01 ` Richard Stallman 3 siblings, 1 reply; 24+ messages in thread From: Kai Großjohann @ 2002-12-17 11:05 UTC (permalink / raw) Ami Fischman <usenet@fischman.org> writes: > I guess I'm looking at two situations: the emacs expert and the emacs > novice. The former knows how to create a face and attach it to an entry > even without my patches (using sexp's); Excuse the silly question: how does one attach faces to an entry with sexp's? -- ~/.signature is: umop ap!sdn (Frank Nobis) ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: specific coloring of diary calendar entries 2002-12-17 11:05 ` Kai Großjohann @ 2002-12-17 16:02 ` Alan Shutko 0 siblings, 0 replies; 24+ messages in thread From: Alan Shutko @ 2002-12-17 16:02 UTC (permalink / raw) Cc: emacs-devel kai.grossjohann@uni-duisburg.de (Kai Großjohann) writes: > Excuse the silly question: how does one attach faces to an entry with > sexp's? (emacs)Special Diary Entries (elisp)Sexp Entries and the Fancy Diary Display (CVS only right now.) 8^) -- Alan Shutko <ats@acm.org> - In a variety of flavors! Got Brother Jimmy on the TV and Killer on the stereo... ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: specific coloring of diary calendar entries 2002-12-17 6:18 ` Ami Fischman 2002-12-17 9:42 ` Alex Schroeder 2002-12-17 11:05 ` Kai Großjohann @ 2002-12-17 11:07 ` Kai Großjohann 2002-12-18 2:01 ` Richard Stallman 3 siblings, 0 replies; 24+ messages in thread From: Kai Großjohann @ 2002-12-17 11:07 UTC (permalink / raw) Ami Fischman <usenet@fischman.org> writes: > I guess I'm looking at two situations: the emacs expert and the emacs > novice. The former knows how to create a face and attach it to an entry > even without my patches (using sexp's); the latter will now be able to > define f/g colors for his/her diary entries. But your color stuff does more: you can define a default color for a file. I guess without your machinery, defining a default face for a file would be much more difficult. And I also guess that your machinery could easily be extended so that entries tagged with [face:frumple], say, are displayed in the frumple face. -- ~/.signature is: umop ap!sdn (Frank Nobis) ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: specific coloring of diary calendar entries 2002-12-17 6:18 ` Ami Fischman ` (2 preceding siblings ...) 2002-12-17 11:07 ` Kai Großjohann @ 2002-12-18 2:01 ` Richard Stallman 2002-12-18 22:27 ` Ami Fischman 3 siblings, 1 reply; 24+ messages in thread From: Richard Stallman @ 2002-12-18 2:01 UTC (permalink / raw) Cc: emacs-devel Upon re-reading your suggestion, I think what you are saying is you want the ability to say [work] or [home] and have `work' and `home' be "categories" -- presumably a conglomerate of face attributes that apply to the entry. But how is this simpler than defining a "work" or "home" face I am not sure. Perhaps being able to specify a face is good enough, and we don't need a categories feature. and having an sexp entry invoke it? These tags are much more convenient than sexp entries. To be able to specify a face (or category) with [...] would certainly be a good feature. ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: specific coloring of diary calendar entries 2002-12-18 2:01 ` Richard Stallman @ 2002-12-18 22:27 ` Ami Fischman 2002-12-19 6:02 ` Ami Fischman 0 siblings, 1 reply; 24+ messages in thread From: Ami Fischman @ 2002-12-18 22:27 UTC (permalink / raw) Cc: emacs-devel Richard Stallman <rms@gnu.org> writes: [...] > I am not sure. Perhaps being able to specify a face is good enough, > and we don't need a categories feature. I think this is the case. > and having an > sexp entry invoke it? > > These tags are much more convenient than sexp entries. > To be able to specify a face (or category) with [...] > would certainly be a good feature. My stubborness is apparently less powerful than my boredom. I went ahead and implemented general tagging (so there will be [background:blah], [face:fooblah], [slant:italic], etc possibilities). However, one biggish problem is still in my way: I was under the impression that overlays stacked "sensibly" -- i.e., if two overlays cover the same region, and one's face defines a foreground (only) and the other's face defines a background (only) then the resulting text will show both. This turns out not to be the case. Is there any way to "merge" overlays like this? By the time the calendar is getting marked up with the second entry for a particular date, the first entry is long gone, so there isn't the possibility of merging the attribute lists "by hand" at this point. I know about setting priorities for overlays, but this would still result in "exclusivity" -- only one entry's colors show. Any pointers as to how to stack overlays "transparently" appreciated. Other workarounds for the problem also sought :) Cheers, -- Ami Fischman usenet@fischman.org ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: specific coloring of diary calendar entries 2002-12-18 22:27 ` Ami Fischman @ 2002-12-19 6:02 ` Ami Fischman 2002-12-19 18:03 ` Ami Fischman 0 siblings, 1 reply; 24+ messages in thread From: Ami Fischman @ 2002-12-19 6:02 UTC (permalink / raw) Ami Fischman <usenet@fischman.org> writes: [...] > However, one biggish problem is still in my way: I was under the impression > that overlays stacked "sensibly" -- i.e., if two overlays cover the same > region, and one's face defines a foreground (only) and the other's face defines a > background (only) then the resulting text will show both. This turns out I guess I misspoke. Seems to work fine now. Will post updated patches tomorrow probably (still cleaning up some small issues). -- Ami Fischman usenet@fischman.org ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: specific coloring of diary calendar entries 2002-12-19 6:02 ` Ami Fischman @ 2002-12-19 18:03 ` Ami Fischman 0 siblings, 0 replies; 24+ messages in thread From: Ami Fischman @ 2002-12-19 18:03 UTC (permalink / raw) [-- Attachment #1: Type: text/plain, Size: 1030 bytes --] At the request of a couple of people, I added tags for all the attributes a face can have except :box :stipple (since I didn't want to mess with parsing the possible values, and anyone defining them can just define their own face), as well as taking [face:blah] tags. These changes required changing the layout of the parsing/usage of the data, and I think it is better this way (much more general and extensible). So, the result is that one can define infinitely ugly and unreadable calendars (hey, want to have one diary entry four times as large as the rest? Fine! Want overlines over some entries and underlines under others? Excellent! :)). And everything seems to work right. One can "stack" attributes (if a date has an entry with a f/g color defined and another with b/g color defined, both show on the date, etc). Since this iteration is much more involved than the previous ones, I'd like to hear from a few people that they are running it through the paces. Cheers, -- Ami Fischman usenet@fischman.org [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: col-dia.patch --] [-- Type: text/x-patch, Size: 23875 bytes --] *** /home/fischman/cvs/emacs/lisp/calendar/diary-lib.el 2002-11-18 01:05:22.000000000 -0800 --- diary-lib.el 2002-12-19 09:52:18.000000000 -0800 *************** *** 184,191 **** --- 184,268 ---- (defvar date-string) (defvar d-file) (defvar original-date) + (defun diary-attrtype-convert (attrvalue type) + "Convert the attrvalue from a string to the appropriate type for using + in a face description" + (let (ret) + (setq ret (cond ((eq type 'string) attrvalue) + ((eq type 'symbol) (read attrvalue)) + ((eq type 'int) (string-to-int attrvalue)) + ((eq type 'stringtnil) + (cond ((string= "t" attrvalue) t) + ((string= "nil" attrvalue) nil) + (t attrvalue))) + ((eq type 'tnil) + (cond ((string= "t" attrvalue) t) + ((string= "nil" attrvalue) nil))))) + ; (message "(%s)[%s]=[%s]" (print type) attrvalue ret) + ret)) + + + (defun diary-pull-attrs (entry fileglobattrs) + "Pull the face-related attributes off the entry, merge with the + fileglobattrs, and return the (possibly modified) entry and face + data in a list of attrname attrvalue values. + The entry will be modified to drop all tags that are used for face matching. + If entry is nil, then the fileglobattrs are being searched for, + the fileglobattrs variable is ignored, and + diary-glob-file-regexp-prefix is prepended to the regexps before each + search." + ;; XXX + (save-excursion + (let (regexp regnum attrname attr-list attrname attrvalue type) + (if (null entry) + (progn + (setq ret-attr '() + attr-list diary-face-attrs) + (while attr-list + (goto-char (point-min)) + (setq attr (car attr-list) + regexp (nth 0 attr) + regnum (nth 1 attr) + attrname (nth 2 attr) + type (nth 3 attr) + regexp (concat diary-glob-file-regexp-prefix regexp)) + (setq attrvalue nil) + (if (re-search-forward regexp (point-max) t) + (setq attrvalue (buffer-substring-no-properties + (match-beginning regnum) + (match-end regnum)))) + (if (and attrvalue + (setq attrvalue (diary-attrtype-convert attrvalue type))) + (setq ret-attr (append ret-attr (list attrname attrvalue)))) + (setq attr-list (cdr attr-list))) + (setq fileglobattrs ret-attr)) + (progn + (setq ret-attr fileglobattrs + attr-list diary-face-attrs) + (while attr-list + (goto-char (point-min)) + (setq attr (car attr-list) + regexp (nth 0 attr) + regnum (nth 1 attr) + attrname (nth 2 attr) + type (nth 3 attr)) + (setq attrvalue nil) + (if (string-match regexp entry) + (progn + (setq attrvalue (substring-no-properties entry + (match-beginning regnum) + (match-end regnum))) + (setq entry (replace-match "" t t entry)))) + (if (and attrvalue + (setq attrvalue (diary-attrtype-convert attrvalue type))) + (setq ret-attr (append ret-attr (list attrname attrvalue)))) + (setq attr-list (cdr attr-list))))))) + (list entry ret-attr)) + + + (defun list-diary-entries (date number) "Create and display a buffer containing the relevant lines in diary-file. The arguments are DATE and NUMBER; the entries selected are those for NUMBER days starting with date DATE. The other entries are hidden *************** *** 222,229 **** --- 299,307 ---- (if (< 0 number) (let* ((original-date date);; save for possible use in the hooks old-diary-syntax-table diary-entries-list + file-glob-attrs (date-string (calendar-date-string date)) (d-file (substitute-in-file-name diary-file))) (message "Preparing diary...") (save-excursion *************** *** 232,239 **** --- 310,318 ---- (set-buffer (find-file-noselect d-file t)) (set-buffer diary-buffer) (or (verify-visited-file-modtime diary-buffer) (revert-buffer t t)))) + (setq file-glob-attrs (nth 1 (diary-pull-attrs nil ""))) (setq selective-display t) (setq selective-display-ellipses nil) (setq old-diary-syntax-table (syntax-table)) (set-syntax-table diary-syntax-table) *************** *** 307,327 **** (re-search-forward "\^M\\|\n" nil t)) (backward-char 1) (subst-char-in-region date-start (point) ?\^M ?\n t) (add-to-diary-list date ! (buffer-substring ! entry-start (point)) (buffer-substring (1+ date-start) (1- entry-start)) ! (copy-marker entry-start)))))) (setq d (cdr d))) (or entry-found (not diary-list-include-blanks) (setq diary-entries-list (append diary-entries-list ! (list (list date "" ""))))) (setq date (calendar-gregorian-from-absolute (1+ (calendar-absolute-from-gregorian date)))) (setq entry-found nil))) --- 386,409 ---- (re-search-forward "\^M\\|\n" nil t)) (backward-char 1) (subst-char-in-region date-start (point) ?\^M ?\n t) + (setq entry (buffer-substring entry-start (point)) + temp (diary-pull-attrs entry file-glob-attrs) + entry (nth 0 temp) + marks (nth 1 temp)) (add-to-diary-list date ! entry (buffer-substring (1+ date-start) (1- entry-start)) ! (copy-marker entry-start) marks))))) (setq d (cdr d))) (or entry-found (not diary-list-include-blanks) (setq diary-entries-list (append diary-entries-list ! (list (list date "" "" "" ""))))) (setq date (calendar-gregorian-from-absolute (1+ (calendar-absolute-from-gregorian date)))) (setq entry-found nil))) *************** *** 512,526 **** x) date-holiday-list (concat "\n" (make-string l ? )))) (insert ?\n (make-string (+ l longest) ?=) ?\n))))) ! (if (< 0 (length (car (cdr (car entry-list))))) ! (if (nth 3 (car entry-list)) ! (insert-button (concat (car (cdr (car entry-list))) "\n") ! 'marker (nth 3 (car entry-list)) ! :type 'diary-entry) ! (insert (car (cdr (car entry-list))) ?\n))) ! (setq entry-list (cdr entry-list)))) (set-buffer-modified-p nil) (goto-char (point-min)) (setq buffer-read-only t) (display-buffer fancy-diary-buffer) --- 594,628 ---- x) date-holiday-list (concat "\n" (make-string l ? )))) (insert ?\n (make-string (+ l longest) ?=) ?\n))))) ! ! (setq entry (car (cdr (car entry-list)))) ! (if (< 0 (length entry)) ! (progn ! (if (nth 3 (car entry-list)) ! (insert-button (concat entry "\n") ! 'marker (nth 3 (car entry-list)) ! :type 'diary-entry) ! (insert entry ?\n)) ! (save-excursion ! (setq marks (fifth (car entry-list))) ! (setq temp-face (make-symbol (apply 'concat "temp-face-" (mapcar '(lambda (sym) (if (not (stringp sym)) (symbol-name sym) sym)) marks)))) ! (make-face temp-face) ! ;; Remove :face info from the marks, copy the face info into temp-face ! (setq faceinfo marks) ! (while (setq faceinfo (memq :face faceinfo)) ! (copy-face (read (nth 1 faceinfo)) temp-face) ! (setcar faceinfo nil) ! (setcar (cdr faceinfo) nil)) ! (setq marks (delq nil marks)) ! ;; Apply the font aspects ! (apply 'set-face-attribute temp-face nil marks) ! (search-backward entry) ! (overlay-put ! (make-overlay (match-beginning 0) (match-end 0)) 'face temp-face)) ! )) ! (setq entry-list (cdr entry-list)))) (set-buffer-modified-p nil) (goto-char (point-min)) (setq buffer-read-only t) (display-buffer fancy-diary-buffer) *************** *** 689,703 **** After the entries are marked, the hooks `nongregorian-diary-marking-hook' and `mark-diary-entries-hook' are run." (interactive) (setq mark-diary-entries-in-calendar t) ! (let ((d-file (substitute-in-file-name diary-file)) (marking-diary-entries t)) (if (and d-file (file-exists-p d-file)) (if (file-readable-p d-file) (save-excursion (message "Marking diary entries...") (set-buffer (find-file-noselect d-file t)) (let ((d diary-date-forms) (old-diary-syntax-table)) (setq old-diary-syntax-table (syntax-table)) (set-syntax-table diary-syntax-table) --- 791,807 ---- After the entries are marked, the hooks `nongregorian-diary-marking-hook' and `mark-diary-entries-hook' are run." (interactive) (setq mark-diary-entries-in-calendar t) ! (let (file-glob-attrs ! (d-file (substitute-in-file-name diary-file)) (marking-diary-entries t)) (if (and d-file (file-exists-p d-file)) (if (file-readable-p d-file) (save-excursion (message "Marking diary entries...") (set-buffer (find-file-noselect d-file t)) + (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) (let ((d diary-date-forms) (old-diary-syntax-table)) (setq old-diary-syntax-table (syntax-table)) (set-syntax-table diary-syntax-table) *************** *** 773,801 **** (- y 100) (if (> (- current-y y) 50) (+ y 100) y))) ! (string-to-int y-str))))) ! (if dd-name ! (mark-calendar-days-named ! (cdr (assoc-ignore-case ! (substring dd-name 0 3) ! (calendar-make-alist ! calendar-day-name-array ! 0 ! (lambda (x) (substring x 0 3)))))) ! (if mm-name ! (if (string-equal mm-name "*") ! (setq mm 0) ! (setq mm ! (cdr (assoc-ignore-case ! (substring mm-name 0 3) ! (calendar-make-alist ! calendar-month-name-array ! 1 ! (lambda (x) (substring x 0 3))) ! ))))) ! (mark-calendar-date-pattern mm dd yy)))) (setq d (cdr d)))) (mark-sexp-diary-entries) (run-hooks 'nongregorian-diary-marking-hook 'mark-diary-entries-hook) --- 877,910 ---- (- y 100) (if (> (- current-y y) 50) (+ y 100) y))) ! (string-to-int y-str)))) ! (save-excursion ! (setq entry (buffer-substring-no-properties (point) (line-end-position)) ! temp (diary-pull-attrs entry file-glob-attrs) ! entry (nth 0 temp) ! marks (nth 1 temp)))) ! (if dd-name ! (mark-calendar-days-named ! (cdr (assoc-ignore-case ! (substring dd-name 0 3) ! (calendar-make-alist ! calendar-day-name-array ! 0 ! (lambda (x) (substring x 0 3))))) marks) ! (if mm-name ! (if (string-equal mm-name "*") ! (setq mm 0) ! (setq mm ! (cdr (assoc-ignore-case ! (substring mm-name 0 3) ! (calendar-make-alist ! calendar-month-name-array ! 1 ! (lambda (x) (substring x 0 3))) ! ))))) ! (mark-calendar-date-pattern mm dd yy marks)))) (setq d (cdr d)))) (mark-sexp-diary-entries) (run-hooks 'nongregorian-diary-marking-hook 'mark-diary-entries-hook) *************** *** 816,824 **** (m) (y) (first-date) (last-date) ! (mark)) (save-excursion (set-buffer calendar-buffer) (setq m displayed-month) (setq y displayed-year)) --- 925,935 ---- (m) (y) (first-date) (last-date) ! (mark) ! file-glob-attrs) ! (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) (save-excursion (set-buffer calendar-buffer) (setq m displayed-month) (setq y displayed-year)) *************** *** 866,877 **** (aset entry (match-beginning 0) ?\n ))) (calendar-for-loop date from first-date to last-date do (if (setq mark (diary-sexp-entry sexp entry (calendar-gregorian-from-absolute date))) ! (mark-visible-calendar-date ! (calendar-gregorian-from-absolute date) ! (if (consp mark) ! (car mark))))))))) (defun mark-included-diary-files () "Mark the diary entries from other diary files with those of the diary file. This function is suitable for use as the `mark-diary-entries-hook'; it enables --- 977,994 ---- (aset entry (match-beginning 0) ?\n ))) (calendar-for-loop date from first-date to last-date do (if (setq mark (diary-sexp-entry sexp entry (calendar-gregorian-from-absolute date))) ! (progn ! (setq marks (diary-pull-attrs entry file-glob-attrs) ! temp (diary-pull-attrs entry file-glob-attrs) ! marks (nth 1 temp)) ! (mark-visible-calendar-date ! (calendar-gregorian-from-absolute date) ! (if (< 0 (length marks)) ! marks ! (if (consp mark) ! (car mark))))))))))) (defun mark-included-diary-files () "Mark the diary entries from other diary files with those of the diary file. This function is suitable for use as the `mark-diary-entries-hook'; it enables *************** *** 904,912 **** (message "Can't find included diary file %s" diary-file) (sleep-for 2)))) (goto-char (point-min))) ! (defun mark-calendar-days-named (dayname) "Mark all dates in the calendar window that are day DAYNAME of the week. 0 means all Sundays, 1 means all Mondays, and so on." (save-excursion (set-buffer calendar-buffer) --- 1021,1029 ---- (message "Can't find included diary file %s" diary-file) (sleep-for 2)))) (goto-char (point-min))) ! (defun mark-calendar-days-named (dayname &optional color) "Mark all dates in the calendar window that are day DAYNAME of the week. 0 means all Sundays, 1 means all Mondays, and so on." (save-excursion (set-buffer calendar-buffer) *************** *** 922,945 **** (calendar-nth-named-day 1 dayname prev-month prev-year))) (setq last-day (calendar-absolute-from-gregorian (calendar-nth-named-day -1 dayname succ-month succ-year))) (while (<= day last-day) ! (mark-visible-calendar-date (calendar-gregorian-from-absolute day)) (setq day (+ day 7)))))) ! (defun mark-calendar-date-pattern (month day year) "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR. A value of 0 in any position is a wildcard." (save-excursion (set-buffer calendar-buffer) (let ((m displayed-month) (y displayed-year)) (increment-calendar-month m y -1) (calendar-for-loop i from 0 to 2 do ! (mark-calendar-month m y month day year) (increment-calendar-month m y 1))))) ! (defun mark-calendar-month (month year p-month p-day p-year) "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR. A value of 0 in any position of the pattern is a wildcard." (if (or (and (= month p-month) (or (= p-year 0) (= year p-year))) --- 1039,1062 ---- (calendar-nth-named-day 1 dayname prev-month prev-year))) (setq last-day (calendar-absolute-from-gregorian (calendar-nth-named-day -1 dayname succ-month succ-year))) (while (<= day last-day) ! (mark-visible-calendar-date (calendar-gregorian-from-absolute day) color) (setq day (+ day 7)))))) ! (defun mark-calendar-date-pattern (month day year &optional color) "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR. A value of 0 in any position is a wildcard." (save-excursion (set-buffer calendar-buffer) (let ((m displayed-month) (y displayed-year)) (increment-calendar-month m y -1) (calendar-for-loop i from 0 to 2 do ! (mark-calendar-month m y month day year color) (increment-calendar-month m y 1))))) ! (defun mark-calendar-month (month year p-month p-day p-year &optional color) "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR. A value of 0 in any position of the pattern is a wildcard." (if (or (and (= month p-month) (or (= p-year 0) (= year p-year))) *************** *** 947,956 **** (or (= p-year 0) (= year p-year)))) (if (= p-day 0) (calendar-for-loop i from 1 to (calendar-last-day-of-month month year) do ! (mark-visible-calendar-date (list month i year))) ! (mark-visible-calendar-date (list month p-day year))))) (defun sort-diary-entries () "Sort the list of diary entries by time of day." (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare))) --- 1064,1073 ---- (or (= p-year 0) (= year p-year)))) (if (= p-day 0) (calendar-for-loop i from 1 to (calendar-last-day-of-month month year) do ! (mark-visible-calendar-date (list month i year) color)) ! (mark-visible-calendar-date (list month p-day year) color)))) (defun sort-diary-entries () "Sort the list of diary entries by time of day." (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare))) *************** *** 1169,1178 **** best if they are nonmarking." (let* ((mark (regexp-quote diary-nonmarking-symbol)) (sexp-mark (regexp-quote sexp-diary-entry-symbol)) (s-entry (concat "\\(\\`\\|\^M\\|\n\\)" mark "?" sexp-mark "(")) ! (entry-found)) (goto-char (point-min)) (while (re-search-forward s-entry nil t) (backward-char 1) (let ((sexp-start (point)) (sexp) --- 1286,1298 ---- best if they are nonmarking." (let* ((mark (regexp-quote diary-nonmarking-symbol)) (sexp-mark (regexp-quote sexp-diary-entry-symbol)) (s-entry (concat "\\(\\`\\|\^M\\|\n\\)" mark "?" sexp-mark "(")) ! (entry-found) ! (file-glob-attrs)) (goto-char (point-min)) + (save-excursion + (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))) (while (re-search-forward s-entry nil t) (backward-char 1) (let ((sexp-start (point)) (sexp) *************** *** 1203,1219 **** (setq entry (buffer-substring-no-properties entry-start (point))) (while (string-match "[\^M]" entry) (aset entry (match-beginning 0) ?\n ))) (let ((diary-entry (diary-sexp-entry sexp entry date))) (if diary-entry ! (subst-char-in-region line-start (point) ?\^M ?\n t)) ! (add-to-diary-list date ! (if (consp diary-entry) ! (cdr diary-entry) ! diary-entry) specifier (if entry-start (copy-marker entry-start) ! nil)) (setq entry-found (or entry-found diary-entry))))) entry-found)) (defun diary-sexp-entry (sexp entry date) --- 1323,1346 ---- (setq entry (buffer-substring-no-properties entry-start (point))) (while (string-match "[\^M]" entry) (aset entry (match-beginning 0) ?\n ))) (let ((diary-entry (diary-sexp-entry sexp entry date))) + (setq entry (if (consp diary-entry) + (cdr diary-entry) + diary-entry)) (if diary-entry ! (progn ! (subst-char-in-region line-start (point) ?\^M ?\n t) ! (if (< 0 (length entry)) ! (setq temp (diary-pull-attrs entry file-glob-attrs) ! entry (nth 0 temp) ! marks (nth 1 temp))))) ! (add-to-diary-list date ! entry specifier (if entry-start (copy-marker entry-start) ! nil) ! marks) (setq entry-found (or entry-found diary-entry))))) entry-found)) (defun diary-sexp-entry (sexp entry date) *************** *** 1469,1483 **** ((and (listp days) days) (or (diary-remind sexp (car days) marking) (diary-remind sexp (cdr days) marking)))))) ! (defun add-to-diary-list (date string specifier marker) ! "Add the entry (DATE STRING SPECIFIER) to `diary-entries-list'. Do nothing if DATE or STRING is nil." (and date string (setq diary-entries-list (append diary-entries-list ! (list (list date string specifier marker)))))) (defun make-diary-entry (string &optional nonmarking file) "Insert a diary entry STRING which may be NONMARKING in FILE. If omitted, NONMARKING defaults to nil and FILE defaults to diary-file." --- 1596,1615 ---- ((and (listp days) days) (or (diary-remind sexp (car days) marking) (diary-remind sexp (cdr days) marking)))))) ! (defun add-to-diary-list (date string specifier marker &optional globcolor) ! "Add the entry (DATE STRING SPECIFIER MARKER GLOBCOLOR) to `diary-entries-list'. Do nothing if DATE or STRING is nil." (and date string + (if (and diary-file-name-prefix + (setq prefix (concat "[" (funcall diary-file-name-prefix-function (buffer-file-name)) "] ")) + (not (string= prefix "[] "))) + (setq string (concat prefix string)) + t) (setq diary-entries-list (append diary-entries-list ! (list (list date string specifier marker globcolor)))))) (defun make-diary-entry (string &optional nonmarking file) "Insert a diary entry STRING which may be NONMARKING in FILE. If omitted, NONMARKING defaults to nil and FILE defaults to diary-file." [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: col-cal.patch --] [-- Type: text/x-patch, Size: 5685 bytes --] *** /home/fischman/cvs/emacs/lisp/calendar/calendar.el 2002-12-07 13:30:57.000000000 -0800 --- calendar.el 2002-12-19 09:53:59.000000000 -0800 *************** *** 309,316 **** --- 309,321 ---- calendar." :type 'boolean :group 'holidays) + (defcustom diary-file-name-prefix-function (function (lambda (str) str)) + "*The function that will take a diary file name and return the desired prefix." + :type 'string + :group 'diary) + ;;;###autoload (defcustom calendar-load-hook nil "*List of functions to be called after the calendar is first loaded. This is the place to add key bindings to `calendar-mode-map'." *************** *** 496,503 **** --- 501,538 ---- See the documentation for the function `include-other-diary-files'." :type 'string :group 'diary) + (defcustom diary-glob-file-regexp-prefix "^\\#" + "*The regular expression that gets pre-pended to each of the attribute-regexp's for file-wide specifiers." + :type 'regexp + :group 'diary) + + (defcustom diary-face-attrs '( + (" *\\[foreground:\\([-a-z]+\\)\\]$" 1 :foreground string) + (" *\\[background:\\([-a-z]+\\)\\]$" 1 :background string) + (" *\\[width:\\([-a-z]+\\)\\]$" 1 :width symbol) + (" *\\[height:\\([-0-9a-z]+\\)\\]$" 1 :height int) + (" *\\[weight:\\([-a-z]+\\)\\]$" 1 :weight symbol) + (" *\\[slant:\\([-a-z]+\\)\\]$" 1 :slant symbol) + (" *\\[underline:\\([-a-z]+\\)\\]$" 1 :underline stringtnil) + (" *\\[overline:\\([-a-z]+\\)\\]$" 1 :overline stringtnil) + (" *\\[strike-through:\\([-a-z]+\\)\\]$" 1 :strike-through stringtnil) + (" *\\[inverse-video:\\([-a-z]+\\)\\]$" 1 :inverse-video tnil) + (" *\\[face:\\([-0-9a-z]+\\)\\]$" 1 :face string) + (" *\\[font:\\([-a-z0-9]+\\)\\]$" 1 :font string) + ;Unsupported (" *\\[box:\\([-a-z]+\\)\\]$" 1 :box) + ;Unsupported (" *\\[stipple:\\([-a-z]+\\)\\]$" 1 :stipple) + ) + "*A list of (regexp regnum attr attrtype) lists where the regexp says how to find the tag, the regnum says which parenthetical sub-regexp this regexp looks for, and the attr says which attribute of the face (or that this _is_ a face) is being modified." + :type 'sexp + :group 'diary) + + (defcustom diary-file-name-prefix nil + "If non-nil then each entry in the diary list will be prefixed with the name of the file in which it was defined." + :type 'boolean + :group 'diary) + ;;;###autoload (defcustom sexp-diary-entry-symbol "%%" "*The string used to indicate a sexp diary entry in `diary-file'. See the documentation for the function `list-sexp-diary-entries'." *************** *** 2552,2574 **** (= (extract-calendar-year date1) (extract-calendar-year date2)))) (defun mark-visible-calendar-date (date &optional mark) "Mark DATE in the calendar window with MARK. ! MARK is either a single-character string 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 mark diary-entry-marker))) ! (if (stringp mark) ! (let ((buffer-read-only nil)) ! (forward-char 1) ! (delete-char 1) ! (insert mark) ! (forward-char -2)) ! (overlay-put ! (make-overlay (1- (point)) (1+ (point))) 'face mark)))))) (defun calendar-star-date () "Replace the date under the cursor in the calendar window with asterisks. This function can be used with the `today-visible-calendar-hook' run after the --- 2587,2634 ---- (= (extract-calendar-year date1) (extract-calendar-year date2)))) (defun mark-visible-calendar-date (date &optional mark) "Mark DATE in the calendar window with MARK. ! 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)) ! (progn ; attr list ! (setq temp-face ! (make-symbol (apply 'concat "temp-face-" ! (mapcar '(lambda (sym) ! (cond ((symbolp sym) (symbol-name sym)) ! ((numberp sym) (int-to-string sym)) ! (t sym))) mark)))) ! (make-face temp-face) ! ;; Remove :face info from the mark, copy the face info into temp-face ! (setq faceinfo mark) ! (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. This function can be used with the `today-visible-calendar-hook' run after the [-- Attachment #4: Type: text/plain, Size: 142 bytes --] _______________________________________________ Emacs-devel mailing list Emacs-devel@gnu.org http://mail.gnu.org/mailman/listinfo/emacs-devel ^ permalink raw reply [flat|nested] 24+ messages in thread
end of thread, other threads:[~2002-12-19 18:03 UTC | newest] Thread overview: 24+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2002-12-11 23:58 specific coloring of diary calendar entries Ami Fischman 2002-12-12 1:02 ` Alan Shutko 2002-12-12 18:24 ` Ami Fischman 2002-12-12 18:56 ` Ami Fischman 2002-12-12 19:31 ` Alan Shutko 2002-12-13 10:14 ` Kai Großjohann 2002-12-14 1:05 ` Alan Shutko 2002-12-14 1:42 ` Miles Bader 2002-12-13 22:22 ` Richard Stallman 2002-12-13 23:37 ` Ami Fischman 2002-12-14 0:07 ` Alan Shutko 2002-12-15 23:39 ` Richard Stallman 2002-12-16 0:31 ` Alex Schroeder 2002-12-17 18:44 ` Richard Stallman 2002-12-17 6:18 ` Ami Fischman 2002-12-17 9:42 ` Alex Schroeder 2002-12-17 16:03 ` Alan Shutko 2002-12-17 11:05 ` Kai Großjohann 2002-12-17 16:02 ` Alan Shutko 2002-12-17 11:07 ` Kai Großjohann 2002-12-18 2:01 ` Richard Stallman 2002-12-18 22:27 ` Ami Fischman 2002-12-19 6:02 ` Ami Fischman 2002-12-19 18:03 ` Ami Fischman
Code repositories for project(s) associated with this public inbox https://git.savannah.gnu.org/cgit/emacs.git This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).