/[emacs]/emacs/lisp/calendar/diary-lib.el
ViewVC logotype

Diff of /emacs/lisp/calendar/diary-lib.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.65 by sds, Fri Apr 25 01:58:48 2003 UTC revision 1.66 by gm, Thu May 8 19:34:30 2003 UTC
# Line 213  the fileglobattrs variable is ignored, a Line 213  the fileglobattrs variable is ignored, a
213  diary-glob-file-regexp-prefix is prepended to the regexps before each  diary-glob-file-regexp-prefix is prepended to the regexps before each
214  search."  search."
215    (save-excursion    (save-excursion
216      (let (regexp regnum attrname attr-list attrname attrvalue type)      (let (regexp regnum attrname attr-list attrname attrvalue type
217                     ret-attr attr)
218        (if (null entry)        (if (null entry)
219            (progn            (progn
220              (setq ret-attr '()              (setq ret-attr '()
# Line 256  search." Line 257  search."
257              (if (and attrvalue              (if (and attrvalue
258                       (setq attrvalue (diary-attrtype-convert attrvalue type)))                       (setq attrvalue (diary-attrtype-convert attrvalue type)))
259                  (setq ret-attr (append ret-attr (list attrname attrvalue))))                  (setq ret-attr (append ret-attr (list attrname attrvalue))))
260              (setq attr-list (cdr attr-list)))))))              (setq attr-list (cdr attr-list)))))
261    (list entry ret-attr))        (list entry ret-attr))))
262    
263    
264    
# Line 377  These hooks have the following distinct Line 378  These hooks have the following distinct
378                             ;; add it to the list.                             ;; add it to the list.
379                             (setq entry-found t)                             (setq entry-found t)
380                             (let ((entry-start (point))                             (let ((entry-start (point))
381                                   (date-start))                                   date-start temp)
382                               (re-search-backward "\^M\\|\n\\|\\`")                               (re-search-backward "\^M\\|\n\\|\\`")
383                               (setq date-start (point))                               (setq date-start (point))
384                               (re-search-forward "\^M\\|\n" nil t 2)                               (re-search-forward "\^M\\|\n" nil t 2)
# Line 388  These hooks have the following distinct Line 389  These hooks have the following distinct
389                                  (point) ?\^M ?\n t)                                  (point) ?\^M ?\n t)
390                               (setq entry (buffer-substring entry-start (point))                               (setq entry (buffer-substring entry-start (point))
391                                     temp (diary-pull-attrs entry file-glob-attrs)                                     temp (diary-pull-attrs entry file-glob-attrs)
392                                     entry (nth 0 temp)                                     entry (nth 0 temp))
                                    marks (nth 1 temp))  
