Function: article-date-ut

article-date-ut is an interactive and byte-compiled function defined in gnus-art.el.gz.

Signature

(article-date-ut &optional TYPE HIGHLIGHT DATE-POSITION)

Documentation

Convert DATE date to TYPE in the current article.

The default type is ut. See gnus-article-date-headers for possible values.

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/gnus-art.el.gz
(defun article-date-ut (&optional type _highlight date-position)
  "Convert DATE date to TYPE in the current article.
The default type is `ut'.  See `gnus-article-date-headers' for
possible values."
  (interactive (list 'ut t) gnus-article-mode)
  (let* ((case-fold-search t)
	 (inhibit-read-only t)
	 (visible-date (mail-fetch-field "Date"))
	 pos date bface eface)
    (save-excursion
      (if date-position
	  (progn
	    (goto-char date-position)
	    (setq date (get-text-property (point) 'original-date))
	    (beginning-of-line)
	    (when (looking-at "[^:]+:[\t ]*")
	      (setq bface (get-text-property (match-beginning 0) 'face)
		    eface (get-text-property (match-end 0) 'face)))
	    (goto-char date-position)
	    (delete-region
	     (or (and (bolp) date-position)
		 ;; There might be space(s) added for line unfolding.
		 (and (get-text-property date-position 'gnus-date-type)
		      (< (skip-chars-backward "\t ") 0)
		      (text-property-any (point) date-position
					 'gnus-date-type nil))
		 date-position)
	     (progn (gnus-article-forward-header) (point)))
	    (article-transform-date date type bface eface))
	(save-restriction
	  (widen)
	  (goto-char (point-min))
	  (while (or (get-text-property (setq pos (point)) 'original-date)
		     (and (setq pos (next-single-property-change
				     (point) 'original-date))
			  (goto-char pos)))
	    (narrow-to-region pos (if (search-forward "\n\n" nil t)
				      (1+ (match-beginning 0))
				    (point-max)))
	    (while (setq pos (text-property-not-all pos (point-max)
						    'gnus-date-type nil))
	      (setq date (get-text-property pos 'original-date))
	      (goto-char pos)
	      (when (looking-at "[^:]+:[\t ]*")
		(setq bface (get-text-property (match-beginning 0) 'face)
		      eface (get-text-property (match-end 0) 'face)))
	      ;; Note: a feature like `gnus-treat-unfold-headers' breaks
	      ;; the continuity of text props of a multi-line Date header,
	      ;; that a user-defined date format might create, by adding
	      ;; spaces.  So, don't rely on gnus-date-type or original-date
	      ;; text prop in case of searching for the header boundary.
	      (delete-region pos (progn
				   (gnus-article-forward-header)
				   (point))))
	    (unless date ;; the 1st time
	      (goto-char (point-min))
	      (while (re-search-forward "^Date:[\t ]*" nil t)
		(setq date (get-text-property (match-beginning 0)
					      'original-date)
		      bface (get-text-property (match-beginning 0) 'face)
		      eface (get-text-property (match-end 0) 'face))
                (delete-region (line-beginning-position)
                               (progn
                                 (gnus-article-forward-header)
                                 (point)))))
	    (when (and (not date)
		       visible-date)
	      (setq date visible-date))
	    (when date
	      (article-transform-date date type bface eface))
	    (goto-char (point-max))
	    (widen)))))))