[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-art.el

[Miles Bader]

Index: emacs/lisp/gnus/gnus-art.el
diff -c emacs/lisp/gnus/gnus-art.el:1.68 emacs/lisp/gnus/gnus-art.el:1.69
*** emacs/lisp/gnus/gnus-art.el:1.68    Wed Apr 13 21:38:06 2005
--- emacs/lisp/gnus/gnus-art.el Fri May  6 00:27:50 2005
***************
*** 2824,2895 ****
          (forward-line 1)
        (setq ended t)))))
  
! (defun article-date-ut (&optional type highlight header)
    "Convert DATE date to universal time in the current article.
  If TYPE is `local', convert to local time; if it is `lapsed', output
  how much time has lapsed since DATE.  For `lapsed', the value of
  `gnus-article-date-lapsed-new-header' says whether the \"X-Sent:\" header
  should replace the \"Date:\" one, or should be added below it."
    (interactive (list 'ut t))
!   (let* ((header (or header
!                    (message-fetch-field "date")
!                    ""))
!        (tdate-regexp "^Date:[ \t]\\|^X-Sent:[ \t]")
!        (date-regexp
!         (cond
!          ((not gnus-article-date-lapsed-new-header)
!           tdate-regexp)
!          ((eq type 'lapsed)
!           "^X-Sent:[ \t]")
!          (t
!           "^Date:[ \t]")))
!        (date (if (vectorp header) (mail-header-date header)
!                header))
         (inhibit-point-motion-hooks t)
!        pos
!        bface eface)
      (save-excursion
        (save-restriction
!       (article-narrow-to-head)
!       (when (re-search-forward tdate-regexp nil t)
!         (setq bface (get-text-property (gnus-point-at-bol) 'face)
!               date (or (get-text-property (gnus-point-at-bol)
!                                           'original-date)
!                        date)
!               eface (get-text-property (1- (gnus-point-at-eol)) 'face))
!         (forward-line 1))
!       (when (and date (not (string= date "")))
          (goto-char (point-min))
!         (let ((inhibit-read-only t))
!           ;; Delete any old Date headers.
!           (while (re-search-forward date-regexp nil t)
!             (if pos
!                 (delete-region (progn (beginning-of-line) (point))
!                                (progn (gnus-article-forward-header)
!                                       (point)))
!               (delete-region (progn (beginning-of-line) (point))
!                                (progn (gnus-article-forward-header)
!                                       (forward-char -1)
!                                       (point)))
!               (setq pos (point))))
!           (when (and (not pos)
!                      (re-search-forward tdate-regexp nil t))
!             (forward-line 1))
!           (when pos
!             (goto-char pos))
!           (insert (article-make-date-line date (or type 'ut)))
!           (unless pos
!             (insert "\n")
!             (forward-line -1))
!           ;; Do highlighting.
!           (beginning-of-line)
!           (when (looking-at "\\([^:]+\\): *\\(.*\\)$")
!             (put-text-property (match-beginning 1) (1+ (match-end 1))
!                                'original-date date)
!             (put-text-property (match-beginning 1) (1+ (match-end 1))
!                                'face bface)
!             (put-text-property (match-beginning 2) (match-end 2)
!                                'face eface))))))))
  
  (defun article-make-date-line (date type)
    "Return a DATE line of TYPE."
--- 2824,2899 ----
          (forward-line 1)
        (setq ended t)))))
  
! (defun article-date-ut (&optional type highlight)
    "Convert DATE date to universal time in the current article.
  If TYPE is `local', convert to local time; if it is `lapsed', output
  how much time has lapsed since DATE.  For `lapsed', the value of
  `gnus-article-date-lapsed-new-header' says whether the \"X-Sent:\" header
  should replace the \"Date:\" one, or should be added below it."
    (interactive (list 'ut t))
!   (let* ((tdate-regexp "^Date:[ \t]\\|^X-Sent:[ \t]")
!        (date-regexp (cond ((not gnus-article-date-lapsed-new-header)
!                            tdate-regexp)
!                           ((eq type 'lapsed)
!                            "^X-Sent:[ \t]")
!                           (article-lapsed-timer
!                            "^Date:[ \t]")
!                           (t
!                            tdate-regexp)))
!        (case-fold-search t)
!        (inhibit-read-only t)
         (inhibit-point-motion-hooks t)
!        pos date bface eface)
      (save-excursion
        (save-restriction
!       (widen)
!       (goto-char (point-min))
!       (while (or (setq date (get-text-property (setq pos (point))
!                                                'original-date))
!                  (when (setq pos (next-single-property-change
!                                   (point) 'original-date))
!                    (setq date (get-text-property pos 'original-date))
!                    t))
!         (narrow-to-region pos (or (text-property-any pos (point-max)
!                                                      'original-date nil)
!                                   (point-max)))
          (goto-char (point-min))
!         (when (re-search-forward tdate-regexp nil t)
!           (setq bface (get-text-property (gnus-point-at-bol) 'face)
!                 eface (get-text-property (1- (gnus-point-at-eol)) 'face)))
!         (goto-char (point-min))
!         (setq pos nil)
!         ;; Delete any old Date headers.
!         (while (re-search-forward date-regexp nil t)
!           (if pos
!               (delete-region (gnus-point-at-bol)
!                              (progn
!                                (gnus-article-forward-header)
!                                (point)))
!             (delete-region (gnus-point-at-bol)
!                            (progn
!                              (gnus-article-forward-header)
!                              (forward-char -1)
!                              (point)))
!             (setq pos (point))))
!         (when (and (not pos)
!                    (re-search-forward tdate-regexp nil t))
!           (forward-line 1))
!         (gnus-goto-char pos)
!         (insert (article-make-date-line date (or type 'ut)))
!         (unless pos
!           (insert "\n")
!           (forward-line -1))
!         ;; Do highlighting.
!         (beginning-of-line)
!         (when (looking-at "\\([^:]+\\): *\\(.*\\)$")
!           (put-text-property (match-beginning 1) (1+ (match-end 1))
!                              'face bface)
!           (put-text-property (match-beginning 2) (match-end 2)
!                              'face eface))
!         (put-text-property (point-min) (1- (point-max)) 'original-date date)
!         (goto-char (point-max))
!         (widen))))))
  
  (defun article-make-date-line (date type)
    "Return a DATE line of TYPE."
***************
*** 3075,3080 ****
--- 3079,3105 ----
    (interactive (list t))
    (article-date-ut 'iso8601 highlight))
  
+ (defmacro gnus-article-save-original-date (&rest forms)
+   "Save the original date as a text property and evaluate FORMS."
+   `(let* ((case-fold-search t)
+         (start (progn
+                  (goto-char (point-min))
+                  (when (and (re-search-forward "^date:[\t\n ]+" nil t)
+                             (not (bolp)))
+                    (match-end 0))))
+         (date (when (and start
+                          (re-search-forward "[\t ]*\n\\([^\t ]\\|\\'\\)"
+                                             nil t))
+                 (buffer-substring-no-properties start
+                                                 (match-beginning 0)))))
+      (goto-char (point-max))
+      (skip-chars-backward "\n")
+      (put-text-property (point-min) (point) 'original-date date)
+      ,@forms
+      (goto-char (point-max))
+      (skip-chars-backward "\n")
+      (put-text-property (point-min) (point) 'original-date date)))
+ 
  ;; (defun article-show-all ()
  ;;   "Show all hidden text in the article buffer."
  ;;   (interactive)
***************
*** 4686,4692 ****
            (save-restriction
              (article-goto-body)
              (narrow-to-region (point-min) (point))
!             (gnus-treat-article 'head))))))))
  
  (defcustom gnus-mime-display-multipart-as-mixed nil
    "Display \"multipart\" parts as  \"multipart/mixed\".
--- 4711,4718 ----
            (save-restriction
              (article-goto-body)
              (narrow-to-region (point-min) (point))
!             (gnus-article-save-original-date
!              (gnus-treat-article 'head)))))))))
  
  (defcustom gnus-mime-display-multipart-as-mixed nil
    "Display \"multipart\" parts as  \"multipart/mixed\".