X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=2a36c43130c1efe9b27ee1960d25d8d198e56057;hb=d7925de009d5e3047e07e52657d7312d9f97979c;hp=e0ff5f2c17e18372655d6c8a4597d083429e1f78;hpb=5b81b4b7b447c64f3c09bad8541b3dfa71c392d1;p=gnus diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index e0ff5f2c1..2a36c4313 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -683,7 +683,7 @@ beginning of a line." :type 'regexp :group 'gnus-article-various) -(defcustom gnus-article-mode-line-format "Gnus: %g [%w] %S%m" +(defcustom gnus-article-mode-line-format "Gnus: %g %S%m" "*The format specification for the article mode line. See `gnus-summary-mode-line-format' for a closer description. @@ -691,6 +691,7 @@ The following additional specs are available: %w The article washing status. %m The number of MIME parts in the article." + :version "24.1" :type 'string :group 'gnus-article-various) @@ -1014,21 +1015,7 @@ on parts -- for instance, adding Vcard info to a database." :group 'gnus-article-mime :type '(repeat (cons :format "%v" (string :tag "MIME type") function))) -(defcustom gnus-article-date-headers - (let ((types '(ut local english lapsed combined-lapsed - iso8601 original user-defined)) - default) - (dolist (type types) - (let ((variable (intern (format "gnus-treat-date-%s" type)))) - (when (and (boundp variable) - (symbol-value variable)) - (push type default)))) - (when (and (or (not (boundp (intern "gnus-article-date-lapsed-new-header"))) - (not (symbol-value (intern "gnus-article-date-lapsed-new-header")))) - (memq 'lapsed default)) - (setq default (delq 'lapsed default))) - (or default - '(combined-lapsed))) +(defcustom gnus-article-date-headers '(combined-lapsed) "A list of Date header formats to display. Valid formats are `ut' (universal time), `local' (local time zone), `english' (readable English), `lapsed' (elapsed time), @@ -1053,7 +1040,7 @@ Some of these headers are updated automatically. See (item :tag "User-defined" :value 'user-defined))) (defcustom gnus-article-update-date-headers 1 - "How often to update the date header. + "A number that says how often to update the date header (in seconds). If nil, don't update it at all." :version "24.1" :group 'gnus-article-headers @@ -3417,69 +3404,62 @@ possible values." (inhibit-read-only t) (inhibit-point-motion-hooks t) (first t) + (visible-date (mail-fetch-field "Date")) 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 (if (setq pos (text-property-any pos (point-max) - 'original-date nil)) - (progn - (goto-char pos) - (if (or (bolp) (eobp)) - (point) - (1+ (point)))) - (point-max))) - (goto-char (point-min)) - (when (re-search-forward "^Date:" nil t) - (setq bface (get-text-property (point-at-bol) 'face) - eface (get-text-property (1- (point-at-eol)) 'face))) - (goto-char (point-min)) - ;; Delete any old Date headers. - (if date-position - (progn - (goto-char date-position) - (delete-region (point) - (progn - (gnus-article-forward-header) - (point)))) - (while (re-search-forward "^Date:" nil t) - (delete-region (point-at-bol) (progn - (gnus-article-forward-header) - (point))))) - (dolist (this-type (cond - ((null type) - (list 'ut)) - ((atom type) - (list type)) - (t - type))) - (insert (article-make-date-line date (or this-type 'ut)) "\n") - (forward-line -1) - (put-text-property (line-beginning-position) - (1+ (line-beginning-position)) - 'gnus-date-type this-type) - ;; 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)))))) + (when (re-search-forward "^Date:" nil t) + (setq bface (get-text-property (point-at-bol) 'face) + eface (get-text-property (1- (point-at-eol)) 'face))) + (goto-char (point-min)) + ;; Delete any old Date headers. + (if date-position + (progn + (goto-char date-position) + (setq date (get-text-property (point) 'original-date)) + (delete-region (point) + (progn + (gnus-article-forward-header) + (point))) + (article-transform-date date type bface eface)) + (while (re-search-forward "^Date:" nil t) + (setq date (get-text-property (match-beginning 0) 'original-date)) + (delete-region (point-at-bol) (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))))))) + +(defun article-transform-date (date type bface eface) + (dolist (this-type (cond + ((null type) + (list 'ut)) + ((atom type) + (list type)) + (t + type))) + (insert (article-make-date-line date (or this-type 'ut)) "\n") + (forward-line -1) + (beginning-of-line) + (put-text-property (point) (1+ (point)) + 'original-date date) + (put-text-property (point) (1+ (point)) + 'gnus-date-type this-type) + ;; Do highlighting. + (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)) + (forward-line 1))) (defun article-make-date-line (date type) "Return a DATE line of TYPE." - (unless (memq type '(local ut original user iso8601 lapsed english + (unless (memq type '(local ut original user-defined iso8601 lapsed english combined-lapsed)) (error "Unknown conversion type: %s" type)) (condition-case () @@ -3508,7 +3488,7 @@ possible values." (substring date 0 (match-beginning 0)) date))) ;; Let the user define the format. - ((eq type 'user) + ((eq type 'user-defined) (let ((format (or (condition-case nil (with-current-buffer gnus-summary-buffer gnus-article-time-format) @@ -3646,31 +3626,43 @@ function and want to see what the date was before converting." (defun article-update-date-lapsed () "Function to be run from a timer to update the lapsed time line." (save-match-data - (let (deactivate-mark) - (save-window-excursion - (ignore-errors - (walk-windows - (lambda (w) - (set-buffer (window-buffer w)) - (when (eq major-mode 'gnus-article-mode) - (let ((old-line (count-lines (point-min) (point))) - (old-column (current-column))) - (goto-char (point-min)) - (while (re-search-forward "^Date:" nil t) - (let ((type (get-text-property (match-beginning 0) 'gnus-date-type))) - (when (memq type '(lapsed combined-lapsed user-format)) - (save-excursion - (article-date-ut type t (match-beginning 0))) - (forward-line 1)))) - (goto-char (point-min)) - (when (> old-column 0) - (setq old-line (1- old-line))) - (forward-line old-line) - (end-of-line) - (when (> (current-column) old-column) - (beginning-of-line) - (forward-char old-column))))) - nil 'visible)))))) + (let ((buffer (current-buffer))) + (ignore-errors + (walk-windows + (lambda (w) + (set-buffer (window-buffer w)) + (when (eq major-mode 'gnus-article-mode) + (let ((old-line (count-lines (point-min) (point))) + (old-column (- (point) (line-beginning-position))) + (window-start + (window-start (get-buffer-window (current-buffer))))) + (goto-char (point-min)) + (while (re-search-forward "^Date:" nil t) + (let ((type (get-text-property (match-beginning 0) + 'gnus-date-type))) + (when (memq type '(lapsed combined-lapsed user-format)) + (when (and window-start + (not (= window-start + (save-excursion + (forward-line 1) + (point))))) + (setq window-start nil)) + (save-excursion + (article-date-ut type t (match-beginning 0))) + (forward-line 1) + (when window-start + (set-window-start (get-buffer-window (current-buffer)) + (point)))))) + (goto-char (point-min)) + (when (> old-column 0) + (setq old-line (1- old-line))) + (forward-line old-line) + (end-of-line) + (when (> (current-column) old-column) + (beginning-of-line) + (forward-char old-column))))) + nil 'visible)) + (set-buffer buffer)))) (defun gnus-start-date-timer (&optional n) "Start a timer to update the Date headers in the article buffers. @@ -4513,8 +4505,9 @@ commands: (setq gnus-summary-buffer (gnus-summary-buffer-name gnus-newsgroup-name)) (gnus-summary-set-local-parameters gnus-newsgroup-name) - (when (and gnus-article-update-date-headers - (not article-lapsed-timer)) + (when article-lapsed-timer + (gnus-stop-date-timer)) + (when gnus-article-update-date-headers (gnus-start-date-timer gnus-article-update-date-headers)) (current-buffer))))) @@ -4641,6 +4634,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (forward-line -1)) (set-window-point (get-buffer-window (current-buffer)) (point)) (gnus-configure-windows 'article) + (gnus-run-hooks 'gnus-article-prepare-hook) t)))))) ;;;###autoload @@ -4658,8 +4652,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." gnus-article-image-alist nil) (gnus-run-hooks 'gnus-tmp-internal-hook) (when gnus-display-mime-function - (funcall gnus-display-mime-function)) - (gnus-run-hooks 'gnus-article-prepare-hook))) + (funcall gnus-display-mime-function)))) ;;; ;;; Gnus Sticky Article Mode @@ -4884,8 +4877,6 @@ General format specifiers can also be used. See Info node (when (zerop parts) (error "No such part")) (pop-to-buffer gnus-article-buffer) - ;; FIXME: why is it necessary? - (sit-for 0) (or n (setq n (if (= parts 1) 1 @@ -6328,7 +6319,8 @@ specifies." (defun gnus-article-next-page-1 (lines) (condition-case () - (let ((scroll-in-place nil)) + (let ((scroll-in-place nil) + (auto-window-vscroll nil)) (scroll-up lines)) (end-of-buffer ;; Long lines may cause an end-of-buffer error. @@ -7348,9 +7340,6 @@ as a symbol to FUN." (defvar gnus-button-handle-describe-prefix "^\\(C-h\\|?\\)") -;; FIXME: Maybe we should merge some of the functions that do quite similar -;; stuff? - (defun gnus-button-handle-describe-function (url) "Call `describe-function' when pushing the corresponding URL button." (describe-function