393                               (add-to-diary-list                               (add-to-diary-list
394                                date                                date
395                                entry                                entry
396                                (buffer-substring                                (buffer-substring
397                                 (1+ date-start) (1- entry-start))                                 (1+ date-start) (1- entry-start))
398                                (copy-marker entry-start) marks)))))                                (copy-marker entry-start) (nth 1 temp))))))
399                       (setq d (cdr d)))                       (setq d (cdr d)))
400                     (or entry-found                     (or entry-found
401                         (not diary-list-include-blanks)                         (not diary-list-include-blanks)
# Line 604  This function is provided for optional u Line 604  This function is provided for optional u
604                                     :type 'diary-entry)                                     :type 'diary-entry)
605                    (insert entry ?\n))                    (insert entry ?\n))
606                  (save-excursion                  (save-excursion
607                    (setq marks (nth 4 (car entry-list)))                    (let* ((marks (nth 4 (car entry-list)))
608                    (setq temp-face (make-symbol (apply 'concat "temp-face-" (mapcar '(lambda (sym) (if (not (stringp sym)) (symbol-name sym) sym)) marks))))                           (temp-face (make-symbol
609                    (make-face temp-face)                                       (apply
610                    ;; Remove :face info from the marks, copy the face info into temp-face                                        'concat "temp-face-"
611                    (setq faceinfo marks)                                        (mapcar '(lambda (sym)
612                    (while (setq faceinfo (memq :face faceinfo))                                                   (if (stringp sym)
613                      (copy-face (read (nth 1 faceinfo)) temp-face)                                                       sym
614                      (setcar faceinfo nil)                                                     (symbol-name sym)))
615                      (setcar (cdr faceinfo) nil))                                                marks))))
616                    (setq marks (delq nil marks))                           faceinfo)
617                        ;; Remove :face info from the marks,
618                        ;; copy the face info into temp-face
619                        (setq faceinfo marks)
620                        (while (setq faceinfo (memq :face faceinfo))
621                          (copy-face (read (nth 1 faceinfo)) temp-face)
622                          (setcar faceinfo nil)
623                          (setcar (cdr faceinfo) nil))
624                        (setq marks (delq nil marks))
625                    ;; Apply the font aspects                    ;; Apply the font aspects
626                    (apply 'set-face-attribute temp-face nil marks)                      (apply 'set-face-attribute temp-face nil marks)
627                    (search-backward entry)                      (search-backward entry)
628                    (overlay-put                      (overlay-put
629                     (make-overlay (match-beginning 0) (match-end 0)) 'face temp-face))                       (make-overlay (match-beginning 0) (match-end 0))
630                  ))                       'face temp-face)))))
631            (setq entry-list (cdr entry-list))))            (setq entry-list (cdr entry-list))))
632        (set-buffer-modified-p nil)        (set-buffer-modified-p nil)
633        (goto-char (point-min))        (goto-char (point-min))
# Line 744  system.  Alternatively, you can specify Line 752  system.  Alternatively, you can specify
752  0 1 * * * diary-rem.sh  0 1 * * * diary-rem.sh
753  to run it every morning at 1am."  to run it every morning at 1am."
754    (interactive "P")    (interactive "P")
755    (let* ((diary-display-hook 'fancy-diary-display)    (let ((diary-display-hook 'fancy-diary-display))
756           (text (progn (list-diary-entries (calendar-current-date)      (list-diary-entries (calendar-current-date) (or ndays diary-mail-days)))
757                                            (if ndays ndays diary-mail-days))    (compose-mail diary-mail-addr
758                        (set-buffer fancy-diary-buffer)                  (concat "Diary entries generated "
759                        (buffer-substring (point-min) (point-max)))))                          (calendar-date-string (calendar-current-date))))
760      (compose-mail diary-mail-addr    (insert
761                    (if (string-equal text "")     (if (get-buffer fancy-diary-buffer)
762                        "No entries found"         (save-excursion
763                      (concat "Diary entries generated "           (set-buffer fancy-diary-buffer)
764                              (calendar-date-string (calendar-current-date)))))           (buffer-substring (point-min) (point-max)))
765      (insert text)       "No entries found"))
766      (funcall (get mail-user-agent 'sendfunc))))    (funcall (get mail-user-agent 'sendfunc)))
767    
768    
769  (defun diary-name-pattern (string-array &optional fullname)  (defun diary-name-pattern (string-array &optional fullname)
# Line 802  After the entries are marked, the hooks Line 810  After the entries are marked, the hooks
810                (set-buffer (find-file-noselect d-file t))                (set-buffer (find-file-noselect d-file t))
811                (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))                (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
812                (let ((d diary-date-forms)                (let ((d diary-date-forms)
813                      (old-diary-syntax-table))                      (old-diary-syntax-table (syntax-table))
814                  (setq old-diary-syntax-table (syntax-table))                      temp)
815                  (set-syntax-table diary-syntax-table)                  (set-syntax-table diary-syntax-table)
816                  (while d                  (while d
817                    (let*                    (let*
# Line 947  is marked.  See the documentation for th Line 955  is marked.  See the documentation for th
955          (setq marking-diary-entry nil))          (setq marking-diary-entry nil))
956        (re-search-backward "(")        (re-search-backward "(")
957        (let ((sexp-start (point))        (let ((sexp-start (point))
958              (sexp)              sexp entry entry-start line-start marks)
             (entry)  
             (entry-start)  
             (line-start))  
959          (forward-sexp)          (forward-sexp)
960          (setq sexp (buffer-substring-no-properties sexp-start (point)))          (setq sexp (buffer-substring-no-properties sexp-start (point)))
961          (save-excursion          (save-excursion
# Line 980  is marked.  See the documentation for th Line 985  is marked.  See the documentation for th
985                                  (calendar-gregorian-from-absolute date)))                                  (calendar-gregorian-from-absolute date)))
986                (progn                (progn
987                  (setq marks (diary-pull-attrs entry file-glob-attrs)                  (setq marks (diary-pull-attrs entry file-glob-attrs)
988                        temp (diary-pull-attrs entry file-glob-attrs)                        marks (nth 1 (diary-pull-attrs entry file-glob-attrs)))
                       marks (nth 1 temp))  
989                  (mark-visible-calendar-date                  (mark-visible-calendar-date
990                   (calendar-gregorian-from-absolute date)                   (calendar-gregorian-from-absolute date)
991                   (if (< 0 (length marks))                   (if (< 0 (length marks))
# Line 1287  best if they are nonmarking." Line 1291  best if they are nonmarking."
1291    (let* ((mark (regexp-quote diary-nonmarking-symbol))    (let* ((mark (regexp-quote diary-nonmarking-symbol))
1292           (sexp-mark (regexp-quote sexp-diary-entry-symbol))           (sexp-mark (regexp-quote sexp-diary-entry-symbol))
1293           (s-entry (concat "\\(\\`\\|\^M\\|\n\\)" mark "?" sexp-mark "("))           (s-entry (concat "\\(\\`\\|\^M\\|\n\\)" mark "?" sexp-mark "("))
1294           (entry-found)           entry-found file-glob-attrs marks)
          (file-glob-attrs)  
          (marks))  
1295      (goto-char (point-min))      (goto-char (point-min))
1296      (save-excursion      (save-excursion
1297        (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))))        (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))))
# Line 1324  best if they are nonmarking." Line 1326  best if they are nonmarking."
1326            (setq entry (buffer-substring-no-properties entry-start (point)))            (setq entry (buffer-substring-no-properties entry-start (point)))
1327            (while (string-match "[\^M]" entry)            (while (string-match "[\^M]" entry)
1328              (aset entry (match-beginning 0) ?\n )))              (aset entry (match-beginning 0) ?\n )))
1329          (let ((diary-entry (diary-sexp-entry sexp entry date)))          (let ((diary-entry (diary-sexp-entry sexp entry date))
1330                  temp)
1331            (setq entry (if (consp diary-entry)            (setq entry (if (consp diary-entry)
1332                            (cdr diary-entry)                            (cdr diary-entry)
1333                          diary-entry))                          diary-entry))
# Line 1601  marked on the calendar." Line 1604  marked on the calendar."
1604  (defun add-to-diary-list (date string specifier marker &optional globcolor)  (defun add-to-diary-list (date string specifier marker &optional globcolor)
1605    "Add the entry (DATE STRING SPECIFIER MARKER GLOBCOLOR) to `diary-entries-list'.    "Add the entry (DATE STRING SPECIFIER MARKER GLOBCOLOR) to `diary-entries-list'.
1606  Do nothing if DATE or STRING is nil."  Do nothing if DATE or STRING is nil."
1607    (and date string    (when (and date string)
1608         (if (and diary-file-name-prefix      (if diary-file-name-prefix
1609                  (setq prefix (concat "[" (funcall diary-file-name-prefix-function (buffer-file-name)) "] "))          (let ((prefix (funcall diary-file-name-prefix-function
1610                  (not (string= prefix "[] ")))                                 (buffer-file-name))))
1611             (setq string (concat prefix string))            (or (string= prefix "")
1612           t)                (setq string (format "[%s] %s" prefix string)))))
1613         (setq diary-entries-list      (setq diary-entries-list
1614               (append diary-entries-list            (append diary-entries-list
1615                       (list (list date string specifier marker globcolor))))))                    (list (list date string specifier marker globcolor))))))
1616    
1617  (defun make-diary-entry (string &optional nonmarking file)  (defun make-diary-entry (string &optional nonmarking file)
1618    "Insert a diary entry STRING which may be NONMARKING in FILE.    "Insert a diary entry STRING which may be NONMARKING in FILE.

Legend:
Removed from v.1.65  
changed lines
  Added in v.1.66

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26