[Emacs-diffs] Changes to emacs/lisp/calendar/diary-lib.el

[Glenn Morris]

Index: emacs/lisp/calendar/diary-lib.el
diff -c emacs/lisp/calendar/diary-lib.el:1.65 
emacs/lisp/calendar/diary-lib.el:1.66
*** emacs/lisp/calendar/diary-lib.el:1.65       Thu Apr 24 21:58:48 2003
--- emacs/lisp/calendar/diary-lib.el    Thu May  8 15:34:30 2003
***************
*** 213,219 ****
  diary-glob-file-regexp-prefix is prepended to the regexps before each
  search."
    (save-excursion
!     (let (regexp regnum attrname attr-list attrname attrvalue type)
        (if (null entry)
          (progn
            (setq ret-attr '()
--- 213,220 ----
  diary-glob-file-regexp-prefix is prepended to the regexps before each
  search."
    (save-excursion
!     (let (regexp regnum attrname attr-list attrname attrvalue type
!                  ret-attr attr)
        (if (null entry)
          (progn
            (setq ret-attr '()
***************
*** 256,263 ****
            (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))
  
  
  
--- 257,264 ----
            (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))))
  
  
  
***************
*** 377,383 ****
                             ;; add it to the list.
                             (setq entry-found t)
                             (let ((entry-start (point))
!                                  (date-start))
                               (re-search-backward "\^M\\|\n\\|\\`")
                               (setq date-start (point))
                               (re-search-forward "\^M\\|\n" nil t 2)
--- 378,384 ----
                             ;; add it to the list.
                             (setq entry-found t)
                             (let ((entry-start (point))
!                                  date-start temp)
                               (re-search-backward "\^M\\|\n\\|\\`")
                               (setq date-start (point))
                               (re-search-forward "\^M\\|\n" nil t 2)
***************
*** 388,401 ****
                                  (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)
--- 389,401 ----
                                  (point) ?\^M ?\n t)
                             (setq entry (buffer-substring entry-start (point))
                                   temp (diary-pull-attrs entry file-glob-attrs)
!                                  entry (nth 0 temp))
                               (add-to-diary-list
                                date
                              entry
                                (buffer-substring
                                 (1+ date-start) (1- entry-start))
!                             (copy-marker entry-start) (nth 1 temp))))))
                       (setq d (cdr d)))
                     (or entry-found
                         (not diary-list-include-blanks)
***************
*** 604,625 ****
                                   :type 'diary-entry)
                  (insert entry ?\n))
                (save-excursion
!                 (setq marks (nth 4 (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))
--- 604,633 ----
                                   :type 'diary-entry)
                  (insert entry ?\n))
                (save-excursion
!                   (let* ((marks (nth 4 (car entry-list)))
!                          (temp-face (make-symbol
!                                      (apply
!                                       'concat "temp-face-"
!                                       (mapcar '(lambda (sym)
!                                                  (if (stringp sym)
!                                                      sym
!                                                    (symbol-name sym)))
!                                               marks))))
!                          faceinfo)
!                     ;; 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))
***************
*** 744,761 ****
  0 1 * * * diary-rem.sh
  to run it every morning at 1am."
    (interactive "P")
!   (let* ((diary-display-hook 'fancy-diary-display)
!          (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)))))
!     (compose-mail diary-mail-addr
!                 (if (string-equal text "")
!                     "No entries found"
!                   (concat "Diary entries generated "
!                           (calendar-date-string (calendar-current-date)))))
!     (insert text)
!     (funcall (get mail-user-agent 'sendfunc))))
  
  
  (defun diary-name-pattern (string-array &optional fullname)
--- 752,769 ----
  0 1 * * * diary-rem.sh
  to run it every morning at 1am."
    (interactive "P")
!   (let ((diary-display-hook 'fancy-diary-display))
!     (list-diary-entries (calendar-current-date) (or ndays diary-mail-days)))
!   (compose-mail diary-mail-addr
!                 (concat "Diary entries generated "
!                         (calendar-date-string (calendar-current-date))))
!   (insert
!    (if (get-buffer fancy-diary-buffer)
!        (save-excursion
!          (set-buffer fancy-diary-buffer)
!          (buffer-substring (point-min) (point-max)))
!      "No entries found"))
!   (funcall (get mail-user-agent 'sendfunc)))
  
  
  (defun diary-name-pattern (string-array &optional fullname)
***************
*** 802,809 ****
                (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)
                  (while d
                    (let*
--- 810,817 ----
                (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 (syntax-table))
!                     temp)
                  (set-syntax-table diary-syntax-table)
                  (while d
                    (let*
***************
*** 947,956 ****
          (setq marking-diary-entry nil))
        (re-search-backward "(")
        (let ((sexp-start (point))
!             (sexp)
!             (entry)
!             (entry-start)
!             (line-start))
          (forward-sexp)
          (setq sexp (buffer-substring-no-properties sexp-start (point)))
          (save-excursion
--- 955,961 ----
          (setq marking-diary-entry nil))
        (re-search-backward "(")
        (let ((sexp-start (point))
!             sexp entry entry-start line-start marks)
          (forward-sexp)
          (setq sexp (buffer-substring-no-properties sexp-start (point)))
          (save-excursion
***************
*** 980,987 ****
                                  (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))
--- 985,991 ----
                                  (calendar-gregorian-from-absolute date)))
              (progn
                (setq marks (diary-pull-attrs entry file-glob-attrs)
!                     marks (nth 1 (diary-pull-attrs entry file-glob-attrs)))
                (mark-visible-calendar-date
                 (calendar-gregorian-from-absolute date)
                 (if (< 0 (length marks))
***************
*** 1287,1295 ****
    (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)
!        (marks))
      (goto-char (point-min))
      (save-excursion
        (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))))
--- 1291,1297 ----
    (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 marks)
      (goto-char (point-min))
      (save-excursion
        (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))))
***************
*** 1324,1330 ****
            (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))
--- 1326,1333 ----
            (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))
!               temp)
          (setq entry (if (consp diary-entry)
                          (cdr diary-entry)
                        diary-entry))
***************
*** 1601,1615 ****
  (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.
--- 1604,1618 ----
  (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."
!   (when (and date string)
!     (if diary-file-name-prefix
!         (let ((prefix (funcall diary-file-name-prefix-function
!                                (buffer-file-name))))
!           (or (string= prefix "")
!               (setq string (format "[%s] %s" prefix string)))))
!     (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.