mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-26 07:33:47 +00:00
Merge changes made in Gnus master
2012-09-05 Julien Danjou <julien@danjou.info> * gnus-srvr.el (gnus-server-open-server): Don't message on failure: this hide the real reason with a message giving absolutely no hint. 2012-09-05 Lars Ingebrigtsen <larsi@gnus.org> * gnus-group.el (gnus-group-mark-article-read): Propagate the read mark to the backend (bug#11804). * message.el (message-insert-newsgroups): Don't insert newsgroup duplicates (bug#12275). 2012-09-05 John Wiegley <johnw@newartisans.com> * gnus.el (gnus-expand-group-parameters): Allow regexp substitutions in sieve rules. 2012-09-05 Jan Tatarik <jan.tatarik@gmail.com> * gnus-score.el (gnus-score-decode-text-parts): Use #' for the local function. * gnus-logic.el (gnus-advanced-body): Allow scoring on decoded bodies. * gnus-score.el (gnus-score-decode-text-parts): Ditto. 2012-09-05 Magnus Henoch <magnus.henoch@gmail.com> * nnmaildir.el: Make nnmaildir understand and write maildir flags. That is, rename files from "unique:2," to "unique:2,S" for "seen", etc. This should make nnmaildir more usable with offlineimap.
This commit is contained in:
Gnus developers
Katsumi Yamaoka
parent
20ef56dbc8
commit
350a188850
@ -1,3 +1,36 @@
|
|||||||
|
2012-09-05 Julien Danjou <julien@danjou.info>
|
||||||
|
|
||||||
|
* gnus-srvr.el (gnus-server-open-server): Don't message on failure:
|
||||||
|
this hide the real reason with a message giving absolutely no hint.
|
||||||
|
|
||||||
|
2012-09-05 Lars Ingebrigtsen <larsi@gnus.org>
|
||||||
|
|
||||||
|
* gnus-group.el (gnus-group-mark-article-read): Propagate the read mark
|
||||||
|
to the backend (bug#11804).
|
||||||
|
|
||||||
|
* message.el (message-insert-newsgroups): Don't insert newsgroup
|
||||||
|
duplicates (bug#12275).
|
||||||
|
|
||||||
|
2012-09-05 John Wiegley <johnw@newartisans.com>
|
||||||
|
|
||||||
|
* gnus.el (gnus-expand-group-parameters): Allow regexp substitutions in
|
||||||
|
sieve rules.
|
||||||
|
|
||||||
|
2012-09-05 Jan Tatarik <jan.tatarik@gmail.com>
|
||||||
|
|
||||||
|
* gnus-score.el (gnus-score-decode-text-parts): Use #' for the local
|
||||||
|
function.
|
||||||
|
|
||||||
|
* gnus-logic.el (gnus-advanced-body): Allow scoring on decoded bodies.
|
||||||
|
|
||||||
|
* gnus-score.el (gnus-score-decode-text-parts): Ditto.
|
||||||
|
|
||||||
|
2012-09-05 Magnus Henoch <magnus.henoch@gmail.com>
|
||||||
|
|
||||||
|
* nnmaildir.el: Make nnmaildir understand and write maildir flags.
|
||||||
|
That is, rename files from "unique:2," to "unique:2,S" for "seen", etc.
|
||||||
|
This should make nnmaildir more usable with offlineimap.
|
||||||
|
|
||||||
2012-09-03 Lars Ingebrigtsen <larsi@gnus.org>
|
2012-09-03 Lars Ingebrigtsen <larsi@gnus.org>
|
||||||
|
|
||||||
* gnus-notifications.el (gnus-notifications-notify): Use it.
|
* gnus-notifications.el (gnus-notifications-notify): Use it.
|
||||||
|
|||||||
@ -4670,6 +4670,8 @@ you the groups that have both dormant articles and cached articles."
|
|||||||
(setq mark gnus-expirable-mark))
|
(setq mark gnus-expirable-mark))
|
||||||
(setq mark (gnus-request-update-mark
|
(setq mark (gnus-request-update-mark
|
||||||
group article mark))
|
group article mark))
|
||||||
|
(gnus-request-set-mark
|
||||||
|
group (list (list (list article) 'add '(read))))
|
||||||
(gnus-mark-article-as-read article mark)
|
(gnus-mark-article-as-read article mark)
|
||||||
(setq gnus-newsgroup-active (gnus-active group))
|
(setq gnus-newsgroup-active (gnus-active group))
|
||||||
(when active
|
(when active
|
||||||
|
|||||||
@ -180,46 +180,51 @@
|
|||||||
(setq header "article"))
|
(setq header "article"))
|
||||||
(with-current-buffer nntp-server-buffer
|
(with-current-buffer nntp-server-buffer
|
||||||
(let* ((request-func (cond ((string= "head" header)
|
(let* ((request-func (cond ((string= "head" header)
|
||||||
'gnus-request-head)
|
'gnus-request-head)
|
||||||
((string= "body" header)
|
;; We need to peek at the headers to detect the
|
||||||
'gnus-request-body)
|
;; content encoding
|
||||||
(t 'gnus-request-article)))
|
((string= "body" header)
|
||||||
ofunc article)
|
'gnus-request-article)
|
||||||
|
(t 'gnus-request-article)))
|
||||||
|
ofunc article handles)
|
||||||
;; Not all backends support partial fetching. In that case, we
|
;; Not all backends support partial fetching. In that case, we
|
||||||
;; just fetch the entire article.
|
;; just fetch the entire article.
|
||||||
(unless (gnus-check-backend-function
|
(unless (gnus-check-backend-function
|
||||||
(intern (concat "request-" header))
|
(intern (concat "request-" header))
|
||||||
gnus-newsgroup-name)
|
gnus-newsgroup-name)
|
||||||
(setq ofunc request-func)
|
(setq ofunc request-func)
|
||||||
(setq request-func 'gnus-request-article))
|
(setq request-func 'gnus-request-article))
|
||||||
(setq article (mail-header-number gnus-advanced-headers))
|
(setq article (mail-header-number gnus-advanced-headers))
|
||||||
(gnus-message 7 "Scoring article %s..." article)
|
(gnus-message 7 "Scoring article %s..." article)
|
||||||
(when (funcall request-func article gnus-newsgroup-name)
|
(when (funcall request-func article gnus-newsgroup-name)
|
||||||
(goto-char (point-min))
|
(when (string= "body" header)
|
||||||
;; If just parts of the article is to be searched and the
|
(setq handles (gnus-score-decode-text-parts)))
|
||||||
;; backend didn't support partial fetching, we just narrow to
|
(goto-char (point-min))
|
||||||
;; the relevant parts.
|
;; If just parts of the article is to be searched and the
|
||||||
(when ofunc
|
;; backend didn't support partial fetching, we just narrow to
|
||||||
(if (eq ofunc 'gnus-request-head)
|
;; the relevant parts.
|
||||||
(narrow-to-region
|
(when ofunc
|
||||||
(point)
|
(if (eq ofunc 'gnus-request-head)
|
||||||
(or (search-forward "\n\n" nil t) (point-max)))
|
(narrow-to-region
|
||||||
(narrow-to-region
|
(point)
|
||||||
(or (search-forward "\n\n" nil t) (point))
|
(or (search-forward "\n\n" nil t) (point-max)))
|
||||||
(point-max))))
|
(narrow-to-region
|
||||||
(let* ((case-fold-search (not (eq (downcase (symbol-name type))
|
(or (search-forward "\n\n" nil t) (point))
|
||||||
(symbol-name type))))
|
(point-max))))
|
||||||
(search-func
|
(let* ((case-fold-search (not (eq (downcase (symbol-name type))
|
||||||
(cond ((memq type '(r R regexp Regexp))
|
(symbol-name type))))
|
||||||
're-search-forward)
|
(search-func
|
||||||
((memq type '(s S string String))
|
(cond ((memq type '(r R regexp Regexp))
|
||||||
'search-forward)
|
're-search-forward)
|
||||||
(t
|
((memq type '(s S string String))
|
||||||
(error "Invalid match type: %s" type)))))
|
'search-forward)
|
||||||
(goto-char (point-min))
|
(t
|
||||||
(prog1
|
(error "Invalid match type: %s" type)))))
|
||||||
(funcall search-func match nil t)
|
(goto-char (point-min))
|
||||||
(widen)))))))
|
(prog1
|
||||||
|
(funcall search-func match nil t)
|
||||||
|
(widen)))
|
||||||
|
(when handles (mm-destroy-parts handles))))))
|
||||||
|
|
||||||
(provide 'gnus-logic)
|
(provide 'gnus-logic)
|
||||||
|
|
||||||
|
|||||||
@ -1717,105 +1717,140 @@ score in `gnus-newsgroup-scored' by SCORE."
|
|||||||
(setq entries rest)))))
|
(setq entries rest)))))
|
||||||
nil)
|
nil)
|
||||||
|
|
||||||
|
(defun gnus-score-decode-text-parts ()
|
||||||
|
(labels ((mm-text-parts (handle)
|
||||||
|
(cond ((stringp (car handle))
|
||||||
|
(let ((parts (mapcan 'mm-text-parts (cdr handle))))
|
||||||
|
(if (equal "multipart/alternative" (car handle))
|
||||||
|
;; pick the first supported alternative
|
||||||
|
(list (car parts))
|
||||||
|
parts)))
|
||||||
|
|
||||||
|
((bufferp (car handle))
|
||||||
|
(when (string-match "^text/" (mm-handle-media-type handle))
|
||||||
|
(list handle)))
|
||||||
|
|
||||||
|
(t (mapcan 'mm-text-parts handle))))
|
||||||
|
(my-mm-display-part (handle)
|
||||||
|
(when handle
|
||||||
|
(save-restriction
|
||||||
|
(narrow-to-region (point) (point))
|
||||||
|
(mm-display-inline handle)
|
||||||
|
(goto-char (point-max))))))
|
||||||
|
|
||||||
|
(let (;(mm-text-html-renderer 'w3m-standalone)
|
||||||
|
(handles (mm-dissect-buffer t)))
|
||||||
|
(save-excursion
|
||||||
|
(article-goto-body)
|
||||||
|
(delete-region (point) (point-max))
|
||||||
|
(mapc #'my-mm-display-part (mm-text-parts handles))
|
||||||
|
handles))))
|
||||||
|
|
||||||
(defun gnus-score-body (scores header now expire &optional trace)
|
(defun gnus-score-body (scores header now expire &optional trace)
|
||||||
(if gnus-agent-fetching
|
(if gnus-agent-fetching
|
||||||
nil
|
nil
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(setq gnus-scores-articles
|
(setq gnus-scores-articles
|
||||||
(sort gnus-scores-articles
|
(sort gnus-scores-articles
|
||||||
(lambda (a1 a2)
|
(lambda (a1 a2)
|
||||||
(< (mail-header-number (car a1))
|
(< (mail-header-number (car a1))
|
||||||
(mail-header-number (car a2))))))
|
(mail-header-number (car a2))))))
|
||||||
(set-buffer nntp-server-buffer)
|
(set-buffer nntp-server-buffer)
|
||||||
(save-restriction
|
(save-restriction
|
||||||
(let* ((buffer-read-only nil)
|
(let* ((buffer-read-only nil)
|
||||||
(articles gnus-scores-articles)
|
(articles gnus-scores-articles)
|
||||||
(all-scores scores)
|
(all-scores scores)
|
||||||
(request-func (cond ((string= "head" header)
|
(request-func (cond ((string= "head" header)
|
||||||
'gnus-request-head)
|
'gnus-request-head)
|
||||||
((string= "body" header)
|
;; We need to peek at the headers to detect
|
||||||
'gnus-request-body)
|
;; the content encoding
|
||||||
(t 'gnus-request-article)))
|
((string= "body" header)
|
||||||
entries alist ofunc article last)
|
'gnus-request-article)
|
||||||
(when articles
|
(t 'gnus-request-article)))
|
||||||
(setq last (mail-header-number (caar (last articles))))
|
entries alist ofunc article last)
|
||||||
;; Not all backends support partial fetching. In that case,
|
(when articles
|
||||||
;; we just fetch the entire article.
|
(setq last (mail-header-number (caar (last articles))))
|
||||||
(unless (gnus-check-backend-function
|
;; Not all backends support partial fetching. In that case,
|
||||||
(and (string-match "^gnus-" (symbol-name request-func))
|
;; we just fetch the entire article.
|
||||||
(intern (substring (symbol-name request-func)
|
(unless (gnus-check-backend-function
|
||||||
(match-end 0))))
|
(and (string-match "^gnus-" (symbol-name request-func))
|
||||||
gnus-newsgroup-name)
|
(intern (substring (symbol-name request-func)
|
||||||
(setq ofunc request-func)
|
(match-end 0))))
|
||||||
(setq request-func 'gnus-request-article))
|
gnus-newsgroup-name)
|
||||||
(while articles
|
(setq ofunc request-func)
|
||||||
(setq article (mail-header-number (caar articles)))
|
(setq request-func 'gnus-request-article))
|
||||||
(gnus-message 7 "Scoring article %s of %s..." article last)
|
(while articles
|
||||||
(widen)
|
(setq article (mail-header-number (caar articles)))
|
||||||
(when (funcall request-func article gnus-newsgroup-name)
|
(gnus-message 7 "Scoring article %s of %s..." article last)
|
||||||
(goto-char (point-min))
|
(widen)
|
||||||
;; If just parts of the article is to be searched, but the
|
(let (handles)
|
||||||
;; backend didn't support partial fetching, we just narrow
|
(when (funcall request-func article gnus-newsgroup-name)
|
||||||
;; to the relevant parts.
|
(when (string= "body" header)
|
||||||
(when ofunc
|
(setq handles (gnus-score-decode-text-parts)))
|
||||||
(if (eq ofunc 'gnus-request-head)
|
(goto-char (point-min))
|
||||||
(narrow-to-region
|
;; If just parts of the article is to be searched, but the
|
||||||
(point)
|
;; backend didn't support partial fetching, we just narrow
|
||||||
(or (search-forward "\n\n" nil t) (point-max)))
|
;; to the relevant parts.
|
||||||
(narrow-to-region
|
(when ofunc
|
||||||
(or (search-forward "\n\n" nil t) (point))
|
(if (eq ofunc 'gnus-request-head)
|
||||||
(point-max))))
|
(narrow-to-region
|
||||||
(setq scores all-scores)
|
(point)
|
||||||
;; Find matches.
|
(or (search-forward "\n\n" nil t) (point-max)))
|
||||||
(while scores
|
(narrow-to-region
|
||||||
(setq alist (pop scores)
|
(or (search-forward "\n\n" nil t) (point))
|
||||||
entries (assoc header alist))
|
(point-max))))
|
||||||
(while (cdr entries) ;First entry is the header index.
|
(setq scores all-scores)
|
||||||
(let* ((rest (cdr entries))
|
;; Find matches.
|
||||||
(kill (car rest))
|
(while scores
|
||||||
(match (nth 0 kill))
|
(setq alist (pop scores)
|
||||||
(type (or (nth 3 kill) 's))
|
entries (assoc header alist))
|
||||||
(score (or (nth 1 kill)
|
(while (cdr entries) ;First entry is the header index.
|
||||||
gnus-score-interactive-default-score))
|
(let* ((rest (cdr entries))
|
||||||
(date (nth 2 kill))
|
(kill (car rest))
|
||||||
(found nil)
|
(match (nth 0 kill))
|
||||||
(case-fold-search
|
(type (or (nth 3 kill) 's))
|
||||||
(not (or (eq type 'R) (eq type 'S)
|
(score (or (nth 1 kill)
|
||||||
(eq type 'Regexp) (eq type 'String))))
|
gnus-score-interactive-default-score))
|
||||||
(search-func
|
(date (nth 2 kill))
|
||||||
(cond ((or (eq type 'r) (eq type 'R)
|
(found nil)
|
||||||
(eq type 'regexp) (eq type 'Regexp))
|
(case-fold-search
|
||||||
're-search-forward)
|
(not (or (eq type 'R) (eq type 'S)
|
||||||
((or (eq type 's) (eq type 'S)
|
(eq type 'Regexp) (eq type 'String))))
|
||||||
(eq type 'string) (eq type 'String))
|
(search-func
|
||||||
'search-forward)
|
(cond ((or (eq type 'r) (eq type 'R)
|
||||||
(t
|
(eq type 'regexp) (eq type 'Regexp))
|
||||||
(error "Invalid match type: %s" type)))))
|
're-search-forward)
|
||||||
(goto-char (point-min))
|
((or (eq type 's) (eq type 'S)
|
||||||
(when (funcall search-func match nil t)
|
(eq type 'string) (eq type 'String))
|
||||||
;; Found a match, update scores.
|
'search-forward)
|
||||||
(setcdr (car articles) (+ score (cdar articles)))
|
(t
|
||||||
(setq found t)
|
(error "Invalid match type: %s" type)))))
|
||||||
(when trace
|
(goto-char (point-min))
|
||||||
(push
|
(when (funcall search-func match nil t)
|
||||||
(cons (car-safe (rassq alist gnus-score-cache))
|
;; Found a match, update scores.
|
||||||
kill)
|
(setcdr (car articles) (+ score (cdar articles)))
|
||||||
gnus-score-trace)))
|
(setq found t)
|
||||||
;; Update expire date
|
(when trace
|
||||||
(unless trace
|
(push
|
||||||
(cond
|
(cons (car-safe (rassq alist gnus-score-cache))
|
||||||
((null date)) ;Permanent entry.
|
kill)
|
||||||
((and found gnus-update-score-entry-dates)
|
gnus-score-trace)))
|
||||||
;; Match, update date.
|
;; Update expire date
|
||||||
(gnus-score-set 'touched '(t) alist)
|
(unless trace
|
||||||
(setcar (nthcdr 2 kill) now))
|
(cond
|
||||||
((and expire (< date expire)) ;Old entry, remove.
|
((null date)) ;Permanent entry.
|
||||||
(gnus-score-set 'touched '(t) alist)
|
((and found gnus-update-score-entry-dates)
|
||||||
(setcdr entries (cdr rest))
|
;; Match, update date.
|
||||||
(setq rest entries))))
|
(gnus-score-set 'touched '(t) alist)
|
||||||
(setq entries rest)))))
|
(setcar (nthcdr 2 kill) now))
|
||||||
(setq articles (cdr articles)))))))
|
((and expire (< date expire)) ;Old entry, remove.
|
||||||
nil))
|
(gnus-score-set 'touched '(t) alist)
|
||||||
|
(setcdr entries (cdr rest))
|
||||||
|
(setq rest entries))))
|
||||||
|
(setq entries rest))))
|
||||||
|
(when handles (mm-destroy-parts handles))))
|
||||||
|
(setq articles (cdr articles)))))))
|
||||||
|
nil))
|
||||||
|
|
||||||
(defun gnus-score-thread (scores header now expire &optional trace)
|
(defun gnus-score-thread (scores header now expire &optional trace)
|
||||||
(gnus-score-followup scores header now expire trace t))
|
(gnus-score-followup scores header now expire trace t))
|
||||||
|
|||||||
@ -490,8 +490,7 @@ The following commands are available:
|
|||||||
(error "No such server: %s" server))
|
(error "No such server: %s" server))
|
||||||
(gnus-server-set-status method 'ok)
|
(gnus-server-set-status method 'ok)
|
||||||
(prog1
|
(prog1
|
||||||
(or (gnus-open-server method)
|
(gnus-open-server method)
|
||||||
(progn (message "Couldn't open %s" server) nil))
|
|
||||||
(gnus-server-update-server server)
|
(gnus-server-update-server server)
|
||||||
(gnus-server-position-point))))
|
(gnus-server-position-point))))
|
||||||
|
|
||||||
|
|||||||
@ -3824,12 +3824,28 @@ You should probably use `gnus-find-method-for-group' instead."
|
|||||||
"Go through PARAMETERS and expand them according to the match data."
|
"Go through PARAMETERS and expand them according to the match data."
|
||||||
(let (new)
|
(let (new)
|
||||||
(dolist (elem parameters)
|
(dolist (elem parameters)
|
||||||
(if (and (stringp (cdr elem))
|
(cond
|
||||||
(string-match "\\\\[0-9&]" (cdr elem)))
|
((and (stringp (cdr elem))
|
||||||
(push (cons (car elem)
|
(string-match "\\\\[0-9&]" (cdr elem)))
|
||||||
(gnus-expand-group-parameter match (cdr elem) group))
|
(push (cons (car elem)
|
||||||
new)
|
(gnus-expand-group-parameter match (cdr elem) group))
|
||||||
(push elem new)))
|
new))
|
||||||
|
;; For `sieve' group parameters, perform substitutions for every
|
||||||
|
;; string within the match rule. This allows for parameters such
|
||||||
|
;; as:
|
||||||
|
;; ("list\\.\\(.*\\)"
|
||||||
|
;; (sieve header :is "list-id" "<\\1.domain.org>"))
|
||||||
|
((eq 'sieve (car elem))
|
||||||
|
(push (mapcar (lambda (sieve-elem)
|
||||||
|
(if (and (stringp sieve-elem)
|
||||||
|
(string-match "\\\\[0-9&]" sieve-elem))
|
||||||
|
(gnus-expand-group-parameter match sieve-elem
|
||||||
|
group)
|
||||||
|
sieve-elem))
|
||||||
|
(cdr elem))
|
||||||
|
new))
|
||||||
|
(t
|
||||||
|
(push elem new))))
|
||||||
new))
|
new))
|
||||||
|
|
||||||
(defun gnus-group-fast-parameter (group symbol &optional allow-list)
|
(defun gnus-group-fast-parameter (group symbol &optional allow-list)
|
||||||
@ -3861,9 +3877,20 @@ The function `gnus-group-find-parameter' will do that for you."
|
|||||||
(when this-result
|
(when this-result
|
||||||
(setq result (car this-result))
|
(setq result (car this-result))
|
||||||
;; Expand if necessary.
|
;; Expand if necessary.
|
||||||
(if (and (stringp result) (string-match "\\\\[0-9&]" result))
|
(cond
|
||||||
(setq result (gnus-expand-group-parameter
|
((and (stringp result) (string-match "\\\\[0-9&]" result))
|
||||||
(car head) result group)))))))
|
(setq result (gnus-expand-group-parameter
|
||||||
|
(car head) result group)))
|
||||||
|
;; For `sieve' group parameters, perform substitutions
|
||||||
|
;; for every string within the match rule (see above).
|
||||||
|
((eq symbol 'sieve)
|
||||||
|
(setq result
|
||||||
|
(mapcar (lambda (elem)
|
||||||
|
(if (stringp elem)
|
||||||
|
(gnus-expand-group-parameter (car head)
|
||||||
|
elem group)
|
||||||
|
elem))
|
||||||
|
result))))))))
|
||||||
;; Done.
|
;; Done.
|
||||||
result))))
|
result))))
|
||||||
|
|
||||||
|
|||||||
@ -3292,11 +3292,33 @@ or in the synonym headers, defined by `message-header-synonyms'."
|
|||||||
(defun message-insert-newsgroups ()
|
(defun message-insert-newsgroups ()
|
||||||
"Insert the Newsgroups header from the article being replied to."
|
"Insert the Newsgroups header from the article being replied to."
|
||||||
(interactive)
|
(interactive)
|
||||||
(when (and (message-position-on-field "Newsgroups")
|
(let ((old-newsgroups (mail-fetch-field "newsgroups"))
|
||||||
(mail-fetch-field "newsgroups")
|
(new-newsgroups (message-fetch-reply-field "newsgroups"))
|
||||||
(not (string-match "\\` *\\'" (mail-fetch-field "newsgroups"))))
|
(first t)
|
||||||
(insert ","))
|
insert-newsgroups)
|
||||||
(insert (or (message-fetch-reply-field "newsgroups") "")))
|
(message-position-on-field "Newsgroups")
|
||||||
|
(cond
|
||||||
|
((not new-newsgroups)
|
||||||
|
(error "No Newsgroups to insert"))
|
||||||
|
((not old-newsgroups)
|
||||||
|
(insert new-newsgroups))
|
||||||
|
(t
|
||||||
|
(setq new-newsgroups (split-string new-newsgroups "[, ]+")
|
||||||
|
old-newsgroups (split-string old-newsgroups "[, ]+"))
|
||||||
|
(dolist (group new-newsgroups)
|
||||||
|
(unless (member group old-newsgroups)
|
||||||
|
(push group insert-newsgroups)))
|
||||||
|
(if (null insert-newsgroups)
|
||||||
|
(error "Newgroup%s already in the header"
|
||||||
|
(if (> (length new-newsgroups) 1)
|
||||||
|
"s" ""))
|
||||||
|
(when old-newsgroups
|
||||||
|
(setq first nil))
|
||||||
|
(dolist (group insert-newsgroups)
|
||||||
|
(unless first
|
||||||
|
(insert ","))
|
||||||
|
(setq first nil)
|
||||||
|
(insert group)))))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@ -77,6 +77,66 @@
|
|||||||
|
|
||||||
(defconst nnmaildir-version "Gnus")
|
(defconst nnmaildir-version "Gnus")
|
||||||
|
|
||||||
|
(defconst nnmaildir-flag-mark-mapping
|
||||||
|
'((?F . tick)
|
||||||
|
(?R . reply)
|
||||||
|
(?S . read))
|
||||||
|
"Alist mapping Maildir filename flags to Gnus marks.
|
||||||
|
Maildir filenames are of the form \"unique-id:2,FLAGS\",
|
||||||
|
where FLAGS are a string of characters in ASCII order.
|
||||||
|
Some of the FLAGS correspond to Gnus marks.")
|
||||||
|
|
||||||
|
(defsubst nnmaildir--mark-to-flag (mark)
|
||||||
|
"Find the Maildir flag that corresponds to MARK (an atom).
|
||||||
|
Return a character, or `nil' if not found.
|
||||||
|
See `nnmaildir-flag-mark-mapping'."
|
||||||
|
(car (rassq mark nnmaildir-flag-mark-mapping)))
|
||||||
|
|
||||||
|
(defsubst nnmaildir--flag-to-mark (flag)
|
||||||
|
"Find the Gnus mark that corresponds to FLAG (a character).
|
||||||
|
Return an atom, or `nil' if not found.
|
||||||
|
See `nnmaildir-flag-mark-mapping'."
|
||||||
|
(cdr (assq flag nnmaildir-flag-mark-mapping)))
|
||||||
|
|
||||||
|
(defun nnmaildir--ensure-suffix (filename)
|
||||||
|
"Ensure that FILENAME contains the suffix \":2,\"."
|
||||||
|
(if (string-match-p ":2," filename)
|
||||||
|
filename
|
||||||
|
(concat filename ":2,")))
|
||||||
|
|
||||||
|
(defun nnmaildir--add-flag (flag suffix)
|
||||||
|
"Return a copy of SUFFIX where FLAG is set.
|
||||||
|
SUFFIX should start with \":2,\"."
|
||||||
|
(unless (string-match-p "^:2," suffix)
|
||||||
|
(error "Invalid suffix `%s'" suffix))
|
||||||
|
(let* ((flags (substring suffix 3))
|
||||||
|
(flags-as-list (append flags nil))
|
||||||
|
(new-flags
|
||||||
|
(concat (gnus-delete-duplicates
|
||||||
|
;; maildir flags must be sorted
|
||||||
|
(sort (cons flag flags-as-list) '<)))))
|
||||||
|
(concat ":2," new-flags)))
|
||||||
|
|
||||||
|
(defun nnmaildir--remove-flag (flag suffix)
|
||||||
|
"Return a copy of SUFFIX where FLAG is cleared.
|
||||||
|
SUFFIX should start with \":2,\"."
|
||||||
|
(unless (string-match-p "^:2," suffix)
|
||||||
|
(error "Invalid suffix `%s'" suffix))
|
||||||
|
(let* ((flags (substring suffix 3))
|
||||||
|
(flags-as-list (append flags nil))
|
||||||
|
(new-flags (concat (delq flag flags-as-list))))
|
||||||
|
(concat ":2," new-flags)))
|
||||||
|
|
||||||
|
(defun nnmaildir--article-set-flags (article new-suffix curdir)
|
||||||
|
(let* ((prefix (nnmaildir--art-prefix article))
|
||||||
|
(suffix (nnmaildir--art-suffix article))
|
||||||
|
(article-file (concat curdir prefix suffix))
|
||||||
|
(new-name (concat curdir prefix new-suffix)))
|
||||||
|
(unless (file-exists-p article-file)
|
||||||
|
(error "Couldn't find article file %s" article-file))
|
||||||
|
(rename-file article-file new-name 'replace)
|
||||||
|
(setf (nnmaildir--art-suffix article) new-suffix)))
|
||||||
|
|
||||||
(defvar nnmaildir-article-file-name nil
|
(defvar nnmaildir-article-file-name nil
|
||||||
"*The filename of the most recently requested article. This variable is set
|
"*The filename of the most recently requested article. This variable is set
|
||||||
by nnmaildir-request-article.")
|
by nnmaildir-request-article.")
|
||||||
@ -208,29 +268,33 @@ by nnmaildir-request-article.")
|
|||||||
(eval param))
|
(eval param))
|
||||||
|
|
||||||
(defmacro nnmaildir--with-nntp-buffer (&rest body)
|
(defmacro nnmaildir--with-nntp-buffer (&rest body)
|
||||||
|
(declare (debug (body)))
|
||||||
`(with-current-buffer nntp-server-buffer
|
`(with-current-buffer nntp-server-buffer
|
||||||
,@body))
|
,@body))
|
||||||
(defmacro nnmaildir--with-work-buffer (&rest body)
|
(defmacro nnmaildir--with-work-buffer (&rest body)
|
||||||
|
(declare (debug (body)))
|
||||||
`(with-current-buffer (get-buffer-create " *nnmaildir work*")
|
`(with-current-buffer (get-buffer-create " *nnmaildir work*")
|
||||||
,@body))
|
,@body))
|
||||||
(defmacro nnmaildir--with-nov-buffer (&rest body)
|
(defmacro nnmaildir--with-nov-buffer (&rest body)
|
||||||
|
(declare (debug (body)))
|
||||||
`(with-current-buffer (get-buffer-create " *nnmaildir nov*")
|
`(with-current-buffer (get-buffer-create " *nnmaildir nov*")
|
||||||
,@body))
|
,@body))
|
||||||
(defmacro nnmaildir--with-move-buffer (&rest body)
|
(defmacro nnmaildir--with-move-buffer (&rest body)
|
||||||
|
(declare (debug (body)))
|
||||||
`(with-current-buffer (get-buffer-create " *nnmaildir move*")
|
`(with-current-buffer (get-buffer-create " *nnmaildir move*")
|
||||||
,@body))
|
,@body))
|
||||||
|
|
||||||
(defmacro nnmaildir--subdir (dir subdir)
|
(defsubst nnmaildir--subdir (dir subdir)
|
||||||
`(file-name-as-directory (concat ,dir ,subdir)))
|
(file-name-as-directory (concat dir subdir)))
|
||||||
(defmacro nnmaildir--srvgrp-dir (srv-dir gname)
|
(defsubst nnmaildir--srvgrp-dir (srv-dir gname)
|
||||||
`(nnmaildir--subdir ,srv-dir ,gname))
|
(nnmaildir--subdir srv-dir gname))
|
||||||
(defmacro nnmaildir--tmp (dir) `(nnmaildir--subdir ,dir "tmp"))
|
(defsubst nnmaildir--tmp (dir) (nnmaildir--subdir dir "tmp"))
|
||||||
(defmacro nnmaildir--new (dir) `(nnmaildir--subdir ,dir "new"))
|
(defsubst nnmaildir--new (dir) (nnmaildir--subdir dir "new"))
|
||||||
(defmacro nnmaildir--cur (dir) `(nnmaildir--subdir ,dir "cur"))
|
(defsubst nnmaildir--cur (dir) (nnmaildir--subdir dir "cur"))
|
||||||
(defmacro nnmaildir--nndir (dir) `(nnmaildir--subdir ,dir ".nnmaildir"))
|
(defsubst nnmaildir--nndir (dir) (nnmaildir--subdir dir ".nnmaildir"))
|
||||||
(defmacro nnmaildir--nov-dir (dir) `(nnmaildir--subdir ,dir "nov"))
|
(defsubst nnmaildir--nov-dir (dir) (nnmaildir--subdir dir "nov"))
|
||||||
(defmacro nnmaildir--marks-dir (dir) `(nnmaildir--subdir ,dir "marks"))
|
(defsubst nnmaildir--marks-dir (dir) (nnmaildir--subdir dir "marks"))
|
||||||
(defmacro nnmaildir--num-dir (dir) `(nnmaildir--subdir ,dir "num"))
|
(defsubst nnmaildir--num-dir (dir) (nnmaildir--subdir dir "num"))
|
||||||
|
|
||||||
(defmacro nnmaildir--unlink (file-arg)
|
(defmacro nnmaildir--unlink (file-arg)
|
||||||
`(let ((file ,file-arg))
|
`(let ((file ,file-arg))
|
||||||
@ -305,6 +369,7 @@ by nnmaildir-request-article.")
|
|||||||
string)
|
string)
|
||||||
|
|
||||||
(defmacro nnmaildir--condcase (errsym body &rest handler)
|
(defmacro nnmaildir--condcase (errsym body &rest handler)
|
||||||
|
(declare (debug (sexp form body)))
|
||||||
`(condition-case ,errsym
|
`(condition-case ,errsym
|
||||||
(let ((system-messages-locale "C")) ,body)
|
(let ((system-messages-locale "C")) ,body)
|
||||||
(error . ,handler)))
|
(error . ,handler)))
|
||||||
@ -759,7 +824,7 @@ by nnmaildir-request-article.")
|
|||||||
(dolist (file (funcall ls ndir nil "\\`[^.]" 'nosort))
|
(dolist (file (funcall ls ndir nil "\\`[^.]" 'nosort))
|
||||||
(setq x (concat ndir file))
|
(setq x (concat ndir file))
|
||||||
(and (time-less-p (nth 5 (file-attributes x)) (current-time))
|
(and (time-less-p (nth 5 (file-attributes x)) (current-time))
|
||||||
(rename-file x (concat cdir file ":2,"))))
|
(rename-file x (concat cdir (nnmaildir--ensure-suffix file)))))
|
||||||
(setf (nnmaildir--grp-new group) nattr))
|
(setf (nnmaildir--grp-new group) nattr))
|
||||||
(setq cattr (nth 5 (file-attributes cdir)))
|
(setq cattr (nth 5 (file-attributes cdir)))
|
||||||
(if (equal cattr (nnmaildir--grp-cur group))
|
(if (equal cattr (nnmaildir--grp-cur group))
|
||||||
@ -784,11 +849,23 @@ by nnmaildir-request-article.")
|
|||||||
cdir (nnmaildir--marks-dir nndir)
|
cdir (nnmaildir--marks-dir nndir)
|
||||||
ndir (nnmaildir--subdir cdir "tick")
|
ndir (nnmaildir--subdir cdir "tick")
|
||||||
cdir (nnmaildir--subdir cdir "read"))
|
cdir (nnmaildir--subdir cdir "read"))
|
||||||
(dolist (file files)
|
(dolist (prefix-suffix files)
|
||||||
(setq file (car file))
|
(let ((prefix (car prefix-suffix))
|
||||||
(if (or (not (file-exists-p (concat cdir file)))
|
(suffix (cdr prefix-suffix)))
|
||||||
(file-exists-p (concat ndir file)))
|
;; increase num for each unread or ticked article
|
||||||
(setq num (1+ num)))))
|
(when (or
|
||||||
|
;; first look for marks in suffix, if it's valid...
|
||||||
|
(when (and (stringp suffix)
|
||||||
|
(string-prefix-p ":2," suffix))
|
||||||
|
(or
|
||||||
|
(not (string-match-p
|
||||||
|
(string (nnmaildir--mark-to-flag 'read)) suffix))
|
||||||
|
(string-match-p
|
||||||
|
(string (nnmaildir--mark-to-flag 'tick)) suffix)))
|
||||||
|
;; then look in marks directories
|
||||||
|
(not (file-exists-p (concat cdir prefix)))
|
||||||
|
(file-exists-p (concat ndir prefix)))
|
||||||
|
(incf num)))))
|
||||||
(setf (nnmaildir--grp-cache group) (make-vector num nil))
|
(setf (nnmaildir--grp-cache group) (make-vector num nil))
|
||||||
(let ((inhibit-quit t))
|
(let ((inhibit-quit t))
|
||||||
(set (intern gname groups) group))
|
(set (intern gname groups) group))
|
||||||
@ -916,12 +993,15 @@ by nnmaildir-request-article.")
|
|||||||
"\n")))))
|
"\n")))))
|
||||||
'group)
|
'group)
|
||||||
|
|
||||||
(defun nnmaildir-request-marks (gname info &optional server)
|
(defun nnmaildir-request-update-info (gname info &optional server)
|
||||||
(let ((group (nnmaildir--prepare server gname))
|
(let* ((group (nnmaildir--prepare server gname))
|
||||||
pgname flist always-marks never-marks old-marks dotfile num dir
|
(curdir (nnmaildir--cur
|
||||||
markdirs marks mark ranges markdir article read end new-marks ls
|
(nnmaildir--srvgrp-dir
|
||||||
old-mmth new-mmth mtime mark-sym existing missing deactivate-mark
|
(nnmaildir--srv-dir nnmaildir--cur-server) gname)))
|
||||||
article-list)
|
(curdir-mtime (nth 5 (file-attributes curdir)))
|
||||||
|
pgname flist always-marks never-marks old-marks dotfile num dir
|
||||||
|
all-marks marks mark ranges markdir read end new-marks ls
|
||||||
|
old-mmth new-mmth mtime mark-sym existing missing deactivate-mark)
|
||||||
(catch 'return
|
(catch 'return
|
||||||
(unless group
|
(unless group
|
||||||
(setf (nnmaildir--srv-error nnmaildir--cur-server)
|
(setf (nnmaildir--srv-error nnmaildir--cur-server)
|
||||||
@ -950,34 +1030,71 @@ by nnmaildir-request-article.")
|
|||||||
dir (nnmaildir--nndir dir)
|
dir (nnmaildir--nndir dir)
|
||||||
dir (nnmaildir--marks-dir dir)
|
dir (nnmaildir--marks-dir dir)
|
||||||
ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
|
ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
|
||||||
markdirs (funcall ls dir nil "\\`[^.]" 'nosort)
|
all-marks (gnus-delete-duplicates
|
||||||
new-mmth (nnmaildir--up2-1 (length markdirs))
|
;; get mark names from mark dirs and from flag
|
||||||
|
;; mappings
|
||||||
|
(append
|
||||||
|
(mapcar 'cdr nnmaildir-flag-mark-mapping)
|
||||||
|
(mapcar 'intern (funcall ls dir nil "\\`[^.]" 'nosort))))
|
||||||
|
new-mmth (nnmaildir--up2-1 (length all-marks))
|
||||||
new-mmth (make-vector new-mmth 0)
|
new-mmth (make-vector new-mmth 0)
|
||||||
old-mmth (nnmaildir--grp-mmth group))
|
old-mmth (nnmaildir--grp-mmth group))
|
||||||
(dolist (mark markdirs)
|
(dolist (mark all-marks)
|
||||||
(setq markdir (nnmaildir--subdir dir mark)
|
(setq markdir (nnmaildir--subdir dir (symbol-name mark))
|
||||||
mark-sym (intern mark)
|
|
||||||
ranges nil)
|
ranges nil)
|
||||||
(catch 'got-ranges
|
(catch 'got-ranges
|
||||||
(if (memq mark-sym never-marks) (throw 'got-ranges nil))
|
(if (memq mark never-marks) (throw 'got-ranges nil))
|
||||||
(when (memq mark-sym always-marks)
|
(when (memq mark always-marks)
|
||||||
(setq ranges existing)
|
(setq ranges existing)
|
||||||
(throw 'got-ranges nil))
|
(throw 'got-ranges nil))
|
||||||
(setq mtime (nth 5 (file-attributes markdir)))
|
;; Find the mtime for this mark. If this mark can be expressed as
|
||||||
(set (intern mark new-mmth) mtime)
|
;; a filename flag, get the later of the mtimes for markdir and
|
||||||
(when (equal mtime (symbol-value (intern-soft mark old-mmth)))
|
;; curdir, otherwise only the markdir counts.
|
||||||
(setq ranges (assq mark-sym old-marks))
|
(setq mtime
|
||||||
|
(let ((markdir-mtime (nth 5 (file-attributes markdir))))
|
||||||
|
(cond
|
||||||
|
((null (nnmaildir--mark-to-flag mark))
|
||||||
|
markdir-mtime)
|
||||||
|
((null markdir-mtime)
|
||||||
|
curdir-mtime)
|
||||||
|
((null curdir-mtime)
|
||||||
|
;; this should never happen...
|
||||||
|
markdir-mtime)
|
||||||
|
((time-less-p markdir-mtime curdir-mtime)
|
||||||
|
curdir-mtime)
|
||||||
|
(t
|
||||||
|
markdir-mtime))))
|
||||||
|
(set (intern (symbol-name mark) new-mmth) mtime)
|
||||||
|
(when (equal mtime (symbol-value (intern-soft (symbol-name mark) old-mmth)))
|
||||||
|
(setq ranges (assq mark old-marks))
|
||||||
(if ranges (setq ranges (cdr ranges)))
|
(if ranges (setq ranges (cdr ranges)))
|
||||||
(throw 'got-ranges nil))
|
(throw 'got-ranges nil))
|
||||||
(setq article-list nil)
|
(let ((article-list nil))
|
||||||
(dolist (prefix (funcall ls markdir nil "\\`[^.]" 'nosort))
|
;; Consider the article marked if it either has the flag in the
|
||||||
(setq article (nnmaildir--flist-art flist prefix))
|
;; filename, or is in the markdir. As you'd rarely remove a
|
||||||
(if article
|
;; flag/mark, this should avoid losing information in the most
|
||||||
(setq article-list
|
;; common usage pattern.
|
||||||
(cons (nnmaildir--art-num article) article-list))))
|
(or
|
||||||
(setq ranges (gnus-add-to-range ranges (sort article-list '<))))
|
(let ((flag (nnmaildir--mark-to-flag mark)))
|
||||||
(if (eq mark-sym 'read) (setq read ranges)
|
;; If this mark has a corresponding maildir flag...
|
||||||
(if ranges (setq marks (cons (cons mark-sym ranges) marks)))))
|
(when flag
|
||||||
|
(let ((regexp
|
||||||
|
(concat "\\`[^.].*:2,[A-Z]*" (string flag))))
|
||||||
|
;; ...then find all files with that flag.
|
||||||
|
(dolist (filename (funcall ls curdir nil regexp 'nosort))
|
||||||
|
(let* ((prefix (car (split-string filename ":2,")))
|
||||||
|
(article (nnmaildir--flist-art flist prefix)))
|
||||||
|
(when article
|
||||||
|
(push (nnmaildir--art-num article) article-list)))))))
|
||||||
|
;; Also check Gnus-specific mark directory, if it exists.
|
||||||
|
(when (file-directory-p markdir)
|
||||||
|
(dolist (prefix (funcall ls markdir nil "\\`[^.]" 'nosort))
|
||||||
|
(let ((article (nnmaildir--flist-art flist prefix)))
|
||||||
|
(when article
|
||||||
|
(push (nnmaildir--art-num article) article-list))))))
|
||||||
|
(setq ranges (gnus-add-to-range ranges (sort article-list '<)))))
|
||||||
|
(if (eq mark 'read) (setq read ranges)
|
||||||
|
(if ranges (setq marks (cons (cons mark ranges) marks)))))
|
||||||
(gnus-info-set-read info (gnus-range-add read missing))
|
(gnus-info-set-read info (gnus-range-add read missing))
|
||||||
(gnus-info-set-marks info marks 'extend)
|
(gnus-info-set-marks info marks 'extend)
|
||||||
(setf (nnmaildir--grp-mmth group) new-mmth)
|
(setf (nnmaildir--grp-mmth group) new-mmth)
|
||||||
@ -1525,39 +1642,63 @@ by nnmaildir-request-article.")
|
|||||||
didnt)))
|
didnt)))
|
||||||
|
|
||||||
(defun nnmaildir-request-set-mark (gname actions &optional server)
|
(defun nnmaildir-request-set-mark (gname actions &optional server)
|
||||||
(let ((group (nnmaildir--prepare server gname))
|
(let* ((group (nnmaildir--prepare server gname))
|
||||||
(coding-system-for-write nnheader-file-coding-system)
|
(curdir (nnmaildir--cur
|
||||||
(buffer-file-coding-system nil)
|
(nnmaildir--srvgrp-dir
|
||||||
(file-coding-system-alist nil)
|
(nnmaildir--srv-dir nnmaildir--cur-server)
|
||||||
del-mark del-action add-action set-action marksdir nlist
|
gname)))
|
||||||
ranges begin end article all-marks todo-marks mdir mfile
|
(coding-system-for-write nnheader-file-coding-system)
|
||||||
pgname ls permarkfile deactivate-mark)
|
(buffer-file-coding-system nil)
|
||||||
|
(file-coding-system-alist nil)
|
||||||
|
del-mark del-action add-action set-action marksdir nlist
|
||||||
|
ranges begin end article all-marks todo-marks mdir mfile
|
||||||
|
pgname ls permarkfile deactivate-mark)
|
||||||
(setq del-mark
|
(setq del-mark
|
||||||
(lambda (mark)
|
(lambda (mark)
|
||||||
(setq mfile (nnmaildir--subdir marksdir (symbol-name mark))
|
(let ((prefix (nnmaildir--art-prefix article))
|
||||||
mfile (concat mfile (nnmaildir--art-prefix article)))
|
(suffix (nnmaildir--art-suffix article))
|
||||||
(nnmaildir--unlink mfile))
|
(flag (nnmaildir--mark-to-flag mark)))
|
||||||
|
(when flag
|
||||||
|
;; If this mark corresponds to a flag, remove the flag from
|
||||||
|
;; the file name.
|
||||||
|
(nnmaildir--article-set-flags
|
||||||
|
article (nnmaildir--remove-flag flag suffix) curdir))
|
||||||
|
;; We still want to delete the hardlink in the marks dir if
|
||||||
|
;; present, regardless of whether this mark has a maildir flag or
|
||||||
|
;; not, to avoid getting out of sync.
|
||||||
|
(setq mfile (nnmaildir--subdir marksdir (symbol-name mark))
|
||||||
|
mfile (concat mfile prefix))
|
||||||
|
(nnmaildir--unlink mfile)))
|
||||||
del-action (lambda (article) (mapcar del-mark todo-marks))
|
del-action (lambda (article) (mapcar del-mark todo-marks))
|
||||||
add-action
|
add-action
|
||||||
(lambda (article)
|
(lambda (article)
|
||||||
(mapcar
|
(mapcar
|
||||||
(lambda (mark)
|
(lambda (mark)
|
||||||
(setq mdir (nnmaildir--subdir marksdir (symbol-name mark))
|
(let ((prefix (nnmaildir--art-prefix article))
|
||||||
permarkfile (concat mdir ":")
|
(suffix (nnmaildir--art-suffix article))
|
||||||
mfile (concat mdir (nnmaildir--art-prefix article)))
|
(flag (nnmaildir--mark-to-flag mark)))
|
||||||
(nnmaildir--condcase err (add-name-to-file permarkfile mfile)
|
(if flag
|
||||||
(cond
|
;; If there is a corresponding maildir flag, just rename
|
||||||
((nnmaildir--eexist-p err))
|
;; the file.
|
||||||
((nnmaildir--enoent-p err)
|
(nnmaildir--article-set-flags
|
||||||
(nnmaildir--mkdir mdir)
|
article (nnmaildir--add-flag flag suffix) curdir)
|
||||||
(nnmaildir--mkfile permarkfile)
|
;; Otherwise, use nnmaildir-specific marks dir.
|
||||||
(add-name-to-file permarkfile mfile))
|
(setq mdir (nnmaildir--subdir marksdir (symbol-name mark))
|
||||||
((nnmaildir--emlink-p err)
|
permarkfile (concat mdir ":")
|
||||||
(let ((permarkfilenew (concat permarkfile "{new}")))
|
mfile (concat mdir prefix))
|
||||||
(nnmaildir--mkfile permarkfilenew)
|
(nnmaildir--condcase err (add-name-to-file permarkfile mfile)
|
||||||
(rename-file permarkfilenew permarkfile 'replace)
|
(cond
|
||||||
(add-name-to-file permarkfile mfile)))
|
((nnmaildir--eexist-p err))
|
||||||
(t (signal (car err) (cdr err))))))
|
((nnmaildir--enoent-p err)
|
||||||
|
(nnmaildir--mkdir mdir)
|
||||||
|
(nnmaildir--mkfile permarkfile)
|
||||||
|
(add-name-to-file permarkfile mfile))
|
||||||
|
((nnmaildir--emlink-p err)
|
||||||
|
(let ((permarkfilenew (concat permarkfile "{new}")))
|
||||||
|
(nnmaildir--mkfile permarkfilenew)
|
||||||
|
(rename-file permarkfilenew permarkfile 'replace)
|
||||||
|
(add-name-to-file permarkfile mfile)))
|
||||||
|
(t (signal (car err) (cdr err))))))))
|
||||||
todo-marks))
|
todo-marks))
|
||||||
set-action (lambda (article)
|
set-action (lambda (article)
|
||||||
(funcall add-action article)
|
(funcall add-action article)
|
||||||
@ -1581,7 +1722,12 @@ by nnmaildir-request-article.")
|
|||||||
pgname (nnmaildir--pgname nnmaildir--cur-server gname)
|
pgname (nnmaildir--pgname nnmaildir--cur-server gname)
|
||||||
ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
|
ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
|
||||||
all-marks (funcall ls marksdir nil "\\`[^.]" 'nosort)
|
all-marks (funcall ls marksdir nil "\\`[^.]" 'nosort)
|
||||||
all-marks (mapcar 'intern all-marks))
|
all-marks (gnus-delete-duplicates
|
||||||
|
;; get mark names from mark dirs and from flag
|
||||||
|
;; mappings
|
||||||
|
(append
|
||||||
|
(mapcar 'cdr nnmaildir-flag-mark-mapping)
|
||||||
|
(mapcar 'intern all-marks))))
|
||||||
(dolist (action actions)
|
(dolist (action actions)
|
||||||
(setq ranges (car action)
|
(setq ranges (car action)
|
||||||
todo-marks (caddr action))
|
todo-marks (caddr action))
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user