procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge changes made in Gnus trunk.

Browse source 
gnus-art.el (gnus-article-next-page): Change last-line-displayed behaviour.
 (article-lapsed-string): Refactor out and allow specifying how many segments you want.
 (gnus-article-setup-buffer): Start updating the lapsed header directly.
 (gnus-article-update-lapsed-header): New variable.
shr.el (shr-put-color): Don't do the box padding in tables, since they're already padded.
gnus-util.el (float-time): If float-time is bound, always use it on all Emacsen.  It's unclear why the subrp check was there.
 (time-date): Require to make some autoload issues on XEmacs go away.
gnus-draft.el (gnus-draft-clear-marks): New function to be run as an exit hook to nix out all data on readedness on group exit.
gnus-sum.el (gnus-auto-select-subject): Doc typo.
This commit is contained in:
Lars Ingebrigtsen 2011-01-27 04:04:58 +00:00 • committed by Katsumi Yamaoka
parent e7f7fbaa11
commit 647559c299
6 changed files with 121 additions and 52 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
lisp/gnus/ChangeLog
View file

@ -1,5 +1,25 @@
2011-01-27 Lars Ingebrigtsen <larsi@gnus.org>
* gnus-draft.el (gnus-draft-clear-marks): New function to be run as an
exit hook to nix out all data on readedness on group exit.
* gnus-util.el (float-time): If float-time is bound, always use it on
all Emacsen. It's unclear why the subrp check was there.
(time-date): Require to make some autoload issues on XEmacs go away.
* shr.el (shr-put-color): Don't do the box padding in tables, since
they're already padded.
2011-01-26 Lars Ingebrigtsen <larsi@gnus.org>
* gnus-art.el (gnus-article-next-page): When the last line of the
article is displayed, scroll down once more instead of going to the
next article at once.
(article-lapsed-string): Refactor out and allow specifying how many
segments you want.
(gnus-article-setup-buffer): Start updating the lapsed header directly.
(gnus-article-update-lapsed-header): New variable.
* shr.el: Revert change that made headings use different-sized faces.
The Emacs display engine isn't advanced enough that, for instance,
tables can comfortably use differntly-sized faces.

133
lisp/gnus/gnus-art.el
View file

