From 659948d3378210d332f1dd2826cbf51c66541caa Mon Sep 17 00:00:00 2001 From: yamaoka Date: Mon, 8 Apr 2002 04:35:57 +0000 Subject: [PATCH] Synch with Oort Gnus. --- lisp/ChangeLog | 84 ++++ lisp/dns.el | 341 ++++++++++++++++ lisp/gnus-art.el | 17 +- lisp/gnus-fun.el | 59 --- lisp/gnus-group.el | 8 +- lisp/gnus-sum.el | 13 +- lisp/gnus.el | 2 +- lisp/lpath.el | 5 +- lisp/message.el | 72 ++-- lisp/mm-view.el | 26 +- lisp/nnmaildir.el | 1065 +++++++++++++++++++++++--------------------------- lisp/nnnil.el | 12 +- lisp/nnwarchive.el | 2 +- lisp/spam.el | 118 ++++++ texi/ChangeLog | 25 ++ texi/gnus-ja.texi | 29 +- texi/gnus.texi | 17 +- texi/message-ja.texi | 84 +++- texi/message.texi | 81 +++- 19 files changed, 1356 insertions(+), 704 deletions(-) create mode 100644 lisp/dns.el create mode 100644 lisp/spam.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ad23074..7825ae2 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,87 @@ +2002-04-07 ShengHuo ZHU + + * mm-view.el (mm-inline-text-html-render-with-w3): Don't ignore + errors when debug. + +2002-04-07 Josh Huber + + * message.el (message-make-mft): Changed MFT code from using + message-recipients (which included Bcc) to use only the To and CC + headers. + +2002-04-05 Per Abrahamsen + + * gnus-art.el (gnus-treat-from-picon): Add to gnus-picon group and + add link. + (gnus-treat-mail-picon): Ditto. + (gnus-treat-newsgroups-picon): Ditto. + (gnus-picon-databases): Fix custom type. + (gnus-picon-databases): Add link. + (gnus-article-x-face-command): Add to gnus-picon group. + +2002-04-01 Jesper Harder + + * message.el (message-buffer-naming-style): Remove. + +2002-04-02 ShengHuo ZHU + + * gnus-group.el (gnus-group-make-tool-bar): Load tool-bar first. + + * message.el (message-tool-bar-map): Ditto. + + * gnus-sum.el (gnus-summary-make-tool-bar): Ditto. + +2002-04-01 ShengHuo ZHU + + * nnwarchive.el (nnwarchive-mail-archive-article): Fix typo. + +2002-04-01 Paul Jarc + + * nnmaildir.el: fixed some buggy invocations of nnmaildir--pgname. + +2002-03-31 Andrew Cohen + + * dns.el: open-network-stream under XEmacs does udp. + +2002-03-31 Lars Magne Ingebrigtsen + + * spam.el (spam-enter-whitelist): New function. + (spam-parse-whitelist): Ditto. + (spam-refresh-list-cache): Ditto. + (spam-address-whitelisted-p): New function. + + * dns.el (query-dns): Use TCP when make-network-process isn't + available. + (dns-servers): New variable. + (dns-parse-resolv-conf): New function. + (query-dns): Use it. + + * spam.el: New file. + + * dns.el (query-dns): Test. + +2002-03-31 Lars Magne Ingebrigtsen + + * lpath.el (featurep): Bind make-network-process. + +2002-03-31 Paul Jarc + + * nnmaildir.el: Use defstruct. Use a single copy of + nnmail-extra-headers to save memory. Store server's group name + prefix instead of each group's prefixed name. + * nnnil.el (nnnil-retrieve-headers, nnnil-request-list): Erase + nntp-server-buffer. + +2002-03-31 Lars Magne Ingebrigtsen + + * dns.el: New file. + +2002-03-28 Simon Josefsson + + * gnus-sum.el (gnus-summary-dummy-line-format): + * gnus.el (gnus-summary-line-format): Fixing links to Info. + Trivial change from Bj,Av(Brn Torkelsson . + 2002-03-29 Kai Gro,A_(Bjohann * gnus-sum.el (gnus-summary-move-article) diff --git a/lisp/dns.el b/lisp/dns.el new file mode 100644 index 0000000..c35300e --- /dev/null +++ b/lisp/dns.el @@ -0,0 +1,341 @@ +;;; dns.el --- Domain Name Service lookups +;; Copyright (C) 2002 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen +;; Keywords: network + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; Code: + +(require 'mm-util) + +(defvar dns-timeout 5 + "How many seconds to wait when doing DNS queries.") + +(defvar dns-servers nil + "Which DNS servers to query. +If nil, /etc/resolv.conf will be consulted.") + +;;; Internal code: + +(defvar dns-query-types + '((A 1) + (NS 2) + (MD 3) + (MF 4) + (CNAME 5) + (SOA 6) + (MB 7) + (MG 8) + (MR 9) + (NULL 10) + (WKS 11) + (PRT 12) + (HINFO 13) + (MINFO 14) + (MX 15) + (TXT 16) + (AXFR 252) + (MAILB 253) + (MAILA 254) + (* 255)) + "Names of query types and their values.") + +(defvar dns-classes + '((IN 1) + (CS 2) + (CH 3) + (HS 4)) + "Classes of queries.") + +(defun dns-write-bytes (value &optional length) + (let (bytes) + (dotimes (i (or length 1)) + (push (% value 256) bytes) + (setq value (/ value 256))) + (dolist (byte bytes) + (insert byte)))) + +(defun dns-read-bytes (length) + (let ((value 0)) + (dotimes (i length) + (setq value (logior (* value 256) (following-char))) + (forward-char 1)) + value)) + +(defun dns-get (type spec) + (cadr (assq type spec))) + +(defun dns-inverse-get (value spec) + (let ((found nil)) + (while (and (not found) + spec) + (if (eq value (cadr (car spec))) + (setq found (caar spec)) + (pop spec))) + found)) + +(defun dns-write-name (name) + (dolist (part (split-string name "\\.")) + (dns-write-bytes (length part)) + (insert part)) + (dns-write-bytes 0)) + +(defun dns-read-string-name (string buffer) + (mm-with-unibyte-buffer + (insert string) + (goto-char (point-min)) + (dns-read-name buffer))) + +(defun dns-read-name (&optional buffer) + (let ((ended nil) + (name nil) + length) + (while (not ended) + (setq length (dns-read-bytes 1)) + (if (= 192 (logand length (lsh 3 6))) + (let ((offset (+ (* (logand 63 length) 256) + (dns-read-bytes 1)))) + (save-excursion + (when buffer + (set-buffer buffer)) + (goto-char (1+ offset)) + (setq ended (dns-read-name buffer)))) + (if (zerop length) + (setq ended t) + (push (buffer-substring (point) + (progn (forward-char length) (point))) + name)))) + (if (stringp ended) + (if (null name) + ended + (concat (mapconcat 'identity (nreverse name) ".") "." ended)) + (mapconcat 'identity (nreverse name) ".")))) + +(defun dns-write (spec &optional tcp-p) + "Write a DNS packet according to SPEC. +If TCP-P, the first two bytes of the package with be the length field." + (with-temp-buffer + (dns-write-bytes (dns-get 'id spec) 2) + (dns-write-bytes + (logior + (lsh (if (dns-get 'response-p spec) 1 0) -7) + (lsh + (cond + ((eq (dns-get 'opcode spec) 'query) 0) + ((eq (dns-get 'opcode spec) 'inverse-query) 1) + ((eq (dns-get 'opcode spec) 'status) 2) + (t (error "No such opcode: %s" (dns-get 'opcode spec)))) + -3) + (lsh (if (dns-get 'authoritative-p spec) 1 0) -2) + (lsh (if (dns-get 'truncated-p spec) 1 0) -1) + (lsh (if (dns-get 'recursion-desired-p spec) 1 0) 0))) + (dns-write-bytes + (cond + ((eq (dns-get 'response-code spec) 'no-error) 0) + ((eq (dns-get 'response-code spec) 'format-error) 1) + ((eq (dns-get 'response-code spec) 'server-failure) 2) + ((eq (dns-get 'response-code spec) 'name-error) 3) + ((eq (dns-get 'response-code spec) 'not-implemented) 4) + ((eq (dns-get 'response-code spec) 'refused) 5) + (t 0))) + (dns-write-bytes (length (dns-get 'queries spec)) 2) + (dns-write-bytes (length (dns-get 'answers spec)) 2) + (dns-write-bytes (length (dns-get 'authorities spec)) 2) + (dns-write-bytes (length (dns-get 'additionals spec)) 2) + (dolist (query (dns-get 'queries spec)) + (dns-write-name (car query)) + (dns-write-bytes (cadr (assq (or (dns-get 'type query) 'A) + dns-query-types)) 2) + (dns-write-bytes (cadr (assq (or (dns-get 'class query) 'IN) + dns-classes)) 2)) + (dolist (slot '(answers authorities additionals)) + (dolist (resource (dns-get slot spec)) + (dns-write-name (car resource)) + (dns-write-bytes (cadr (assq (dns-get 'type resource) dns-query-types)) + 2) + (dns-write-bytes (cadr (assq (dns-get 'class resource) dns-classes)) + 2) + (dns-write-bytes (dns-get 'ttl resource) 4) + (dns-write-bytes (length (dns-get 'data resource)) 2) + (insert (dns-get 'data resource)))) + (when tcp-p + (goto-char (point-min)) + (dns-write-bytes (buffer-size) 2)) + (buffer-string))) + +(defun dns-read (packet) + (mm-with-unibyte-buffer + (let ((spec nil) + queries answers authorities additionals) + (insert packet) + (goto-char (point-min)) + (push (list 'id (dns-read-bytes 2)) spec) + (let ((byte (dns-read-bytes 1))) + (push (list 'response-p (if (zerop (logand byte (lsh 1 7))) nil t)) + spec) + (let ((opcode (logand byte (lsh 7 3)))) + (push (list 'opcode + (cond ((eq opcode 0) 'query) + ((eq opcode 1) 'inverse-query) + ((eq opcode 2) 'status))) + spec)) + (push (list 'authoritative-p (if (zerop (logand byte (lsh 1 2))) + nil t)) spec) + (push (list 'truncated-p (if (zerop (logand byte (lsh 1 2))) nil t)) + spec) + (push (list 'recursion-desired-p + (if (zerop (logand byte (lsh 1 0))) nil t)) spec)) + (let ((rc (logand (dns-read-bytes 1) 15))) + (push (list 'response-code + (cond + ((eq rc 0) 'no-error) + ((eq rc 1) 'format-error) + ((eq rc 2) 'server-failure) + ((eq rc 3) 'name-error) + ((eq rc 4) 'not-implemented) + ((eq rc 5) 'refused))) + spec)) + (setq queries (dns-read-bytes 2)) + (setq answers (dns-read-bytes 2)) + (setq authorities (dns-read-bytes 2)) + (setq additionals (dns-read-bytes 2)) + (let ((qs nil)) + (dotimes (i queries) + (push (list (dns-read-name) + (list 'type (dns-inverse-get (dns-read-bytes 2) + dns-query-types)) + (list 'class (dns-inverse-get (dns-read-bytes 2) + dns-classes))) + qs)) + (push (list 'queries qs) spec)) + (dolist (slot '(answers authorities additionals)) + (let ((qs nil) + type) + (dotimes (i (symbol-value slot)) + (push (list (dns-read-name) + (list 'type + (setq type (dns-inverse-get (dns-read-bytes 2) + dns-query-types))) + (list 'class (dns-inverse-get (dns-read-bytes 2) + dns-classes)) + (list 'ttl (dns-read-bytes 4)) + (let ((length (dns-read-bytes 2))) + (list 'data + (dns-read-type + (buffer-substring + (point) + (progn (forward-char length) (point))) + type)))) + qs)) + (push (list slot qs) spec))) + (nreverse spec)))) + +(defun dns-read-type (string type) + (let ((buffer (current-buffer)) + (point (point))) + (prog1 + (mm-with-unibyte-buffer + (insert string) + (goto-char (point-min)) + (cond + ((eq type 'A) + (let ((bytes nil)) + (dotimes (i 4) + (push (dns-read-bytes 1) bytes)) + (mapconcat 'number-to-string (nreverse bytes) "."))) + ((eq type 'NS) + (dns-read-string-name string buffer)) + ((eq type 'CNAME) + (dns-read-string-name string buffer)) + (t string))) + (goto-char point)))) + +(defun dns-parse-resolv-conf () + (when (file-exists-p "/etc/resolv.conf") + (with-temp-buffer + (insert-file-contents "/etc/resolv.conf") + (goto-char (point-min)) + (while (re-search-forward "^nameserver[\t ]+\\([^ \t\n]+\\)" nil t) + (push (match-string 1) dns-servers)) + (setq dns-servers (nreverse dns-servers))))) + +;;; Interface functions. + +(defun query-dns (name &optional type fullp) + "Query a DNS server for NAME of TYPE. +If FULLP, return the entire record returned." + (setq type (or type 'A)) + (unless dns-servers + (dns-parse-resolv-conf) + (unless dns-servers + (error "No DNS server configuration found"))) + (mm-with-unibyte-buffer + (let ((coding-system-for-read 'binary) + (coding-system-for-write 'binary) + (tcp-p (and (not (fboundp 'open-network-stream)) + (not (featurep 'xemacs))))) + (let ((process + (cond + ((featurep 'xemacs) + (open-network-stream + "dns" (current-buffer) (car dns-servers) "domain" 'udp)) + (tcp-p + (open-network-stream + "dns" (current-buffer) (car dns-servers) "domain")) + (t + (make-network-process + :name "dns" + :coding 'binary + :buffer (current-buffer) + :host (car dns-servers) + :service "domain" + :type 'datagram)))) + (step 100) + (times (* dns-timeout 1000)) + (id (random 65000))) + (process-send-string + process + (dns-write `((id ,id) + (opcode query) + (queries ((,name (type ,type)))) + (recursion-desired-p t)) + tcp-p)) + (while (and (zerop (buffer-size)) + (> times 0)) + (accept-process-output process 0 step) + (decf times step)) + (ignore-errors + (delete-process process)) + (when tcp-p + (goto-char (point-min)) + (delete-region (point) (+ (point) 2))) + (unless (zerop (buffer-size)) + (let ((result (dns-read (buffer-string)))) + (if fullp + result + (let ((answer (car (dns-get 'answers result)))) + (when (eq type (dns-get 'type answer)) + (dns-get 'data answer)))))))))) + +(provide 'dns) + +;;; dns.el ends here diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 8be4868..b67befb 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -278,6 +278,7 @@ asynchronously. The compressed face will be piped to this command." x-face-mule-gnus-article-display-x-face)) 'function)))) ;;:version "21.1" + :group 'gnus-picon :group 'gnus-article-washing) (defcustom gnus-article-x-face-too-ugly nil @@ -754,10 +755,13 @@ be controlled by `gnus-treat-body-boundary'." string)) (defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces") - "*Defines the location of the faces database. + "Defines the location of the faces database. For information on obtaining this database of pretty pictures, please see http://www.cs.indiana.edu/picons/ftp/index.html" - :type 'directory + :type '(repeat directory) + :link '(url-link :tag "download" + "http://www.cs.indiana.edu/picons/ftp/index.html") + :link '(custom-manual "(gnus)Picons") :group 'gnus-picon) (defun gnus-picons-installed-p () @@ -1190,6 +1194,9 @@ Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' and Info node `(gnus)Picons' for details." :group 'gnus-article-treat + :group 'gnus-picon + :link '(info-link "(gnus)Customizing Articles") + :link '(info-link "(gnus)Picons") :type gnus-article-treat-head-custom) (put 'gnus-treat-from-picon 'highlight t) @@ -1202,6 +1209,9 @@ Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' and Info node `(gnus)Picons' for details." :group 'gnus-article-treat + :group 'gnus-picon + :link '(info-link "(gnus)Customizing Articles") + :link '(info-link "(gnus)Picons") :type gnus-article-treat-head-custom) (put 'gnus-treat-mail-picon 'highlight t) @@ -1214,6 +1224,9 @@ Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' and Info node `(gnus)Picons' for details." :group 'gnus-article-treat + :group 'gnus-picon + :link '(info-link "(gnus)Customizing Articles") + :link '(info-link "(gnus)Picons") :type gnus-article-treat-head-custom) (put 'gnus-treat-newsgroups-picon 'highlight t) diff --git a/lisp/gnus-fun.el b/lisp/gnus-fun.el index 5421360..4589fd7 100644 --- a/lisp/gnus-fun.el +++ b/lisp/gnus-fun.el @@ -240,65 +240,6 @@ colors of the displayed X-Faces." (gnus-convert-image-to-gray-x-face (concat file ".gif") 3) (delete-file (concat file ".gif")))) -(defun gnus-respond-to-confirmation () - "Respond to a Gmane confirmation message." - (interactive) - (gnus-summary-show-article 'raw) - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil)) - (goto-char (point-min)) - (gnus-article-goto-header "Original-To") - (replace-match "To:")) - (let ((auth nil)) - (when (and (search-forward "Majordomo" nil t) - (re-search-forward "auth.*subscribe.*$" nil t)) - (setq auth (match-string 0))) - (message-wide-reply) - (goto-char (point-min)) - (gnus-article-goto-header "Cc") - (replace-match "From:") - (message-goto-body) - (delete-region (point) (point-max)) - (when auth - (insert auth "\n")))) - -(defun gnus-subscribe-to-mailing-list (type) - "Generate a Gmane subscription message based on the current gmane.conf line." - (interactive - (list - (intern - (completing-read "Mailing list type: " - '(("mailman") ("majordomo") ("exmlm")) - nil t)))) - (beginning-of-line) - (let* ((entry - (split-string - (buffer-substring (point) (progn (end-of-line) (point))) - ":")) - (local (car (split-string (nth 2 entry) "@"))) - (host (cadr (split-string (nth 2 entry) "@"))) - (from (car entry)) - (subject "subscribe") - to) - (when (string-match "#" from) - (setq from (substring from 1))) - (cond - ((eq type 'mailman) - (setq to (concat local "-request@" host))) - ((eq type 'majordomo) - (setq to (concat "majordomo@" host) - subject (concat "subscribe " local))) - ((eq type 'exmlm) - (setq to (concat local "-" from "=m.gmane.org@" host))) - (t - (error "No such type: %s" type))) - (message-mail - to subject - `((From . ,(concat from "@m.gmane.org")))) - (message-goto-body) - (delete-region (point) (point-max)) - (insert subject "\n"))) - (provide 'gnus-fun) ;;; gnus-fun.el ends here diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 18e07e3..5b0be07 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -920,9 +920,11 @@ simple manner.") ;; Emacs 21 tool bar. Should be no-op otherwise. (defun gnus-group-make-tool-bar () - (if (and (fboundp 'tool-bar-add-item-from-menu) - (default-value 'tool-bar-mode) - (not gnus-group-toolbar-map)) + (if (and + (condition-case nil (require 'tool-bar) (error nil)) + (fboundp 'tool-bar-add-item-from-menu) + (default-value 'tool-bar-mode) + (not gnus-group-toolbar-map)) (setq gnus-group-toolbar-map (let ((tool-bar-map (make-sparse-keymap)) (load-path (mm-image-load-path))) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 5bdbc5f..3690eab 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -607,7 +607,7 @@ with some simple extensions. %S The subject General format specifiers can also be used. -See (gnus)Formatting Variables." +See `(gnus)Formatting Variables'." :link '(custom-manual "(gnus)Formatting Variables") :group 'gnus-threading :type 'string) @@ -2328,10 +2328,15 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) (defvar gnus-summary-tool-bar-map nil) ;; Emacs 21 tool bar. Should be no-op otherwise. +;; NB: A new function tool-bar-local-item-from-menu is added in Emacs +;; 21.2.50+. Considering many users use Emacs 21, use +;; tool-bar-add-item-from-menu here. (defun gnus-summary-make-tool-bar () - (if (and (fboundp 'tool-bar-add-item-from-menu) - (default-value 'tool-bar-mode) - (not gnus-summary-tool-bar-map)) + (if (and + (condition-case nil (require 'tool-bar) (error nil)) + (fboundp 'tool-bar-add-item-from-menu) + (default-value 'tool-bar-mode) + (not gnus-summary-tool-bar-map)) (setq gnus-summary-tool-bar-map (let ((tool-bar-map (make-sparse-keymap)) (load-path (mm-image-load-path))) diff --git a/lisp/gnus.el b/lisp/gnus.el index 4f949ff..2999da7 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -2349,7 +2349,7 @@ possible. This restriction may disappear in later versions of Gnus. General format specifiers can also be used. -See (gnus)Formatting Variables." +See `(gnus)Formatting Variables'." :link '(custom-manual "(gnus)Formatting Variables") :type 'string :group 'gnus-summary-format) diff --git a/lisp/lpath.el b/lisp/lpath.el index 0442069..6e33af8 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -87,7 +87,8 @@ url-retrieve w3-form-encode-xwfu window-at window-edges x-color-values x-popup-menu browse-url frame-char-height frame-char-width - url-generic-parse-url xml-parse-region)) + url-generic-parse-url xml-parse-region + make-network-process)) (maybe-bind '(buffer-display-table buffer-file-coding-system font-lock-defaults global-face-data gnus-article-x-face-too-ugly @@ -118,7 +119,7 @@ specifier-instance url-generic-parse-url valid-image-instantiator-format-p w3-do-setup window-pixel-height window-pixel-width - xml-parse-region))) + xml-parse-region make-network-process))) ;; T-gnus. (let ((functions diff --git a/lisp/message.el b/lisp/message.el index d6a920f..c297963 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1004,14 +1004,6 @@ If nil, Message won't auto-save." :group 'message-buffers :type '(choice directory (const :tag "Don't auto-save" nil))) -(defcustom message-buffer-naming-style 'unique - "*The way new message buffers are named. -Valid valued are `unique' and `unsent'." - :version "21.1" - :group 'message-buffers - :type '(choice (const :tag "unique" unique) - (const :tag "unsent" unsent))) - (defcustom message-default-charset (and (featurep 'xemacs) (not (featurep 'mule)) 'iso-8859-1) "Default charset used in non-MULE XEmacsen." @@ -4560,7 +4552,9 @@ give as trustworthy answer as possible." (defun message-make-mft () "Return the Mail-Followup-To header." (let* ((case-fold-search t) - (msg-recipients (message-options-get 'message-recipients)) + (to (message-fetch-field "To")) + (cc (message-fetch-field "cc")) + (msg-recipients (concat to (and to cc ", ") cc)) (recipients (mapcar 'mail-strip-quoted-names (message-tokenize-header msg-recipients))) @@ -6091,35 +6085,37 @@ which specify the range to operate on." (defun message-tool-bar-map () (or message-tool-bar-map (setq message-tool-bar-map - (and (fboundp 'tool-bar-add-item-from-menu) - tool-bar-mode - (let ((tool-bar-map (copy-keymap tool-bar-map)) - (load-path (mm-image-load-path))) - ;; Zap some items which aren't so relevant and take - ;; up space. - (dolist (key '(print-buffer kill-buffer save-buffer - write-file dired open-file)) - (define-key tool-bar-map (vector key) nil)) - (tool-bar-add-item-from-menu - 'message-send-and-exit "mail_send" message-mode-map) - (tool-bar-add-item-from-menu - 'message-kill-buffer "close" message-mode-map) - (tool-bar-add-item-from-menu - 'message-dont-send "cancel" message-mode-map) - (tool-bar-add-item-from-menu - 'mime-edit-insert-file "attach" message-mode-map) - (tool-bar-add-item-from-menu - 'ispell-message "spell" message-mode-map) - (tool-bar-add-item-from-menu - 'message-insert-importance-high "important" - message-mode-map) - (tool-bar-add-item-from-menu - 'message-insert-importance-low "unimportant" - message-mode-map) - (tool-bar-add-item-from-menu - 'message-insert-disposition-notification-to "receipt" - message-mode-map) - tool-bar-map))))) + (and + (condition-case nil (require 'tool-bar) (error nil)) + (fboundp 'tool-bar-add-item-from-menu) + tool-bar-mode + (let ((tool-bar-map (copy-keymap tool-bar-map)) + (load-path (mm-image-load-path))) + ;; Zap some items which aren't so relevant and take + ;; up space. + (dolist (key '(print-buffer kill-buffer save-buffer + write-file dired open-file)) + (define-key tool-bar-map (vector key) nil)) + (tool-bar-add-item-from-menu + 'message-send-and-exit "mail_send" message-mode-map) + (tool-bar-add-item-from-menu + 'message-kill-buffer "close" message-mode-map) + (tool-bar-add-item-from-menu + 'message-dont-send "cancel" message-mode-map) + (tool-bar-add-item-from-menu + 'mime-edit-insert-file "attach" message-mode-map) + (tool-bar-add-item-from-menu + 'ispell-message "spell" message-mode-map) + (tool-bar-add-item-from-menu + 'message-insert-importance-high "important" + message-mode-map) + (tool-bar-add-item-from-menu + 'message-insert-importance-low "unimportant" + message-mode-map) + (tool-bar-add-item-from-menu + 'message-insert-disposition-notification-to "receipt" + message-mode-map) + tool-bar-map))))) ;;; Group name completion. diff --git a/lisp/mm-view.el b/lisp/mm-view.el index 2a096ab..405b304 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -145,23 +145,25 @@ ;; Don't let w3 set the global version of ;; this variable. (fill-column fill-column)) - (condition-case () + (if (or debug-on-error debug-on-quit) (w3-region (point-min) (point-max)) - (error - (delete-region (point-min) (point-max)) - (let ((b (point)) - (charset (mail-content-type-get - (mm-handle-type handle) 'charset))) - (if (or (eq charset 'gnus-decoded) - (eq mail-parse-charset 'gnus-decoded)) + (condition-case () + (w3-region (point-min) (point-max)) + (error + (delete-region (point-min) (point-max)) + (let ((b (point)) + (charset (mail-content-type-get + (mm-handle-type handle) 'charset))) + (if (or (eq charset 'gnus-decoded) + (eq mail-parse-charset 'gnus-decoded)) (save-restriction (narrow-to-region (point) (point)) (mm-insert-part handle) (goto-char (point-max))) - (insert (mm-decode-string (mm-get-part handle) - charset)))) - (message - "Error while rendering html; showing as text/plain")))))) + (insert (mm-decode-string (mm-get-part handle) + charset)))) + (message + "Error while rendering html; showing as text/plain"))))))) (mm-handle-set-undisplayer handle `(lambda () diff --git a/lisp/nnmaildir.el b/lisp/nnmaildir.el index 59da1b9..2d21303 100644 --- a/lisp/nnmaildir.el +++ b/lisp/nnmaildir.el @@ -40,7 +40,7 @@ ;; Todo: ;; * Don't force article renumbering, so nnmaildir can be used with ;; the cache and agent. Alternatively, completely rewrite the Gnus -;; backend interface, which would have other advantages. +;; backend interface, which would have other advantages as well. ;; ;; See also until that ;; information is added to the Gnus manual. @@ -79,164 +79,85 @@ by nnmaildir-request-article.") ;; The current server: (defvar nnmaildir--cur-server nil) -;; A server is a vector: -["server-name" - select-method - "/expanded/path/to/directory/containing/symlinks/to/maildirs/" - directory-files-function - group-name-transformation-function - ;; An obarray containing symbols whose names are group names and whose values - ;; are groups: - group-hash - ;; A group which has not necessarily been added to the group hash, or nil: - tmp-group - current-group ;; or nil - "Last error message, or nil" - directory-modtime - get-new-mail-p ;; Should we split mail from mail-sources? - "new/group/creation/directory"] - -;; A group is a vector: -["group.name" - "prefixed:group.name" - ;; Modification times of the "new", and "cur" directories: - new-modtime - cur-modtime - ;; A vector containing lists of articles: - [;; A list of articles, with article numbers in descending order, ending with - ;; article 1: - article-list - ;; An obarray containing symbols whose names are filename prefixes and whose - ;; values are articles: - file-hash - ;; Same as above, but keyed on Message-ID: - msgid-hash - ;; An article which has not necessarily been added to the file and msgid - ;; hashes, or nil: - tmp-article] - ;; A vector containing nil, or articles with NOV data: - nov-cache - ;; The index of the next nov-cache entry to be replaced: - nov-cache-index - ;; An obarray containing symbols whose names are mark names and whose values - ;; are modtimes of mark directories: - mark-modtime-hash] - -;; An article is a vector: -["file.name.prefix" - ":2,suffix" ;; or 'expire if expired - number - "msgid" - ;; A NOV data vector, or nil: - ["subject\tfrom\tdate" - "references\tchars\lines" - "extra" - article-file-modtime - ;; The value of nnmail-extra-headers when this NOV data was parsed: - (to in-reply-to)]] - -(defmacro nnmaildir--srv-new () '(make-vector 11 nil)) -(defmacro nnmaildir--srv-get-name (server) `(aref ,server 0)) -(defmacro nnmaildir--srv-get-method (server) `(aref ,server 1)) -(defmacro nnmaildir--srv-get-dir (server) `(aref ,server 2)) -(defmacro nnmaildir--srv-get-ls (server) `(aref ,server 3)) -(defmacro nnmaildir--srv-get-groups (server) `(aref ,server 4)) -(defmacro nnmaildir--srv-get-curgrp (server) `(aref ,server 6)) -(defmacro nnmaildir--srv-get-error (server) `(aref ,server 7)) -(defmacro nnmaildir--srv-get-mtime (server) `(aref ,server 8)) -(defmacro nnmaildir--srv-get-gnm (server) `(aref ,server 9)) -(defmacro nnmaildir--srv-get-create-dir (server) `(aref ,server 10)) -(defmacro nnmaildir--srv-set-name (server val) `(aset ,server 0 ,val)) -(defmacro nnmaildir--srv-set-method (server val) `(aset ,server 1 ,val)) -(defmacro nnmaildir--srv-set-dir (server val) `(aset ,server 2 ,val)) -(defmacro nnmaildir--srv-set-ls (server val) `(aset ,server 3 ,val)) -(defmacro nnmaildir--srv-set-groups (server val) `(aset ,server 4 ,val)) -(defmacro nnmaildir--srv-set-curgrp (server val) `(aset ,server 6 ,val)) -(defmacro nnmaildir--srv-set-error (server val) `(aset ,server 7 ,val)) -(defmacro nnmaildir--srv-set-mtime (server val) `(aset ,server 8 ,val)) -(defmacro nnmaildir--srv-set-gnm (server val) `(aset ,server 9 ,val)) -(defmacro nnmaildir--srv-set-create-dir (server val) `(aset ,server 10 ,val)) - -(defmacro nnmaildir--grp-new () '(make-vector 8 nil)) -(defmacro nnmaildir--grp-get-name (group) `(aref ,group 0)) -(defmacro nnmaildir--grp-get-pname (group) `(aref ,group 1)) -(defmacro nnmaildir--grp-get-new (group) `(aref ,group 2)) -(defmacro nnmaildir--grp-get-cur (group) `(aref ,group 3)) -(defmacro nnmaildir--grp-get-lists (group) `(aref ,group 4)) -(defmacro nnmaildir--grp-get-cache (group) `(aref ,group 5)) -(defmacro nnmaildir--grp-get-index (group) `(aref ,group 6)) -(defmacro nnmaildir--grp-get-mmth (group) `(aref ,group 7)) -(defmacro nnmaildir--grp-set-name (group val) `(aset ,group 0 ,val)) -(defmacro nnmaildir--grp-set-pname (group val) `(aset ,group 1 ,val)) -(defmacro nnmaildir--grp-set-new (group val) `(aset ,group 2 ,val)) -(defmacro nnmaildir--grp-set-cur (group val) `(aset ,group 3 ,val)) -(defmacro nnmaildir--grp-set-lists (group val) `(aset ,group 4 ,val)) -(defmacro nnmaildir--grp-set-cache (group val) `(aset ,group 5 ,val)) -(defmacro nnmaildir--grp-set-index (group val) `(aset ,group 6 ,val)) -(defmacro nnmaildir--grp-set-mmth (group val) `(aset ,group 7 ,val)) - -(defmacro nnmaildir--lists-new () '(make-vector 4 nil)) -(defmacro nnmaildir--lists-get-nlist (lists) `(aref ,lists 0)) -(defmacro nnmaildir--lists-get-flist (lists) `(aref ,lists 1)) -(defmacro nnmaildir--lists-get-mlist (lists) `(aref ,lists 2)) -(defmacro nnmaildir--lists-get-tmpart (lists) `(aref ,lists 3)) -(defmacro nnmaildir--lists-set-nlist (lists val) `(aset ,lists 0 ,val)) -(defmacro nnmaildir--lists-set-flist (lists val) `(aset ,lists 1 ,val)) -(defmacro nnmaildir--lists-set-mlist (lists val) `(aset ,lists 2 ,val)) -(defmacro nnmaildir--lists-set-tmpart (lists val) `(aset ,lists 3 ,val)) - -(defmacro nnmaildir--nlist-last-num (list) - `(if ,list (nnmaildir--art-get-num (car ,list)) 0)) -(defmacro nnmaildir--nlist-art (list num) - `(and ,list - (>= (nnmaildir--art-get-num (car ,list)) ,num) - (nth (- (nnmaildir--art-get-num (car ,list)) ,num) ,list))) -(defmacro nnmaildir--flist-art (list file) - `(symbol-value (intern-soft ,file ,list))) -(defmacro nnmaildir--mlist-art (list msgid) - `(symbol-value (intern-soft ,msgid ,list))) - -(defmacro nnmaildir--art-new () '(make-vector 5 nil)) -(defmacro nnmaildir--art-get-prefix (article) `(aref ,article 0)) -(defmacro nnmaildir--art-get-suffix (article) `(aref ,article 1)) -(defmacro nnmaildir--art-get-num (article) `(aref ,article 2)) -(defmacro nnmaildir--art-get-msgid (article) `(aref ,article 3)) -(defmacro nnmaildir--art-get-nov (article) `(aref ,article 4)) -(defmacro nnmaildir--art-set-prefix (article val) `(aset ,article 0 ,val)) -(defmacro nnmaildir--art-set-suffix (article val) `(aset ,article 1 ,val)) -(defmacro nnmaildir--art-set-num (article val) `(aset ,article 2 ,val)) -(defmacro nnmaildir--art-set-msgid (article val) `(aset ,article 3 ,val)) -(defmacro nnmaildir--art-set-nov (article val) `(aset ,article 4 ,val)) - -(defmacro nnmaildir--nov-new () '(make-vector 5 nil)) +;; A copy of nnmail-extra-headers +(defvar nnmaildir--extra nil) + +;; A disk NOV structure (must be prin1-able, so no defstruct) looks like this: +["subject\tfrom\tdate" + "references\tchars\lines" + "To: you\tIn-Reply-To: " + (12345 67890) ;; modtime of the corresponding article file + (to in-reply-to)] ;; contemporary value of nnmail-extra-headers +(defconst nnmaildir--novlen 5) +(defmacro nnmaildir--nov-new (beg mid end mtime extra) + `(vector ,beg ,mid ,end ,mtime ,extra)) (defmacro nnmaildir--nov-get-beg (nov) `(aref ,nov 0)) (defmacro nnmaildir--nov-get-mid (nov) `(aref ,nov 1)) (defmacro nnmaildir--nov-get-end (nov) `(aref ,nov 2)) (defmacro nnmaildir--nov-get-mtime (nov) `(aref ,nov 3)) -(defmacro nnmaildir--nov-get-neh (nov) `(aref ,nov 4)) -(defmacro nnmaildir--nov-set-beg (nov val) `(aset ,nov 0 ,val)) -(defmacro nnmaildir--nov-set-mid (nov val) `(aset ,nov 1 ,val)) -(defmacro nnmaildir--nov-set-end (nov val) `(aset ,nov 2 ,val)) -(defmacro nnmaildir--nov-set-mtime (nov val) `(aset ,nov 3 ,val)) -(defmacro nnmaildir--nov-set-neh (nov val) `(aset ,nov 4 ,val)) +(defmacro nnmaildir--nov-get-extra (nov) `(aref ,nov 4)) +(defmacro nnmaildir--nov-set-beg (nov value) `(aset ,nov 0 ,value)) +(defmacro nnmaildir--nov-set-mid (nov value) `(aset ,nov 1 ,value)) +(defmacro nnmaildir--nov-set-end (nov value) `(aset ,nov 2 ,value)) +(defmacro nnmaildir--nov-set-mtime (nov value) `(aset ,nov 3 ,value)) +(defmacro nnmaildir--nov-set-extra (nov value) `(aset ,nov 4 ,value)) + +(defstruct nnmaildir--art + (prefix nil :type string) ;; "time.pid.host" + (suffix nil :type string) ;; ":2,flags" + (num nil :type natnum) ;; article number + (msgid nil :type string) ;; "" + (nov nil :type vector)) ;; cached nov structure, or nil + +(defstruct nnmaildir--lists + (nlist nil :type list) ;; list of articles, ordered descending by number + (flist nil :type vector) ;; obarray mapping filename prefix->article + (mlist nil :type vector)) ;; obarray mapping message-id->article + +(defstruct nnmaildir--grp + (name nil :type string) ;; "group.name" + (new nil :type list) ;; new/ modtime + (cur nil :type list) ;; cur/ modtime + (lists nil :type nnmaildir--lists) ;; lists of articles in this group + (cache nil :type vector) ;; nov cache + (index nil :type natnum) ;; index of next cache entry to replace + (mmth nil :type vector)) ;; obarray mapping mark name->dir modtime + +(defstruct nnmaildir--srv + (address nil :type string) ;; server address string + (method nil :type list) ;; (nnmaildir "address" ...) + (prefix nil :type string) ;; "nnmaildir+address:" + (dir nil :type string) ;; "/expanded/path/to/server/dir/" + (ls nil :type function) ;; directory-files function + (groups nil :type vector) ;; obarray mapping group names->groups + (curgrp nil :type nnmaildir--grp) ;; current group, or nil + (error nil :type string) ;; last error message, or nil + (mtime nil :type list) ;; modtime of dir + (gnm nil) ;; flag: split from mail-sources? + (create-dir nil :type string)) ;; group creation directory + +(defmacro nnmaildir--nlist-last-num (nlist) + `(let ((nlist ,nlist)) + (if nlist (nnmaildir--art-num (car nlist)) 0))) +(defmacro nnmaildir--nlist-art (nlist num) ;;;; evals args multiple times + `(and ,nlist + (>= (nnmaildir--art-num (car ,nlist)) ,num) + (nth (- (nnmaildir--art-num (car ,nlist)) ,num) ,nlist))) +(defmacro nnmaildir--flist-art (list file) + `(symbol-value (intern-soft ,file ,list))) +(defmacro nnmaildir--mlist-art (list msgid) + `(symbol-value (intern-soft ,msgid ,list))) -(defmacro nnmaildir--subdir (dir subdir) - `(file-name-as-directory (concat ,dir ,subdir))) -(defmacro nnmaildir--srv-grp-dir (srv-dir gname) - `(nnmaildir--subdir ,srv-dir ,gname)) -(defmacro nnmaildir--tmp (dir) `(nnmaildir--subdir ,dir "tmp")) -(defmacro nnmaildir--new (dir) `(nnmaildir--subdir ,dir "new")) -(defmacro nnmaildir--cur (dir) `(nnmaildir--subdir ,dir "cur")) -(defmacro nnmaildir--nndir (dir) - `(nnmaildir--subdir ,dir ".nnmaildir")) -(defmacro nnmaildir--nov-dir (dir) - `(nnmaildir--subdir ,dir "nov")) -(defmacro nnmaildir--marks-dir (dir) - `(nnmaildir--subdir ,dir "marks")) +(defun nnmaildir--pgname (server gname) + (let ((prefix (nnmaildir--srv-prefix server))) + (if prefix (concat prefix gname) + (setq gname (gnus-group-prefixed-name gname + (nnmaildir--srv-method server))) + (setf (nnmaildir--srv-prefix server) (gnus-group-real-prefix gname)) + gname))) (defun nnmaildir--param (pgname param) - (setq param - (gnus-group-find-parameter pgname param 'allow-list) + (setq param (gnus-group-find-parameter pgname param 'allow-list) param (if (vectorp param) (aref param 0) param)) (eval param)) @@ -257,6 +178,17 @@ by nnmaildir-request-article.") (set-buffer (get-buffer-create " *nnmaildir move*")) ,@body)) +(defmacro nnmaildir--subdir (dir subdir) + `(file-name-as-directory (concat ,dir ,subdir))) +(defmacro nnmaildir--srvgrp-dir (srv-dir gname) + `(nnmaildir--subdir ,srv-dir ,gname)) +(defmacro nnmaildir--tmp (dir) `(nnmaildir--subdir ,dir "tmp")) +(defmacro nnmaildir--new (dir) `(nnmaildir--subdir ,dir "new")) +(defmacro nnmaildir--cur (dir) `(nnmaildir--subdir ,dir "cur")) +(defmacro nnmaildir--nndir (dir) `(nnmaildir--subdir ,dir ".nnmaildir")) +(defmacro nnmaildir--nov-dir (dir) `(nnmaildir--subdir ,dir "nov")) +(defmacro nnmaildir--marks-dir (dir) `(nnmaildir--subdir ,dir "marks")) + (defmacro nnmaildir--unlink (file-arg) `(let ((file ,file-arg)) (if (file-attributes file) (delete-file file)))) @@ -274,48 +206,51 @@ by nnmaildir-request-article.") (throw 'return nil)) (setq server (symbol-value server) nnmaildir--cur-server server)) - (or (setq groups (nnmaildir--srv-get-groups server)) + (or (setq groups (nnmaildir--srv-groups server)) (throw 'return nil)) - (or (nnmaildir--srv-get-method server) - (setq x (concat "nnmaildir:" (nnmaildir--srv-get-name server)) - x (gnus-server-to-method x) - x (or x (throw 'return nil)) - x (nnmaildir--srv-set-method server x))) + (if (nnmaildir--srv-method server) nil + (setq x (concat "nnmaildir:" (nnmaildir--srv-address server)) + x (gnus-server-to-method x)) + (or x (throw 'return nil)) + (setf (nnmaildir--srv-method server) x)) (if (null group) - (or (setq group (nnmaildir--srv-get-curgrp server)) + (or (setq group (nnmaildir--srv-curgrp server)) (throw 'return nil)) (or (setq group (intern-soft group groups)) (throw 'return nil)) (setq group (symbol-value group))) group))) -(defun nnmaildir--update-nov (srv-dir group article) +(defun nnmaildir--update-nov (server group article) (let ((nnheader-file-coding-system 'binary) + (srv-dir (nnmaildir--srv-dir server)) dir gname pgname msgdir prefix suffix file attr mtime novdir novfile - nov msgid nov-beg nov-mid nov-end field pos extra val old-neh new-neh - deactivate-mark) + nov msgid nov-beg nov-mid nov-end field pos extra val old-extra + new-extra deactivate-mark) (catch 'return - (setq suffix (nnmaildir--art-get-suffix article)) + (setq suffix (nnmaildir--art-suffix article)) (if (stringp suffix) nil - (nnmaildir--art-set-nov article nil) + (setf (nnmaildir--art-nov article) nil) (throw 'return nil)) - (setq gname (nnmaildir--grp-get-name group) - pgname (nnmaildir--grp-get-pname group) - dir (nnmaildir--srv-grp-dir srv-dir gname) + (setq gname (nnmaildir--grp-name group) + pgname (nnmaildir--pgname server gname) + dir (nnmaildir--srvgrp-dir srv-dir gname) msgdir (if (nnmaildir--param pgname 'read-only) (nnmaildir--new dir) (nnmaildir--cur dir)) - prefix (nnmaildir--art-get-prefix article) + prefix (nnmaildir--art-prefix article) file (concat msgdir prefix suffix) attr (file-attributes file)) (if attr nil - (nnmaildir--art-set-suffix article 'expire) - (nnmaildir--art-set-nov article nil) + (setf (nnmaildir--art-suffix article) 'expire) + (setf (nnmaildir--art-nov article) nil) (throw 'return nil)) (setq mtime (nth 5 attr) attr (nth 7 attr) - nov (nnmaildir--art-get-nov article) + nov (nnmaildir--art-nov article) novdir (nnmaildir--nov-dir (nnmaildir--nndir dir)) novfile (concat novdir prefix)) + (or (equal nnmaildir--extra nnmail-extra-headers) + (setq nnmaildir--extra (copy-sequence nnmail-extra-headers))) (nnmaildir--with-nov-buffer (when (file-exists-p novfile) ;; If not, force reparsing the message. (if nov nil ;; It's already in memory. @@ -323,28 +258,35 @@ by nnmaildir-request-article.") (erase-buffer) (nnheader-insert-file-contents novfile) (setq nov (read (current-buffer))) - (nnmaildir--art-set-msgid article (car nov)) + (setf (nnmaildir--art-msgid article) (car nov)) (setq nov (cadr nov))) - ;; If the NOV's modtime matches the file's current modtime, - ;; and it has the right length (i.e., it wasn't produced by - ;; a too-much older version of nnmaildir), then we may use - ;; this NOV data rather than parsing the message file, - ;; unless nnmail-extra-headers has been augmented since this - ;; data was last parsed. + ;; If the NOV's modtime matches the file's current modtime, and it + ;; has the right structure (i.e., it wasn't produced by a too-much + ;; older version of nnmaildir), then we may use this NOV data + ;; rather than parsing the message file, unless + ;; nnmail-extra-headers has been augmented since this data was last + ;; parsed. (when (and (equal mtime (nnmaildir--nov-get-mtime nov)) - (= (length nov) (length (nnmaildir--nov-new)))) - ;; This NOV data is potentially up-to-date. - (setq old-neh (nnmaildir--nov-get-neh nov) - new-neh nnmail-extra-headers) - (if (equal new-neh old-neh) (throw 'return nov)) ;; Common case. + (= (length nov) nnmaildir--novlen) + (stringp (nnmaildir--nov-get-beg nov)) + (stringp (nnmaildir--nov-get-mid nov)) + (stringp (nnmaildir--nov-get-end nov)) + (listp (nnmaildir--nov-get-mtime nov)) + (listp (nnmaildir--nov-get-extra nov))) + ;; this NOV data is potentially up-to-date; now check extra headers + (setq old-extra (nnmaildir--nov-get-extra nov)) + (when (equal nnmaildir--extra old-extra) ;; common case + (nnmaildir--nov-set-extra nov nnmaildir--extra) ;; save memory + (throw 'return nov)) ;; They're not equal, but maybe the new is a subset of the old... - (if (null new-neh) (throw 'return nov)) - (while new-neh - (if (memq (car new-neh) old-neh) + (if (null nnmaildir--extra) (throw 'return nov)) + (setq new-extra nnmaildir--extra) + (while new-extra + (if (memq (car new-extra) old-extra) (progn - (setq new-neh (cdr new-neh)) - (if new-neh nil (throw 'return nov))) - (setq new-neh nil))))) + (setq new-extra (cdr new-extra)) + (if new-extra nil (throw 'return nov))) + (setq new-extra nil))))) ;;found one not in old-extra;quit loop ;; Parse the NOV data out of the message. (erase-buffer) (nnheader-insert-file-contents file) @@ -413,100 +355,92 @@ by nnmaildir-request-article.") (setq msgid field)) (if (or (null msgid) (nnheader-fake-message-id-p msgid)) (setq msgid (concat "<" prefix "@nnmaildir>"))) + (setq nov (nnmaildir--nov-new nov-beg nov-mid nov-end mtime + nnmaildir--extra)) (erase-buffer) - (setq nov (nnmaildir--nov-new)) - (nnmaildir--nov-set-beg nov nov-beg) - (nnmaildir--nov-set-mid nov nov-mid) - (nnmaildir--nov-set-end nov nov-end) - (nnmaildir--nov-set-mtime nov mtime) - (nnmaildir--nov-set-neh nov (copy-sequence nnmail-extra-headers)) (prin1 (list msgid nov) (current-buffer)) (setq file (concat novfile ":")) (nnmaildir--unlink file) (write-region (point-min) (point-max) file nil 'no-message)) (rename-file file novfile 'replace) - (nnmaildir--art-set-msgid article msgid) + (setf (nnmaildir--art-msgid article) msgid) nov))) (defun nnmaildir--cache-nov (group article nov) - (let ((cache (nnmaildir--grp-get-cache group)) - (index (nnmaildir--grp-get-index group)) + (let ((cache (nnmaildir--grp-cache group)) + (index (nnmaildir--grp-index group)) goner) - (if (nnmaildir--art-get-nov article) nil + (if (nnmaildir--art-nov article) nil (setq goner (aref cache index)) - (if goner (nnmaildir--art-set-nov goner nil)) + (if goner (setf (nnmaildir--art-nov goner) nil)) (aset cache index article) - (nnmaildir--grp-set-index group (% (1+ index) (length cache)))) - (nnmaildir--art-set-nov article nov))) + (setf (nnmaildir--grp-index group) (% (1+ index) (length cache)))) + (setf (nnmaildir--art-nov article) nov))) -(defun nnmaildir--grp-add-art (srv-dir group article) - (let ((nov (nnmaildir--update-nov srv-dir group article)) +(defun nnmaildir--grp-add-art (server group article) + (let ((nov (nnmaildir--update-nov server group article)) old-lists new-lists) (when nov - (setq old-lists (nnmaildir--grp-get-lists group) - new-lists (nnmaildir--lists-new)) - (nnmaildir--lists-set-nlist - new-lists (cons article (nnmaildir--lists-get-nlist old-lists))) - (nnmaildir--lists-set-flist new-lists - (nnmaildir--lists-get-flist old-lists)) - (nnmaildir--lists-set-mlist new-lists - (nnmaildir--lists-get-mlist old-lists)) + (setq old-lists (nnmaildir--grp-lists group) + new-lists (copy-nnmaildir--lists old-lists)) + (setf (nnmaildir--lists-nlist new-lists) + (cons article (nnmaildir--lists-nlist new-lists))) (let ((inhibit-quit t)) - (nnmaildir--grp-set-lists group new-lists) - (set (intern (nnmaildir--art-get-prefix article) - (nnmaildir--lists-get-flist new-lists)) + (setf (nnmaildir--grp-lists group) new-lists) + (set (intern (nnmaildir--art-prefix article) + (nnmaildir--lists-flist new-lists)) article) - (set (intern (nnmaildir--art-get-msgid article) - (nnmaildir--lists-get-mlist new-lists)) + (set (intern (nnmaildir--art-msgid article) + (nnmaildir--lists-mlist new-lists)) article)) (nnmaildir--cache-nov group article nov) t))) (defun nnmaildir--group-ls (server pgname) (or (nnmaildir--param pgname 'directory-files) - (nnmaildir--srv-get-ls server))) + (nnmaildir--srv-ls server))) (defun nnmaildir--article-count (group) (let ((ct 0) (min 1)) - (setq group (nnmaildir--grp-get-lists group) - group (nnmaildir--lists-get-nlist group)) + (setq group (nnmaildir--grp-lists group) + group (nnmaildir--lists-nlist group)) (while group - (if (stringp (nnmaildir--art-get-suffix (car group))) + (if (stringp (nnmaildir--art-suffix (car group))) (setq ct (1+ ct) - min (nnmaildir--art-get-num (car group)))) + min (nnmaildir--art-num (car group)))) (setq group (cdr group))) (cons ct min))) (defun nnmaildir-article-number-to-file-name (number group-name server-address-string) (let ((group (nnmaildir--prepare server-address-string group-name)) - list article suffix dir filename) + list article suffix dir filename pgname) (catch 'return (if (null group) ;; The given group or server does not exist. (throw 'return nil)) - (setq list (nnmaildir--grp-get-lists group) - list (nnmaildir--lists-get-nlist list) + (setq list (nnmaildir--grp-lists group) + list (nnmaildir--lists-nlist list) article (nnmaildir--nlist-art list number)) (if (null article) ;; The given article number does not exist in this group. (throw 'return nil)) - (setq suffix (nnmaildir--art-get-suffix article)) + (setq suffix (nnmaildir--art-suffix article)) (if (not (stringp suffix)) ;; The article has expired. (throw 'return nil)) - (setq dir (nnmaildir--srv-get-dir nnmaildir--cur-server) - dir (nnmaildir--srv-grp-dir dir group-name) - group (if (nnmaildir--param (nnmaildir--grp-get-pname group) - 'read-only) + (setq dir (nnmaildir--srv-dir nnmaildir--cur-server) + dir (nnmaildir--srvgrp-dir dir group-name) + pgname (nnmaildir--pgname nnmaildir--cur-server group-name) + group (if (nnmaildir--param pgname 'read-only) (nnmaildir--new dir) (nnmaildir--cur dir)) - filename (concat group (nnmaildir--art-get-prefix article) suffix)) + filename (concat group (nnmaildir--art-prefix article) suffix)) (if (file-exists-p filename) filename ;; The article disappeared out from under us. - (nnmaildir--art-set-suffix article 'expire) - (nnmaildir--art-set-nov article nil) + (setf (nnmaildir--art-suffix article) 'expire) + (setf (nnmaildir--art-nov article) nil) nil)))) (defun nnmaildir-article-number-to-base-name @@ -517,17 +451,17 @@ by nnmaildir-request-article.") (if (null group) ;; The given group or server does not exist. (throw 'return nil)) - (setq list (nnmaildir--grp-get-lists group) - list (nnmaildir--lists-get-nlist list) + (setq list (nnmaildir--grp-lists group) + list (nnmaildir--lists-nlist list) article (nnmaildir--nlist-art list number)) (if (null article) ;; The given article number does not exist in this group. (throw 'return nil)) - (setq suffix (nnmaildir--art-get-suffix article)) + (setq suffix (nnmaildir--art-suffix article)) (if (not (stringp suffix)) ;; The article has expired. (throw 'return nil)) - (cons (nnmaildir--art-get-prefix article) suffix)))) + (cons (nnmaildir--art-prefix article) suffix)))) (defun nnmaildir-base-name-to-article-number (base-name group-name server-address-string) @@ -537,28 +471,27 @@ by nnmaildir-request-article.") (if (null group) ;; The given group or server does not exist. (throw 'return nil)) - (setq list (nnmaildir--grp-get-lists group) - list (nnmaildir--lists-get-flist list) + (setq list (nnmaildir--grp-lists group) + list (nnmaildir--lists-flist list) article (nnmaildir--flist-art list base-name)) (if (null article) ;; The given article number does not exist in this group. (throw 'return nil)) - (nnmaildir--art-get-num article)))) + (nnmaildir--art-num article)))) (defun nnmaildir-request-type (group &optional article) 'mail) (defun nnmaildir-status-message (&optional server) (nnmaildir--prepare server nil) - (nnmaildir--srv-get-error nnmaildir--cur-server)) + (nnmaildir--srv-error nnmaildir--cur-server)) (defun nnmaildir-server-opened (&optional server) (and nnmaildir--cur-server (if server - (string-equal server - (nnmaildir--srv-get-name nnmaildir--cur-server)) + (string-equal server (nnmaildir--srv-address nnmaildir--cur-server)) t) - (nnmaildir--srv-get-groups nnmaildir--cur-server) + (nnmaildir--srv-groups nnmaildir--cur-server) t)) (defun nnmaildir-open-server (server &optional defs) @@ -568,26 +501,25 @@ by nnmaildir-request-article.") (setq server (intern-soft x nnmaildir--servers)) (if server (and (setq server (symbol-value server)) - (nnmaildir--srv-get-groups server) + (nnmaildir--srv-groups server) (setq nnmaildir--cur-server server) (throw 'return t)) - (setq server (nnmaildir--srv-new)) - (nnmaildir--srv-set-name server x) + (setq server (make-nnmaildir--srv :address x)) (let ((inhibit-quit t)) (set (intern x nnmaildir--servers) server))) (setq dir (assq 'directory defs)) (if dir nil - (nnmaildir--srv-set-error - server "You must set \"directory\" in the select method") + (setf (nnmaildir--srv-error server) + "You must set \"directory\" in the select method") (throw 'return nil)) (setq dir (cadr dir) dir (eval dir) dir (expand-file-name dir) dir (file-name-as-directory dir)) (if (file-exists-p dir) nil - (nnmaildir--srv-set-error server (concat "No such directory: " dir)) + (setf (nnmaildir--srv-error server) (concat "No such directory: " dir)) (throw 'return nil)) - (nnmaildir--srv-set-dir server dir) + (setf (nnmaildir--srv-dir server) dir) (setq x (assq 'directory-files defs)) (if (null x) (setq x (symbol-function (if nnheader-directory-files-is-safe @@ -595,10 +527,10 @@ by nnmaildir-request-article.") 'nnheader-directory-files-safe))) (setq x (cadr x)) (if (functionp x) nil - (nnmaildir--srv-set-error - server (concat "Not a function: " (prin1-to-string x))) + (setf (nnmaildir--srv-error server) + (concat "Not a function: " (prin1-to-string x))) (throw 'return nil))) - (nnmaildir--srv-set-ls server x) + (setf (nnmaildir--srv-ls server) x) (setq x (funcall x dir nil "\\`[^.]" 'nosort) x (length x) size 1) @@ -607,14 +539,14 @@ by nnmaildir-request-article.") (and (setq x (assq 'get-new-mail defs)) (setq x (cdr x)) (car x) - (nnmaildir--srv-set-gnm server t) + (setf (nnmaildir--srv-gnm server) t) (require 'nnmail)) (setq x (assq 'create-directory defs)) (when x (setq x (cadr x) x (eval x)) - (nnmaildir--srv-set-create-dir server x)) - (nnmaildir--srv-set-groups server (make-vector size 0)) + (setf (nnmaildir--srv-create-dir server) x)) + (setf (nnmaildir--srv-groups server) (make-vector size 0)) (setq nnmaildir--cur-server server) t))) @@ -655,11 +587,11 @@ by nnmaildir-request-article.") (let ((36h-ago (- (car (current-time)) 2)) absdir nndir tdir ndir cdir nattr cattr isnew pgname read-only ls files file num dir flist group x) - (setq absdir (nnmaildir--srv-grp-dir srv-dir gname) + (setq absdir (nnmaildir--srvgrp-dir srv-dir gname) nndir (nnmaildir--nndir absdir)) (if (file-exists-p absdir) nil - (nnmaildir--srv-set-error nnmaildir--cur-server - (concat "No such directory: " absdir)) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (concat "No such directory: " absdir)) (throw 'return nil)) (setq tdir (nnmaildir--tmp absdir) ndir (nnmaildir--new absdir) @@ -667,20 +599,16 @@ by nnmaildir-request-article.") nattr (file-attributes ndir) cattr (file-attributes cdir)) (if (and (file-exists-p tdir) nattr cattr) nil - (nnmaildir--srv-set-error nnmaildir--cur-server - (concat "Not a maildir: " absdir)) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (concat "Not a maildir: " absdir)) (throw 'return nil)) - (setq group (nnmaildir--prepare nil gname)) + (setq group (nnmaildir--prepare nil gname) + pgname (nnmaildir--pgname nnmaildir--cur-server gname)) (if group - (setq isnew nil - pgname (nnmaildir--grp-get-pname group)) + (setq isnew nil) (setq isnew t - group (nnmaildir--grp-new) - pgname (gnus-group-prefixed-name gname method)) - (nnmaildir--grp-set-name group gname) - (nnmaildir--grp-set-pname group pgname) - (nnmaildir--grp-set-lists group (nnmaildir--lists-new)) - (nnmaildir--grp-set-index group 0) + group (make-nnmaildir--grp :name gname :index 0 + :lists (make-nnmaildir--lists))) (nnmaildir--mkdir nndir) (nnmaildir--mkdir (nnmaildir--nov-dir nndir)) (nnmaildir--mkdir (nnmaildir--marks-dir nndir)) @@ -690,9 +618,8 @@ by nnmaildir-request-article.") (if read-only nil (setq x (nth 11 (file-attributes tdir))) (if (and (= x (nth 11 nattr)) (= x (nth 11 cattr))) nil - (nnmaildir--srv-set-error nnmaildir--cur-server - (concat "Maildir spans filesystems: " - absdir)) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (concat "Maildir spans filesystems: " absdir)) (throw 'return nil)) (setq files (funcall ls tdir 'full "\\`[^.]" 'nosort)) (while files @@ -704,7 +631,7 @@ by nnmaildir-request-article.") isnew (throw 'return t)) (setq nattr (nth 5 nattr)) - (if (equal nattr (nnmaildir--grp-get-new group)) + (if (equal nattr (nnmaildir--grp-new group)) (setq nattr nil)) (if read-only (setq dir (and (or isnew nattr) ndir)) (when (or isnew nattr) @@ -712,9 +639,9 @@ by nnmaildir-request-article.") (while files (setq file (car files) files (cdr files)) (rename-file (concat ndir file) (concat cdir file ":2,"))) - (nnmaildir--grp-set-new group nattr)) + (setf (nnmaildir--grp-new group) nattr)) (setq cattr (nth 5 (file-attributes cdir))) - (if (equal cattr (nnmaildir--grp-get-cur group)) + (if (equal cattr (nnmaildir--grp-cur group)) (setq cattr nil)) (setq dir (and (or isnew cattr) cdir))) (if dir nil (throw 'return t)) @@ -724,10 +651,10 @@ by nnmaildir-request-article.") num 1) (while (<= num x) (setq num (* 2 num))) (if (/= num 1) (setq num (1- num))) - (setq x (nnmaildir--grp-get-lists group)) - (nnmaildir--lists-set-flist x (make-vector num 0)) - (nnmaildir--lists-set-mlist x (make-vector num 0)) - (nnmaildir--grp-set-mmth group (make-vector 1 0)) + (setq x (nnmaildir--grp-lists group)) + (setf (nnmaildir--lists-flist x) (make-vector num 0)) + (setf (nnmaildir--lists-mlist x) (make-vector num 0)) + (setf (nnmaildir--grp-mmth group) (make-vector 1 0)) (setq num (nnmaildir--param pgname 'nov-cache-size)) (if (numberp num) (if (< num 1) (setq num 1)) (setq x files @@ -742,13 +669,13 @@ by nnmaildir-request-article.") (if (or (not (file-exists-p (concat cdir file))) (file-exists-p (concat ndir file))) (setq num (1+ num))))) - (nnmaildir--grp-set-cache group (make-vector num nil)) + (setf (nnmaildir--grp-cache group) (make-vector num nil)) (let ((inhibit-quit t)) (set (intern gname groups) group)) (or scan-msgs (throw 'return t))) - (setq flist (nnmaildir--grp-get-lists group) - num (nnmaildir--lists-get-nlist flist) - flist (nnmaildir--lists-get-flist flist) + (setq flist (nnmaildir--grp-lists group) + num (nnmaildir--lists-nlist flist) + flist (nnmaildir--lists-flist flist) num (nnmaildir--nlist-last-num num) x files files nil) @@ -763,38 +690,36 @@ by nnmaildir-request-article.") (while files (setq file (car files) files (cdr files) file (if (consp file) file (aref file 5)) - x (nnmaildir--art-new)) - (nnmaildir--art-set-prefix x (car file)) - (nnmaildir--art-set-suffix x (cdr file)) - (nnmaildir--art-set-num x (1+ num)) - (if (nnmaildir--grp-add-art srv-dir group x) + x (make-nnmaildir--art :prefix (car file) :suffix(cdr file) + :num (1+ num))) + (if (nnmaildir--grp-add-art nnmaildir--cur-server group x) (setq num (1+ num)))) - (if read-only (nnmaildir--grp-set-new group nattr) - (nnmaildir--grp-set-cur group cattr))) + (if read-only (setf (nnmaildir--grp-new group) nattr) + (setf (nnmaildir--grp-cur group) cattr))) t)) (defun nnmaildir-request-scan (&optional scan-group server) (let ((coding-system-for-write nnheader-file-coding-system) (buffer-file-coding-system nil) (file-coding-system-alist nil) - (nnmaildir-get-new-mail t) + (nnmaildir-new-mail t) (nnmaildir-group-alist nil) (nnmaildir-active-file nil) x srv-ls srv-dir method groups group dirs grp-dir seen deactivate-mark) (nnmaildir--prepare server nil) - (setq srv-ls (nnmaildir--srv-get-ls nnmaildir--cur-server) - srv-dir (nnmaildir--srv-get-dir nnmaildir--cur-server) - method (nnmaildir--srv-get-method nnmaildir--cur-server) - groups (nnmaildir--srv-get-groups nnmaildir--cur-server)) + (setq srv-ls (nnmaildir--srv-ls nnmaildir--cur-server) + srv-dir (nnmaildir--srv-dir nnmaildir--cur-server) + method (nnmaildir--srv-method nnmaildir--cur-server) + groups (nnmaildir--srv-groups nnmaildir--cur-server)) (nnmaildir--with-work-buffer (save-match-data (if (stringp scan-group) (if (nnmaildir--scan scan-group t groups method srv-dir srv-ls) - (if (nnmaildir--srv-get-gnm nnmaildir--cur-server) + (if (nnmaildir--srv-gnm nnmaildir--cur-server) (nnmail-get-new-mail 'nnmaildir nil nil scan-group)) (unintern scan-group groups)) (setq x (nth 5 (file-attributes srv-dir))) - (if (equal x (nnmaildir--srv-get-mtime nnmaildir--cur-server)) + (if (equal x (nnmaildir--srv-mtime nnmaildir--cur-server)) (if scan-group nil (mapatoms (lambda (sym) (nnmaildir--scan (symbol-name sym) t groups @@ -821,9 +746,9 @@ by nnmaildir-request-article.") (while x (unintern (car x) groups) (setq x (cdr x))) - (nnmaildir--srv-set-mtime nnmaildir--cur-server - (nth 5 (file-attributes srv-dir)))) - (if (nnmaildir--srv-get-gnm nnmaildir--cur-server) + (setf (nnmaildir--srv-mtime nnmaildir--cur-server) + (nth 5 (file-attributes srv-dir)))) + (if (nnmaildir--srv-gnm nnmaildir--cur-server) (nnmail-get-new-mail 'nnmaildir nil nil)))))) t) @@ -834,19 +759,20 @@ by nnmaildir-request-article.") (nnmaildir--with-nntp-buffer (erase-buffer) (mapatoms (lambda (group) - (setq group (symbol-value group) - ro (nnmaildir--param (nnmaildir--grp-get-pname group) - 'read-only) + (setq pgname (symbol-name group) + pgname (nnmaildir--pgname nnmaildir--cur-server pgname) + group (symbol-value group) + ro (nnmaildir--param pgname 'read-only) ct-min (nnmaildir--article-count group)) - (insert (nnmaildir--grp-get-name group) " ") + (insert (nnmaildir--grp-name group) " ") (princ (nnmaildir--nlist-last-num - (nnmaildir--lists-get-nlist - (nnmaildir--grp-get-lists group))) + (nnmaildir--lists-nlist + (nnmaildir--grp-lists group))) nntp-server-buffer) (insert " ") (princ (cdr ct-min) nntp-server-buffer) (insert " " (if ro "n" "y") "\n")) - (nnmaildir--srv-get-groups nnmaildir--cur-server)))) + (nnmaildir--srv-groups nnmaildir--cur-server)))) t) (defun nnmaildir-request-newgroups (date &optional server) @@ -869,8 +795,8 @@ by nnmaildir-request-article.") (princ (cdr ct-min) nntp-server-buffer) (insert " ") (princ (nnmaildir--nlist-last-num - (nnmaildir--lists-get-nlist - (nnmaildir--grp-get-lists group))) + (nnmaildir--lists-nlist + (nnmaildir--grp-lists group))) nntp-server-buffer) (insert " " gname "\n"))))) 'group) @@ -883,14 +809,14 @@ by nnmaildir-request-article.") old-mmth new-mmth mtime mark-sym deactivate-mark) (catch 'return (if group nil - (nnmaildir--srv-set-error nnmaildir--cur-server - (concat "No such group: " gname)) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (concat "No such group: " gname)) (throw 'return nil)) - (setq gname (nnmaildir--grp-get-name group) - pgname (nnmaildir--grp-get-pname group) - nlist (nnmaildir--grp-get-lists group) - flist (nnmaildir--lists-get-flist nlist) - nlist (nnmaildir--lists-get-nlist nlist)) + (setq gname (nnmaildir--grp-name group) + pgname (nnmaildir--pgname nnmaildir--cur-server gname) + nlist (nnmaildir--grp-lists group) + flist (nnmaildir--lists-flist nlist) + nlist (nnmaildir--lists-nlist nlist)) (if nlist nil (gnus-info-set-read info nil) (gnus-info-set-marks info nil 'extend) @@ -900,8 +826,8 @@ by nnmaildir-request-article.") last (nnmaildir--nlist-last-num nlist) always-marks (nnmaildir--param pgname 'always-marks) never-marks (nnmaildir--param pgname 'never-marks) - dir (nnmaildir--srv-get-dir nnmaildir--cur-server) - dir (nnmaildir--srv-grp-dir dir gname) + dir (nnmaildir--srv-dir nnmaildir--cur-server) + dir (nnmaildir--srvgrp-dir dir gname) dir (nnmaildir--nndir dir) dir (nnmaildir--marks-dir dir) ls (nnmaildir--group-ls nnmaildir--cur-server pgname) @@ -911,7 +837,7 @@ by nnmaildir-request-article.") (while (<= new-mmth num) (setq new-mmth (* 2 new-mmth))) (if (/= new-mmth 1) (setq new-mmth (1- new-mmth))) (setq new-mmth (make-vector new-mmth 0) - old-mmth (nnmaildir--grp-get-mmth group)) + old-mmth (nnmaildir--grp-mmth group)) (while markdirs (setq mark (car markdirs) markdirs (cdr markdirs) articles (nnmaildir--subdir dir mark) @@ -933,13 +859,13 @@ by nnmaildir-request-article.") (setq article (car articles) articles (cdr articles) article (nnmaildir--flist-art flist article)) (if article - (setq num (nnmaildir--art-get-num article) + (setq num (nnmaildir--art-num article) ranges (gnus-add-to-range ranges (list num)))))) (if (eq mark-sym 'read) (setq read ranges) (if ranges (setq marks (cons (cons mark-sym ranges) marks))))) (gnus-info-set-read info read) (gnus-info-set-marks info marks 'extend) - (nnmaildir--grp-set-mmth group new-mmth) + (setf (nnmaildir--grp-mmth group) new-mmth) info))) (defun nnmaildir-request-group (gname &optional server fast) @@ -951,10 +877,10 @@ by nnmaildir-request-article.") (catch 'return (if group nil (insert "411 no such news group\n") - (nnmaildir--srv-set-error nnmaildir--cur-server - (concat "No such group: " gname)) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (concat "No such group: " gname)) (throw 'return nil)) - (nnmaildir--srv-set-curgrp nnmaildir--cur-server group) + (setf (nnmaildir--srv-curgrp nnmaildir--cur-server) group) (if fast (throw 'return t)) (setq ct-min (nnmaildir--article-count group)) (insert "211 ") @@ -963,8 +889,8 @@ by nnmaildir-request-article.") (princ (cdr ct-min) nntp-server-buffer) (insert " ") (princ (nnmaildir--nlist-last-num - (nnmaildir--lists-get-nlist - (nnmaildir--grp-get-lists group))) + (nnmaildir--lists-nlist + (nnmaildir--grp-lists group))) nntp-server-buffer) (insert " " gname "\n") t)))) @@ -972,27 +898,27 @@ by nnmaildir-request-article.") (defun nnmaildir-request-create-group (gname &optional server args) (nnmaildir--prepare server nil) (catch 'return - (let ((create-dir (nnmaildir--srv-get-create-dir nnmaildir--cur-server)) + (let ((create-dir (nnmaildir--srv-create-dir nnmaildir--cur-server)) srv-dir dir groups) (when (zerop (length gname)) - (nnmaildir--srv-set-error nnmaildir--cur-server - "Invalid (empty) group name") + (setf (nnmaildir--srv-error nnmaildir--cur-server) + "Invalid (empty) group name") (throw 'return nil)) (when (eq (aref "." 0) (aref gname 0)) - (nnmaildir--srv-set-error nnmaildir--cur-server - "Group names may not start with \".\"") + (setf (nnmaildir--srv-error nnmaildir--cur-server) + "Group names may not start with \".\"") (throw 'return nil)) (when (save-match-data (string-match "[\0/\t]" gname)) - (nnmaildir--srv-set-error nnmaildir--cur-server - (concat "Illegal characters (null, tab, or /) in group name: " - gname)) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (concat "Illegal characters (null, tab, or /) in group name: " + gname)) (throw 'return nil)) - (setq groups (nnmaildir--srv-get-groups nnmaildir--cur-server)) + (setq groups (nnmaildir--srv-groups nnmaildir--cur-server)) (when (intern-soft gname groups) - (nnmaildir--srv-set-error nnmaildir--cur-server - (concat "Group already exists: " gname)) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (concat "Group already exists: " gname)) (throw 'return nil)) - (setq srv-dir (nnmaildir--srv-get-dir nnmaildir--cur-server)) + (setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server)) (if (file-name-absolute-p create-dir) (setq dir (expand-file-name create-dir)) (setq dir srv-dir @@ -1015,38 +941,37 @@ by nnmaildir-request-article.") srv-dir x groups) (catch 'return (if group nil - (nnmaildir--srv-set-error nnmaildir--cur-server - (concat "No such group: " gname)) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (concat "No such group: " gname)) (throw 'return nil)) (when (zerop (length new-name)) - (nnmaildir--srv-set-error nnmaildir--cur-server - "Invalid (empty) group name") + (setf (nnmaildir--srv-error nnmaildir--cur-server) + "Invalid (empty) group name") (throw 'return nil)) (when (eq (aref "." 0) (aref new-name 0)) - (nnmaildir--srv-set-error nnmaildir--cur-server - "Group names may not start with \".\"") + (setf (nnmaildir--srv-error nnmaildir--cur-server) + "Group names may not start with \".\"") (throw 'return nil)) (when (save-match-data (string-match "[\0/\t]" new-name)) - (nnmaildir--srv-set-error nnmaildir--cur-server - (concat "Illegal characters (null, tab, or /) in group name: " - new-name)) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (concat "Illegal characters (null, tab, or /) in group name: " + new-name)) (throw 'return nil)) (if (string-equal gname new-name) (throw 'return t)) (when (intern-soft new-name - (nnmaildir--srv-get-groups nnmaildir--cur-server)) - (nnmaildir--srv-set-error nnmaildir--cur-server - (concat "Group already exists: " new-name)) + (nnmaildir--srv-groups nnmaildir--cur-server)) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (concat "Group already exists: " new-name)) (throw 'return nil)) - (setq srv-dir (nnmaildir--srv-get-dir nnmaildir--cur-server)) + (setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server)) (condition-case err (rename-file (concat srv-dir gname) (concat srv-dir new-name)) (error - (nnmaildir--srv-set-error nnmaildir--cur-server - (concat "Error renaming link: " - (prin1-to-string err))) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (concat "Error renaming link: " (prin1-to-string err))) (throw 'return nil))) - (setq x (nnmaildir--srv-get-groups nnmaildir--cur-server) + (setq x (nnmaildir--srv-groups nnmaildir--cur-server) groups (make-vector (length x) 0)) (mapatoms (lambda (sym) (if (eq (symbol-value sym) group) nil @@ -1054,9 +979,9 @@ by nnmaildir-request-article.") (symbol-value sym)))) x) (setq group (copy-sequence group)) - (nnmaildir--grp-set-name group new-name) + (setf (nnmaildir--grp-name group) new-name) (set (intern new-name groups) group) - (nnmaildir--srv-set-groups nnmaildir--cur-server groups) + (setf (nnmaildir--srv-groups nnmaildir--cur-server) groups) t))) (defun nnmaildir-request-delete-group (gname force &optional server) @@ -1064,16 +989,16 @@ by nnmaildir-request-article.") pgname grp-dir dir dirs files ls deactivate-mark) (catch 'return (if group nil - (nnmaildir--srv-set-error nnmaildir--cur-server - (concat "No such group: " gname)) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (concat "No such group: " gname)) (throw 'return nil)) - (if (eq group (nnmaildir--srv-get-curgrp nnmaildir--cur-server)) - (nnmaildir--srv-set-curgrp nnmaildir--cur-server nil)) - (setq gname (nnmaildir--grp-get-name group) - pgname (nnmaildir--grp-get-pname group)) - (unintern gname (nnmaildir--srv-get-groups nnmaildir--cur-server)) - (setq grp-dir (nnmaildir--srv-get-dir nnmaildir--cur-server) - grp-dir (nnmaildir--srv-grp-dir grp-dir gname)) + (if (eq group (nnmaildir--srv-curgrp nnmaildir--cur-server)) + (setf (nnmaildir--srv-curgrp nnmaildir--cur-server) nil)) + (setq gname (nnmaildir--grp-name group) + pgname (nnmaildir--pgname nnmaildir--cur-server gname)) + (unintern gname (nnmaildir--srv-groups nnmaildir--cur-server)) + (setq grp-dir (nnmaildir--srv-dir nnmaildir--cur-server) + grp-dir (nnmaildir--srvgrp-dir grp-dir gname)) (if (not force) (setq grp-dir (directory-file-name grp-dir)) (if (nnmaildir--param pgname 'read-only) (progn (delete-directory (nnmaildir--tmp grp-dir)) @@ -1111,16 +1036,16 @@ by nnmaildir-request-article.") (delete-file (car files)) (setq files (cdr files))) (delete-directory dir)) - (setq dir (nnmaildir--nndir grp-dir) - files (concat dir "markfile")) - (nnmaildir--unlink files) + (setq dir (nnmaildir--nndir grp-dir)) + (nnmaildir--unlink (concat dir "markfile")) + (nnmaildir--unlink (concat dir "markfile{new}")) (delete-directory (nnmaildir--marks-dir dir)) (delete-directory dir) (setq grp-dir (directory-file-name grp-dir) dir (car (file-attributes grp-dir))) (if (eq (aref "/" 0) (aref dir 0)) nil (setq dir (concat (file-truename - (nnmaildir--srv-get-dir nnmaildir--cur-server)) + (nnmaildir--srv-dir nnmaildir--cur-server)) dir))) (delete-directory dir)) (nnmaildir--unlink grp-dir) @@ -1131,30 +1056,30 @@ by nnmaildir-request-article.") srv-dir dir nlist mlist article num stop nov nlist2 deactivate-mark) (catch 'return (if group nil - (nnmaildir--srv-set-error nnmaildir--cur-server - (if gname (concat "No such group: " gname) - "No current group")) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (if gname (concat "No such group: " gname) "No current group")) (throw 'return nil)) (nnmaildir--with-nntp-buffer (erase-buffer) - (setq nlist (nnmaildir--grp-get-lists group) - mlist (nnmaildir--lists-get-mlist nlist) - nlist (nnmaildir--lists-get-nlist nlist) - gname (nnmaildir--grp-get-name group) - srv-dir (nnmaildir--srv-get-dir nnmaildir--cur-server) - dir (nnmaildir--srv-grp-dir srv-dir gname)) + (setq nlist (nnmaildir--grp-lists group) + mlist (nnmaildir--lists-mlist nlist) + nlist (nnmaildir--lists-nlist nlist) + gname (nnmaildir--grp-name group) + srv-dir (nnmaildir--srv-dir nnmaildir--cur-server) + dir (nnmaildir--srvgrp-dir srv-dir gname)) (cond ((null nlist)) ((and fetch-old (not (numberp fetch-old))) (while nlist (setq article (car nlist) nlist (cdr nlist) - nov (nnmaildir--update-nov srv-dir group article)) + nov (nnmaildir--update-nov nnmaildir--cur-server group + article)) (when nov (nnmaildir--cache-nov group article nov) - (setq num (nnmaildir--art-get-num article)) + (setq num (nnmaildir--art-num article)) (princ num nntp-server-buffer) (insert "\t" (nnmaildir--nov-get-beg nov) "\t" - (nnmaildir--art-get-msgid article) "\t" + (nnmaildir--art-msgid article) "\t" (nnmaildir--nov-get-mid nov) "\tXref: nnmaildir " gname ":") (princ num nntp-server-buffer) @@ -1166,13 +1091,13 @@ by nnmaildir-request-article.") (setq article (car articles) articles (cdr articles) article (nnmaildir--mlist-art mlist article)) (when (and article - (setq nov (nnmaildir--update-nov srv-dir group - article))) + (setq nov (nnmaildir--update-nov nnmaildir--cur-server + group article))) (nnmaildir--cache-nov group article nov) - (setq num (nnmaildir--art-get-num article)) + (setq num (nnmaildir--art-num article)) (princ num nntp-server-buffer) (insert "\t" (nnmaildir--nov-get-beg nov) "\t" - (nnmaildir--art-get-msgid article) "\t" + (nnmaildir--art-msgid article) "\t" (nnmaildir--nov-get-mid nov) "\tXref: nnmaildir " gname ":") (princ num nntp-server-buffer) @@ -1193,19 +1118,20 @@ by nnmaildir-request-article.") (setq articles (cdr articles))) (if (numberp stop) (setq num stop) (setq num (cdr stop) stop (car stop))) - (setq nlist2 (nthcdr (- (nnmaildir--art-get-num (car nlist)) num) + (setq nlist2 (nthcdr (- (nnmaildir--art-num (car nlist)) num) nlist)) (while (and nlist2 (setq article (car nlist2) - num (nnmaildir--art-get-num article)) + num (nnmaildir--art-num article)) (>= num stop)) (setq nlist2 (cdr nlist2) - nov (nnmaildir--update-nov srv-dir group article)) + nov (nnmaildir--update-nov nnmaildir--cur-server group + article)) (when nov (nnmaildir--cache-nov group article nov) (princ num nntp-server-buffer) (insert "\t" (nnmaildir--nov-get-beg nov) "\t" - (nnmaildir--art-get-msgid article) "\t" + (nnmaildir--art-msgid article) "\t" (nnmaildir--nov-get-mid nov) "\tXref: nnmaildir " gname ":") (princ num nntp-server-buffer) @@ -1217,51 +1143,52 @@ by nnmaildir-request-article.") (defun nnmaildir-request-article (num-msgid &optional gname server to-buffer) (let ((group (nnmaildir--prepare server gname)) (case-fold-search t) - list article suffix dir deactivate-mark) + list article suffix dir pgname deactivate-mark) (catch 'return (if group nil - (nnmaildir--srv-set-error nnmaildir--cur-server - (if gname (concat "No such group: " gname) - "No current group")) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (if gname (concat "No such group: " gname) "No current group")) (throw 'return nil)) - (setq list (nnmaildir--grp-get-lists group)) + (setq list (nnmaildir--grp-lists group)) (if (numberp num-msgid) - (setq list (nnmaildir--lists-get-nlist list) + (setq list (nnmaildir--lists-nlist list) article (nnmaildir--nlist-art list num-msgid)) - (setq list (nnmaildir--lists-get-mlist list) + (setq list (nnmaildir--lists-mlist list) article (nnmaildir--mlist-art list num-msgid)) - (if article (setq num-msgid (nnmaildir--art-get-num article)) + (if article (setq num-msgid (nnmaildir--art-num article)) (catch 'found (mapatoms - (lambda (grp) - (setq group (symbol-value grp) - list (nnmaildir--grp-get-lists group) - list (nnmaildir--lists-get-mlist list) - article (nnmaildir--mlist-art list num-msgid)) - (when article - (setq num-msgid (nnmaildir--art-get-num article)) - (throw 'found nil))) - (nnmaildir--srv-get-groups nnmaildir--cur-server))))) + (lambda (grp) + (setq group (symbol-value grp) + list (nnmaildir--grp-lists group) + list (nnmaildir--lists-mlist list) + article (nnmaildir--mlist-art list num-msgid)) + (when article + (setq num-msgid (nnmaildir--art-num article)) + (throw 'found nil))) + (nnmaildir--srv-groups nnmaildir--cur-server))))) (if article nil - (nnmaildir--srv-set-error nnmaildir--cur-server "No such article") + (setf (nnmaildir--srv-error nnmaildir--cur-server) "No such article") (throw 'return nil)) - (if (stringp (setq suffix (nnmaildir--art-get-suffix article))) nil - (nnmaildir--srv-set-error nnmaildir--cur-server "Article has expired") + (if (stringp (setq suffix (nnmaildir--art-suffix article))) nil + (setf (nnmaildir--srv-error nnmaildir--cur-server) + "Article has expired") (throw 'return nil)) - (setq gname (nnmaildir--grp-get-name group) - dir (nnmaildir--srv-get-dir nnmaildir--cur-server) - dir (nnmaildir--srv-grp-dir dir gname) - group (if (nnmaildir--param (nnmaildir--grp-get-pname group) - 'read-only) + (setq gname (nnmaildir--grp-name group) + pgname (nnmaildir--pgname nnmaildir--cur-server gname) + dir (nnmaildir--srv-dir nnmaildir--cur-server) + dir (nnmaildir--srvgrp-dir dir gname) + group (if (nnmaildir--param pgname 'read-only) (nnmaildir--new dir) (nnmaildir--cur dir)) nnmaildir-article-file-name (concat group - (nnmaildir--art-get-prefix + (nnmaildir--art-prefix article) suffix)) (if (file-exists-p nnmaildir-article-file-name) nil - (nnmaildir--art-set-suffix article 'expire) - (nnmaildir--art-set-nov article nil) - (nnmaildir--srv-set-error nnmaildir--cur-server "Article has expired") + (setf (nnmaildir--art-suffix article) 'expire) + (setf (nnmaildir--art-nov article) nil) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + "Article has expired") (throw 'return nil)) (save-excursion (set-buffer (or to-buffer nntp-server-buffer)) @@ -1281,31 +1208,32 @@ by nnmaildir-request-article.") file dir suffix tmpfile deactivate-mark) (catch 'return (if group nil - (nnmaildir--srv-set-error nnmaildir--cur-server - (concat "No such group: " gname)) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (concat "No such group: " gname)) (throw 'return nil)) - (when (nnmaildir--param (nnmaildir--grp-get-pname group) 'read-only) - (nnmaildir--srv-set-error nnmaildir--cur-server - (concat "Read-only group: " group)) + (when (nnmaildir--param (nnmaildir--pgname nnmaildir--cur-server gname) + 'read-only) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (concat "Read-only group: " group)) (throw 'return nil)) - (setq dir (nnmaildir--srv-get-dir nnmaildir--cur-server) - dir (nnmaildir--srv-grp-dir dir gname) - file (nnmaildir--grp-get-lists group) - file (nnmaildir--lists-get-nlist file) + (setq dir (nnmaildir--srv-dir nnmaildir--cur-server) + dir (nnmaildir--srvgrp-dir dir gname) + file (nnmaildir--grp-lists group) + file (nnmaildir--lists-nlist file) file (nnmaildir--nlist-art file article)) - (if (and file (stringp (setq suffix (nnmaildir--art-get-suffix file)))) + (if (and file (stringp (setq suffix (nnmaildir--art-suffix file)))) nil - (nnmaildir--srv-set-error nnmaildir--cur-server - (format "No such article: %d" article)) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (format "No such article: %d" article)) (throw 'return nil)) (save-excursion (set-buffer buffer) (setq article file - file (nnmaildir--art-get-prefix article) + file (nnmaildir--art-prefix article) tmpfile (concat (nnmaildir--tmp dir) file)) (when (file-exists-p tmpfile) - (nnmaildir--srv-set-error nnmaildir--cur-server - (concat "File exists: " tmpfile)) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (concat "File exists: " tmpfile)) (throw 'return nil)) (write-region (point-min) (point-max) tmpfile nil 'no-message nil 'confirm-overwrite)) ;; error would be preferred :( @@ -1319,32 +1247,34 @@ by nnmaildir-request-article.") pgname list suffix result nnmaildir--file deactivate-mark) (catch 'return (if group nil - (nnmaildir--srv-set-error nnmaildir--cur-server - (concat "No such group: " gname)) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (concat "No such group: " gname)) (throw 'return nil)) - (setq gname (nnmaildir--grp-get-name group) - pgname (nnmaildir--grp-get-pname group) - list (nnmaildir--grp-get-lists group) - list (nnmaildir--lists-get-nlist list) + (setq gname (nnmaildir--grp-name group) + pgname (nnmaildir--pgname nnmaildir--cur-server gname) + list (nnmaildir--grp-lists group) + list (nnmaildir--lists-nlist list) article (nnmaildir--nlist-art list article)) (if article nil - (nnmaildir--srv-set-error nnmaildir--cur-server "No such article") + (setf (nnmaildir--srv-error nnmaildir--cur-server) "No such article") (throw 'return nil)) - (if (stringp (setq suffix (nnmaildir--art-get-suffix article))) nil - (nnmaildir--srv-set-error nnmaildir--cur-server "Article has expired") + (if (stringp (setq suffix (nnmaildir--art-suffix article))) nil + (setf (nnmaildir--srv-error nnmaildir--cur-server) + "Article has expired") (throw 'return nil)) - (setq nnmaildir--file (nnmaildir--srv-get-dir nnmaildir--cur-server) - nnmaildir--file (nnmaildir--srv-grp-dir nnmaildir--file gname) + (setq nnmaildir--file (nnmaildir--srv-dir nnmaildir--cur-server) + nnmaildir--file (nnmaildir--srvgrp-dir nnmaildir--file gname) nnmaildir--file (if (nnmaildir--param pgname 'read-only) (nnmaildir--new nnmaildir--file) (nnmaildir--cur nnmaildir--file)) nnmaildir--file (concat nnmaildir--file - (nnmaildir--art-get-prefix article) + (nnmaildir--art-prefix article) suffix)) (if (file-exists-p nnmaildir--file) nil - (nnmaildir--art-set-suffix article 'expire) - (nnmaildir--art-set-nov article nil) - (nnmaildir--srv-set-error nnmaildir--cur-server "Article has expired") + (setf (nnmaildir--art-suffix article) 'expire) + (setf (nnmaildir--art-nov article) nil) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + "Article has expired") (throw 'return nil)) (nnmaildir--with-move-buffer (erase-buffer) @@ -1352,8 +1282,8 @@ by nnmaildir-request-article.") (setq result (eval accept-form))) (if (or (null result) (nnmaildir--param pgname 'read-only)) nil (nnmaildir--unlink nnmaildir--file) - (nnmaildir--art-set-suffix article 'expire) - (nnmaildir--art-set-nov article nil)) + (setf (nnmaildir--art-suffix article) 'expire) + (setf (nnmaildir--art-nov article) nil)) result))) (defun nnmaildir-request-accept-article (gname &optional server last) @@ -1364,16 +1294,17 @@ by nnmaildir-request-article.") srv-dir dir file tmpfile curfile 24h num article) (catch 'return (if group nil - (nnmaildir--srv-set-error nnmaildir--cur-server - (concat "No such group: " gname)) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (concat "No such group: " gname)) (throw 'return nil)) - (setq gname (nnmaildir--grp-get-name group)) - (when (nnmaildir--param (nnmaildir--grp-get-pname group) 'read-only) - (nnmaildir--srv-set-error nnmaildir--cur-server - (concat "Read-only group: " gname)) + (setq gname (nnmaildir--grp-name group)) + (when (nnmaildir--param (nnmaildir--pgname nnmaildir--cur-server gname) + 'read-only) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (concat "Read-only group: " gname)) (throw 'return nil)) - (setq srv-dir (nnmaildir--srv-get-dir nnmaildir--cur-server) - dir (nnmaildir--srv-grp-dir srv-dir gname) + (setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server) + dir (nnmaildir--srvgrp-dir srv-dir gname) file (format-time-string "%s" nil)) (if (string-equal nnmaildir--delivery-time file) nil (setq nnmaildir--delivery-time file @@ -1386,20 +1317,20 @@ by nnmaildir-request-article.") tmpfile (concat (nnmaildir--tmp dir) file) curfile (concat (nnmaildir--cur dir) file ":2,")) (when (file-exists-p tmpfile) - (nnmaildir--srv-set-error nnmaildir--cur-server - (concat "File exists: " tmpfile)) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (concat "File exists: " tmpfile)) (throw 'return nil)) (when (file-exists-p curfile) - (nnmaildir--srv-set-error nnmaildir--cur-server - (concat "File exists: " curfile)) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (concat "File exists: " curfile)) (throw 'return nil)) (setq nnmaildir--delivery-ct (1+ nnmaildir--delivery-ct) 24h (run-with-timer 86400 nil (lambda () (nnmaildir--unlink tmpfile) - (nnmaildir--srv-set-error - nnmaildir--cur-server - "24-hour timer expired") + (setf (nnmaildir--srv-error + nnmaildir--cur-server) + "24-hour timer expired") (throw 'return nil)))) (condition-case nil (add-name-to-file nnmaildir--file tmpfile) @@ -1411,20 +1342,17 @@ by nnmaildir-request-article.") (condition-case err (add-name-to-file tmpfile curfile) (error - (nnmaildir--srv-set-error nnmaildir--cur-server - (concat "Error linking: " - (prin1-to-string err))) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (concat "Error linking: " (prin1-to-string err))) (nnmaildir--unlink tmpfile) (throw 'return nil))) (nnmaildir--unlink tmpfile) - (setq article (nnmaildir--art-new) - num (nnmaildir--grp-get-lists group) - num (nnmaildir--lists-get-nlist num) - num (1+ (nnmaildir--nlist-last-num num))) - (nnmaildir--art-set-prefix article file) - (nnmaildir--art-set-suffix article ":2,") - (nnmaildir--art-set-num article num) - (if (nnmaildir--grp-add-art srv-dir group article) (cons gname num))))) + (setq num (nnmaildir--grp-lists group) + num (nnmaildir--lists-nlist num) + num (1+ (nnmaildir--nlist-last-num num)) + article (make-nnmaildir--art :prefix file :suffix ":2," :num num)) + (if (nnmaildir--grp-add-art nnmaildir--cur-server group article) + (cons gname num))))) (defun nnmaildir-save-mail (group-art) (catch 'return @@ -1438,7 +1366,7 @@ by nnmaildir-request-article.") (while (looking-at "From ") (replace-match "X-From-Line: ") (forward-line 1)))) - (setq groups (nnmaildir--srv-get-groups nnmaildir--cur-server) + (setq groups (nnmaildir--srv-groups nnmaildir--cur-server) ga (car group-art) group-art (cdr group-art) gname (car ga)) (or (intern-soft gname groups) @@ -1447,15 +1375,15 @@ by nnmaildir-request-article.") (if (nnmaildir-request-accept-article gname) nil (throw 'return nil)) (setq x (nnmaildir--prepare nil gname) - nnmaildir--file (nnmaildir--srv-get-dir nnmaildir--cur-server) + nnmaildir--file (nnmaildir--srv-dir nnmaildir--cur-server) nnmaildir--file (nnmaildir--subdir nnmaildir--file - (nnmaildir--grp-get-name x)) - x (nnmaildir--grp-get-lists x) - x (nnmaildir--lists-get-nlist x) + (nnmaildir--grp-name x)) + x (nnmaildir--grp-lists x) + x (nnmaildir--lists-nlist x) x (car x) nnmaildir--file (concat nnmaildir--file - (nnmaildir--art-get-prefix x) - (nnmaildir--art-get-suffix x))) + (nnmaildir--art-prefix x) + (nnmaildir--art-suffix x))) (while group-art (setq ga (car group-art) group-art (cdr group-art) gname (car ga)) @@ -1469,14 +1397,14 @@ by nnmaildir-request-article.") (let ((x (nnmaildir--prepare nil group))) (catch 'return (if x nil - (nnmaildir--srv-set-error nnmaildir--cur-server - (concat "No such group: " group)) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (concat "No such group: " group)) (throw 'return nil)) - (setq x (nnmaildir--grp-get-lists x) - x (nnmaildir--lists-get-nlist x)) + (setq x (nnmaildir--grp-lists x) + x (nnmaildir--lists-nlist x)) (if x (setq x (car x) - x (nnmaildir--art-get-num x) + x (nnmaildir--art-num x) x (1+ x)) 1)))) @@ -1488,12 +1416,11 @@ by nnmaildir-request-article.") nnmaildir-article-file-name deactivate-mark) (catch 'return (if group nil - (nnmaildir--srv-set-error nnmaildir--cur-server - (if gname (concat "No such group: " gname) - "No current group")) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (if gname (concat "No such group: " gname) "No current group")) (throw 'return (gnus-uncompress-range ranges))) - (setq gname (nnmaildir--grp-get-name group) - pgname (nnmaildir--grp-get-pname group)) + (setq gname (nnmaildir--grp-name group) + pgname (nnmaildir--pgname nnmaildir--cur-server gname)) (if (nnmaildir--param pgname 'read-only) (throw 'return (gnus-uncompress-range ranges))) (setq time (or (nnmaildir--param pgname 'expire-age) @@ -1511,11 +1438,11 @@ by nnmaildir-request-article.") high (1- high))) (setcar (cdr boundary) low) (setcar boundary high) - (setq dir (nnmaildir--srv-get-dir nnmaildir--cur-server) - dir (nnmaildir--srv-grp-dir dir gname) + (setq dir (nnmaildir--srv-dir nnmaildir--cur-server) + dir (nnmaildir--srvgrp-dir dir gname) dir (nnmaildir--cur dir) - nlist (nnmaildir--grp-get-lists group) - nlist (nnmaildir--lists-get-nlist nlist) + nlist (nnmaildir--grp-lists group) + nlist (nnmaildir--lists-nlist nlist) ranges (reverse ranges)) (nnmaildir--with-move-buffer (while ranges @@ -1524,25 +1451,25 @@ by nnmaildir-request-article.") (setq ranges (cdr ranges))) (if (numberp number) (setq stop number) (setq stop (car number) number (cdr number))) - (setq nlist (nthcdr (- (nnmaildir--art-get-num (car nlist)) number) + (setq nlist (nthcdr (- (nnmaildir--art-num (car nlist)) number) nlist)) (while (and nlist (setq article (car nlist) - number (nnmaildir--art-get-num article)) + number (nnmaildir--art-num article)) (>= number stop)) (setq nlist (cdr nlist) - suffix (nnmaildir--art-get-suffix article)) + suffix (nnmaildir--art-suffix article)) (catch 'continue (if (stringp suffix) nil - (nnmaildir--art-set-suffix article 'expire) - (nnmaildir--art-set-nov article nil) + (setf (nnmaildir--art-suffix article) 'expire) + (setf (nnmaildir--art-nov article) nil) (throw 'continue nil)) - (setq nnmaildir--file (nnmaildir--art-get-prefix article) + (setq nnmaildir--file (nnmaildir--art-prefix article) nnmaildir--file (concat dir nnmaildir--file suffix) time (file-attributes nnmaildir--file)) (if time nil - (nnmaildir--art-set-suffix article 'expire) - (nnmaildir--art-set-nov article nil) + (setf (nnmaildir--art-suffix article) 'expire) + (setf (nnmaildir--art-nov article) nil) (throw 'continue nil)) (setq time (nth 5 time) time-iter time @@ -1567,8 +1494,8 @@ by nnmaildir-request-article.") (if (equal target pgname) (setq didnt (cons number didnt)) ;; Leave it here. (nnmaildir--unlink nnmaildir--file) - (nnmaildir--art-set-suffix article 'expire) - (nnmaildir--art-set-nov article nil)))))) + (setf (nnmaildir--art-suffix article) 'expire) + (setf (nnmaildir--art-nov article) nil)))))) (erase-buffer)) didnt))) @@ -1579,47 +1506,48 @@ by nnmaildir-request-article.") (file-coding-system-alist nil) del-mark add-marks marksdir markfile action group-nlist nlist ranges begin end article all-marks todo-marks did-marks marks form mdir mfile - pgname ls deactivate-mark) + pgname ls markfilenew deactivate-mark) (setq del-mark (lambda () (setq mfile (nnmaildir--subdir marksdir (symbol-name (car marks))) - mfile (concat mfile (nnmaildir--art-get-prefix article))) + mfile (concat mfile (nnmaildir--art-prefix article))) (nnmaildir--unlink mfile)) add-marks (lambda () (while marks (setq mdir (nnmaildir--subdir marksdir (symbol-name (car marks))) - mfile (concat mdir (nnmaildir--art-get-prefix article))) + mfile (concat mdir (nnmaildir--art-prefix article))) (if (memq (car marks) did-marks) nil (nnmaildir--mkdir mdir) (setq did-marks (cons (car marks) did-marks))) (if (file-exists-p mfile) nil (condition-case nil (add-name-to-file markfile mfile) - (file-error ;; too many links, probably + (file-error (if (file-exists-p mfile) nil - (nnmaildir--unlink markfile) - (write-region "" nil markfile nil 'no-message) - (add-name-to-file markfile mfile - 'ok-if-already-exists))))) + ;; too many links, maybe + (write-region "" nil markfilenew nil 'no-message) + (add-name-to-file markfilenew mfile 'ok-if-already-exists) + (rename-file markfilenew markfile 'replace))))) (setq marks (cdr marks))))) (catch 'return (if group nil - (nnmaildir--srv-set-error nnmaildir--cur-server - (concat "No such group: " gname)) + (setf (nnmaildir--srv-error nnmaildir--cur-server) + (concat "No such group: " gname)) (while actions (setq ranges (gnus-range-add ranges (caar actions)) actions (cdr actions))) (throw 'return ranges)) - (setq group-nlist (nnmaildir--grp-get-lists group) - group-nlist (nnmaildir--lists-get-nlist group-nlist) - marksdir (nnmaildir--srv-get-dir nnmaildir--cur-server) - marksdir (nnmaildir--srv-grp-dir marksdir gname) + (setq group-nlist (nnmaildir--grp-lists group) + group-nlist (nnmaildir--lists-nlist group-nlist) + marksdir (nnmaildir--srv-dir nnmaildir--cur-server) + marksdir (nnmaildir--srvgrp-dir marksdir gname) marksdir (nnmaildir--nndir marksdir) markfile (concat marksdir "markfile") + markfilenew (concat markfile "{new}") marksdir (nnmaildir--marks-dir marksdir) - gname (nnmaildir--grp-get-name group) - pgname (nnmaildir--grp-get-pname group) + gname (nnmaildir--grp-name group) + pgname (nnmaildir--pgname nnmaildir--cur-server gname) ls (nnmaildir--group-ls nnmaildir--cur-server pgname) all-marks (funcall ls marksdir nil "\\`[^.]" 'nosort) marks all-marks) @@ -1659,13 +1587,13 @@ by nnmaildir-request-article.") (setq ranges (cdr ranges))) (if (numberp begin) (setq end begin) (setq end (cdr begin) begin (car begin))) - (setq nlist (nthcdr (- (nnmaildir--art-get-num (car nlist)) end) + (setq nlist (nthcdr (- (nnmaildir--art-num (car nlist)) end) nlist)) (while (and nlist (setq article (car nlist)) - (>= (nnmaildir--art-get-num article) begin)) + (>= (nnmaildir--art-num article) begin)) (setq nlist (cdr nlist)) - (when (stringp (nnmaildir--art-get-suffix article)) + (when (stringp (nnmaildir--art-suffix article)) (setq marks todo-marks) (eval form))))) nil))) @@ -1681,40 +1609,39 @@ by nnmaildir-request-article.") (setq nnmaildir--cur-server nil) (save-match-data (mapatoms - (lambda (group) - (setq group (symbol-value group) - x (nnmaildir--grp-get-pname group) - ls (nnmaildir--group-ls server x) - dir (nnmaildir--srv-get-dir server) - dir (nnmaildir--srv-grp-dir - dir (nnmaildir--grp-get-name group)) - x (nnmaildir--param x 'read-only) - x (if x (nnmaildir--new dir) (nnmaildir--cur dir)) - files (funcall ls x nil "\\`[^.]" 'nosort) - x (length files) - flist 1) - (while (<= flist x) (setq flist (* 2 flist))) - (if (/= flist 1) (setq flist (1- flist))) - (setq flist (make-vector flist 0)) - (while files - (setq file (car files) files (cdr files)) - (string-match "\\`\\([^:]*\\)\\(:.*\\)?\\'" file) - (intern (match-string 1 file) flist)) - (setq dir (nnmaildir--nndir dir) - dirs (cons (nnmaildir--nov-dir dir) - (funcall ls (nnmaildir--marks-dir dir) 'full - "\\`[^.]" 'nosort))) - (while dirs - (setq dir (car dirs) dirs (cdr dirs) - files (funcall ls dir nil "\\`[^.]" 'nosort) - dir (file-name-as-directory dir)) - (while files - (setq file (car files) files (cdr files)) - (if (intern-soft file flist) nil - (setq file (concat dir file)) - (delete-file file))))) - (nnmaildir--srv-get-groups server))) - (unintern (nnmaildir--srv-get-name server) nnmaildir--servers))) + (lambda (group) + (setq x (nnmaildir--pgname server (symbol-name group)) + group (symbol-value group) + ls (nnmaildir--group-ls server x) + dir (nnmaildir--srv-dir server) + dir (nnmaildir--srvgrp-dir dir (nnmaildir--grp-name group)) + x (nnmaildir--param x 'read-only) + x (if x (nnmaildir--new dir) (nnmaildir--cur dir)) + files (funcall ls x nil "\\`[^.]" 'nosort) + x (length files) + flist 1) + (while (<= flist x) (setq flist (* 2 flist))) + (if (/= flist 1) (setq flist (1- flist))) + (setq flist (make-vector flist 0)) + (while files + (setq file (car files) files (cdr files)) + (string-match "\\`\\([^:]*\\)\\(:.*\\)?\\'" file) + (intern (match-string 1 file) flist)) + (setq dir (nnmaildir--nndir dir) + dirs (cons (nnmaildir--nov-dir dir) + (funcall ls (nnmaildir--marks-dir dir) 'full + "\\`[^.]" 'nosort))) + (while dirs + (setq dir (car dirs) dirs (cdr dirs) + files (funcall ls dir nil "\\`[^.]" 'nosort) + dir (file-name-as-directory dir)) + (while files + (setq file (car files) files (cdr files)) + (if (intern-soft file flist) nil + (setq file (concat dir file)) + (delete-file file))))) + (nnmaildir--srv-groups server))) + (unintern (nnmaildir--srv-address server) nnmaildir--servers))) t) (defun nnmaildir-request-close () @@ -1739,15 +1666,21 @@ by nnmaildir-request-article.") (mapatoms (lambda (sym) (when (or (memq sym extras) - (and (fboundp sym) - (>= (length (setq name (symbol-name sym))) 10) - (string-equal "nnmaildir-" (substring name 0 10)))) + (and (fboundp sym) + (setq name (symbol-name sym)) + (>= (length name) 10) + (or (string-equal "nnmaildir-" (substring name 0 10)) + (and (>= (length name) 15) + (string-equal "make-nnmaildir-" + (substring name 0 15)))))) (put sym 'lisp-indent-function 0)))) 'done)) (provide 'nnmaildir) ;; Local Variables: +;; indent-tabs-mode: t +;; fill-column: 77 ;; eval: (progn (require 'nnmaildir) (nnmaildir--edit-prep)) ;; End: diff --git a/lisp/nnnil.el b/lisp/nnnil.el index aa02a84..08a097d 100644 --- a/lisp/nnnil.el +++ b/lisp/nnnil.el @@ -20,9 +20,9 @@ ;;; Commentary: -;; nnnil is a Gnus backend that provides no groups or articles. It's -;; useful ass a primary select method when you want all your real -;; select methods to be secondary or foreign. +;; nnnil is a Gnus backend that provides no groups or articles. It's useful +;; as a primary select method when you want all your real select methods to +;; be secondary or foreign. ;;; Code: @@ -32,6 +32,9 @@ (defvar nnnil-status-string "") (defun nnnil-retrieve-headers (articles &optional group server fetch-old) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer)) 'nov) (defun nnnil-open-server (server &optional definitions) @@ -66,6 +69,9 @@ t) (defun nnnil-request-list (&optional server) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer)) t) (defun nnnil-request-post (&optional server) diff --git a/lisp/nnwarchive.el b/lisp/nnwarchive.el index e2683d2..e780aa9 100644 --- a/lisp/nnwarchive.el +++ b/lisp/nnwarchive.el @@ -589,7 +589,7 @@ (let (p refs url mime e from subject date id done - (case-fold-serch t)) + (case-fold-search t)) (save-restriction (goto-char (point-min)) (when (search-forward "X-Head-End" nil t) diff --git a/lisp/spam.el b/lisp/spam.el new file mode 100644 index 0000000..e2e4d93 --- /dev/null +++ b/lisp/spam.el @@ -0,0 +1,118 @@ +;;; spam.el --- Identifying spam +;; Copyright (C) 2002 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen +;; Keywords: network + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; Code: + +(require 'dns) +(require 'message) + +;;; Blackholes + +(defvar spam-blackhole-servers + '("bl.spamcop.net" "relays.ordb.org" "dev.null.dk" + "relays.visi.com" "rbl.maps.vix.com") + "List of blackhole servers.") + +(defun spam-check-blackholes () + "Check the Recevieved headers for blackholed relays." + (let ((headers (message-fetch-field "received")) + ips matches) + (with-temp-buffer + (insert headers) + (goto-char (point-min)) + (while (re-search-forward + "\\[\\([0-9]+.[0-9]+.[0-9]+.[0-9]+\\)\\]" nil t) + (push (mapconcat 'identity + (nreverse (split-string (match-string 1) "\\.")) + ".") + ips))) + (dolist (server spam-blackhole-servers) + (dolist (ip ips) + (when (query-dns (concat ip "." server)) + (push (list ip server (query-dns (concat ip "." server) 'TXT)) + matches)))) + matches)) + +;;; Black- and white-lists + +(defvar spam-directory "~/News/spam/" + "When spam files are kept.") + +(defvar spam-whitelist (expand-file-name "whitelist" spam-directory) + "The location of the whitelist.") + +(defvar spam-blacklist (expand-file-name "blacklist" spam-directory) + "The location of the whitelist.") + +(defvar spam-whitelist-cache nil) +(defvar spam-blacklist-cache nil) + +(defun spam-enter-whitelist (address &optional blacklist) + "Enter ADDRESS into the whitelist." + (interactive "sAddress: ") + (let ((file (if blacklist spam-blacklist spam-whitelist))) + (unless (file-exists-p (file-name-directory file)) + (make-directory (file-name-directory file) t)) + (save-excursion + (set-buffer + (find-file-noselect file)) + (goto-char (point-max)) + (unless (bobp) + (insert "\n")) + (insert address "\n") + (save-buffer)))) + +(defun spam-parse-whitelist (&optional blacklist) + (let ((file (if blacklist spam-blacklist spam-whitelist)) + contents address) + (when (file-exists-p file) + (with-temp-buffer + (insert-file-contents file) + (while (not (eobp)) + (setq address (buffer-substring (point) (point-at-eol))) + (forward-line 1) + (unless (zerop (length address)) + (setq address (regexp-quote address)) + (while (string-match "\\\\\\*" address) + (setq address (replace-match ".*" t t address))) + (push address contents)))) + (nreverse contents)))) + +(defun spam-refresh-list-cache () + (setq spam-whitelist-cache (spam-parse-whitelist)) + (setq spam-blacklist-cache (spam-parse-whitelist t))) + +(defun spam-address-whitelisted-p (address &optional blacklist) + (let ((cache (if blacklist spam-blacklist-cache spam-whitelist-cache)) + found) + (while (and (not found) + cache) + (when (string-match (pop cache) address) + (setq found t))) + found)) + +(provide 'spam) + +;;; spam.el ends here diff --git a/texi/ChangeLog b/texi/ChangeLog index e0760bb..d3ab325 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,28 @@ +2002-04-05 Kai Gro,A_(Bjohann + + * gnus.texi (Saving Articles): Add xref to Mail Group Commands + because people might be interested in `B c' for saving articles. + (Archived Messages): Ditto. + +2002-04-01 Jesper Harder + + * gnus.texi (Sorting Groups): Add gnus-group-sort-selected-groups. + (Article Washing): Fix typo. + + * message.texi (Various Commands): Index message-elide-ellipsis. + Add message-sort-headers. + (Mail Variables): Add message-qmail-inject-args, + message-mailer-swallows-blank-line, message-sendmail-f-is-evil, + message-qmail-inject-program. + (Various Message Variables): Add message-auto-save-directory, + message-strip-special-text-properties, message-cancel-hook. + (News Headers): Index message-user-organization etc. + (Forwarding): Add message-forward-before-signature. + (Mailing Lists): Index message-subscribed-address-file. + (Wide Reply): Add message-wide-reply-confirm-recipients. + (Canceling News): Add message-cancel-message. + (Sending Variables): Add message-interactive. + 2002-03-25 Simon Josefsson * gnus.texi (Mail Spool): Add cindex for marks. diff --git a/texi/gnus-ja.texi b/texi/gnus-ja.texi index f3e806c..c6ccfbc 100644 --- a/texi/gnus-ja.texi +++ b/texi/gnus-ja.texi @@ -3287,39 +3287,44 @@ kill $B$5$l$?%0%k!<%W$rA4$FI=<($7$^$9(B (@code{gnus-group-list-killed})$B!#@\ @item G P a @kindex G P a ($B%0%k!<%W(B) @findex gnus-group-sort-selected-groups-by-alphabet -$B%0%k!<%W$r!"%0%k!<%WL>$N%"%k%U%!%Y%C%H=g$GJB$YBX$($^(B +$B%0%k!<%W$r%0%k!<%WL>$N%"%k%U%!%Y%C%H=g$GJB$YBX$($^(B $B$9(B (@code{gnus-group-sort-selected-groups-by-alphabet})$B!#(B @item G P u @kindex G P u ($B%0%k!<%W(B) @findex gnus-group-sort-selected-groups-by-unread -$B%0%k!<%W$r!"L$FI5-;v$N?t$GJB$YBX$($^(B +$B%0%k!<%W$rL$FI5-;v$N?t$GJB$YBX$($^(B $B$9(B (@code{gnus-group-sort-selected-groups-by-unread})$B!#(B @item G P l @kindex G P l ($B%0%k!<%W(B) @findex gnus-group-sort-selected-groups-by-level -$B%0%k!<%W$r!"%0%k!<%W%l%Y%k$GJB$YBX$($^(B +$B%0%k!<%W$r%0%k!<%W%l%Y%k$GJB$YBX$($^(B $B$9(B (@code{gnus-group-sort-selected-groups-by-level})$B!#(B @item G P v @kindex G P v ($B%0%k!<%W(B) @findex gnus-group-sort-selected-groups-by-score -$B%0%k!<%W$r!"%0%k!<%W$N%9%3%"$GJB$YBX$($^(B +$B%0%k!<%W$r%0%k!<%W$N%9%3%"$GJB$YBX$($^(B $B$9(B (@code{gnus-group-sort-selected-groups-by-score})$B!#(B @xref{Group Score}. @item G P r @kindex G P r ($B%0%k!<%W(B) @findex gnus-group-sort-selected-groups-by-rank -$B%0%k!<%W$r!"%0%k!<%W$N%i%s%/$GJB$YBX$($^(B +$B%0%k!<%W$r%0%k!<%W$N%i%s%/$GJB$YBX$($^(B $B$9(B (@code{gnus-group-sort-selected-groups-by-rank})$B!#(B@xref{Group Score}. @item G P m @kindex G P m ($B%0%k!<%W(B) @findex gnus-group-sort-selected-groups-by-method -$B%0%k!<%W$r!"%P%C%/%(%s%I$NL>A0$G%"%k%U%!%Y%C%H=g$KJB$YBX$($^(B +$B%0%k!<%W$r%P%C%/%(%s%I$NL>A0$G%"%k%U%!%Y%C%H=g$KJB$YBX$($^(B $B$9(B (@code{gnus-group-sort-selected-groups-by-method})$B!#(B + +@item G P s +@kindex G P s ($B%0%k!<%W(B) +@findex gnus-group-sort-selected-groups +$B%0%k!<%W$r(B @code{gnus-group-sort-function} $B$K=>$C$FJB$YBX$($^$9!#(B @end table $B:G8e$K!"(B@kbd{C-k} $B$H(B @kbd{C-y} $B$r;H$C$F!"o$KN((B $B$k(B) $B$K$D$$$F$O(B@code{gnus-uu} $B$r;H$&$N$,NI$$$G$7$g(B $B$&(B (@pxref{Decoding Articles})$B!#(B +$B$3$3$K:\$C$F$$$k%3%^%s%I$OBP>]$,%U%!%$%k$G$9!#%0%k!<%W$KJ]B8$7$?$$>l9g(B +$B$O(B @kbd{B c} (@code{gnus-summary-copy-article}) $B%3%^%s%I$r;2>H$7$F2<$5(B +$B$$(B (@pxref{Mail Group Commands})$B!#(B + @vindex gnus-save-all-headers @code{gnus-save-all-headers} $B$,(B @code{nil} $B$G$J$$$H!"(Bgnus $B$O5-;v$rJ]B8$9(B $B$kA0$KK>$^$7$/$J$$%X%C%@!<$r>C5n$7$^$;$s!#(B @@ -7922,9 +7931,9 @@ gnus $B$,5-;v$rI=<($9$k4{Dj$N$d$jJ}$rJQ$($?$$$H$-(B @item W v @kindex W v ($B35N,(B) -@findex gnus-summary-verbose-header +@findex gnus-summary-verbose-headers $B5-;v%P%C%U%!$K$9$Y$F$N%X%C%@!<$r1J1s$KI=<($9$k$+$I$&$+$r@Z$jBX$($^(B -$B$9(B (@code{gnus-summary-verbose-header})$B!#(B +$B$9(B (@code{gnus-summary-verbose-headers})$B!#(B @item W m @kindex W m ($B35N,(B) @@ -10246,6 +10255,10 @@ Gnus $B$O$"$J$?$,Aw$C$?%a!<%k$H%K%e!<%9$rCy$a$F$*$/$?$a$N$$$/$D$+$N0c$C$?(B $BJQ?t(B @code{gnus-message-archive-group} $B$O(B @code{nil} $B$K$J$k$Y$-$G!"$3$l(B $B$,%G%#%U%)%k%H$G$9!#(B +$B$"$J$?$,FI$s$G6=L#$r;}$C$?%a%C%;!<%8$r%0%k!<%W$KJ]B8$9$k$K(B +$B$O(B @kbd{B c} (@code{gnus-summary-copy-article}) $B%3%^%s%I$r;2>H$7$F2<$5(B +$B$$(B (@pxref{Mail Group Commands})$B!#(B + @vindex gnus-message-archive-method @code{gnus-message-archive-method} $B$OAw$C$?%a%C%;!<%8$rC_@Q$9$k$?$a$K$I(B $B$N;ve$N%5!<%P!<$r(B gnus $B$,;H$&$Y$-$+$r;XDj$7$^$9!#%G%#%U%)%k%H$O(B: diff --git a/texi/gnus.texi b/texi/gnus.texi index f7aa73c..9ab673f 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -3238,6 +3238,11 @@ Sort the groups by group rank Sort the groups alphabetically by back end name (@code{gnus-group-sort-selected-groups-by-method}). +@item G P s +@kindex G P s (Group) +@findex gnus-group-sort-selected-groups +Sort the groups according to @code{gnus-group-sort-function}. + @end table And finally, note that you can use @kbd{C-k} and @kbd{C-y} to manually @@ -6958,6 +6963,10 @@ processing of the article is done before it is saved). For a different approach (uudecoding, unsharing) you should use @code{gnus-uu} (@pxref{Decoding Articles}). +For the commands listed here, the target is a file. If you want to +save to a group, see the @kbd{B c} (@code{gnus-summary-copy-article}) +command (@pxref{Mail Group Commands}). + @vindex gnus-save-all-headers If @code{gnus-save-all-headers} is non-@code{nil}, gnus will not delete unwanted headers before saving the article. @@ -8063,9 +8072,9 @@ Toggle whether to display all headers in the article buffer @item W v @kindex W v (Summary) -@findex gnus-summary-verbose-header +@findex gnus-summary-verbose-headers Toggle whether to display all headers in the article buffer permanently -(@code{gnus-summary-verbose-header}). +(@code{gnus-summary-verbose-headers}). @item W m @kindex W m (Summary) @@ -10740,6 +10749,10 @@ store the messages. If you want to disable this completely, the @code{gnus-message-archive-group} variable should be @code{nil}, which is the default. +For archiving interesting messages in a group you read, see the +@kbd{B c} (@code{gnus-summary-copy-article}) command (@pxref{Mail +Group Commands}). + @vindex gnus-message-archive-method @code{gnus-message-archive-method} says what virtual server gnus is to use to store sent messages. The default is: diff --git a/texi/message-ja.texi b/texi/message-ja.texi index dbd4ddd..7da6aee 100644 --- a/texi/message-ja.texi +++ b/texi/message-ja.texi @@ -223,10 +223,15 @@ Message $B$OJVEz$,2?=h$K9T$/$+$r7hDj$9$k$?$a$KIaDL$NJ}K!$r;H$$$^$9$,!"(B $BJQ99$9$k;v$,$G$-$^$9!#$=$l$O(B @code{message-reply-to-function} $B$HF1$8$h$&(B $B$K;H$o$l$^$9(B (@pxref{Reply})$B!#(B -@findex message-dont-reply-to-names +@vindex message-dont-reply-to-names $B@55,I=8=(B @code{rmail-dont-reply-to-names} $B$K9gCW$9$k%"%I%l%9$O(B @code{Cc} $B%X%C%@!<$+$iC$7$^$9!#(B +@vindex message-cancel-message +@code{message-cancel-message} $B$NCM$,C$75-;v$NK\J8$KA^F~$5$l$^$9!#%G%#(B +$B%U%)%k%H$O(B @samp{I am canceling my own article.} $B$G$9!#(B + @node Superseding @section $BBeBX(B @@ -313,6 +322,11 @@ included as inline @sc{mime} RFC822 parts. If it's @code{nil}, forwarded messages will just be copied inline to the new message, like previous, non @sc{mime}-savvy versions of gnus would do. @end ignore + +@item message-forward-before-signature +@vindex message-forward-before-signature +$BHs(B-@code{nil} $B$@$C$?$i=pL>$NA0$K!"$=$l0J30$@$C$?$i8e$K!"E>Aw$9$k%a%C%;!<(B +$B%8$rCV$-$^$9!#(B @end table @node Resending @@ -421,6 +435,7 @@ gnus $B$K$O$3$NJQ?t$N9%E,$J8uJd$G$"$k$H$3$m$N!"$"$i$+$8$aDj5A$5$l$F$$$k4X(B '(gnus-find-subscribed-addresses)) @end lisp +@vindex message-subscribed-address-file @item message-subscribed-address-file $B$"$J$?$O$b$7$+$7$?$i?l68$J?M(B ($B86E5(B: one organised human freak) $B$G!"9XFI(B $B$7$F$$$k$9$Y$F$N%a!<%j%s%0%j%9%H$N%"%I%l%9$N%j%9%H$rJL%U%!%$%k$G;}$C$F$$(B @@ -875,6 +890,7 @@ documentation of your OpenPGP implementation, so we refer to it. @item C-c C-e @kindex C-c C-e @findex message-elide-region +@vindex message-elide-ellipsis $B%]%$%s%H$H%^!<%/$N4V$NJ8$r>J$-$^$9(B (@code{message-elide-region})$B!#J8>O$O(B $B@Z$i$l$F(B (killed) $BJQ?t(B @code{message-elide-ellipsis} $B$NCM$GCV$-49$($i$l(B $B$^$9!#%G%#%U%)%k%H$N>JN,Id9f$H$7$F;H$o$l$kCM$O(B (@samp{[...]}) $B$G$9!#(B @@ -930,6 +946,13 @@ documentation of your OpenPGP implementation, so we refer to it. $B$rH?1G$7$?(B @code{Newsgroups} $B%X%C%@!<$rA^F~$7$^(B $B$9(B (@code{message-insert-newsgroups})$B!#(B +@item C-c C-o +@kindex C-c C-o +@findex message-sort-headers +@vindex message-header-format-alist +@code{message-header-format-alist} $B$K=>$C$F%X%C%@!<$rJB$YBX$($^(B +$B$9(B (@code{message-sort-headers})$B!#(B + @item C-c M-r @kindex C-c M-r @findex message-rename-buffer @@ -1198,10 +1221,37 @@ Lines (optional . User-Agent))} $B$G$9!#(B $B$J$?$N(B MH $B$,$3$l$i$N%X%C%@!<$r07$($k$N$G$"$l$P!"$=$l$r(B @code{nil} $B$K@_Dj(B $B$7$F2<$5$$!#(B +@item message-qmail-inject-program +@vindex message-qmail-inject-program +@cindex qmail +qmail-inject $B%W%m%0%i%`$G$9!#(B + +@item message-qmail-inject-args +@vindex message-qmail-inject-args +qmail-inject $B%W%m%0%i%`$KEO$90z?t$G$9!#$3$l$OJ8;zNs$N%j%9%H$G!"$=$l$>$l(B +$B$N0z?t$O0l$D$NJ8;zNs$G$J$1$l$P$J$j$^$;$s!#$3$l$O4X?t$G$bNI$$$G$9!#(B + +$BNc$($P!"@5$7$$>l=j$KD7$MJV$7$?$j!"%a!<%j%s%0%j%9%H$N47=,$K=>$&$?$a(B +$B$K(B envelope sender $B$N%"%I%l%9$r@_Dj$7$?$$>l9g$O!"$3$NJQ?t(B +$B$r(B @code{'("-f" "you@@some.where")} $B$K@_Dj$9$l$PNI$$$G$7$g$&!#(B + +@item message-sendmail-f-is-evil +@vindex message-sendmail-f-is-evil +@cindex sendmail +$BHs(B-@code{nil} $B$G(B sendmail $B$N%3%^%s%I9T$K(B @samp{-f username} $B$rIU2C$7$^$;(B +$B$s!#$=$&$9$k$3$H$O!"IU2C$7$J$$$h$jl9g$O!"(B +$BHs(B-@code{nil} $B$K@_Dj$7$F2<$5$$!#(B(Sunos 4 $B$G(B sendmail $B$,%j%b!<%H%b!<%I$G(B +$BF0:n$9$k>l9g$,3:Ev$7$^$9!#(B) $BCM$O!">c32$,$r7h$a$k$?$a$K;H$$$^$9!#$b$7$ @item Expires @cindex Expires +@vindex message-expires $B$3$NHs>o$KA*Br<+M3$J%X%C%@!<$OJQ?t(B @code{message-expires} $B$K$7$?$,$C$FA^(B $BF~$5$l$^$9!#$3$l$O<+J,$,2?$r$7$F$$$k$+$rCN$i$J$$8B$j!";HMQ$OA4$/4+$a$i$l(B $B$^$;$s!#(B @item Distribution @cindex Distribution +@vindex message-distribution-function $B$3$NA*Br<+M3$J%X%C%@!<$OJQ?t(B @code{message-distribution-function} $B$K$7$?(B $B$,$C$F:n$i$l$^$9!#$=$l$OHs?d>)$G!"Hs>o$K8m2r$5$l$?%X%C%@!<$G$9!#(B @item Path @cindex path +@vindex message-user-path $B$3$NHs>o$KA*Br<+M3$J%X%C%@!<$O$*$=$i$/7h$7$F;H$o$l$F$O$J$i$J$$$G$7$g$&!#(B $B$7$+$7$$$/$D$+$N(B @emph{$B$H$F$b(B} $B8E$$%5!<%P!<$O$3$N%X%C%@!<$,B8:_$9$k;v$r(B $BMW5a$7$^$9!#(B@code{message-user-path} $B$,$3$N(B @code{Path} $B%X%C%@!<$,$I$N$h(B @@ -1545,6 +1600,12 @@ follows this line--} $B$G$9!#(B $BB?$/$N%a!<%k$N$b$N$+$i;H$o$l$k%G%#%l%/%H%j!<$G$9!#=i4|CM(B $B$O(B @file{~/Mail/} $B$G$9!#(B +@item message-auto-save-directory +@vindex message-auto-save-directory +gnus $B$,F0:n$7$F$$$J$$$H$-$K(B Message $B$,%P%C%U%!$r<+F0J]B8$9$k%G%#%l%/%H%j(B +$B$G$9!#(B@code{nil} $B$@$C$?$i(B Message $B$O<+F0J]B8$r9T$J$$$^$;$s!#%G%#%U%)%k%H(B +$B$O(B @file{~/Mail/drafts/} $B$G$9!#(B + @item message-signature-setup-hook @vindex message-signature-setup-hook $B%a%C%;!<%8%P%C%U%!$r=i4|2=$9$k$H$-$KC$9$H$-$K