Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
0b6799c3
Commit
0b6799c3
authored
Jan 20, 2008
by
Miles Bader
Browse files
Merge from gnus--devo--0
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-1001
parent
f2c6de6a
Changes
9
Hide whitespace changes
Inline
Side-by-side
Showing
9 changed files
with
334 additions
and
153 deletions
+334
-153
doc/misc/ChangeLog
doc/misc/ChangeLog
+8
-0
doc/misc/gnus-news.texi
doc/misc/gnus-news.texi
+13
-0
etc/GNUS-NEWS
etc/GNUS-NEWS
+13
-2
lisp/ChangeLog
lisp/ChangeLog
+43
-13
lisp/gnus/ChangeLog
lisp/gnus/ChangeLog
+51
-20
lisp/gnus/gnus-art.el
lisp/gnus/gnus-art.el
+43
-26
lisp/gnus/gnus-registry.el
lisp/gnus/gnus-registry.el
+142
-89
lisp/gnus/gnus-sum.el
lisp/gnus/gnus-sum.el
+2
-2
lisp/net/imap.el
lisp/net/imap.el
+19
-1
No files found.
doc/misc/ChangeLog
View file @
0b6799c3
2008-01-18 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-news.texi: Mention gnus-article-describe-bindings.
2008-01-18 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-news.texi: Mention gnus-article-wide-reply-with-original.
2008-01-18 Carsten Dominik <dominik@science.uva.nl>
* org.texi (Property inheritance): New section.
...
...
doc/misc/gnus-news.texi
View file @
0b6799c3
...
...
@@ -140,6 +140,19 @@ inline @acronym{PGP} signed messages. @xref{Flowed text, ,Flowed text,
emacs-mime, The Emacs MIME Manual}. (New in Gnus 5.10.7)
@c This entry is also present in the node "Oort Gnus".
@item Now the new command @kbd{S W}
(@code{gnus-article-wide-reply-with-original}) for a wide reply in the
article buffer yanks a text that is in the active region, if it is set,
as well as the @kbd{R} (@code{gnus-article-reply-with-original}) command.
Note that the @kbd{R} command in the article buffer no longer accepts a
prefix argument, which was used to make it do a wide reply.
@xref{Article Keymap}.
@item The new command @kbd{C-h b}
(@code{gnus-article-describe-bindings}) used in the article buffer now
shows not only the article commands but also the real summary commands
that are accessible from the article buffer.
@end itemize
@item Changes in Message mode
...
...
etc/GNUS-NEWS
View file @
0b6799c3
...
...
@@ -58,7 +58,7 @@ Articles::.
** International host names (IDNA) can now be decoded inside article bodies
using `W i' (`gnus-summary-idna-message'). This requires that GNU Libidn
(
<
http://www.gnu.org/software/libidn/
>
) has been installed.
(
`
http://www.gnu.org/software/libidn/
'
) has been installed.
** The non-ASCII group names handling has been much improved. The back
ends that fully support non-ASCII group names are now `nntp', `nnml',
...
...
@@ -106,13 +106,24 @@ From Newsgroups::.
** You can replace MIME parts with external bodies. See
`gnus-mime-replace-part' and `gnus-article-replace-part'. *Note MIME
Commands::, *
N
ote Using MIME::.
Commands::, *
n
ote Using MIME::.
** The option `mm-fill-flowed' can be used to disable treatment of
format=flowed messages. Also, flowed text is disabled when sending
inline PGP signed messages. *Note Flowed text: (emacs-mime)Flowed text.
(New in Gnus 5.10.7)
** Now the new command `S W' (`gnus-article-wide-reply-with-original') for
a wide reply in the article buffer yanks a text that is in the active
region, if it is set, as well as the `R'
(`gnus-article-reply-with-original') command. Note that the `R' command
in the article buffer no longer accepts a prefix argument, which was
used to make it do a wide reply. *Note Article Keymap::.
** The new command `C-h b' (`gnus-article-describe-bindings') used in the
article buffer now shows not only the article commands but also the real
summary commands that are accessible from the article buffer.
* Changes in Message mode
...
...
lisp/ChangeLog
View file @
0b6799c3
2008-01-19 Reiner Steib <Reiner.Steib@gmx.de>
* net/imap.el (imap-ping-server): New variable.
(imap-opened): On add extra ping if imap-ping-server is non-nil.
(imap-ping-server): Minor doc string fixes.
2008-01-19 Knut Anders Hatlen <kahatlen@gmail.com> (tiny change)
* net/imap.el (imap-ping-server): New function.
(imap-opened): Call imap-ping-server.
2008-01-20 Glenn Morris <rgm@gnu.org>
* progmodes/python.el: Quote all calls to "auxiliary skeleton"s to
...
...
@@ -108,9 +119,11 @@
(org-flag-drawer): Use the original value of `outline-regexp'.
(org-remember-handler): Add invisible-ok flag to call to
`org-end-of-subtree'.
(org-agenda-highlight-todo): Respect `org-agenda-todo-keyword-format'.
(org-agenda-highlight-todo): Respect
`org-agenda-todo-keyword-format'.
(org-agenda-todo-keyword-format): New option.
(org-infile-export-plist): No restriction while searching for options.
(org-infile-export-plist): No restriction while searching for
options.
(org-remember-handler): Remove comments at the end of the buffer.
(org-remember-use-refile-when-interactive): New option.
(org-table-sort-lines): Make sure sorting works on link
...
...
@@ -121,7 +134,8 @@
`full-file-path'.
(org-get-refile-targets): Respect new values for
`org-refile-use-outline-path'.
(org-agenda-get-restriction-and-command): DEL goes back to initial list.
(org-agenda-get-restriction-and-command): DEL goes back to initial
list.
(org-export-as-xoxo): Restore point when done.
(org-open-file): Allow multiple %s in command.
(org-clock-in-switch-to-state): New option.
...
...
@@ -129,7 +143,8 @@
(org-last-remember-storage-locations): New variable.
(org-get-refile-targets): Interpret the new maxlevel setting.
(org-refile-targets): New option `:maxlevel'.
(org-copy-subtree): Include empty lines before but not after subtree.
(org-copy-subtree): Include empty lines before but not after
subtree.
(org-back-over-empty-lines, org-skip-whitespace): New functions.
(org-move-item-down, org-move-item-up): Include empty lines before
but not after item.
...
...
@@ -142,7 +157,8 @@
(org-imenu-markers): New variable.
(org-imenu-new-marker, org-imenu-get-tree)
(org-speedbar-set-agenda-restriction): New functions.
(org-agenda-set-restriction-lock, org-agenda-remove-restriction-lock)
(org-agenda-set-restriction-lock)
(org-agenda-remove-restriction-lock)
(org-agenda-maybe-redo): New functions.
(org-agenda-restriction-lock): New face.
(org-agenda-restriction-lock-overlay)
...
...
@@ -164,8 +180,8 @@
(org-link-escape-chars): Use characters instead of strings.
(org-link-escape-chars-browser, org-link-escape)
(org-link-unescape): Use characters instead of strings.
(org-export-html-convert-sub-super, org-html-do-expand):
Check for
protected text.
(org-export-html-convert-sub-super, org-html-do-expand):
Check for
protected text.
(org-emphasis-alist): Additional `verbatim' flag.
(org-set-emph-re): Handle the verbatim flag and compute
`org-verbatim-re'.
...
...
@@ -174,13 +190,15 @@
(org-hide-emphasis-markers): New option.
(org-additional-option-like-keywords): Add new keywords.
(org-get-entry): Rename from `org-get-cleaned-entry'.
(org-icalendar-cleanup-string): New function for quoting icalendar text.
(org-icalendar-cleanup-string): New function for quoting icalendar
text.
(org-agenda-skip-scheduled-if-done): New option.
(org-agenda-get-scheduled, org-agenda-get-blocks):
Use
`org-agenda-skip-scheduled-if-done'.
(org-agenda-get-scheduled, org-agenda-get-blocks):
Use
`org-agenda-skip-scheduled-if-done'.
(org-prepare-agenda-buffers): Allow buffers as arguments.
(org-entry-properties): Add CATEGORY as a special property.
(org-use-property-inheritance): Allow a list of properties as a value.
(org-use-property-inheritance): Allow a list of properties as a
value.
(org-eval-in-calendar): No longer update the prompt.
(org-read-date-popup-calendar): Rename from
`org-popup-calendar-for-date-prompt'.
...
...
@@ -191,8 +209,8 @@
not yet defined.
(org-remember-insinuate): New function.
(org-read-date-prefer-future): New option.
(org-read-date): Respect the setting of
`org-read-date-prefer-future'.
Use `org-read-date-analyze'.
(org-read-date): Respect the setting of
`org-read-date-prefer-future'.
Use `org-read-date-analyze'.
(org-set-font-lock-defaults): Use `org-archive-tag' instead of a
hardcoded string.
(org-remember-apply-template): Use `remember-finalize' instead of
...
...
@@ -1482,6 +1500,12 @@
* newcomment.el (comment-region-default): Don't triple the
comment starter if the first region line isn't indented enough.
2007-12-21 Teodor Zlatanov <tzz@lifelogs.com>
* net/imap.el (imap-authenticate): Use current-buffer instead of
buffer, for the cases where imap-authenticate is called with a nil
buffer parameter.
2007-12-21 Martin Rudalics <rudalics@gmx.at>
* autoinsert.el (auto-insert-alist): Remove nonsensical precision
...
...
@@ -2172,6 +2196,12 @@
* textmodes/reftex-toc.el (reftex-make-separate-toc-frame):
Try x-focus-frame before focus-frame. Only try focus-frame on XEmacs.
2007-12-03 Nathan J. Williams <nathanw@MIT.EDU> (tiny change)
* net/imap.el (imap-mailbox-status-asynch): Upcase STATUS items.
(imap-parse-status): Upcase status-att for servers that sends them
lower-case (e.g., MS Exchange 2007).
2007-12-03 Karl Fogel <kfogel@red-bean.com>
* saveplace.el (save-place-quiet): Remove, reverting 2007-12-02T19:54:46Z!kfogel@red-bean.com.
...
...
lisp/gnus/ChangeLog
View file @
0b6799c3
2008-01-18 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-art.el (gnus-article-describe-bindings): Make it possible to use
xrefs, i.e. [back] and [forward] buttons, in *Help* buffer.
2008-01-18 Teodor Zlatanov <tzz@lifelogs.com>
* gnus-registry.el (gnus-registry-trim): Use append, not concat.
2008-01-17 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-art.el (gnus-article-read-summary-keys): Work for some `A'
prefix keys.
(gnus-article-read-summary-send-keys): Use gnus-character-to-event.
(gnus-article-describe-bindings): Simplify; move XEmacs stuff to
gnus-xmas.el.
2008-01-16 Teodor Zlatanov <tzz@lifelogs.com>
* gnus-registry.el (gnus-registry-marks, gnus-registry-default-mark):
Add new variables for article mark management.
(gnus-registry-extra-entries-precious, gnus-registry-trim): Define a
list of extra data entries which, when present, will indicate that the
article ID should not be trimmed from the registry.
(gnus-registry-mark-article, gnus-registry-article-marks): Remove these
functions.
(gnus-registry-read-mark): New function to read a mark name from the
user.
(gnus-registry-set-article-mark, gnus-registry-remove-article-mark)
(gnus-registry-set-article-mark-internal): New functions to add and
remove marks.
(gnus-registry-get-article-marks): New function to show the marks for
an article, or retrieve them for further use.
2008-01-16 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-art.el (gnus-article-describe-bindings): Show all `S' prefix
keys when no argument is given.
2008-01-12 Reiner Steib <Reiner.Steib@gmx.de>
* gnus-sum.el (gnus-article-sort-by-random)
(gnus-thread-sort-by-random): Fix doc strings. Reported by
jidanni@jidanni.org.
2008-01-11 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-art.el (gnus-article-describe-bindings): New function.
(gnus-article-read-summary-keys): Use it.
(gnus-article-mode-map): Bind `C-h b' to it.
2008-01-10 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-art.el (gnus-article-read-summary-keys): Work for `C-h' on
...
...
@@ -5,8 +56,6 @@
(gnus-article-describe-key, gnus-article-describe-key-briefly): Protect
against non-character events.
* lpath.el: Fbind map-keymap for Emacs 21.
2008-01-09 Reiner Steib <Reiner.Steib@gmx.de>
* gnus-group.el (gnus-group-read-ephemeral-gmane-group-url): New
...
...
@@ -31,9 +80,6 @@
(gnus-article-reply-with-original): Ignore prefix argument.
(gnus-article-wide-reply-with-original): New function.
* lpath.el: Fbind character-to-event and set-keymap-default-binding for
Emacs 21.
2008-01-08 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-bookmark.el (gnus-bookmark-mouse-available-p): Don't test for
...
...
@@ -55,12 +101,6 @@
* mml-sec.el, sieve-manage.el, smime.el: Simplify loading of
password-cache or password. Suggested by Glenn Morris <rgm@gnu.org>.
2007-12-21 Teodor Zlatanov <tzz@lifelogs.com>
* imap.el (imap-authenticate): Use current-buffer instead of buffer,
for the cases where imap-authenticate is called with a nil buffer
parameter.
2007-12-19 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-art.el (gnus-article-browse-html-parts): Work for two or more
...
...
@@ -364,12 +404,6 @@
* message.el (message-ignored-supersedes-headers): Add "X-ID".
2007-12-03 Nathan J. Williams <nathanw@MIT.EDU> (tiny change)
* imap.el (imap-mailbox-status-asynch): Upcase STATUS items.
(imap-parse-status): Upcase status-att for servers that sends them
lower-case (e.g., MS Exchange 2007).
2007-12-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-sum.el (gnus-uu-extract-map): Add a command for the yenc
...
...
@@ -837,9 +871,6 @@
* webmail.el (webmail-debug): Replace mapcar called for effect with
dolist.
* gnus-xmas.el (gnus-group-add-icon): Replace mapcar called for effect
with mapc.
2007-10-24 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-agent.el (gnus-agent-read-agentview, gnus-agent-save-alist)
...
...
lisp/gnus/gnus-art.el
View file @
0b6799c3
...
...
@@ -4215,6 +4215,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
"F" gnus-article-followup-with-original
"\C-hk" gnus-article-describe-key
"\C-hc" gnus-article-describe-key-briefly
"\C-hb" gnus-article-describe-bindings
"\C-d" gnus-article-read-summary-keys
"\M-*" gnus-article-read-summary-keys
...
...
@@ -6241,9 +6242,10 @@ not have a face in `gnus-article-boring-faces'."
"Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
"=" "^" "\M-^" "|"))
(nosave-but-article
'
(
"A\r"
))
'("A " "A<" "A>" "AM" "AP" "AR" "AT" "A\C-?" "A\M-\r" "A\r" "Ab" "Ae"
"An" "Ap" [?A (meta return)] [?A delete]))
(nosave-in-article
'
(
"\C-d"
))
'(
"AS"
"\C-d"))
(up-to-top
'("n" "Gn" "p" "Gp"))
keys new-sum-point)
...
...
@@ -6260,27 +6262,7 @@ not have a face in `gnus-article-boring-faces'."
(cond
((eq (aref keys (1- (length keys))) ?\C-h)
(
if
(
featurep
'xemacs
)
(
let
((
keymap
(
with-current-buffer
gnus-article-current-summary
(
copy-keymap
(
current-local-map
)))))
(
map-keymap
(
lambda
(
key
def
)
(
define-key
keymap
(
vector
?S
key
)
def
))
gnus-article-send-map
)
(
with-temp-buffer
(
setq
major-mode
'gnus-article-mode
)
(
use-local-map
keymap
)
(
describe-bindings
(
substring
keys
0
-1
))))
(
let
((
keymap
(
make-sparse-keymap
))
(
map
(
copy-keymap
gnus-article-send-map
)))
(
define-key
keymap
"S"
map
)
(
define-key
map
[t]
nil
)
(
set-keymap-parent
keymap
(
with-current-buffer
gnus-article-current-summary
(
current-local-map
)))
(
with-temp-buffer
(
use-local-map
keymap
)
(
describe-bindings
(
substring
keys
0
-1
))))))
(gnus-article-describe-bindings (substring keys 0 -1)))
((or (member keys nosaves)
(member keys nosave-but-article)
(member keys nosave-in-article))
...
...
@@ -6368,9 +6350,7 @@ not have a face in `gnus-article-boring-faces'."
(defun gnus-article-read-summary-send-keys ()
(interactive)
(
let
((
unread-command-events
(
list
(
if
(
featurep
'xemacs
)
(
character-to-event
?S
)
?S
))))
(let ((unread-command-events (list (gnus-character-to-event ?S))))
(gnus-article-read-summary-keys)))
(defun gnus-article-describe-key (key)
...
...
@@ -6418,6 +6398,43 @@ KEY is a string or a vector."
(describe-key-briefly (read-key-sequence nil t) insert)))
(describe-key-briefly key insert)))
;;`gnus-agent-mode' in gnus-agent.el will define it.
(defvar gnus-agent-summary-mode)
(defun gnus-article-describe-bindings (&optional prefix)
"Show a list of all defined keys, and their definitions.
The optional argument PREFIX, if non-nil, should be a key sequence;
then we display only bindings that start with that prefix."
(interactive)
(gnus-article-check-buffer)
(let ((keymap (copy-keymap gnus-article-mode-map))
(map (copy-keymap gnus-article-send-map))
(sumkeys (where-is-internal 'gnus-article-read-summary-keys))
agent)
(define-key keymap "S" map)
(define-key map [t] nil)
(with-current-buffer gnus-article-current-summary
(set-keymap-parent map (key-binding "S"))
(let (def gnus-pick-mode)
(dolist (key sumkeys)
(when (setq def (key-binding key))
(define-key keymap key def))))
(when (boundp 'gnus-agent-summary-mode)
(setq agent gnus-agent-summary-mode)))
(with-temp-buffer
(use-local-map keymap)
(set (make-local-variable 'gnus-agent-summary-mode) agent)
(describe-bindings prefix))
(let ((item `((lambda (prefix)
(save-excursion
(set-buffer ,(current-buffer))
(gnus-article-describe-bindings prefix)))
,prefix)))
(with-current-buffer (if (fboundp 'help-buffer)
(let (help-xref-following) (help-buffer))
"*Help*") ;; Emacs 21
(setq help-xref-stack-item item)))))
(defun gnus-article-reply-with-original (&optional wide)
"Start composing a reply mail to the current message.
The text in the region will be yanked. If the region isn't active,
...
...
lisp/gnus/gnus-registry.el
View file @
0b6799c3
...
...
@@ -78,6 +78,17 @@
:test
'equal
)
"*The article registry by Message ID."
)
(
defcustom
gnus-registry-marks
'
(
Important
Work
Personal
To-Do
Later
)
"List of marks that `gnus-registry-mark-article' will offer for completion."
:group
'gnus-registry
:type
'
(
repeat
symbol
))
(
defcustom
gnus-registry-default-mark
'To-Do
"The default mark."
:group
'gnus-registry
:type
'symbol
)
(
defcustom
gnus-registry-unfollowed-groups
'
(
"delayed$"
"drafts$"
"queue$"
"INBOX$"
)
"List of groups that gnus-registry-split-fancy-with-parent won't return.
The group names are matched, they don't have to be fully
...
...
@@ -129,6 +140,16 @@ way."
:group
'gnus-registry
:type
'boolean
)
(
defcustom
gnus-registry-extra-entries-precious
'
(
marks
)
"What extra entries are precious, meaning they won't get trimmed.
When you save the Gnus registry, it's trimmed to be no longer
than `gnus-registry-max-entries' (which is nil by default, so no
trimming happens). Any entries with extra data in this list (by
default, marks are included, so articles with marks are
considered precious) will not be trimmed."
:group
'gnus-registry
:type
'
(
repeat
symbol
))
(
defcustom
gnus-registry-cache-file
(
nnheader-concat
(
or
gnus-dribble-directory
gnus-home-directory
"~/"
)
...
...
@@ -313,30 +334,50 @@ way."
(
defun
gnus-registry-trim
(
alist
)
"Trim alist to size, using gnus-registry-max-entries.
Also, drop all gnus-registry-ignored-groups matches."
(
if
(
null
gnus-registry-max-entries
)
Also, drop all gnus-registry-ignored-groups matches.
Any entries with extra data (marks, currently) are left alone."
(
if
(
null
gnus-registry-max-entries
)
alist
; just return the alist
;; else, when given max-entries, trim the alist
(
let*
((
timehash
(
make-hash-table
:size
4096
:size
20000
:test
'equal
))
(
precious
(
make-hash-table
:size
20000
:test
'equal
))
(
trim-length
(
-
(
length
alist
)
gnus-registry-max-entries
))
(
trim-length
(
if
(
natnump
trim-length
)
trim-length
0
)))
(
trim-length
(
if
(
natnump
trim-length
)
trim-length
0
))
precious-list
junk-list
)
(
maphash
(
lambda
(
key
value
)
(
puthash
key
(
gnus-registry-fetch-extra
key
'mtime
)
timehash
))
(
let
((
extra
(
gnus-registry-fetch-extra
key
)))
(
dolist
(
item
gnus-registry-extra-entries-precious
)
(
dolist
(
e
extra
)
(
when
(
equal
(
nth
0
e
)
item
)
(
puthash
key
t
precious
)
(
return
))))
(
puthash
key
(
gnus-registry-fetch-extra
key
'mtime
)
timehash
)))
gnus-registry-hashtb
)
;; we use the return value of this setq, which is the trimmed alist
(
setq
alist
(
nthcdr
trim-length
(
sort
alist
(
lambda
(
a
b
)
(
time-less-p
(
or
(
cdr
(
gethash
(
car
a
)
timehash
))
'
(
0
0
0
))
(
or
(
cdr
(
gethash
(
car
b
)
timehash
))
'
(
0
0
0
))))))))))
(
dolist
(
item
alist
)
(
let
((
key
(
nth
0
item
)))
(
if
(
gethash
key
precious
)
(
push
item
precious-list
)
(
push
item
junk-list
))))
(
sort
junk-list
(
lambda
(
a
b
)
(
let
((
t1
(
or
(
cdr
(
gethash
(
car
a
)
timehash
))
'
(
0
0
0
)))
(
t2
(
or
(
cdr
(
gethash
(
car
b
)
timehash
))
'
(
0
0
0
))))
(
time-less-p
t1
t2
))))
;; we use the return value of this setq, which is the trimmed alist
(
setq
alist
(
append
precious-list
(
nthcdr
trim-length
junk-list
))))))
(
defun
gnus-registry-action
(
action
data-header
from
&optional
to
method
)
(
let*
((
id
(
mail-header-id
data-header
))
(
subject
(
gnus-string-remove-all-properties
...
...
@@ -577,6 +618,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(
assoc
article
(
gnus-data-list
nil
)))))
nil
))
;;; this should be redone with catch/throw
(
defun
gnus-registry-grep-in-list
(
word
list
)
(
when
word
(
memq
nil
...
...
@@ -586,80 +628,91 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(
string-match
word
x
))
list
)))))
(
defun
gnus-registry-mark-article
(
article
&optional
mark
remove
)
"Mark ARTICLE with MARK in the Gnus registry or remove MARK.
MARK can be any symbol. If ARTICLE is nil, then the
`gnus-current-article' will be marked. If MARK is nil,
`gnus-registry-flag-default' will be used."
(
interactive
"nArticle number: "
)
(
let
((
article
(
or
article
gnus-current-article
))
(
mark
(
or
mark
'gnus-registry-flag-default
))
article-id
)
(
unless
article
(
error
"No article on current line"
))
(
setq
article-id
(
gnus-registry-fetch-message-id-fast
gnus-current-article
))
(
unless
article-id
(
error
"No article ID could be retrieved"
))
(
let*
(
;; all the marks for this article
(
marks
(
gnus-registry-fetch-extra-flags
article-id
))
;; the marks without the mark of interest
(
cleaned-marks
(
delq
mark
marks
))
;; the new marks we want to use
(
new-marks
(
if
remove
cleaned-marks
(
cons
mark
cleaned-marks
))))
(
apply
'gnus-registry-store-extra-flags
; set the extra flags
article-id
; for the message ID
new-marks
)
(
gnus-registry-fetch-extra-flags
article-id
))))
(
defun
gnus-registry-article-marks
(
article
)
"Get the Gnus registry marks for ARTICLE.
If ARTICLE is nil, then the `gnus-current-article' will be
used."
(
interactive
"nArticle number: "
)
(
let
((
article
(
or
article
gnus-current-article
))
article-id
)
(
unless
article
(
error
"No article on current line"
))
(
setq
article-id
(
gnus-registry-fetch-message-id-fast
gnus-current-article
))
(
unless
article-id
(
error
"No article ID could be retrieved"
))
(
gnus-message
1
"Message ID %s, Registry flags: %s"
article-id
(
concat
(
gnus-registry-fetch-extra-flags
article-id
)))))
;;; if this extends to more than 'flags, it should be improved to be more generic.
(
defun
gnus-registry-fetch-extra-flags
(
id
)
"Get the flags of a message, based on the message ID.
Returns a list of symbol flags or nil."
(
car-safe
(
cdr
(
gnus-registry-fetch-extra
id
'flags
))))
(
defun
gnus-registry-has-extra-flag
(
id
flag
)
"Checks if a message has `flag', based on the message ID."
(
memq
flag
(
gnus-registry-fetch-extra-flags
id
)))
(
defun
gnus-registry-store-extra-flags
(
id
&rest
flag-list
)
"Set the flags of a message, based on the message ID.
The `flag-list' can be nil, in which case no flags are left."
(
gnus-registry-store-extra-entry
id
'flags
(
list
flag-list
)))
(
defun
gnus-registry-delete-extra-flags
(
id
&rest
flag-delete-list
)
"Delete the message flags in `flag-delete-list', based on the message ID."
(
let
((
flags
(
gnus-registry-fetch-extra-flags
id
)))
(
when
flags
(
dolist
(
flag
flag-delete-list
)
(
setq
flags
(
delq
flag
flags
))))
(
gnus-registry-store-extra-flags
id
(
car
flags
))))
(
defun
gnus-registry-delete-all-extra-flags
(
id
)
"Delete all the flags for a message ID."
(
gnus-registry-store-extra-flags
id
nil
))
(
defun
gnus-registry-read-mark
()
"Read a mark name from the user with completion."
(
let
((
mark
(
gnus-completing-read-with-default
(
symbol-name
gnus-registry-default-mark
)
"Label"
(
mapcar
(
lambda
(
x
)
; completion list
(
cons
(
symbol-name
x
)
x
))
gnus-registry-marks
))))
(
when
(
stringp
mark
)
(
intern
mark
))))
(
defun
gnus-registry-set-article-mark
(
&rest
articles
)
"Apply a mark to process-marked ARTICLES."
(
interactive
(
gnus-summary-work-articles
current-prefix-arg
))
(
gnus-registry-set-article-mark-internal
(
gnus-registry-read-mark
)
articles
nil
t
))
(
defun
gnus-registry-remove-article-mark
(
&rest
articles
)
"Remove a mark from process-marked ARTICLES."
(
interactive
(
gnus-summary-work-articles
current-prefix-arg
))
(
gnus-registry-set-article-mark-internal
(
gnus-registry-read-mark
)
articles
t
t
))
(
defun
gnus-registry-set-article-mark-internal
(
mark
articles
&optional
remove
show-message
)
"Apply a mark to a list of ARTICLES."
(
let
((
article-id-list
(
mapcar
'gnus-registry-fetch-message-id-fast
articles
)))
(
dolist
(
id
article-id-list
)
(
let*
(
;; all the marks for this article without the mark of
;; interest
(
marks
(
delq
mark
(
gnus-registry-fetch-extra-marks
id
)))
;; the new marks we want to use
(
new-marks
(
if
remove
marks
(
cons
mark
marks
))))
(
when
show-message
(
gnus-message
1
"%s mark %s with message ID %s, resulting in %S"
(
if
remove
"Removing"
"Adding"
)
mark
id
new-marks
))
(
apply
'gnus-registry-store-extra-marks
; set the extra marks
id
; for the message ID
new-marks
)))))
(
defun
gnus-registry-get-article-marks
(
&rest
articles
)
"Get the Gnus registry marks for ARTICLES and show them if interactive.
Uses process/prefix conventions. For multiple articles,
only the last one's marks are returned."
(
interactive
(
gnus-summary-work-articles
1
))
(
let
(
marks
)
(
dolist
(
article
articles
)
(
let
((
article-id
(
gnus-registry-fetch-message-id-fast
article
)))
(
setq
marks
(
gnus-registry-fetch-extra-marks
article-id
))))
(
when
(
interactive-p
)