@ -1023,6 +1023,15 @@ be added below it (otherwise)."
:group 'gnus-article-headers
:type 'boolean)
(defcustom gnus-article-update-lapsed-header 1
"How often to update the lapsed date header.
If nil, don't update it at all."
:version "24.1"
:group 'gnus-article-headers
:type '(choice
(item :tag "Don't update" :value nil)
integer))
(defcustom gnus-article-mime-match-handle-function 'undisplayed-alternative
"Function called with a MIME handle as the argument.
This is meant for people who want to view first matched part.
@ -1290,6 +1299,14 @@ predicate. See Info node `(gnus)Customizing Articles'."
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-date-combined-lapsed 'head
"Display the Date header in a way that says how much time has elapsed.
Valid values are nil, t, `head', `first', `last', an integer or a
predicate. See Info node `(gnus)Customizing Articles'."
:group 'gnus-article-treat
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-date-original nil
"Display the date in the original timezone.
Valid values are nil, t, `head', `first', `last', an integer or a
@ -1680,6 +1697,7 @@ regexp."
(gnus-treat-date-user-defined gnus-article-date-user)
(gnus-treat-date-iso8601 gnus-article-date-iso8601)
(gnus-treat-date-lapsed gnus-article-date-lapsed)
(gnus-treat-date-combined-lapsed gnus-article-date-combined-lapsed)
(gnus-treat-display-x-face gnus-article-display-x-face)
(gnus-treat-display-face gnus-article-display-face)
(gnus-treat-hide-headers gnus-article-maybe-hide-headers)
@ -3500,7 +3518,8 @@ should replace the \"Date:\" one, or should be added below it."
(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 iso8601 lapsed english
combined-lapsed))
(error "Unknown conversion type: %s" type))
(condition-case ()
(let ((time (date-to-time date)))
@ -3548,47 +3567,11 @@ should replace the \"Date:\" one, or should be added below it."
(/ (% (abs tz) 3600) 60)))))
;; Do an X-Sent lapsed format.
((eq type 'lapsed)
;; If the date is seriously mangled, the timezone functions are
;; liable to bug out, so we ignore all errors.
(let* ((now (current-time))
(real-time (subtract-time now time))
(real-sec (and real-time
(+ (* (float (car real-time)) 65536)
(cadr real-time))))
(sec (and real-time (abs real-sec)))
num prev)
(cond
((null real-time)
"X-Sent: Unknown")
((zerop sec)
"X-Sent: Now")
(t
(concat
"X-Sent: "
;; This is a bit convoluted, but basically we go
;; through the time units for years, weeks, etc,
;; and divide things to see whether that results
;; in positive answers.
(mapconcat
(lambda (unit)
(if (zerop (setq num (ffloor (/ sec (cdr unit)))))
;; The (remaining) seconds are too few to
;; be divided into this time unit.
""
;; It's big enough, so we output it.
(setq sec (- sec (* num (cdr unit))))
(prog1
(concat (if prev ", " "") (int-to-string
(floor num))
" " (symbol-name (car unit))
(if (> num 1) "s" ""))
(setq prev t))))
article-time-units "")
;; If dates are odd, then it might appear like the
;; article was sent in the future.
(if (> real-sec 0)
" ago"
" in the future"))))))
(concat "X-Sent: " (article-lapsed-string time)))
;; A combined date/lapsed format.
((eq type 'combined-lapsed)
(concat (article-make-date-line date 'original)
" (" (article-lapsed-string time 3) ")"))
;; Display the date in proper English
((eq type 'english)
(let ((dtime (decode-time time)))
@ -3610,9 +3593,56 @@ should replace the \"Date:\" one, or should be added below it."
(format "%02d" (nth 2 dtime))
":"
(format "%02d" (nth 1 dtime)))))))
(error
(foo
(format "Date: %s (from Gnus)" date))))
(defun article-lapsed-string (time &optional max-segments)
;; If the date is seriously mangled, the timezone functions are
;; liable to bug out, so we ignore all errors.
(let* ((now (current-time))
(real-time (subtract-time now time))
(real-sec (and real-time
(+ (* (float (car real-time)) 65536)
(cadr real-time))))
(sec (and real-time (abs real-sec)))
(segments 0)
num prev)
(unless max-segments
(setq max-segments (length article-time-units)))
(cond
((null real-time)
"Unknown")
((zerop sec)
"Now")
(t
(concat
;; This is a bit convoluted, but basically we go
;; through the time units for years, weeks, etc,
;; and divide things to see whether that results
;; in positive answers.
(mapconcat
(lambda (unit)
(if (or (zerop (setq num (ffloor (/ sec (cdr unit)))))
(>= segments max-segments))
;; The (remaining) seconds are too few to
;; be divided into this time unit.
""
;; It's big enough, so we output it.
(setq sec (- sec (* num (cdr unit))))
(prog1
(concat (if prev ", " "") (int-to-string
(floor num))
" " (symbol-name (car unit))
(if (> num 1) "s" ""))
(setq prev t
segments (1+ segments)))))
article-time-units "")
;; If dates are odd, then it might appear like the
;; article was sent in the future.
(if (> real-sec 0)
" ago"
" in the future"))))))
(defun article-date-local (&optional highlight)
"Convert the current article date to the local timezone."
(interactive (list t))
@ -3635,6 +3665,11 @@ function and want to see what the date was before converting."
(interactive (list t))
(article-date-ut 'lapsed highlight))
(defun article-date-combined-lapsed (&optional highlight)
"Convert the current article date to time lapsed since it was sent."
(interactive (list t))
(article-date-ut 'combined-lapsed highlight))
(defun article-update-date-lapsed ()
"Function to be run from a timer to update the lapsed time line."
(save-match-data
@ -3647,8 +3682,10 @@ function and want to see what the date was before converting."
(when (eq major-mode 'gnus-article-mode)
(let ((mark (point-marker)))
(goto-char (point-min))
(when (re-search-forward "^X-Sent:" nil t)
(article-date-lapsed t))
(when (re-search-forward "^X-Sent:\\|^Date:" nil t)
(if gnus-treat-date-combined-lapsed
(article-date-combined-lapsed t)
(article-date-lapsed t)))
(goto-char (marker-position mark))
(move-marker mark nil))))
nil 'visible))))))
@ -4296,6 +4333,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
article-decode-encoded-words
article-date-user
article-date-lapsed
article-date-combined-lapsed
article-emphasize
article-treat-dumbquotes
article-treat-non-ascii
@ -4492,6 +4530,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-lapsed-header
(not article-lapsed-timer))
(gnus-start-date-timer gnus-article-update-lapsed-header))
(current-buffer)))))
;; Set article window start at LINE, where LINE is the number of lines
@ -6267,7 +6308,7 @@ Argument LINES specifies lines to be scrolled up."
(save-excursion
(end-of-line)
(and (pos-visible-in-window-p) ;Not continuation line.
(>= (1+ (point)) (point-max))))) ;Allow for trailing newline.
(>= (point) (point-max)))))
;; Nothing in this page.
(if (or (not gnus-page-broken)
(save-excursion

9
lisp/gnus/gnus-draft.el
View file

@ -68,7 +68,8 @@
(gnus-draft-mode
;; Set up the menu.
(when (gnus-visual-p 'draft-menu 'menu)
(gnus-draft-make-menu-bar)))))
(gnus-draft-make-menu-bar))
(add-hook 'gnus-summary-prepare-exit-hook 'gnus-draft-clear-marks t t))))
;;; Commands
@ -325,6 +326,12 @@ Obeys the standard process/prefix convention."
(pop-to-buffer buff t)))
(error "The draft %s is under edit" file)))))
(defun gnus-draft-clear-marks ()
(setq gnus-newsgroup-reads nil
gnus-newsgroup-marked nil
gnus-newsgroup-unreads
(gnus-uncompress-range (gnus-active gnus-newsgroup-name))))
(provide 'gnus-draft)
;;; gnus-draft.el ends here

2
lisp/gnus/gnus-sum.el
View file

@ -359,7 +359,7 @@ first subject), `unread' (place point on the subject line of the first
unread article), `best' (place point on the subject line of the
higest-scored article), `unseen' (place point on the subject line of
the first unseen article), `unseen-or-unread' (place point on the subject
line of the first unseen article or, if all article have been seen, on the
line of the first unseen article or, if all articles have been seen, on the
subject line of the first unread article), or a function to be called to
place point on some subject line."
:version "24.1"

6
lisp/gnus/gnus-util.el
View file

@ -38,6 +38,8 @@
(eval-when-compile
(require 'cl))
(require 'time-date)
(defcustom gnus-completing-read-function 'gnus-emacs-completing-read
"Function use to do completing read."
:version "24.1"
@ -332,9 +334,7 @@ Symbols are also allowed; their print names are used instead."
(> (nth 1 fdate) (nth 1 date))))))
(eval-and-compile
(if (or (featurep 'emacs)
(and (fboundp 'float-time)
(subrp (symbol-function 'float-time))))
(if (fboundp 'float-time)
(defalias 'gnus-float-time 'float-time)
(defun gnus-float-time (&optional time)
"Convert time value TIME to a floating point number.

3
lisp/gnus/shr.el
View file

@ -619,7 +619,8 @@ ones, in case fg and bg are nil."
(if (< (line-end-position) end)
(forward-line 1)
(goto-char end)))
(when (eq type :background)
(when (and (eq type :background)
(= shr-table-depth 0))
(shr-expand-newlines start end color))))
(defun shr-expand-newlines (start end color)