mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-23 07:19:15 +00:00
Code Issues Releases Activity

Merge changes made in Gnus trunk.

Browse Source 
gnus-util.el: change default value of gnus-user-date-format-alist.
gnus-art.el (gnus-article-jump-to-part): Remove useless sit-for.
gnus-art.el: remove old FIXME.
gnus.el (gnus-summary-line-format): Add missing semi-colon for user-date in docstring.
message.el (message-setup-1): Always generate References first.
 (message-mail): Return the return value of message-setup, not always t.
gnus-start.el (gnus-read-active-for-groups): This function is never called with a nil `infos', so clean that up.
 (gnus-get-unread-articles): Request active files from primary/secondary methods that have no groups (yet).
 (message-setup-1): Insert mail-header-separator with read-only and intangible properties set.
gnus-draft.el: Remove progn around gnus-draft-setup.
gnus-start.el (gnus-get-unread-articles): Fix the call to methods that have no groups.
nnimap.el (nnimap-request-accept-article): Give an error message if the APPEND wasn't successful.
This commit is contained in:
Gnus developers 2011-02-03 23:43:22 +00:00 committed by Katsumi Yamaoka
parent 5dc7a1d2c4
commit 0d1c2cc8c8
10 changed files with 233 additions and 177 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
doc/misc/gnus.texi
View File

@ -4941,7 +4941,7 @@ Download mark.
Desired cursor position (instead of after first colon).
@item &user-date;
Age sensitive date format. Various date format is defined in
@code{gnus-user-date-format-alist}.
@code{gnus-summary-user-date-format-alist}.
@item u
User defined specifier. The next character in the format string should
be a letter. Gnus will call the function

40
lisp/gnus/ChangeLog
View File

@ -1,3 +1,43 @@
2011-02-03 Lars Ingebrigtsen <larsi@gnus.org>
* nnimap.el (nnimap-request-accept-article): Give an error message if
the APPEND wasn't successful.
2011-02-03 Adam Sjøgren <asjo@koldfront.dk>
* gnus-start.el (gnus-get-unread-articles): Fix the call to methods
that have no groups.
2011-02-03 Julien Danjou <julien@danjou.info>
* gnus-draft.el: Remove progn around gnus-draft-setup.
2011-02-03 Lars Ingebrigtsen <larsi@gnus.org>
* gnus-start.el (gnus-read-active-for-groups): This function is never
called with a nil `infos', so clean that up.
(gnus-get-unread-articles): Request active files from primary/secondary
methods that have no groups (yet).
2011-02-03 Julien Danjou <julien@danjou.info>
* message.el (message-setup-1): Always generate References first.
(message-mail): Return the return value of message-setup, not always t.
(message-setup-1): Insert mail-header-separator with read-only and
intangible properties set.
* gnus.el (gnus-summary-line-format): Add missing semi-colon for
user-date in docstring.
* gnus-art.el (gnus-article-jump-to-part): Remove useless sit-for.
* gnus.el (gnus-summary-line-format): Mention &user-date format in
docstring.
* gnus.el (gnus-user-date-format-alist): Change default value. Use
defcustom, with type and group. Move from gnus-util.el. Rename to
gnus-summary-user-date-format-alist.
2011-02-03 Glenn Morris <rgm@gnu.org>
* nnimap.el (gnus-fetch-headers): Declare.

5
lisp/gnus/gnus-art.el
View File

@ -4874,8 +4874,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
@ -7338,9 +7336,6 @@ as a symbol to FUN."
(defvar gnus-button-handle-describe-prefix "^\\(C-h\\|<?[Ff]1>?\\)")
;; 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

90
lisp/gnus/gnus-draft.el
View File

