From: yamaoka Date: Mon, 14 Jun 1999 01:33:21 +0000 (+0000) Subject: Importing Pterodactyl Gnus v0.86. X-Git-Tag: pgnus-0_86~1 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=f0e38408ebe4249827e9fc21cdf1556a636966d3;p=elisp%2Fgnus.git- Importing Pterodactyl Gnus v0.86. --- diff --git a/etc/gnus/x-splash b/etc/gnus/x-splash new file mode 100644 index 0000000..cbd1c2c Binary files /dev/null and b/etc/gnus/x-splash differ diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f857607..07c8ed2 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,199 @@ +Sun Jun 13 07:30:40 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.86 is released. + +1999-06-13 08:51:25 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-treat-translate): New variable. + (gnus-treat-predicate): Accept a list of regexps. + (gnus-article-treat-custom): Allow a list of regexps. + +1999-06-09 Markus Rost + + * gnus/gnus-group.el (gnus-permanently-visible-groups): Fix custom + type. + +1999-06-13 05:15:52 Lars Magne Ingebrigtsen + + * gnus-art.el (article-babel): Narrow a bit. + + * gnus-agent.el (gnus-agent-get-undownloaded-list): Was too slow. + +1999-06-12 Simon Josefsson + + (gnus-agent-get-undownloaded-list): Operate on all articles, not + only unread ones. + (gnus-agent-fetch-headers): Fetch headers from unread and marked + articles, not only unread ones. + +1999-06-13 03:01:35 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-limit-to-extra): New command and + keystroke. + + * gnus-art.el (gnus-article-x-face-command): Ditto. + + * gnus-uu.el (gnus-uu-default-view-rules): Default to "display". + + * gnus.el (gnus-method-simplify): Accept server names. + +1999-06-13 02:36:15 Per Abrahamsen + + * gnus-art.el (article-babel-prompt): New function. + (article-babel): New command. + +1999-06-13 01:01:52 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-part-wrapper): Go to part. + + * mml.el (mml-generate-mime-1): Don't insert literally. + + * gnus-util.el (gnus-parse-netrc): Skip lines with #'s. + (gnus-netrc-syntax-table): Removed. + (gnus-parse-netrc): Don't use syntax table; just use whitespace. + +Wed May 5 13:51:13 1999 Shenghuo ZHU + + * mm-view.el (mm-inline-text): Fix charset for text/html. + +Wed May 5 01:15:08 1999 Shenghuo ZHU + + * message.el (message-draft-coding-system): Use emacs-mule-dos. + +1999-06-12 07:29:39 Lars Magne Ingebrigtsen + + * nnmail.el (nnmail-split-incoming): Return the number of split + mails. + (nnmail-process-babyl-mail-format): Ditto. + (nnmail-process-unix-mail-format): Ditto. + (nnmail-process-mmdf-mail-format): Ditto. + (nnmail-process-maildir-mail-format): Ditto. + + * mail-source.el (mail-source-callback): Return the number from + the callback. + + * message.el (message-send-mail): Generate Lines. + + * mail-source.el (mail-source-call-script): New function. + (mail-source-call-script): New function. + +Sun May 2 02:00:27 1999 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-setup-highlight-words): New function. + (gnus-select-newsgroup): Use it. + (gnus-group-highlight-words-alist): New variable. + (gnus-newsgroup-emphasis-alist): New variable. + (gnus-summary-local-variables): Use it. + * lpath.el: Use it. + * gnus-art.el (article-emphasize): Use it. + (gnus-emphasis-highlight-words): New face. + * gnus-cus.el (gnus-group-parameters): New parameter. + +Sun May 2 01:00:02 1999 Shenghuo ZHU + + * gnus-cache.el (gnus-cache-possibly-enter-article): Remove + parameter `headers'. + (gnus-cache-enter-article): Ditto. + (gnus-cache-update-article): Ditto. + * gnus-sum.el (gnus-summary-move-article): Ditto. + (gnus-summary-mark-article-as-unread): Ditto. + (gnus-summary-mark-article): Ditto. + +1999-06-12 03:59:56 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-message-insert-stylings): Removed. + (gnus-posting-style-alist): Removed. + (gnus-message-style-insertions): Ditto. + (gnus-configure-posting-styles): Reimplementation. + + * mail-source.el (mail-source-fetch): Error the message. + + * gnus-msg.el (gnus-inews-do-gcc): Do mml and encoding. + +Sat Jun 12 00:19:57 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.85 is released. + +1999-04-20 Michael Cook + + * gnus-cite.el (gnus-cite-attribution-prefix): Tweak for MS + Outlook citation regex. + +1999-06-12 02:09:49 Lars Magne Ingebrigtsen + + * nndoc.el (nndoc-mime-parts-type-p): Accept space before + semicolon. + +1999-05-24 Simon Josefsson + + * gnus-range.el (gnus-remove-from-range): Document range1 + modification, protect range2. + +1999-05-24 Simon Josefsson + + * gnus-sum.el (gnus-update-marks): Protect lists from + gnus-remove-from-range, don't sort twice. + +1999-05-21 Simon Josefsson + + * gnus-start.el (gnus-read-descriptions-file): Protect if no + function in backend. + +1999-05-15 Simon Josefsson + + * gnus-sum.el (gnus-valid-move-group-p): Check for a + request-accept-article function in the backend instead of using + the 'respool capability. + +1999-04-18 Hrvoje Niksic + + * mm-bodies.el (mm-decode-content-transfer-encoding): Handle + spurious whitespace at eob. + +1999-06-12 02:02:06 Adrian Aichner + + * nnmail.el (nnmail-get-new-mail): Check right variable. + +1999-06-12 01:57:39 Karl Kleinpaste + + * mailcap.el (mailcap-mime-data): Fix rfc822. + +1999-06-11 23:48:50 TOZAWA Akihiko + + * nndoc.el (nndoc-nsmail-type-p): New function. + (nndoc-type-alist): Recognize nsmail. + +1999-05-12 Mike McEwan + + * gnus-art.el (gnus-treatment-function-alist): Display `x-face' + *before* `article-hide-headers' deletes the information. + +1999-05-22 00:26:46 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-save-parts): New command and + keystroke. + (gnus-summary-save-parts-1): New function. + (gnus-summary-iterate): Buggy. + + * mm-decode.el (mm-save-part-to-file): Made into own function. + +1999-05-11 05:53:16 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-set-info): Resist nils. + +1999-05-04 19:26:08 Lars Magne Ingebrigtsen + + * mailcap.el (mailcap-mime-data): Ditto. + + * gnus-uu.el (gnus-uu-default-view-rules): Ditto. + + * gnus-art.el (gnus-article-x-face-command): Default to ee. + +1999-05-02 Gareth Jones + + * gnus-art.el (article-make-date-line): Put X-Sent below Date if + gnus-article-date-lapsed-new-header is t. + Sat May 1 20:27:43 1999 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.84 is released. diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index acc9b0d..efe869a 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -515,11 +515,13 @@ the actual number of articles toggled is returned." (gnus-agent-method-p gnus-command-method)) (gnus-agent-load-alist gnus-newsgroup-name) ;; First mark all undownloaded articles as undownloaded. - (let ((articles gnus-newsgroup-unreads) + (let ((articles (append gnus-newsgroup-unreads + gnus-newsgroup-marked + gnus-newsgroup-dormant)) article) (while (setq article (pop articles)) (unless (or (cdr (assq article gnus-agent-article-alist)) - (memq article gnus-newsgroup-downloadable)) + (memq article gnus-newsgroup-downloadable)) (push article gnus-newsgroup-undownloaded)))) ;; Then mark downloaded downloadable as not-downloadable, ;; if you get my drift. @@ -787,15 +789,21 @@ the actual number of articles toggled is returned." (pop gnus-agent-group-alist)))) (defun gnus-agent-fetch-headers (group &optional force) - (let ((articles (if (gnus-agent-load-alist group) - (gnus-sorted-intersection - (gnus-list-of-unread-articles group) - (gnus-uncompress-range - (cons (1+ (caar (last gnus-agent-article-alist))) - (cdr (gnus-active group))))) - (gnus-list-of-unread-articles group))) + (let ((articles (gnus-list-of-unread-articles group)) (gnus-decode-encoded-word-function 'identity) (file (gnus-agent-article-name ".overview" group))) + ;; add article with marks to list of article headers we want to fetch + (dolist (arts (gnus-info-marks (gnus-get-info group))) + (setq articles (union (gnus-uncompress-sequence (cdr arts)) + articles))) + (setq articles (sort articles '<)) + ;; remove known articles + (when (gnus-agent-load-alist group) + (setq articles (gnus-sorted-intersection + articles + (gnus-uncompress-range + (cons (1+ (caar (last gnus-agent-article-alist))) + (cdr (gnus-active group))))))) ;; Fetch them. (gnus-make-directory (nnheader-translate-file-chars (file-name-directory file))) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 1bf48af..f97f826 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -193,7 +193,7 @@ regexp. If it matches, the text in question is not a signature." :group 'gnus-article-hiding) (defcustom gnus-article-x-face-command - "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -" + "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | display -" "*String or function to be executed to display an X-Face header. If it is a string, the command will be executed in a sub-shell asynchronously. The compressed face will be piped to this command." @@ -271,6 +271,11 @@ is the face used for highlighting." Esample: (_/*word*/_)." :group 'gnus-article-emphasis) +(defface gnus-emphasis-highlight-words + '((t (:background "black" :foreground "yellow"))) + "Face used for displaying highlighted words." + :group 'gnus-article-emphasis) + (defcustom gnus-article-time-format "%a, %b %d %Y %T %Z" "Format for display of Date headers in article bodies. See `format-time-string' for the possible values. @@ -617,6 +622,7 @@ be added below it (otherwise)." (const :tag "Header" head) (const :tag "Last" last) (integer :tag "Less") + (repeat :tag "Groups" regexp) (sexp :tag "Predicate"))) (defvar gnus-article-treat-head-custom @@ -875,6 +881,13 @@ See the manual for details." :group 'gnus-article-treat :type gnus-article-treat-custom) +(defcustom gnus-treat-translate nil + "Translate articles from one language to another. +Valid values are nil, t, `head', `last', an integer or a predicate. +See the manual for details." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + ;;; Internal variables (defvar article-goto-body-goes-to-point-min-p nil) @@ -890,6 +903,7 @@ See the manual for details." (gnus-treat-fill-long-lines gnus-article-fill-long-lines) (gnus-treat-strip-cr gnus-article-remove-cr) (gnus-treat-emphasize gnus-article-emphasize) + (gnus-treat-display-xface gnus-article-display-x-face) (gnus-treat-hide-headers gnus-article-maybe-hide-headers) (gnus-treat-hide-boring-headers gnus-article-hide-boring-headers) (gnus-treat-hide-signature gnus-article-hide-signature) @@ -914,7 +928,6 @@ See the manual for details." (gnus-treat-strip-blank-lines gnus-article-strip-blank-lines) (gnus-treat-overstrike gnus-article-treat-overstrike) (gnus-treat-buttonize-head gnus-article-add-buttons-to-head) - (gnus-treat-display-xface gnus-article-display-x-face) (gnus-treat-display-smileys gnus-smiley-display) (gnus-treat-display-picons gnus-article-display-picons) (gnus-treat-play-sounds gnus-earcon-display))) @@ -1516,6 +1529,33 @@ always hide." (while (re-search-forward banner nil t) (delete-region (match-beginning 0) (match-end 0)))))))))) +(defun article-babel-prompt () + "Prompt for a babel translation." + (require 'babel) + (completing-read "Translate from: " + babel-translations nil t + (car (car babel-translations)) + babel-history)) + +(defun article-babel (translation) + "Translate article according to TRANSLATION using babelfish." + (interactive (list (article-babel-prompt))) + (require 'babel) + (save-excursion + (set-buffer gnus-article-buffer) + (when (article-goto-body) + (let* ((buffer-read-only nil) + (start (point)) + (end (point-max)) + (msg (buffer-substring start end))) + (save-restriction + (narrow-to-region start end) + (delete-region start end) + (babel-fetch msg (cdr (assoc translation babel-translations))) + (save-restriction + (narrow-to-region start (point-max)) + (babel-wash))))))) + (defun article-hide-signature (&optional arg) "Hide the signature in the current article. If given a negative prefix, always show; if given a positive prefix, @@ -1781,6 +1821,8 @@ should replace the \"Date:\" one, or should be added below it." (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point)))) (setq newline nil)) + (if (re-search-forward tdate-regexp nil t) + (forward-line 1)) (insert (article-make-date-line date type)) (when newline (insert "\n") @@ -1954,7 +1996,7 @@ This format is defined by the `gnus-article-time-format' variable." (interactive (gnus-article-hidden-arg)) (unless (gnus-article-check-hidden-text 'emphasis arg) (save-excursion - (let ((alist gnus-emphasis-alist) + (let ((alist (or gnus-newsgroup-emphasis-alist gnus-emphasis-alist)) (buffer-read-only nil) (props (append '(article-type emphasis) gnus-hidden-properties)) @@ -2296,6 +2338,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-mime-decode-quoted-printable article-hide-pgp article-strip-banner + article-babel article-hide-pem article-hide-signature article-strip-headers-in-body @@ -2763,6 +2806,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (set-buffer gnus-article-buffer) (when (> n (length gnus-article-mime-handle-alist)) (error "No such part")) + (gnus-article-goto-part n) (let ((handle (cdr (assq n gnus-article-mime-handle-alist)))) (funcall function handle)))) @@ -4357,6 +4401,11 @@ For example: (eq part-number total-parts)) ((numberp val) (< length val)) + ((and (listp val) + (stringp (car val))) + (apply 'gnus-or (mapcar `(lambda (s) + (string-match s ,(or gnus-newsgroup-name ""))) + val))) ((listp val) (let ((pred (pop val))) (cond diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index 064c500..bc1f221 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -145,20 +145,17 @@ it's not cached." (setq gnus-cache-buffer nil)))) (defun gnus-cache-possibly-enter-article - (group article headers ticked dormant unread &optional force) + (group article ticked dormant unread &optional force) (when (and (or force (not (eq gnus-use-cache 'passive))) (numberp article) - (> article 0) - (vectorp headers)) ; This might be a dummy article. - ;; If this is a virtual group, we find the real group. - (when (gnus-virtual-group-p group) - (let ((result (nnvirtual-find-group-art - (gnus-group-real-name group) article))) - (setq group (car result) - headers (copy-sequence headers)) - (mail-header-set-number headers (cdr result)))) - (let ((number (mail-header-number headers)) - file) + (> article 0)) ; This might be a dummy article. + (let ((number article) file headers) + ;; If this is a virtual group, we find the real group. + (when (gnus-virtual-group-p group) + (let ((result (nnvirtual-find-group-art + (gnus-group-real-name group) article))) + (setq group (car result) + number (cdr result)))) (when (and number (> number 0) ; Reffed article. (or force @@ -330,7 +327,6 @@ Returns the list of articles entered." (if (natnump article) (when (gnus-cache-possibly-enter-article gnus-newsgroup-name article - (gnus-summary-article-header article) nil nil nil t) (push article out)) (gnus-message 2 "Can't cache article %d" article)) @@ -426,7 +422,7 @@ Returns the list of articles removed." (when (gnus-cache-possibly-remove-article article nil nil nil t) (let ((gnus-use-cache nil)) (gnus-cache-possibly-enter-article - gnus-newsgroup-name article (gnus-summary-article-header article) + gnus-newsgroup-name article nil nil nil t)))) (defun gnus-cache-possibly-remove-article (article ticked dormant unread diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el index aaf46a5..6c70d44 100644 --- a/lisp/gnus-cite.el +++ b/lisp/gnus-cite.el @@ -104,7 +104,7 @@ The first regexp group should match the Supercite attribution." :type 'integer) (defcustom gnus-cite-attribution-prefix - "In article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),\\| > -----Original Message-----" + "In article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),\\|-----Original Message-----" "*Regexp matching the beginning of an attribution line." :group 'gnus-cite :type 'regexp) diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el index 0f3d5d3..ee9f042 100644 --- a/lisp/gnus-cus.el +++ b/lisp/gnus-cus.el @@ -168,7 +168,18 @@ Always display this group, even when there are no unread articles in it..") (charset (symbol :tag "Charset") "\ -The default charset to use in the group.")) +The default charset to use in the group.") + + (highlight-words + (choice :tag "Highlight words" + :value nil + (repeat (list (regexp :tag "Highlight regexp") + (number :tag "Group for entire word" 0) + (number :tag "Group for displayed part" 0) + (symbol :tag "Face" + gnus-emphasis-highlight-words)))) + "highlight regexps. +See gnus-emphasis-alist.")) "Alist of valid group parameters. Each entry has the form (NAME TYPE DOC), where NAME is the parameter diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 0e6f1b1..d9a7bb5 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -90,7 +90,7 @@ unread articles in the groups. If nil, no groups are permanently visible." :group 'gnus-group-listing - :type 'regexp) + :type '(choice regexp (const nil))) (defcustom gnus-list-groups-with-ticked-articles t "*If non-nil, list groups that have only ticked articles. @@ -3287,59 +3287,60 @@ and the second element is the address." (gnus-browse-foreign-server method)) (defun gnus-group-set-info (info &optional method-only-group part) - (let* ((entry (gnus-gethash - (or method-only-group (gnus-info-group info)) - gnus-newsrc-hashtb)) - (part-info info) - (info (if method-only-group (nth 2 entry) info)) - method) - (when method-only-group + (when info + (let* ((entry (gnus-gethash + (or method-only-group (gnus-info-group info)) + gnus-newsrc-hashtb)) + (part-info info) + (info (if method-only-group (nth 2 entry) info)) + method) + (when method-only-group + (unless entry + (error "Trying to change non-existent group %s" method-only-group)) + ;; We have received parts of the actual group info - either the + ;; select method or the group parameters. We first check + ;; whether we have to extend the info, and if so, do that. + (let ((len (length info)) + (total (if (eq part 'method) 5 6))) + (when (< len total) + (setcdr (nthcdr (1- len) info) + (make-list (- total len) nil))) + ;; Then we enter the new info. + (setcar (nthcdr (1- total) info) part-info))) (unless entry - (error "Trying to change non-existent group %s" method-only-group)) - ;; We have received parts of the actual group info - either the - ;; select method or the group parameters. We first check - ;; whether we have to extend the info, and if so, do that. - (let ((len (length info)) - (total (if (eq part 'method) 5 6))) - (when (< len total) - (setcdr (nthcdr (1- len) info) - (make-list (- total len) nil))) - ;; Then we enter the new info. - (setcar (nthcdr (1- total) info) part-info))) - (unless entry - ;; This is a new group, so we just create it. - (save-excursion - (set-buffer gnus-group-buffer) - (setq method (gnus-info-method info)) - (when (gnus-server-equal method "native") - (setq method nil)) + ;; This is a new group, so we just create it. (save-excursion (set-buffer gnus-group-buffer) - (if method - ;; It's a foreign group... - (gnus-group-make-group - (gnus-group-real-name (gnus-info-group info)) - (if (stringp method) method - (prin1-to-string (car method))) - (and (consp method) - (nth 1 (gnus-info-method info)))) - ;; It's a native group. - (gnus-group-make-group (gnus-info-group info)))) - (gnus-message 6 "Note: New group created") - (setq entry - (gnus-gethash (gnus-group-prefixed-name - (gnus-group-real-name (gnus-info-group info)) - (or (gnus-info-method info) gnus-select-method)) - gnus-newsrc-hashtb)))) - ;; Whether it was a new group or not, we now have the entry, so we - ;; can do the update. - (if entry - (progn - (setcar (nthcdr 2 entry) info) - (when (and (not (eq (car entry) t)) - (gnus-active (gnus-info-group info))) - (setcar entry (length (gnus-list-of-unread-articles (car info)))))) - (error "No such group: %s" (gnus-info-group info))))) + (setq method (gnus-info-method info)) + (when (gnus-server-equal method "native") + (setq method nil)) + (save-excursion + (set-buffer gnus-group-buffer) + (if method + ;; It's a foreign group... + (gnus-group-make-group + (gnus-group-real-name (gnus-info-group info)) + (if (stringp method) method + (prin1-to-string (car method))) + (and (consp method) + (nth 1 (gnus-info-method info)))) + ;; It's a native group. + (gnus-group-make-group (gnus-info-group info)))) + (gnus-message 6 "Note: New group created") + (setq entry + (gnus-gethash (gnus-group-prefixed-name + (gnus-group-real-name (gnus-info-group info)) + (or (gnus-info-method info) gnus-select-method)) + gnus-newsrc-hashtb)))) + ;; Whether it was a new group or not, we now have the entry, so we + ;; can do the update. + (if entry + (progn + (setcar (nthcdr 2 entry) info) + (when (and (not (eq (car entry) t)) + (gnus-active (gnus-info-group info))) + (setcar entry (length (gnus-list-of-unread-articles (car info)))))) + (error "No such group: %s" (gnus-info-group info)))))) (defun gnus-group-set-method-info (group select-method) (gnus-group-set-info select-method group 'method)) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 8be2d2b..ad27d85 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -100,14 +100,6 @@ the second with the current group name.") (defvar gnus-posting-styles nil "*Alist of styles to use when posting.") -(defvar gnus-posting-style-alist - '((organization . message-user-organization) - (signature . message-signature) - (signature-file . message-signature-file) - (address . user-mail-address) - (name . user-full-name)) - "*Mapping from style parameters to variables.") - (defcustom gnus-group-posting-charset-alist '(("^no\\." iso-8859-1) (message-this-is-mail nil) @@ -984,6 +976,10 @@ this is a reply." (save-excursion (nnheader-set-temp-buffer " *acc*") (insert-buffer-substring cur) + (message-encode-message-body) + (save-restriction + (message-narrow-to-headers) + (mail-encode-encoded-word-buffer)) (goto-char (point-min)) (when (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") @@ -1088,27 +1084,23 @@ this is a reply." ;;; Posting styles. -(defvar gnus-message-style-insertions nil) - (defun gnus-configure-posting-styles () "Configure posting styles according to `gnus-posting-styles'." (unless gnus-inhibit-posting-styles - (let ((styles gnus-posting-styles) - (gnus-newsgroup-name (or gnus-newsgroup-name "")) - style match variable attribute value value-value) - (make-local-variable 'gnus-message-style-insertions) + (let ((group (or gnus-newsgroup-name "")) + (styles gnus-posting-styles) + style match variable attribute value v styles results + filep name address element) ;; If the group has a posting-style parameter, add it at the end with a ;; regexp matching everything, to be sure it takes precedence over all ;; the others. - (unless (zerop (length gnus-newsgroup-name)) - (let ((tmp-style (gnus-group-find-parameter - gnus-newsgroup-name 'posting-style t))) + (when gnus-newsgroup-name + (let ((tmp-style (gnus-group-find-parameter group 'posting-style t))) (when tmp-style (setq styles (append styles (list (cons ".*" tmp-style))))))) ;; Go through all styles and look for matches. - (while styles - (setq style (pop styles) - match (pop style)) + (dolist (style styles) + (setq match (pop style)) (when (cond ((stringp match) ;; Regexp string match on the group name. @@ -1126,59 +1118,85 @@ this is a reply." ;; This is a form to be evaled. (eval match))) ;; We have a match, so we set the variables. - (while style - (setq attribute (pop style) - value (cadr attribute) - variable nil) - ;; We find the variable that is to be modified. - (if (and (not (stringp (car attribute))) - (not (eq 'body (car attribute))) - (not (setq variable - (cdr (assq (car attribute) - gnus-posting-style-alist))))) - (message "Couldn't find attribute %s" (car attribute)) - ;; We get the value. - (setq value-value + (dolist (attribute style) + (setq element (pop attribute) + variable nil + filep nil) + (setq value + (cond + ((eq (car attribute) :file) + (setq filep t) + (cadr attribute)) + ((eq (car attribute) :value) + (cadr attribute)) + (t + (car attribute)))) + ;; We get the value. + (setq v + (cond + ((stringp value) + value) + ((or (symbolp value) + (gnus-functionp value)) + (cond ((gnus-functionp value) + (funcall value)) + ((boundp value) + (symbol-value value)))) + ((listp value) + (eval value)))) + ;; Translate obsolescent value. + (when (eq element 'signature-file) + (setq element 'signature + filep t)) + ;; Get the contents of file elems. + (when filep + (setq v (with-temp-buffer + (insert-file-contents v) + (buffer-string)))) + (setq results (delq (assoc element results) results)) + (push (cons element + v) results)))) + ;; Now we have all the styles, so we insert them. + (setq name (assq 'name results) + address (assq 'address results)) + (setq results (delq name (delq address results))) + (make-local-variable 'message-setup-hook) + (dolist (result results) + (when (cdr result) + (add-hook 'message-setup-hook (cond - ((stringp value) - value) - ((or (symbolp value) - (gnus-functionp value)) - (cond ((gnus-functionp value) - (funcall value)) - ((boundp value) - (symbol-value value)))) - ((listp value) - (eval value)))) - (if variable - ;; This is an ordinary variable. - (set (make-local-variable variable) value-value) - ;; This is either a body or a header to be inserted in the - ;; message. - (let ((attr (car attribute))) - (make-local-variable 'message-setup-hook) - (if (eq 'body attr) - (add-hook 'message-setup-hook - `(lambda () - (save-excursion - (message-goto-body) - (insert ,value-value)))) - (add-hook 'message-setup-hook - 'gnus-message-insert-stylings) - (push (cons (if (stringp attr) attr - (symbol-name attr)) - value-value) - gnus-message-style-insertions))))))))))) - -(defun gnus-message-insert-stylings () - (let (val) - (save-excursion - (while (setq val (pop gnus-message-style-insertions)) - (when (cdr val) - (message-remove-header (car val)) - (message-goto-eoh) - (insert (car val) ": " (cdr val) "\n")) - (gnus-pull (car val) gnus-message-style-insertions t))))) + ((eq 'body (car result)) + `(lambda () + (save-excursion + (message-goto-body) + (insert ,(cdr result))))) + ((eq 'signature (car result)) + (set (make-local-variable 'message-signature) nil) + (set (make-local-variable 'message-signature-file) nil) + `(lambda () + (save-excursion + (let ((message-signature ,(cdr result))) + (message-insert-signature))))) + (t + (let ((header + (if (symbolp (car result)) + (capitalize (symbol-name (car result))) + (car result)))) + `(lambda () + (save-excursion + (message-remove-header ,header) + (message-goto-eoh) + (insert ,header ": " ,(cdr result) "\n"))))))))) + (when (or name address) + (add-hook 'message-setup-hook + `(lambda () + (let ((user-full-name ,(or (cdr name) user-full-name)) + (user-mail-address + ,(or (cdr address) user-mail-address))) + (save-excursion + (message-remove-header "From") + (message-goto-eoh) + (insert "From: " (message-make-from) "\n"))))))))) ;;; Allow redefinition of functions. diff --git a/lisp/gnus-range.el b/lisp/gnus-range.el index 14b6f49..1964880 100644 --- a/lisp/gnus-range.el +++ b/lisp/gnus-range.el @@ -227,18 +227,17 @@ Note: LIST has to be sorted over `<'." (defun gnus-remove-from-range (range1 range2) "Return a range that has all articles from RANGE2 removed from RANGE1. The returned range is always a list. RANGE2 can also be a -unsorted list of articles." +unsorted list of articles. RANGE1 is modified by side effects, RANGE2 +is not modified." (if (or (null range1) (null range2)) range1 (let (out r1 r2 r1_min r1_max r2_min r2_max - (range1 range1) - (range2 (if (listp (cdr range2)) - (sort range2 (lambda (e1 e2) - (< (if (consp e1) (car e1) e1) - (if (consp e2) (car e2) e2)))) - range2))) + (range2 (gnus-copy-sequence range2))) (setq range1 (if (listp (cdr range1)) range1 (list range1)) - range2 (if (listp (cdr range2)) range2 (list range2)) + range2 (sort (if (listp (cdr range2)) range2 (list range2)) + (lambda (e1 e2) + (< (if (consp e1) (car e1) e1) + (if (consp e2) (car e2) e2)))) r1 (car range1) r2 (car range2) r1_min (if (consp r1) (car r1) r1) diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index f859220..f45c011 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -631,15 +631,15 @@ used as score." (setq extra (and gnus-extra-headers (equal (nth 1 entry) "extra") - (intern ; need symbol + (intern ; need symbol (gnus-completing-read (symbol-name (car gnus-extra-headers)) ; default response - "Score extra header:" ; prompt - (mapcar (lambda (x) ; completion list + "Score extra header:" ; prompt + (mapcar (lambda (x) ; completion list (cons (symbol-name x) x)) gnus-extra-headers) - nil ; no completion limit - t)))) ; require match + nil ; no completion limit + t)))) ; require match ;; extra is now nil or a symbol. ;; We have all the data, so we enter this score. diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 45d87a1..4830d43 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -2499,6 +2499,8 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-message 5 "Reading descriptions file via %s..." (car method)) (cond + ((null (gnus-get-function method 'request-list-newsgroups t)) + t) ((not (gnus-check-server method)) (gnus-message 1 "Couldn't open server") nil) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index c92f080..0445367 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -819,6 +819,17 @@ default charset will be used instead." :type '(repeat symbol) :group 'gnus-charset) +(defcustom gnus-group-highlight-words-alist nil + "Alist of group regexps and highlight regexps. +This variable uses the same syntax as `gnus-emphasis-alist'." + :type '(repeat (cons (regexp :tag "Group") + (repeat (list (regexp :tag "Highlight regexp") + (number :tag "Group for entire word" 0) + (number :tag "Group for displayed part" 0) + (symbol :tag "Face" + gnus-emphasis-highlight-words))))) + :group 'gnus-summary-visual) + ;;; Internal variables (defvar gnus-article-mime-handles nil) @@ -1008,6 +1019,7 @@ variable (string, integer, character, etc).") (defvar gnus-last-article nil) (defvar gnus-newsgroup-history nil) (defvar gnus-newsgroup-charset nil) +(defvar gnus-newsgroup-emphasis-alist nil) (defconst gnus-summary-local-variables '(gnus-newsgroup-name @@ -1041,7 +1053,7 @@ variable (string, integer, character, etc).") gnus-cache-removable-articles gnus-newsgroup-cached gnus-newsgroup-data gnus-newsgroup-data-reverse gnus-newsgroup-limit gnus-newsgroup-limits - gnus-newsgroup-charset) + gnus-newsgroup-charset gnus-newsgroup-emphasis-alist) "Variables that are buffer-local to the summary buffers.") ;; Byte-compiler warning. @@ -1376,6 +1388,7 @@ increase the score of each group you read." "T" gnus-summary-limit-include-thread "d" gnus-summary-limit-exclude-dormant "t" gnus-summary-limit-to-age + "x" gnus-summary-limit-to-extra "E" gnus-summary-limit-include-expunged "c" gnus-summary-limit-exclude-childless-dormant "C" gnus-summary-limit-mark-excluded-as-read) @@ -1451,7 +1464,8 @@ increase the score of each group you read." "T" gnus-summary-refer-thread "g" gnus-summary-show-article "s" gnus-summary-isearch-article - "P" gnus-summary-print-article) + "P" gnus-summary-print-article + "t" gnus-article-babel) (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map) "b" gnus-article-add-buttons @@ -1689,6 +1703,7 @@ increase the score of each group you read." ("Cache" ["Enter article" gnus-cache-enter-article t] ["Remove article" gnus-cache-remove-article t]) + ["Translate" gnus-article-babel t] ["Select article buffer" gnus-summary-select-article-buffer t] ["Enter digest buffer" gnus-summary-enter-digest-group t] ["Isearch article..." gnus-summary-isearch-article t] @@ -1779,6 +1794,7 @@ increase the score of each group you read." ["Subject..." gnus-summary-limit-to-subject t] ["Author..." gnus-summary-limit-to-author t] ["Age..." gnus-summary-limit-to-age t] + ["Extra..." gnus-summary-limit-to-extra t] ["Score" gnus-summary-limit-to-score t] ["Unread" gnus-summary-limit-to-unread t] ["Non-dormant" gnus-summary-limit-exclude-dormant t] @@ -2423,7 +2439,8 @@ marks of articles." (gac gnus-article-current) (reffed gnus-reffed-article-number) (score-file gnus-current-score-file) - (default-charset gnus-newsgroup-charset)) + (default-charset gnus-newsgroup-charset) + (emphasis-alist gnus-newsgroup-emphasis-alist)) (save-excursion (set-buffer gnus-group-buffer) (setq gnus-newsgroup-name name @@ -2437,7 +2454,8 @@ marks of articles." gnus-original-article-buffer original gnus-reffed-article-number reffed gnus-current-score-file score-file - gnus-newsgroup-charset default-charset) + gnus-newsgroup-charset default-charset + gnus-newsgroup-emphasis-alist emphasis-alist) ;; The article buffer also has local variables. (when (gnus-buffer-live-p gnus-article-buffer) (set-buffer gnus-article-buffer) @@ -4018,6 +4036,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq gnus-newsgroup-unselected nil) (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group)) (gnus-summary-setup-default-charset) + (gnus-summary-setup-highlight-words) ;; Adjust and set lists of article marks. (when info @@ -4289,27 +4308,24 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq arts (cdr arts))) (setq list (cdr all))))) - (when (gnus-check-backend-function 'request-set-mark - gnus-newsgroup-name) - ;; uncompressed:s are not proper flags (they are cons cells) - ;; cache is a internal gnus flag - (unless (memq (cdr type) (cons 'cache uncompressed)) - (let* ((old (cdr (assq (cdr type) (gnus-info-marks info)))) - (list (gnus-compress-sequence (sort list '<))) - (del (gnus-remove-from-range old list)) - (add (gnus-remove-from-range list old))) - (if add - (push (list add 'add (list (cdr type))) delta-marks)) - (if del - (push (list del 'del (list (cdr type))) delta-marks))))) + (or (memq (cdr type) uncompressed) + (setq list (gnus-compress-sequence (set symbol (sort list '<)) t))) + + (when (gnus-check-backend-function 'request-set-mark + gnus-newsgroup-name) + ;; uncompressed:s are not proper flags (they are cons cells) + ;; cache is a internal gnus flag + (unless (memq (cdr type) (cons 'cache uncompressed)) + (let* ((old (cdr (assq (cdr type) (gnus-info-marks info)))) + (del (gnus-remove-from-range (gnus-copy-sequence old) list)) + (add (gnus-remove-from-range (gnus-copy-sequence list) old))) + (if add + (push (list add 'add (list (cdr type))) delta-marks)) + (if del + (push (list del 'del (list (cdr type))) delta-marks))))) (when list - (push (cons (cdr type) - (if (memq (cdr type) uncompressed) list - (gnus-compress-sequence - (set symbol (sort list '<)) t))) - newmarked))) - + (push (cons (cdr type) list) newmarked))) (when delta-marks (unless (gnus-check-group gnus-newsgroup-name) @@ -4872,7 +4888,8 @@ executed with point over the summary line of the articles." `(let ((,articles (gnus-summary-work-articles ,arg))) (while ,articles (gnus-summary-goto-subject (car ,articles)) - ,@forms)))) + ,@forms + (pop ,articles))))) (put 'gnus-summary-iterate 'lisp-indent-function 1) (put 'gnus-summary-iterate 'edebug-form-spec '(form body)) @@ -6141,7 +6158,7 @@ If given a prefix, remove all limits." "Limit the summary buffer to articles that are older than (or equal) AGE days. If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to articles that are younger than AGE days." - (interactive "nTime in days: \nP") + (interactive "nLimit to articles older than (in days): \nP") (prog1 (let ((data gnus-newsgroup-data) (cutoff (days-to-time age)) @@ -6159,6 +6176,30 @@ articles that are younger than AGE days." (gnus-summary-limit (nreverse articles))) (gnus-summary-position-point))) +(defun gnus-summary-limit-to-extra (header regexp) + "Limit the summary buffer to articles that match an 'extra' header." + (interactive + (let ((header + (intern + (gnus-completing-read + (symbol-name (car gnus-extra-headers)) + "Score extra header:" + (mapcar (lambda (x) + (cons (symbol-name x) x)) + gnus-extra-headers) + nil + t)))) + (list header + (read-string (format "Limit to header %s (regexp): " header))))) + (when (not (equal "" regexp)) + (prog1 + (let ((articles (gnus-summary-find-matching + (cons 'extra header) regexp 'all))) + (unless articles + (error "Found no matches for \"%s\"" regexp)) + (gnus-summary-limit articles)) + (gnus-summary-position-point)))) + (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) (make-obsolete 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) @@ -6874,11 +6915,18 @@ in the comparisons." (let ((data (if (eq backward 'all) gnus-newsgroup-data (gnus-data-find-list (gnus-summary-article-number) (gnus-data-list backward)))) - (func `(lambda (h) (,(intern (concat "mail-header-" header)) h))) (case-fold-search (not not-case-fold)) - articles d) - (unless (fboundp (intern (concat "mail-header-" header))) - (error "%s is not a valid header" header)) + articles d func) + (if (consp header) + (if (eq (car header) 'extra) + (setq func + `(lambda (h) + (or (cdr (assq ',(cdr header) (mail-header-extra h))) + ""))) + (error "%s is an invalid header" header)) + (unless (fboundp (intern (concat "mail-header-" header))) + (error "%s is not a valid header" header)) + (setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))) (while data (setq d (car data)) (and (or (not unread) ; We want all articles... @@ -7233,10 +7281,6 @@ and `request-accept' functions." (when gnus-use-cache (gnus-cache-possibly-enter-article to-group to-article - (let ((header (copy-sequence - (gnus-summary-article-header article)))) - (mail-header-set-number header to-article) - header) (memq article gnus-newsgroup-marked) (memq article gnus-newsgroup-dormant) (memq article gnus-newsgroup-unreads))) @@ -7904,7 +7948,6 @@ returned." (save-excursion (gnus-cache-possibly-enter-article gnus-newsgroup-name article - (gnus-summary-article-header article) (= mark gnus-ticked-mark) (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) @@ -7950,7 +7993,6 @@ marked." (save-excursion (gnus-cache-possibly-enter-article gnus-newsgroup-name article - (gnus-summary-article-header article) (= mark gnus-ticked-mark) (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) @@ -8793,11 +8835,8 @@ save those articles instead." (and (boundp group) (symbol-name group) (symbol-value group) - (memq 'respool - (assoc (symbol-name - (car (gnus-find-method-for-group - (symbol-name group)))) - gnus-valid-select-methods)))) + (gnus-get-function (gnus-find-method-for-group + (symbol-name group)) 'request-accept-article t))) (defun gnus-read-move-group-name (prompt default articles prefix) "Read a group name." @@ -8848,6 +8887,40 @@ save those articles instead." (error "No such group: %s" to-newsgroup))) to-newsgroup)) +(defun gnus-summary-save-parts (type dir n reverse) + "Save parts matching TYPE to DIR. +If REVERSE, save parts that do not match TYPE." + (interactive + (list (read-string "Save parts of type: " "image/.*") + (read-file-name "Save to directory: " t nil t) + current-prefix-arg)) + (gnus-summary-iterate n + (let ((gnus-display-mime-function nil) + (gnus-inhibit-treatment t)) + (gnus-summary-select-article)) + (save-excursion + (set-buffer gnus-article-buffer) + (let ((handles (or (mm-dissect-buffer) (mm-uu-dissect)))) + (when handles + (gnus-summary-save-parts-1 type dir handles reverse)))))) + +(defun gnus-summary-save-parts-1 (type dir handle reverse) + (if (stringp (car handle)) + (mapcar (lambda (h) (gnus-summary-save-parts-1 type dir h reverse)) + (cdr handle)) + (when (if reverse + (not (string-match type (car (mm-handle-type handle)))) + (string-match type (car (mm-handle-type handle)))) + (let ((file (expand-file-name + (file-name-nondirectory + (or + (mail-content-type-get + (mm-handle-disposition handle) 'filename) + (concat gnus-newsgroup-name "." gnus-current-article))) + dir))) + (unless (file-exists-p file) + (mm-save-part-to-file handle file)))))) + ;; Summary extract commands (defun gnus-summary-insert-pseudos (pslist &optional not-view) @@ -9351,6 +9424,25 @@ returned." (gnus-set-mode-line 'summary) n)) +;; Added by Shenghuo Zhu +(defun gnus-summary-setup-highlight-words (&optional highlight-words) + "Setup newsgroup emphasis alist." + (let ((name (and gnus-newsgroup-name + (gnus-group-real-name gnus-newsgroup-name)))) + (setq gnus-newsgroup-emphasis-alist + (nconc + (let ((alist gnus-group-highlight-words-alist) elem highlight) + (while (setq elem (pop alist)) + (when (and name (string-match (car elem) name)) + (setq alist nil + highlight (copy-list (cdr elem))))) + highlight) + (copy-list highlight-words) + (if gnus-newsgroup-name + (copy-list (gnus-group-find-parameter + gnus-newsgroup-name 'highlight-words t))) + gnus-emphasis-alist)))) + (gnus-summary-make-all-marking-commands) (gnus-ems-redefine) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 47891ca..0c22d41 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -797,73 +797,55 @@ ARG is passed to the first function." ;;; .netrc and .authinforc parsing ;;; -(defvar gnus-netrc-syntax-table - (let ((table (copy-syntax-table text-mode-syntax-table))) - (modify-syntax-entry ?@ "w" table) - (modify-syntax-entry ?- "w" table) - (modify-syntax-entry ?_ "w" table) - (modify-syntax-entry ?! "w" table) - (modify-syntax-entry ?. "w" table) - (modify-syntax-entry ?, "w" table) - (modify-syntax-entry ?: "w" table) - (modify-syntax-entry ?\; "w" table) - (modify-syntax-entry ?% "w" table) - (modify-syntax-entry ?) "w" table) - (modify-syntax-entry ?( "w" table) - table) - "Syntax table when parsing .netrc files.") - (defun gnus-parse-netrc (file) "Parse FILE and return an list of all entries in the file." - (if (not (file-exists-p file)) - () - (save-excursion + (when (file-exists-p file) + (with-temp-buffer (let ((tokens '("machine" "default" "login" "password" "account" "macdef" "force")) alist elem result pair) - (nnheader-set-temp-buffer " *netrc*") - (unwind-protect - (progn - (set-syntax-table gnus-netrc-syntax-table) - (insert-file-contents file) - (goto-char (point-min)) - ;; Go through the file, line by line. - (while (not (eobp)) - (narrow-to-region (point) (gnus-point-at-eol)) - ;; For each line, get the tokens and values. - (while (not (eobp)) - (skip-chars-forward "\t ") - (unless (eobp) - (setq elem (buffer-substring - (point) (progn (forward-sexp 1) (point)))) - (cond - ((equal elem "macdef") - ;; We skip past the macro definition. - (widen) - (while (and (zerop (forward-line 1)) - (looking-at "$"))) - (narrow-to-region (point) (point))) - ((member elem tokens) - ;; Tokens that don't have a following value are ignored, - ;; except "default". - (when (and pair (or (cdr pair) - (equal (car pair) "default"))) - (push pair alist)) - (setq pair (list elem))) - (t - ;; Values that haven't got a preceding token are ignored. - (when pair - (setcdr pair elem) - (push pair alist) - (setq pair nil)))))) - (if alist - (push (nreverse alist) result)) - (setq alist nil - pair nil) - (widen) - (forward-line 1)) - (nreverse result)) - (kill-buffer " *netrc*")))))) + (insert-file-contents file) + (goto-char (point-min)) + ;; Go through the file, line by line. + (while (not (eobp)) + (narrow-to-region (point) (gnus-point-at-eol)) + ;; For each line, get the tokens and values. + (while (not (eobp)) + (skip-chars-forward "\t ") + ;; Skip lines that begin with a "#". + (if (eq (char-after) ?#) + (goto-char (point-max)) + (unless (eobp) + (setq elem (buffer-substring + (point) (progn (skip-chars-forward "^\t ") + (point)))) + (cond + ((equal elem "macdef") + ;; We skip past the macro definition. + (widen) + (while (and (zerop (forward-line 1)) + (looking-at "$"))) + (narrow-to-region (point) (point))) + ((member elem tokens) + ;; Tokens that don't have a following value are ignored, + ;; except "default". + (when (and pair (or (cdr pair) + (equal (car pair) "default"))) + (push pair alist)) + (setq pair (list elem))) + (t + ;; Values that haven't got a preceding token are ignored. + (when pair + (setcdr pair elem) + (push pair alist) + (setq pair nil))))))) + (when alist + (push (nreverse alist) result)) + (setq alist nil + pair nil) + (widen) + (forward-line 1)) + (nreverse result))))) (defun gnus-netrc-machine (list machine) "Return the netrc values from LIST for MACHINE or for the default entry." diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index 387d178..2380ecb 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -58,8 +58,8 @@ '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed 's/\r$//'") ("\\.pas$" "cat %s | sed 's/\r$//'") ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g") - ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv") - ("\\.tga$" "tgatoppm %s | xv -") + ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "display") + ("\\.tga$" "tgatoppm %s | ee -") ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$" "sox -v .5 %s -t .au -u - > /dev/audio") ("\\.au$" "cat %s > /dev/audio") @@ -369,7 +369,8 @@ didn't work, and overwrite existing files. Otherwise, ask each time." "k" gnus-summary-kill-process-mark "y" gnus-summary-yank-process-mark "w" gnus-summary-save-process-mark - "i" gnus-uu-invert-processable) + "i" gnus-uu-invert-processable + "m" gnus-summary-save-parts) (gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map) ;;"x" gnus-uu-extract-any @@ -1398,7 +1399,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." ;; We replace certain characters that could make things messy. (setq gnus-uu-file-name (let ((nnheader-file-name-translation-alist - '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) + '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) (nnheader-translate-file-chars (match-string 1)))) (replace-match (concat "begin 644 " gnus-uu-file-name) t t) diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 773aef7..daa7b8d 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -77,7 +77,7 @@ automatically." (if (or (featurep 'xface) (featurep 'xpm)) 'gnus-xmas-article-display-xface - "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -") + "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -") "*String or function to be executed to display an X-Face header. If it is a string, the command will be executed in a sub-shell asynchronously. The compressed face will be piped to this command." diff --git a/lisp/gnus.el b/lisp/gnus.el index 5fc357c..4eb6be2 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -260,7 +260,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.84" +(defconst gnus-version-number "0.86" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) @@ -2455,12 +2455,14 @@ You should probably use `gnus-find-method-for-group' instead." (defun gnus-method-simplify (method) "Return the shortest uniquely identifying string or method for METHOD." - (cond ((gnus-native-method-p method) - nil) - ((gnus-secondary-method-p method) - (format "%s:%s" (nth 0 method) (nth 1 method))) - (t - method))) + (cond ((stringp method) + method) + ((gnus-native-method-p method) + nil) + ((gnus-secondary-method-p method) + (format "%s:%s" (nth 0 method) (nth 1 method))) + (t + method))) (defun gnus-groups-from-server (server) "Return a list of all groups that are fetched from SERVER." diff --git a/lisp/lpath.el b/lisp/lpath.el index d1e9a66..4b89027 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -37,26 +37,31 @@ find-charset-region find-coding-systems-region get-charset-property coding-system-get w3-region + w3-coding-system-for-mime-charset rmail-summary-exists rmail-select-summary rmail-update-summary url-retrieve - temp-directory + temp-directory babel-fetch babel-wash )) (maybe-bind '(global-face-data mark-active transient-mark-mode mouse-selection-click-count mouse-selection-click-count-buffer buffer-display-table font-lock-defaults user-full-name user-login-name gnus-newsgroup-name gnus-article-x-face-too-ugly - gnus-newsgroup-charset + gnus-newsgroup-charset gnus-newsgroup-emphasis-alist mail-mode-hook enable-multibyte-characters adaptive-fill-first-line-regexp adaptive-fill-regexp url-current-mime-headers buffer-file-coding-system w3-image-mappings url-current-mime-type + w3-meta-content-type-charset-regexp + w3-meta-charset-content-type-regexp url-current-callback-func url-current-callback-data - url-be-asynchronous temporary-file-directory))) + url-be-asynchronous temporary-file-directory + babel-translations babel-history))) (maybe-bind '(mail-mode-hook enable-multibyte-characters browse-url-browser-function adaptive-fill-first-line-regexp adaptive-fill-regexp - url-current-mime-headers help-echo-owns-message)) + url-current-mime-headers help-echo-owns-message + babel-translations babel-history)) (maybe-fbind '(color-instance-rgb-components temp-directory glyph-width annotation-glyph window-pixel-width glyph-height window-pixel-height @@ -78,9 +83,10 @@ annotationp delete-annotation make-image-specifier make-annotation w3-do-setup w3-region + w3-coding-system-for-mime-charset rmail-summary-exists rmail-select-summary rmail-update-summary url-generic-parse-url valid-image-instantiator-format-p - ))) + babel-fetch babel-wash))) (setq load-path (cons "." load-path)) (require 'custom) diff --git a/lisp/mail-source.el b/lisp/mail-source.el index acd758c..777e504 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -181,7 +181,7 @@ Return the number of files that were found." (funcall function source callback) (error (unless (yes-or-no-p - (format "Mail source error. Continue? ")) + (format "Mail source error (%s). Continue? " err)) (error "Cannot get new mail.")) 0)))))) @@ -202,19 +202,19 @@ Pass INFO on to CALLBACK." (when (file-exists-p mail-source-crash-box) (delete-file mail-source-crash-box)) 0) - (funcall callback mail-source-crash-box info) - (when (file-exists-p mail-source-crash-box) - ;; Delete or move the incoming mail out of the way. - (if mail-source-delete-incoming - (delete-file mail-source-crash-box) - (let ((incoming - (mail-source-make-complex-temp-name - (expand-file-name - "Incoming" mail-source-directory)))) - (unless (file-exists-p (file-name-directory incoming)) - (make-directory (file-name-directory incoming) t)) - (rename-file mail-source-crash-box incoming t)))) - 1)) + (prog1 + (funcall callback mail-source-crash-box info) + (when (file-exists-p mail-source-crash-box) + ;; Delete or move the incoming mail out of the way. + (if mail-source-delete-incoming + (delete-file mail-source-crash-box) + (let ((incoming + (mail-source-make-complex-temp-name + (expand-file-name + "Incoming" mail-source-directory)))) + (unless (file-exists-p (file-name-directory incoming)) + (make-directory (file-name-directory incoming) t)) + (rename-file mail-source-crash-box incoming t))))))) (defun mail-source-movemail (from to) "Move FROM to TO using movemail." @@ -302,6 +302,14 @@ If ARGS, PROMPT is used as an argument to `format'." (zerop (call-process shell-file-name nil nil nil shell-command-switch program))) +(defun mail-source-call-script (script) + (let ((background nil)) + (when (string-match "& *$" script) + (setq script (substring script 0 (match-beginning 0)) + background 0)) + (call-process shell-file-name nil background nil + shell-command-switch script))) + ;;; ;;; Different fetchers ;;; @@ -312,11 +320,9 @@ If ARGS, PROMPT is used as an argument to `format'." (when prescript (if (and (symbolp prescript) (fboundp prescript)) (funcall prescript) - (call-process shell-file-name nil nil nil - shell-command-switch - (format-spec - prescript - (format-spec-make ?t mail-source-crash-box))))) + (mail-source-call-script + (format-spec + prescript (format-spec-make ?t mail-source-crash-box))))) (let ((mail-source-string (format "file:%s" path))) (if (mail-source-movemail path mail-source-crash-box) (prog1 @@ -324,11 +330,9 @@ If ARGS, PROMPT is used as an argument to `format'." (when prescript (if (and (symbolp prescript) (fboundp prescript)) (funcall prescript) - (call-process shell-file-name nil nil nil - shell-command-switch - (format-spec - postscript - (format-spec-make ?t mail-source-crash-box)))))) + (mail-source-call-script + (format-spec + postscript (format-spec-make ?t mail-source-crash-box)))))) 0)))) (defun mail-source-fetch-directory (source callback) @@ -351,12 +355,10 @@ If ARGS, PROMPT is used as an argument to `format'." (if (and (symbolp prescript) (fboundp prescript)) (funcall prescript) - (call-process shell-file-name nil 0 nil - shell-command-switch - (format-spec - prescript - (format-spec-make ?p password ?t mail-source-crash-box - ?s server ?P port ?u user))))) + (mail-source-call-script + (format-spec + prescript (format-spec-make ?p password ?t mail-source-crash-box + ?s server ?P port ?u user))))) (let ((from (format "%s:%s:%s" server user port)) (mail-source-string (format "pop:%s@%s" user server)) result) @@ -392,17 +394,15 @@ If ARGS, PROMPT is used as an argument to `format'." (if result (prog1 (mail-source-callback callback server) - (when prescript + (when postscript (if (and (symbolp postscript) (fboundp postscript)) - (funcall prescript) - (call-process shell-file-name nil 0 nil - shell-command-switch - (format-spec - postscript - (format-spec-make - ?p password ?t mail-source-crash-box - ?s server ?P port ?u user)))))) + (funcall postscript) + (mail-source-call-script + (format-spec + postscript (format-spec-make + ?p password ?t mail-source-crash-box + ?s server ?P port ?u user)))))) ;; We nix out the password in case the error ;; was because of a wrong password being given. (setq mail-source-password-cache diff --git a/lisp/mailcap.el b/lisp/mailcap.el index 9a4df73..b576100 100644 --- a/lisp/mailcap.el +++ b/lisp/mailcap.el @@ -133,22 +133,22 @@ (viewer . mm-view-message) (test . (and (featurep 'gnus) (gnus-alive-p))) - (type . "message/rfc-822")) + (type . "message/rfc822")) ("rfc-*822" (viewer . vm-mode) (test . (fboundp 'vm-mode)) - (type . "message/rfc-822")) + (type . "message/rfc822")) ("rfc-*822" (viewer . w3-mode) (test . (fboundp 'w3-mode)) - (type . "message/rfc-822")) + (type . "message/rfc822")) ("rfc-*822" (viewer . view-mode) (test . (fboundp 'view-mode)) - (type . "message/rfc-822")) + (type . "message/rfc822")) ("rfc-*822" (viewer . fundamental-mode) - (type . "message/rfc-822"))) + (type . "message/rfc822"))) ("image" ("x-xwd" (viewer . "xwud -in %s") @@ -181,11 +181,6 @@ (viewer . "ee %s") (type . "image/*") (test . (eq (mm-device-type) 'x)) - ("needsx11")) - (".*" - (viewer . "xv -perfect %s") - (type . "image/*") - (test . (eq (mm-device-type) 'x)) ("needsx11"))) ("text" ("plain" diff --git a/lisp/message.el b/lisp/message.el index 6b709a7..6d8d2e3 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -862,7 +862,9 @@ The cdr of ech entry is a function for applying the face to a region.") (defvar message-draft-coding-system (cond ((not (fboundp 'coding-system-p)) nil) - ((coding-system-p 'emacs-mule) 'emacs-mule) + ((coding-system-p 'emacs-mule) + (if (string-match "nt" system-configuration) + 'emacs-mule-dos 'emacs-mule)) ((memq 'escape-quoted (mm-get-coding-system-list)) 'escape-quoted) ((coding-system-p 'no-conversion) 'no-conversion) (t nil)) @@ -2110,6 +2112,9 @@ the user from the mailer." (message-encode-message-body) (save-restriction (message-narrow-to-headers) + ;; We (re)generate the Lines header. + (when (memq 'Lines message-required-mail-headers) + (message-generate-headers '(Lines))) ;; Remove some headers. (message-remove-header message-ignored-mail-headers t) (mail-encode-encoded-word-buffer)) @@ -2288,6 +2293,9 @@ to find out how to use this." ;; Remove some headers. (save-restriction (message-narrow-to-headers) + ;; We (re)generate the Lines header. + (when (memq 'Lines message-required-mail-headers) + (message-generate-headers '(Lines))) ;; Remove some headers. (message-remove-header message-ignored-news-headers t) (let ((mail-parse-charset message-posting-charset)) diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index 79afd06..bcbd4f1 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -161,7 +161,14 @@ If no encoding was done, nil is returned." ((eq encoding 'quoted-printable) (quoted-printable-decode-region (point-min) (point-max))) ((eq encoding 'base64) - (base64-decode-region (point-min) (point-max))) + (base64-decode-region (point-min) + ;; Some mailers insert whitespace + ;; junk at the end which + ;; base64-decode-region dislikes. + (save-excursion + (goto-char (point-max)) + (skip-chars-backward "\n\t ") + (point)))) ((memq encoding '(7bit 8bit binary)) ) ((null encoding) diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 375efd6..0538fb5 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -505,28 +505,31 @@ This overrides entries in the mailcap file." (or filename name "") (or mm-default-directory default-directory)))) (setq mm-default-directory (file-name-directory file)) - (mm-with-unibyte-buffer - (mm-insert-part handle) - (when (or (not (file-exists-p file)) - (yes-or-no-p (format "File %s already exists; overwrite? " - file))) - ;; Now every coding system is 100% binary within mm-with-unibyte-buffer - ;; Is text still special? - (let ((coding-system-for-write - (if (equal "text" (car (split-string - (car (mm-handle-type handle)) "/"))) - buffer-file-coding-system - 'binary)) - ;; Don't re-compress .gz & al. Arguably we should make - ;; `file-name-handler-alist' nil, but that would chop - ;; ange-ftp which it's reasonable to use here. - (inhibit-file-name-operation 'write-region) - (inhibit-file-name-handlers - (if (equal (car (mm-handle-type handle)) - "application/octet-stream") - (cons 'jka-compr-handler inhibit-file-name-handlers) - inhibit-file-name-handlers))) - (write-region (point-min) (point-max) file)))))) + (when (or (not (file-exists-p file)) + (yes-or-no-p (format "File %s already exists; overwrite? " + file))) + (mm-save-part-to-file handle file)))) + +(defun mm-save-part-to-file (handle file) + (mm-with-unibyte-buffer + (mm-insert-part handle) + ;; Now every coding system is 100% binary within mm-with-unibyte-buffer + ;; Is text still special? + (let ((coding-system-for-write + (if (equal "text" (car (split-string + (car (mm-handle-type handle)) "/"))) + buffer-file-coding-system + 'binary)) + ;; Don't re-compress .gz & al. Arguably we should make + ;; `file-name-handler-alist' nil, but that would chop + ;; ange-ftp which it's reasonable to use here. + (inhibit-file-name-operation 'write-region) + (inhibit-file-name-handlers + (if (equal (car (mm-handle-type handle)) + "application/octet-stream") + (cons 'jka-compr-handler inhibit-file-name-handlers) + inhibit-file-name-handlers))) + (write-region (point-min) (point-max) file)))) (defun mm-pipe-part (handle) "Pipe HANDLE to a process." diff --git a/lisp/mm-view.el b/lisp/mm-view.el index b81c78b..8be8603 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -65,11 +65,21 @@ (url-standalone-mode t) (url-current-object (url-generic-parse-url (format "cid:%s" (mm-handle-id handle)))) - (width (window-width))) + (width (window-width)) + (charset (mail-content-type-get + (mm-handle-type handle) 'charset))) (save-excursion (insert text) (save-restriction (narrow-to-region b (point)) + (goto-char (point-min)) + (if (or (re-search-forward w3-meta-content-type-charset-regexp nil t) + (re-search-forward w3-meta-charset-content-type-regexp nil t)) + (setq charset (w3-coding-system-for-mime-charset + (buffer-substring-no-properties + (match-beginning 2) + (match-end 2))))) + (mm-decode-body charset) (save-window-excursion (let ((w3-strict-width width) (url-standalone-mode t)) diff --git a/lisp/mml.el b/lisp/mml.el index 70abd88..dc6266b 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -207,7 +207,7 @@ ((cdr (assq 'buffer cont)) (insert-buffer-substring (cdr (assq 'buffer cont)))) ((setq filename (cdr (assq 'filename cont))) - (insert-file-contents-literally filename)) + (insert-file-contents filename)) (t (save-restriction (narrow-to-region (point) (point)) @@ -226,7 +226,7 @@ ((cdr (assq 'buffer cont)) (insert-buffer-substring (cdr (assq 'buffer cont)))) ((setq filename (cdr (assq 'filename cont))) - (insert-file-contents-literally filename)) + (insert-file-contents filename)) (t (insert (cdr (assq 'contents cont))))) (setq encoding (mm-encode-buffer type) @@ -299,7 +299,7 @@ ((cdr (assq 'buffer cont)) (insert-buffer-substring (cdr (assq 'buffer cont)))) ((setq filename (cdr (assq 'filename cont))) - (insert-file-contents-literally filename)) + (insert-file-contents filename)) (t (insert (cdr (assq 'contents cont))))) (goto-char (point-min)) diff --git a/lisp/nndoc.el b/lisp/nndoc.el index f573b2d..fc7a6ed 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -39,7 +39,7 @@ "*Type of the file. One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward', `rfc934', `rfc822-forward', `mime-parts', `standard-digest', -`slack-digest', `clari-briefs' or `guess'.") +`slack-digest', `clari-briefs', `nsmail' or `guess'.") (defvoo nndoc-post-type 'mail "*Whether the nndoc group is `mail' or `post'.") @@ -53,6 +53,8 @@ from the document.") `((mmdf (article-begin . "^\^A\^A\^A\^A\n") (body-end . "^\^A\^A\^A\^A\n")) + (nsmail + (article-begin . "^From - ")) (news (article-begin . "^Path:")) (rnews @@ -449,7 +451,7 @@ from the document.") (when (and limit (re-search-forward (concat "\ -^Content-Type:[ \t]*multipart/[a-z]+ *;\\(\\(\n[ \t]\\)?.*;\\)*" +^Content-Type:[ \t]*multipart/[a-z]+ *; *\\(\\(\n[ \t]\\)?.*;\\)*" "\\(\n[ \t]\\)?[ \t]*boundary=\"?[^\"\n]*[^\" \t\n]") limit t)) t))) @@ -552,11 +554,14 @@ from the document.") (insert "From: " (or from "unknown") "\nSubject: " (or subject "(no subject)") "\n"))) +(defun nndoc-nsmail-type-p () + (when (looking-at "From - ") + t)) + (deffoo nndoc-request-accept-article (group &optional server last) nil) - ;;; ;;; Functions for dissecting the documents ;;; diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 8d6b254..ede54a2 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -25,17 +25,6 @@ ;;; Commentary: -;; These macros may look very much like the ones in GNUS 4.1. They -;; are, in a way, but you should note that the indices they use have -;; been changed from the internal GNUS format to the NOV format. The -;; makes it possible to read headers from XOVER much faster. -;; -;; The format of a header is now: -;; [number subject from date id references chars lines xref] -;; -;; (That last entry is defined as "misc" in the NOV format, but Gnus -;; uses it for xrefs.) - ;;; Code: (eval-when-compile (require 'cl)) @@ -67,6 +56,17 @@ on your system, you could say something like: ;;; Header access macros. +;; These macros may look very much like the ones in GNUS 4.1. They +;; are, in a way, but you should note that the indices they use have +;; been changed from the internal GNUS format to the NOV format. The +;; makes it possible to read headers from XOVER much faster. +;; +;; The format of a header is now: +;; [number subject from date id references chars lines xref extra] +;; +;; (That next-to-last entry is defined as "misc" in the NOV format, +;; but Gnus uses it for xrefs.) + (defmacro mail-header-number (header) "Return article number in HEADER." `(aref ,header 0)) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index d120169..9877077 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -514,6 +514,7 @@ If SOURCE is a directory spec, try to return the group name component." (defun nnmail-process-babyl-mail-format (func artnum-func) (let ((case-fold-search t) + (count 0) start message-id content-length do-search end) (while (not (eobp)) (goto-char (point-min)) @@ -585,8 +586,10 @@ If SOURCE is a directory spec, try to return the group name component." (narrow-to-region start (point)) (goto-char (point-min)) (nnmail-check-duplication message-id func artnum-func) + (incf count) (setq end (point-max)))) - (goto-char end)))) + (goto-char end)) + count)) (defsubst nnmail-search-unix-mail-delim () "Put point at the beginning of the next Unix mbox message." @@ -648,6 +651,7 @@ If SOURCE is a directory spec, try to return the group name component." (defun nnmail-process-unix-mail-format (func artnum-func) (let ((case-fold-search t) + (count 0) start message-id content-length end skip head-end) (goto-char (point-min)) (if (not (and (re-search-forward "^From " nil t) @@ -726,13 +730,16 @@ If SOURCE is a directory spec, try to return the group name component." (save-restriction (narrow-to-region start (point)) (goto-char (point-min)) + (incf count) (nnmail-check-duplication message-id func artnum-func) (setq end (point-max)))) - (goto-char end))))) + (goto-char end))) + count)) (defun nnmail-process-mmdf-mail-format (func artnum-func) (let ((delim "^\^A\^A\^A\^A$") (case-fold-search t) + (count 0) start message-id end) (goto-char (point-min)) (if (not (and (re-search-forward delim nil t) @@ -776,13 +783,15 @@ If SOURCE is a directory spec, try to return the group name component." (save-restriction (narrow-to-region start (point)) (goto-char (point-min)) + (incf count) (nnmail-check-duplication message-id func artnum-func) (setq end (point-max)))) (goto-char end) - (forward-line 2))))) + (forward-line 2))) + count)) (defun nnmail-process-maildir-mail-format (func artnum-func) -; In a maildir, every file contains exactly one mail + ;; In a maildir, every file contains exactly one mail. (let ((case-fold-search t) message-id) (goto-char (point-min)) @@ -803,7 +812,7 @@ If SOURCE is a directory spec, try to return the group name component." (setq message-id (match-string 1)) ;; There is no Message-ID here, so we create one. (save-excursion - (when (re-search-backward "^Message-ID[ \t]*:" nil t) + (when (re-search-backward "^Message-ID[ \t]*:" nil t) (beginning-of-line) (insert "Original-"))) (forward-line 1) @@ -812,8 +821,9 @@ If SOURCE is a directory spec, try to return the group name component." ;; Allow the backend to save the article. (widen) (save-excursion - (goto-char (point-min)) - (nnmail-check-duplication message-id func artnum-func)))) + (goto-char (point-min)) + (nnmail-check-duplication message-id func artnum-func)) + 1)) (defun nnmail-split-incoming (incoming func &optional exit-func group artnum-func) @@ -831,24 +841,26 @@ FUNC will be called with the buffer narrowed to each mail." (erase-buffer) (let ((nnheader-file-coding-system nnmail-incoming-coding-system)) (nnheader-insert-file-contents incoming)) - (unless (zerop (buffer-size)) - (goto-char (point-min)) - (save-excursion (run-hooks 'nnmail-prepare-incoming-hook)) - ;; Handle both babyl, MMDF and unix mail formats, since movemail will - ;; use the former when fetching from a mailbox, the latter when - ;; fetching from a file. - (cond ((or (looking-at "\^L") - (looking-at "BABYL OPTIONS:")) - (nnmail-process-babyl-mail-format func artnum-func)) - ((looking-at "\^A\^A\^A\^A") - (nnmail-process-mmdf-mail-format func artnum-func)) - ((looking-at "Return-Path:") - (nnmail-process-maildir-mail-format func artnum-func)) - (t - (nnmail-process-unix-mail-format func artnum-func)))) - (when exit-func - (funcall exit-func)) - (kill-buffer (current-buffer))))) + (prog1 + (if (zerop (buffer-size)) + 0 + (goto-char (point-min)) + (save-excursion (run-hooks 'nnmail-prepare-incoming-hook)) + ;; Handle both babyl, MMDF and unix mail formats, since + ;; movemail will use the former when fetching from a + ;; mailbox, the latter when fetching from a file. + (cond ((or (looking-at "\^L") + (looking-at "BABYL OPTIONS:")) + (nnmail-process-babyl-mail-format func artnum-func)) + ((looking-at "\^A\^A\^A\^A") + (nnmail-process-mmdf-mail-format func artnum-func)) + ((looking-at "Return-Path:") + (nnmail-process-maildir-mail-format func artnum-func)) + (t + (nnmail-process-unix-mail-format func artnum-func)))) + (when exit-func + (funcall exit-func)) + (kill-buffer (current-buffer)))))) (defun nnmail-article-group (func &optional trace) "Look at the headers and return an alist of groups that match. @@ -1401,7 +1413,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (incf total new) (incf i)))) ;; If we did indeed read any incoming spools, we save all info. - (unless (zerop i) + (unless (zerop new) (nnmail-save-active (nnmail-get-value "%s-group-alist" method) (nnmail-get-value "%s-active-file" method)) diff --git a/texi/ChangeLog b/texi/ChangeLog index 13df68b..2d6386b 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,23 @@ +1999-06-13 02:29:22 Lars Magne Ingebrigtsen + + * gnus.texi (MIME Commands): Addition. + (Article Miscellania): New. + (Customizing Articles): Addition. + +1999-06-12 00:13:25 Lars Magne Ingebrigtsen + + * gnus.texi (Comparing Mail Backends): Slight edits. + +1999-06-12 00:13:20 Karl Kleinpaste + + * gnus.texi (Comparing Mail Backends): New. + +1999-06-11 21:47:22 Lars Magne Ingebrigtsen + + * gnus.texi (Group Score): Doc fix. + (The Active File): Addition. + (Document Groups): Addition. + 1999-04-18 Didier Verna * gnus.texi (Article treatment): document the new variable diff --git a/texi/gnus.texi b/texi/gnus.texi index 27a9a1e..2e4af46 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,8 +1,7 @@ - -\input texinfo @c -*-texinfo-*- +@c \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Pterodactyl Gnus 0.84 Manual +@settitle Pterodactyl Gnus 0.86 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -51,6 +50,7 @@ \newcommand{\gnussc}[1]{\textsc{#1}} \newcommand{\gnustitle}[1]{{\huge\textbf{#1}}} \newcommand{\gnusauthor}[1]{{\large\textbf{#1}}} +\newcommand{\gnusresult}[1]{\gnustt{=> #1}} \newcommand{\gnusbullet}{{${\bullet}$}} \newcommand{\gnusdollar}{\$} @@ -319,7 +319,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Gnus 0.84 Manual +@title Pterodactyl Gnus 0.86 Manual @author by Lars Magne Ingebrigtsen @page @@ -355,7 +355,7 @@ can be gotten by any nefarious means you can think of---@sc{nntp}, local spool or your mbox file. All at the same time, if you want to push your luck. -This manual corresponds to Pterodactyl Gnus 0.84. +This manual corresponds to Pterodactyl Gnus 0.86. @end ifinfo @@ -993,6 +993,10 @@ support the @code{LIST ACTIVE group} command), on others this isn't fast at all. In any case, @code{some} should be faster than @code{nil}, and is certainly faster than @code{t} over slow lines. +Some news servers (Leafnode and old versions of INN, for instance) do +not support the @code{LIST ACTIVE group}. For these servers, @code{nil} +is probably the most effficient value for this variable. + If this variable is @code{nil}, Gnus will ask for group info in total lock-step, which isn't very fast. If it is @code{some} and you use an @sc{nntp} server, Gnus will pump out commands as fast as it can, and @@ -1000,6 +1004,9 @@ read all the replies in one swoop. This will normally result in better performance, but if the server does not support the aforementioned @code{LIST ACTIVE group} command, this isn't very nice to the server. +If you think that starting up Gnus takes too long, try all the three +different values for this variable and see what works best for you. + In any case, if you use @code{some} or @code{nil}, you should definitely kill all groups that you aren't interested in to speed things up. @@ -1742,13 +1749,14 @@ is somewhat restrictive. Don't you wish you could have Gnus sort the group buffer according to how often you read groups, perhaps? Within reason? -This is what @dfn{group score} is for. You can assign a score to each -group. You can then sort the group buffer based on this score. -Alternatively, you can sort on score and then level. (Taken together, -the level and the score is called the @dfn{rank} of the group. A group -that is on level 4 and has a score of 1 has a higher rank than a group -on level 5 that has a score of 300. (The level is the most significant -part and the score is the least significant part.)) +This is what @dfn{group score} is for. You can have Gnus assign a score +to each group through the mechanism described below. You can then sort +the group buffer based on this score. Alternatively, you can sort on +score and then level. (Taken together, the level and the score is +called the @dfn{rank} of the group. A group that is on level 4 and has +a score of 1 has a higher rank than a group on level 5 that has a score +of 300. (The level is the most significant part and the score is the +least significant part.)) @findex gnus-summary-bubble-group If you want groups you read often to get higher scores than groups you @@ -1928,9 +1936,9 @@ Make a group based on some file or other command, you will be prompted for a file name and a file type. Currently supported types are @code{babyl}, @code{mbox}, @code{digest}, @code{mmdf}, @code{news}, @code{rnews}, @code{clari-briefs}, -@code{rfc934}, @code{rfc822-forward}, and @code{forward}. If you run -this command without a prefix, Gnus will guess at the file type. -@xref{Document Groups}. +@code{rfc934}, @code{rfc822-forward}, @code{nsmail} and @code{forward}. +If you run this command without a prefix, Gnus will guess at the file +type. @xref{Document Groups}. @item G u @kindex G u (Group) @@ -4685,6 +4693,13 @@ Limit the summary buffer to articles that match some subject Limit the summary buffer to articles that match some author (@code{gnus-summary-limit-to-author}). +@item / x +@kindex / x (Summary) +@findex gnus-summary-limit-to-extra +Limit the summary buffer to articles that match one of the ``extra'' +headers (@pxref{To From Newsgroups}) +(@code{gnus-summary-limit-to-author}). + @item / u @itemx x @kindex / u (Summary) @@ -6286,6 +6301,7 @@ these articles easier. * Article Buttons:: Click on URLs, Message-IDs, addresses and the like. * Article Date:: Grumble, UT! * Article Signature:: What is a signature? +* Article Miscellania:: Various other stuff. @end menu @@ -6444,6 +6460,13 @@ say something like: (copy-face 'red 'gnus-emphasis-italic) @end lisp +@vindex gnus-group-highlight-words-alist + +If you want to highlight arbitrary words, you can use the +@code{gnus-group-highlight-words-alist} variable, which uses the same +syntax as @code{gnus-emphasis-alist}. The @code{highlight-words} group +parameter (@pxref{Group Parameters}) can also be used. + @xref{Customizing Articles}, for how to fontize articles automatically. @@ -7024,11 +7047,31 @@ the regular expression @samp{^---*Forwarded article}, then it isn't a signature after all. +@node Article Miscellania +@subsection Article Miscellania + +@table @kbd +@item A t +@kindex A t (Summary) +@findex gnus-article-babel +Translate the article from one language to another +(@code{gnus-article-babel}). + +@end table + + @node MIME Commands -@section MIME Commands +@section @sc{mime} Commands @cindex MIME decoding @table @kbd +@item X m +@kindex X m (Summary) +@findex gnus-summary-save-parts +Save all parts matching a @sc{mime} type to a directory +(@code{gnus-summary-save-parts}). Understands the process/prefix +convention (@pxref{Process/Prefix}). + @item M-t @kindex M-t (Summary) @findex gnus-summary-display-buttonized @@ -8325,6 +8368,8 @@ to look at you disdainfully, and you'll feel rather stupid.) Any similarity to real events and people is purely coincidental. Ahem. +Also see @pxref{MIME Commands}. + @node Customizing Articles @section Customizing Articles @@ -8357,7 +8402,12 @@ An integer: Do this treatment on all body parts that have a length less than this number. @item -A list: +A list of strings: Do this treatment on all body parts that are in +articles that are read in groups that have names that match one of the +regexps in the list. + +@item +A list where the first element is not a string: The list is evaluated recursively. The first element of the list is a predicate. The following predicates are recognized: @code{or}, @@ -8416,6 +8466,10 @@ group. @item gnus-treat-display-xface @item gnus-treat-display-smileys @item gnus-treat-display-picons +@item gnus-treat-capitalize-sentences +@item gnus-treat-fill-long-lines +@item gnus-treat-play-sounds +@item gnus-treat-translate @end table @vindex gnus-part-display-hook @@ -10849,6 +10903,7 @@ backends are available separately. The mail backend most people use * Mail Spool:: Store your mail in a private spool? * MH Spool:: An mhspool-like backend. * Mail Folders:: Having one file for each group. +* Comparing Mail Backends:: An in-depth looks at pros and cons. @end menu @@ -11078,6 +11133,127 @@ command to make @code{nnfolder} aware of all likely files in @code{nnfolder-directory}. This only works if you use long file names, though. +@node Comparing Mail Backends +@subsubsection Comparing Mail Backends + +First, just for terminology, the @dfn{backend} is the common word for a +low-level access method---a transport, if you will, by which something +is acquired. The sense is that one's mail has to come from somewhere, +and so selection of a suitable backend is required in order to get that +mail within spitting distance of Gnus. + +The same concept exists for Usenet itself: Though access to articles is +typically done by NNTP these days, once upon a midnight dreary, everyone +in the world got at Usenet by running a reader on the machine where the +articles lay (the machine which today we call an NNTP server), and +access was by the reader stepping into the articles' directory spool +area directly. One can still select between either the @code{nntp} or +@code{nnspool} backends, to select between these methods, if one happens +actually to live on the server (or can see its spool directly, anyway, +via NFS). + +The goal in selecting a mail backend is to pick one which +simultaneously represents a suitable way of dealing with the original +format plus leaving mail in a form that is convenient to use in the +future. Here are some high and low points on each: + +@table @code +@item nnmbox + +UNIX systems have historically had a single, very common, and well- +defined format. All messages arrive in a single @dfn{spool file}, and +they are delineated by a line whose regular expression matches +@samp{^From_}. (My notational use of @samp{_} is to indicate a space, +to make it clear in this instance that this is not the RFC-specified +@samp{From:} header.) Because Emacs and therefore Gnus emanate +historically from the Unix environment, it is simplest if one does not +mess a great deal with the original mailbox format, so if one chooses +this backend, Gnus' primary activity in getting mail from the real spool +area to Gnus' preferred directory is simply to copy it, with no +(appreciable) format change in the process. It is the ``dumbest'' way +to move mail into availability in the Gnus environment. This makes it +fast to move into place, but slow to parse, when Gnus has to look at +what's where. + +@item nnbabyl + +Once upon a time, there was the DEC-10 and DEC-20, running operating +systems called TOPS and related things, and the usual (only?) mail +reading environment was a thing called Babyl. I don't know what format +was used for mail landing on the system, but Babyl had its own internal +format to which mail was converted, primarily involving creating a +spool-file-like entity with a scheme for inserting Babyl-specific +headers and status bits above the top of each message in the file. +RMAIL was Emacs' first mail reader, it was written by Richard Stallman, +and Stallman came out of that TOPS/Babyl environment, so he wrote RMAIL +to understand the mail files folks already had in existence. Gnus (and +VM, for that matter) continue to support this format because it's +perceived as having some good qualities in those mailer-specific +headers/status bits stuff. RMAIL itself still exists as well, of +course, and is still maintained by Stallman. + +Both of the above forms leave your mail in a single file on your +filesystem, and they must parse that entire file each time you take a +look at your mail. + +@item nnml + +@code{nnml} is the backend which smells the most as though you were +actually operating with an @code{nnspool}-accessed Usenet system. (In +fact, I believe @code{nnml} actually derived from @code{nnspool} code, +lo these years ago.) One's mail is taken from the original spool file, +and is then cut up into individual message files, 1:1. It maintains a +Usenet-style active file (analogous to what one finds in an INN- or +CNews-based news system in (for instance) @file{/var/lib/news/active}, +or what is returned via the @samp{NNTP LIST} verb) and also creates +@dfn{overview} files for efficient group entry, as has been defined for +@sc{nntp} servers for some years now. It is slower in mail-splitting, +due to the creation of lots of files, updates to the @code{nnml} active +file, and additions to overview files on a per-message basis, but it is +extremely fast on access because of what amounts to the indexing support +provided by the active file and overviews. + +@code{nnml} costs @dfn{inodes} in a big way; that is, it soaks up the +resource which defines available places in the filesystem to put new +files. Sysadmins take a dim view of heavy inode occupation within +tight, shared filesystems. But if you live on a personal machine where +the filesystem is your own and space is not at a premium, @code{nnml} +wins big. + +It is also problematic using this backend if you are living in a +FAT16-based Windows world, since much space will be wasted on all these +tiny files. + +@item nnmh + +The Rand MH mail-reading system has been around UNIX systems for a very +long time; it operates by splitting one's spool file of messages into +individual files, but with little or no indexing support -- @code{nnmh} +is considered to be semantically equivalent to ``@code{nnml} without +active file or overviews''. This is arguably the worst choice, because +one gets the slowness of individual file creation married to the +slowness of access parsing when learning what's new in one's groups. + +@item nnfolder + +Basically the effetc of @code{nnfolder} is @code{nnmbox} (the first +method described above) on a per-group basis. That is, @code{nnmbox} +itself puts *all* one's mail in one file; @code{nnfolder} provides a +little bit of optimization to this so that each of one's mail groups has +a Unix mail box file. It's faster than @code{nnmbox} because each group +can be parsed separately, and still provides the simple Unix mail box +format requiring minimal effort in moving the mail around. In addition, +it maintains an ``active'' file making it much faster for Gnus to figure +out how many messages there are in each separate group. + +If you have groups that are expected to have a massive amount of +messages, @code{nnfolder} is not the best choice, but if you receive +only a moderate amount of mail, @code{nnfolder} is probably the most +friendly mail backend all over. + +@end table + + @node Other Sources @section Other Sources @@ -11224,6 +11400,9 @@ The rnews batch transport format. @item forward Forwarded articles. +@item nsmail +Netscape mail boxes. + @item mime-parts MIME multipart messages. @@ -11262,7 +11441,7 @@ Virtual server variables: This should be one of @code{mbox}, @code{babyl}, @code{digest}, @code{news}, @code{rnews}, @code{mmdf}, @code{forward}, @code{rfc934}, @code{rfc822-forward}, @code{mime-parts}, @code{standard-digest}, -@code{slack-digest}, @code{clari-briefs} or @code{guess}. +@code{slack-digest}, @code{clari-briefs}, @code{nsmail} or @code{guess}. @item nndoc-post-type @vindex nndoc-post-type @@ -18819,6 +18998,20 @@ but it gives an error that it cant access the group. Is the "+" character illegal in newsgroup names? Is there any way in Gnus to work around this? (gnus 5.6.45 - XEmacs 20.4) +@item + +When `#F', do: + +@example +Subject: Answer to your mails 01.01.1999-01.05.1999 + --text follows this line-- +Sorry I killfiled you... + +Under the subject "foo", you wrote on 01.01.1999: +> bar +Under the subject "foo1", you wrote on 01.01.1999: +> bar 1 +@end example @item Solve the halting problem. diff --git a/texi/message.texi b/texi/message.texi index e2d3a30..6d60fe2 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Pterodactyl Message 0.84 Manual +@settitle Pterodactyl Message 0.86 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -42,7 +42,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Message 0.84 Manual +@title Pterodactyl Message 0.86 Manual @author by Lars Magne Ingebrigtsen @page @@ -83,7 +83,7 @@ Message mode buffers. * Key Index:: List of Message mode keys. @end menu -This manual corresponds to Pterodactyl Message 0.84. Message is +This manual corresponds to Pterodactyl Message 0.86. Message is distributed with the Gnus distribution bearing the same version number as this manual.