* 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-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-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-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-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 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 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 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 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-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-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).