@ -244,55 +244,49 @@ Obeys the standard process/prefix convention."
:version "23.1" ;; No Gnus
:type 'hook)
;;; Utility functions
;;;!!!If this is byte-compiled, it fails miserably.
;;;!!!This is because `gnus-setup-message' uses uninterned symbols.
;;;!!!This has been fixed in recent versions of Emacs and XEmacs,
;;;!!!but for the time being, we'll just run this tiny function uncompiled.
(progn
(defun gnus-draft-setup (narticle group &optional restore)
(let (ga)
(gnus-setup-message 'forward
(let ((article narticle))
(message-mail)
(erase-buffer)
(if (not (gnus-request-restore-buffer article group))
(error "Couldn't restore the article")
(when (and restore
(equal group "nndraft:queue"))
(mime-to-mml))
;; Insert the separator.
(goto-char (point-min))
(search-forward "\n\n")
(forward-char -1)
(save-restriction
(narrow-to-region (point-min) (point))
(setq ga
(message-fetch-field gnus-draft-meta-information-header)))
(insert mail-header-separator)
(forward-line 1)
(message-set-auto-save-file-name))))
(gnus-backlog-remove-article group narticle)
(when (and ga
(ignore-errors (setq ga (car (read-from-string ga)))))
(setq gnus-newsgroup-name
(if (equal (car ga) "") nil (car ga)))
(gnus-configure-posting-styles)
(setq gnus-message-group-art (cons gnus-newsgroup-name (cadr ga)))
(setq message-post-method
`(lambda (arg)
(gnus-post-method arg ,(car ga))))
(unless (equal (cadr ga) "")
(dolist (article (cdr ga))
(message-add-action
`(progn
(gnus-add-mark ,(car ga) 'replied ,article)
(gnus-request-set-mark ,(car ga) (list (list (list ,article)
'add '(reply)))))
'send))))
(run-hooks 'gnus-draft-setup-hook))))
(defun gnus-draft-setup (narticle group &optional restore)
(let (ga)
(gnus-setup-message 'forward
(let ((article narticle))
(message-mail)
(let ((inhibit-read-only t))
(erase-buffer))
(if (not (gnus-request-restore-buffer article group))
(error "Couldn't restore the article")
(when (and restore
(equal group "nndraft:queue"))
(mime-to-mml))
;; Insert the separator.
(goto-char (point-min))
(search-forward "\n\n")
(forward-char -1)
(save-restriction
(narrow-to-region (point-min) (point))
(setq ga
(message-fetch-field gnus-draft-meta-information-header)))
(insert mail-header-separator)
(forward-line 1)
(message-set-auto-save-file-name))))
(gnus-backlog-remove-article group narticle)
(when (and ga
(ignore-errors (setq ga (car (read-from-string ga)))))
(setq gnus-newsgroup-name
(if (equal (car ga) "") nil (car ga)))
(gnus-configure-posting-styles)
(setq gnus-message-group-art (cons gnus-newsgroup-name (cadr ga)))
(setq message-post-method
`(lambda (arg)
(gnus-post-method arg ,(car ga))))
(unless (equal (cadr ga) "")
(dolist (article (cdr ga))
(message-add-action
`(progn
(gnus-add-mark ,(car ga) 'replied ,article)
(gnus-request-set-mark ,(car ga) (list (list (list ,article)
'add '(reply)))))
'send))))
(run-hooks 'gnus-draft-setup-hook)))
(defun gnus-draft-article-sendable-p (article)
"Say whether ARTICLE is sendable."

13
lisp/gnus/gnus-start.el
View File

@ -1705,6 +1705,15 @@ If SCAN, request a scan of that group as well."
(setcar (nthcdr 3 elem)
(gnus-retrieve-group-data-early method infos)))))))
;; If we have primary/secondary select methods, but no groups from
;; them, we still want to issue a retrieval request from them.
(dolist (method (cons gnus-select-method
gnus-secondary-select-methods))
(when (and (not (assoc method type-cache))
(gnus-check-backend-function 'request-list (car method)))
(with-current-buffer nntp-server-buffer
(gnus-read-active-file-1 method nil))))
;; Do the rest of the retrieval.
(dolist (elem type-cache)
(destructuring-bind (method method-type infos early-data) elem
@ -1747,14 +1756,12 @@ If SCAN, request a scan of that group as well."
;; methods.
((and
(gnus-check-backend-function 'finish-retrieve-group-infos (car method))
infos
(or (not (gnus-agent-method-p method))
(gnus-online method)))
(gnus-finish-retrieve-group-infos method infos early-data)
(gnus-agent-save-active method))
;; Most backends have -retrieve-groups.
((and (gnus-check-backend-function 'retrieve-groups (car method))
infos)
((gnus-check-backend-function 'retrieve-groups (car method))
(when (gnus-check-backend-function 'request-scan (car method))
(gnus-request-scan nil method))
(let (groups)

52
lisp/gnus/gnus-sum.el
View File

@ -1395,7 +1395,7 @@ the normal Gnus MIME machinery."
(?u gnus-tmp-user-defined ?s)
(?P (gnus-pick-line-number) ?d)
(?B gnus-tmp-thread-tree-header-string ?s)
(user-date (gnus-user-date
(user-date (gnus-summary-user-date
,(macroexpand '(mail-header-date gnus-tmp-header))) ?s))
"An alist of format specifications that can appear in summary lines.
These are paired with what variables they correspond with, along with
@ -3852,6 +3852,56 @@ This function is intended to be used in
((< c (* 1000 10000)) (format "%1.1fM" (/ c (* 1024.0 1024))))
(t (format "%dM" (/ c (* 1024.0 1024)))))))
(defcustom gnus-summary-user-date-format-alist
'(((gnus-seconds-today) . "Today, %H:%M")
((+ 86400 (gnus-seconds-today)) . "Yesterday, %H:%M")
(604800 . "%A %H:%M") ; That's one week
((gnus-seconds-month) . "%A %d")
((gnus-seconds-year) . "%B %d")
(t . "%b %d %Y")) ; This one is used when no other
; does match
"Specifies date format depending on age of article.
This is an alist of items (AGE . FORMAT). AGE can be a number (of
seconds) or a Lisp expression evaluating to a number. When the age of
the article is less than this number, then use `format-time-string'
with the corresponding FORMAT for displaying the date of the article.
If AGE is not a number or a Lisp expression evaluating to a
non-number, then the corresponding FORMAT is used as a default value.
Note that the list is processed from the beginning, so it should be
sorted by ascending AGE. Also note that items following the first
non-number AGE will be ignored.
You can use the functions `gnus-seconds-today', `gnus-seconds-month'
and `gnus-seconds-year' in the AGE spec. They return the number of
seconds passed since the start of today, of this month, of this year,
respectively."
:version "24.1"
:group 'gnus-summary-format
:type '(alist :key-type sexp :value-type string))
(make-obsolete-variable 'gnus-user-date-format-alist
'gnus-summary-user-date-format-alist "24.1")
(defun gnus-summary-user-date (messy-date)
"Format the messy-date according to `gnus-summary-user-date-format-alist'.
Returns \" ? \" if there's bad input or if another error occurs.
Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"."
(condition-case ()
(let* ((messy-date (gnus-float-time (gnus-date-get-time messy-date)))
(now (gnus-float-time))
;;If we don't find something suitable we'll use this one
(my-format "%b %d '%y"))
(let* ((difference (- now messy-date))
(templist gnus-summary-user-date-format-alist)
(top (eval (caar templist))))
(while (if (numberp top) (< top difference) (not top))
(progn
(setq templist (cdr templist))
(setq top (eval (caar templist)))))
(if (stringp (cdr (car templist)))
(setq my-format (cdr (car templist)))))
(format-time-string (eval my-format) (seconds-to-time messy-date)))
(error " ? ")))
(defun gnus-summary-set-local-parameters (group)
"Go through the local params of GROUP and set all variable specs in that list."

45
lisp/gnus/gnus-util.el
View File

@ -477,51 +477,6 @@ Cache the result as a text property stored in DATE."
(put-text-property 0 1 'gnus-time time d)
time)))))
(defvar gnus-user-date-format-alist
'(((gnus-seconds-today) . "%k:%M")
(604800 . "%a %k:%M") ;;that's one week
((gnus-seconds-month) . "%a %d")
((gnus-seconds-year) . "%b %d")
(t . "%b %d '%y")) ;;this one is used when no
;;other does match
"Specifies date format depending on age of article.
This is an alist of items (AGE . FORMAT). AGE can be a number (of
seconds) or a Lisp expression evaluating to a number. When the age of
the article is less than this number, then use `format-time-string'
with the corresponding FORMAT for displaying the date of the article.
If AGE is not a number or a Lisp expression evaluating to a
non-number, then the corresponding FORMAT is used as a default value.
Note that the list is processed from the beginning, so it should be
sorted by ascending AGE. Also note that items following the first
non-number AGE will be ignored.
You can use the functions `gnus-seconds-today', `gnus-seconds-month'
and `gnus-seconds-year' in the AGE spec. They return the number of
seconds passed since the start of today, of this month, of this year,
respectively.")
(defun gnus-user-date (messy-date)
"Format the messy-date according to gnus-user-date-format-alist.
Returns \" ? \" if there's bad input or if another error occurs.
Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"."
(condition-case ()
(let* ((messy-date (gnus-float-time (gnus-date-get-time messy-date)))
(now (gnus-float-time))
;;If we don't find something suitable we'll use this one
(my-format "%b %d '%y"))
(let* ((difference (- now messy-date))
(templist gnus-user-date-format-alist)
(top (eval (caar templist))))
(while (if (numberp top) (< top difference) (not top))
(progn
(setq templist (cdr templist))
(setq top (eval (caar templist)))))
(if (stringp (cdr (car templist)))
(setq my-format (cdr (car templist)))))
(format-time-string (eval my-format) (seconds-to-time messy-date)))
(error " ? ")))
(defun gnus-dd-mmm (messy-date)
"Return a string like DD-MMM from a big messy string."
(condition-case ()

100
lisp/gnus/gnus.el
View File

@ -2908,50 +2908,62 @@ gnus-registry.el will populate this if it's loaded.")
It works along the same lines as a normal formatting string,
with some simple extensions.
%N Article number, left padded with spaces (string)
%S Subject (string)
%s Subject if it is at the root of a thread, and \"\" otherwise (string)
%n Name of the poster (string)
%a Extracted name of the poster (string)
%A Extracted address of the poster (string)
%F Contents of the From: header (string)
%f Contents of the From: or To: headers (string)
%x Contents of the Xref: header (string)
%D Date of the article (string)
%d Date of the article (string) in DD-MMM format
%o Date of the article (string) in YYYYMMDD`T'HHMMSS format
%M Message-id of the article (string)
%r References of the article (string)
%c Number of characters in the article (integer)
%k Pretty-printed version of the above (string)
For example, \"1.2k\" or \"0.4M\".
%L Number of lines in the article (integer)
%I Indentation based on thread level (a string of spaces)
%B A complex trn-style thread tree (string)
The variables `gnus-sum-thread-*' can be used for customization.
%T A string with two possible values: 80 spaces if the article
is on thread level two or larger and 0 spaces on level one
%R \"A\" if this article has been replied to, \" \" otherwise (character)
%U Status of this article (character, \"R\", \"K\", \"-\" or \" \")
%[ Opening bracket (character, \"[\" or \"<\")
%] Closing bracket (character, \"]\" or \">\")
%> Spaces of length thread-level (string)
%< Spaces of length (- 20 thread-level) (string)
%i Article score (number)
%z Article zcore (character)
%t Number of articles under the current thread (number).
%e Whether the thread is empty or not (character).
%V Total thread score (number).
%P The line number (number).
%O Download mark (character).
%* If present, indicates desired cursor position
(instead of after first colon).
%u User defined specifier. The next character in the format string should
be a letter. Gnus will call the function gnus-user-format-function-X,
where X is the letter following %u. The function will be passed the
current header as argument. The function should return a string, which
will be inserted into the summary just like information from any other
summary specifier.
%N Article number, left padded with spaces (string)
%S Subject (string)
%s Subject if it is at the root of a thread, and \"\"
otherwise (string)
%n Name of the poster (string)
%a Extracted name of the poster (string)
%A Extracted address of the poster (string)
%F Contents of the From: header (string)
%f Contents of the From: or To: headers (string)
%x Contents of the Xref: header (string)
%D Date of the article (string)
%d Date of the article (string) in DD-MMM format
%o Date of the article (string) in YYYYMMDD`T'HHMMSS
format
%M Message-id of the article (string)
%r References of the article (string)
%c Number of characters in the article (integer)
%k Pretty-printed version of the above (string)
For example, \"1.2k\" or \"0.4M\".
%L Number of lines in the article (integer)
%I Indentation based on thread level (a string of
spaces)
%B A complex trn-style thread tree (string)
The variables `gnus-sum-thread-*' can be used for
customization.
%T A string with two possible values: 80 spaces if the
article is on thread level two or larger and 0 spaces
on level one
%R \"A\" if this article has been replied to, \" \"
otherwise (character)
%U Status of this article (character, \"R\", \"K\",
\"-\" or \" \")
%[ Opening bracket (character, \"[\" or \"<\")
%] Closing bracket (character, \"]\" or \">\")
%> Spaces of length thread-level (string)
%< Spaces of length (- 20 thread-level) (string)
%i Article score (number)
%z Article zcore (character)
%t Number of articles under the current thread (number).
%e Whether the thread is empty or not (character).
%V Total thread score (number).
%P The line number (number).
%O Download mark (character).
%* If present, indicates desired cursor position
(instead of after first colon).
%u User defined specifier. The next character in the
format string should be a letter. Gnus will call the
function gnus-user-format-function-X, where X is the
letter following %u. The function will be passed the
current header as argument. The function should
return a string, which will be inserted into the
summary just like information from any other summary
specifier.
&user-date; Age sensitive date format. Various date format is
defined in `gnus-summary-user-date-format-alist'.
The %U (status), %R (replied) and %z (zcore) specs have to be handled
with care. For reasons of efficiency, Gnus will compute what column

54
lisp/gnus/message.el
View File

@ -869,11 +869,7 @@ variable isn't used."
;; create a dependence to `gnus.el'.
:type 'sexp)
;; FIXME: This should be a temporary workaround until someone implements a
;; proper solution. If a crash happens while replying, the auto-save file
;; will *not* have a `References:' header if `message-generate-headers-first'
;; is nil. See: http://article.gmane.org/gmane.emacs.gnus.general/51138
(defcustom message-generate-headers-first '(references)
(defcustom message-generate-headers-first nil
"Which headers should be generated before starting to compose a message.
If t, generate all required headers. This can also be a list of headers to
generate. The variables `message-required-news-headers' and
@ -885,7 +881,6 @@ will not have a visible effect for those headers."
:group 'message-headers
:link '(custom-manual "(message)Message Headers")
:type '(choice (const :tag "None" nil)
(const :tag "References" '(references))
(const :tag "All" t)
(repeat (sexp :tag "Header"))))
@ -6405,30 +6400,35 @@ are not included."
(funcall message-default-headers)
message-default-headers))
(or (bolp) (insert ?\n)))
(insert mail-header-separator "\n")
(let ((message-forbidden-properties nil))
(insert (propertize (concat mail-header-separator "\n")
'read-only t 'rear-nonsticky t 'intangible t)))
(forward-line -1)
(when (message-news-p)
(when message-default-news-headers
(insert message-default-news-headers)
(or (bolp) (insert ?\n)))
(when message-generate-headers-first
;; If a crash happens while replying, the auto-save file would *not* have a
;; `References:' header if `message-generate-headers-first' was nil.
;; Therefore, always generate it first.
(let ((message-generate-headers-first
(append message-generate-headers-first '(References))))
(when (message-news-p)
(when message-default-news-headers
(insert message-default-news-headers)
(or (bolp) (insert ?\n)))
(message-generate-headers
(message-headers-to-generate
(append message-required-news-headers
message-required-headers)
message-generate-headers-first
'(Lines Subject)))))
(when (message-mail-p)
(when message-default-mail-headers
(insert message-default-mail-headers)
(or (bolp) (insert ?\n)))
(when message-generate-headers-first
(append message-required-news-headers
message-required-headers)
message-generate-headers-first
'(Lines Subject))))
(when (message-mail-p)
(when message-default-mail-headers
(insert message-default-mail-headers)
(or (bolp) (insert ?\n)))
(message-generate-headers
(message-headers-to-generate
(append message-required-mail-headers
message-required-headers)
message-generate-headers-first
'(Lines Subject)))))
(append message-required-mail-headers
message-required-headers)
message-generate-headers-first
'(Lines Subject)))))
(run-hooks 'message-signature-setup-hook)
(message-insert-signature)
(save-restriction
@ -6540,9 +6540,7 @@ is a function used to switch to and display the mail buffer."
(dolist (h other-headers other-headers)
(if (stringp (car h)) (setcar h (intern (capitalize (car h)))))))
yank-action send-actions continue switch-function
return-action)
;; FIXME: Should return nil if failure.
t))
return-action)))
;;;###autoload
(defun message-news (&optional newsgroups subject)

9
lisp/gnus/nnimap.el
View File

@ -985,15 +985,20 @@ textual parts.")
"\n"
"\r\n"))
(let ((result (nnimap-get-response sequence)))
(if (not (car result))
(if (not (nnimap-ok-p result))
(progn
(nnheader-message 7 "%s" (nnheader-get-report-string 'nnimap))
(nnheader-report 'nnimap "%s" result)
nil)
(cons group
(or (nnimap-find-uid-response "APPENDUID" (car result))
(nnimap-find-article-by-message-id
group message-id)))))))))
(defun nnimap-ok-p (value)
(and (consp value)
(consp (car value))
(equal (caar value) "OK")))
(defun nnimap-find-uid-response (name list)
(let ((result (car (last (nnimap-find-response-element name list)))))
(and result