From c8b25eebe2bfccd8b707d8c9e8ffa0d88d4a20af Mon Sep 17 00:00:00 2001 From: yamaoka Date: Mon, 27 Sep 1999 23:18:32 +0000 Subject: [PATCH] Importing Pterodactyl Gnus v0.97. --- lisp/ChangeLog | 140 ++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/gnus-agent.el | 25 ++++----- lisp/gnus-art.el | 44 ++++++++++------ lisp/gnus-cache.el | 2 +- lisp/gnus-group.el | 2 +- lisp/gnus-msg.el | 4 +- lisp/gnus-nocem.el | 13 +++-- lisp/gnus-score.el | 4 +- lisp/gnus-srvr.el | 5 +- lisp/gnus-sum.el | 7 ++- lisp/gnus-util.el | 6 ++- lisp/gnus-xmas.el | 2 +- lisp/gnus.el | 51 +++++++++--------- lisp/lpath.el | 2 +- lisp/mail-source.el | 20 ++++---- lisp/message.el | 60 +++++++++++++++------- lisp/mm-decode.el | 12 +++-- lisp/mm-encode.el | 29 ++++------- lisp/mm-util.el | 2 +- lisp/mml.el | 39 ++++++++++---- lisp/nnmail.el | 4 +- lisp/nntp.el | 1 - lisp/qp.el | 18 ++++--- texi/ChangeLog | 22 ++++++++ texi/emacs-mime.texi | 29 +++++++++++ texi/gnus.texi | 29 +++++++---- texi/message.texi | 33 +++--------- 27 files changed, 425 insertions(+), 180 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b0c1665..14ba45e 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,143 @@ +Mon Sep 27 15:18:05 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.97 is released. + +1999-09-01 Brendan Kehoe + + * gnus-sum.el (gnus-summary-catchup-and-goto-next-group): Use + gnus-summary-next-group, not gnus-summary-next-article. Only give + 3 args. + +1999-09-25 08:07:57 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-fetch-group-1): Look in the group + buffer for params. + + * gnus-xmas.el (gnus-xmas-summary-recenter): Display one more + line. + + * message.el (message-forward-ignored-headers): New variable. + + * gnus-art.el (gnus-article-prepare-display): Nix out + gnus-article-wash-types. + + * gnus-agent.el (gnus-agent-create-buffer): New function. + (gnus-agent-fetch-group-1): Use it. + (gnus-agent-start-fetch): Ditto. + + * gnus-sum.el (gnus-summary-exit): Don't use + `gnus-use-adaptive-scoring'. + + * mail-source.el (mail-source-fetch-pop): Only store password when + successful. + + * gnus-nocem.el (gnus-nocem-scan-groups): Message better. + +1999-09-24 18:43:23 Lars Magne Ingebrigtsen + + * message.el (message-reply): Use it. + (message-dont-reply-to-names): New variable. + + * nntp.el (nntp-open-telnet): Don't erase-buffer. + + * mm-util.el (mm-preferred-coding-system): Typo fix. + + * message.el (message-bounce): Work for non-MIME. + + * gnus.el (gnus-short-group-name): Short the right parts of the + name. + +1999-09-24 18:17:48 Johan Kullstam + + * mm-encode.el (mm-qp-or-base64): New version. + +1999-09-10 Shenghuo ZHU + + * gnus-art.el (article-make-date-line): Fix time-zone bug. + +1999-09-09 Shenghuo ZHU + + * gnus-art.el (gnus-article-add-buttons): Don't delete markers out + of restricted region. + (gnus-mime-display-single): Set beg at correct point. + +1999-09-09 Shenghuo ZHU + + * nnmail.el (nnmail-process-maildir-mail-format): Typo. + +1999-09-09 Jens-Ulrik Petersen + + * gnus-msg.el (gnus-configure-posting-styles): Let + `gnus-posting-styles' have its say in posting-style: local + variable `styles' is already bound to `gnus-posting-styles' so + don't rebind it to nil. + +1999-09-24 18:10:56 Robert Bihlmeyer + + * gnus-score.el (gnus-summary-increase-score): Allow editing of + Message-ID. + +1999-09-08 Shenghuo ZHU + + * mm-encode.el (mm-encode-content-transfer-encoding): Fold + quoted-printable-encode-region. + + * qp.el (quoted-printable-encode-region): Assume charset + encoded. Fold every line in the region. + +1999-09-02 Shenghuo ZHU + + * gnus-srvr.el (gnus-browse-foreign-server): Read the first line + of active file. + +1999-09-01 Didier Verna + + * message.el (message-mode): allows whitespaces between multiple + instances of the fill character ">". + +1999-09-24 18:02:50 Kim-Minh Kaplan + + * mm-encode.el (mm-qp-or-base64): Fix. + +1999-09-01 12:18:01 Katsumi Yamaoka + + * message.el (message-send): Too much and. + +1999-09-24 17:58:07 Andreas Schwab + + * gnus-art.el (gnus-mime-view-part-as-type): Renamed. + +1999-08-28 12:44:20 Lars Magne Ingebrigtsen + + * gnus-score.el (gnus-score-headers): Work for nil scores. + +1999-08-27 20:46:11 Lars Magne Ingebrigtsen + + * gnus-cache.el (gnus-cache-write-active): Write full names. + + * gnus-util.el (gnus-write-active-file): Accept full name. + + * mm-decode.el (mm-inlinable-p): Use string-match on the types. + (mm-assoc-string-match): New function. + (mm-display-inline): Use it. + + * gnus-group.el (gnus-group-set-info): Work for nil group params. + + * gnus-msg.el (gnus-configure-posting-styles): Allow eval. + +1999-08-27 19:08:10 Florian Weimer + + * mml.el (mml-generate-multipart-alist): New variable. + +1999-08-27 15:30:02 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-treat-predicate): Work for (not 5). + +1999-08-27 Peter von der Ahé + + * message.el (message-send): More helpful error message if sending + fails + Fri Aug 27 13:17:48 1999 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.96 is released. diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index a05c579..d2ed36b 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -110,14 +110,20 @@ If nil, only read articles will be expired." (setq gnus-agent t) (gnus-agent-read-servers) (gnus-category-read) - (setq gnus-agent-overview-buffer - (gnus-get-buffer-create " *Gnus agent overview*")) - (with-current-buffer gnus-agent-overview-buffer - (mm-enable-multibyte)) + (gnus-agent-create-buffer) (add-hook 'gnus-group-mode-hook 'gnus-agent-mode) (add-hook 'gnus-summary-mode-hook 'gnus-agent-mode) (add-hook 'gnus-server-mode-hook 'gnus-agent-mode)) +(defun gnus-agent-create-buffer () + (if (gnus-buffer-live-p gnus-agent-overview-buffer) + t + (setq gnus-agent-overview-buffer + (gnus-get-buffer-create " *Gnus agent overview*")) + (with-current-buffer gnus-agent-overview-buffer + (mm-enable-multibyte)) + nil)) + (gnus-add-shutdown 'gnus-close-agent 'gnus) (defun gnus-close-agent () @@ -159,7 +165,8 @@ If nil, only read articles will be expired." (defun gnus-agent-start-fetch () "Initialize data structures for efficient fetching." (gnus-agent-open-history) - (setq gnus-agent-current-history (gnus-agent-history-buffer))) + (setq gnus-agent-current-history (gnus-agent-history-buffer)) + (gnus-agent-create-buffer)) (defun gnus-agent-stop-fetch () "Save all data structures and clean up." @@ -964,13 +971,7 @@ the actual number of articles toggled is returned." group))) ;; `gnus-agent-overview-buffer' may be killed for ;; timeout reason. If so, recreate it. - (if (gnus-buffer-live-p gnus-agent-overview-buffer) - t - (setq gnus-agent-overview-buffer - (gnus-get-buffer-create " *Gnus agent overview*")) - (with-current-buffer gnus-agent-overview-buffer - (mm-enable-multibyte)) - nil))) + (gnus-agent-create-buffer))) (setq category (gnus-group-category group)) (setq predicate (gnus-get-predicate diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 4c486fb..e084612 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -403,7 +403,7 @@ beginning of a line." :type 'regexp :group 'gnus-article-various) -(defcustom gnus-article-mode-line-format "Gnus: %g %S%m" +(defcustom gnus-article-mode-line-format "Gnus: %g [%w] %S%m" "*The format specification for the article mode line. See `gnus-summary-mode-line-format' for a closer description. @@ -1832,6 +1832,9 @@ should replace the \"Date:\" one, or should be added below it." (article-narrow-to-head) (when (re-search-forward tdate-regexp nil t) (setq bface (get-text-property (gnus-point-at-bol) 'face) + date (or (get-text-property (gnus-point-at-bol) + 'original-date) + date) eface (get-text-property (1- (gnus-point-at-eol)) 'face)) (forward-line 1)) @@ -1855,6 +1858,8 @@ should replace the \"Date:\" one, or should be added below it." (beginning-of-line) (when (looking-at "\\([^:]+\\): *\\(.*\\)$") (put-text-property (match-beginning 1) (1+ (match-end 1)) + 'original-date date) + (put-text-property (match-beginning 1) (1+ (match-end 1)) 'face bface) (put-text-property (match-beginning 2) (match-end 2) 'face eface)))))))) @@ -1870,9 +1875,10 @@ should replace the \"Date:\" one, or should be added below it." ;; functions since they aren't particularly resistant to ;; buggy dates. ((eq type 'local) - (let ((tz (car (current-time-zone)))) + (let ((tz (car (current-time-zone time)))) (format "Date: %s %s%02d%02d" (current-time-string time) - (if (> tz 0) "+" "-") (/ tz 3600) (/ (% tz 3600) 60)))) + (if (> tz 0) "+" "-") (/ (abs tz) 3600) + (/ (% (abs tz) 3600) 60)))) ;; Convert to Universal Time. ((eq type 'ut) (concat "Date: " @@ -1880,7 +1886,7 @@ should replace the \"Date:\" one, or should be added below it." (let* ((e (parse-time-string date)) (tm (apply 'encode-time e)) (ms (car tm)) - (ls (- (cadr tm) (car (current-time-zone))))) + (ls (- (cadr tm) (car (current-time-zone time))))) (cond ((< ls 0) (list (1- ms) (+ ls 65536))) ((> ls 65535) (list (1+ ms) (- ls 65536))) (t (list ms ls))))) @@ -2686,7 +2692,8 @@ If ALL-HEADERS is non-nil, no headers are hidden." buffer-read-only) (unless (eq major-mode 'gnus-article-mode) (gnus-article-mode)) - (setq buffer-read-only nil) + (setq buffer-read-only nil + gnus-article-wash-types nil) (gnus-run-hooks 'gnus-tmp-internal-hook) (gnus-run-hooks 'gnus-article-prepare-hook) (when gnus-display-mime-function @@ -2792,7 +2799,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (let ((data (get-text-property (point) 'gnus-data))) (mm-interactively-view-part data))) -(defun gnus-mime-view-part-as-media () +(defun gnus-mime-view-part-as-type () "Choose a MIME media type, and view the part as such." (interactive (list (completing-read "View as MIME type: " mailcap-mime-types))) @@ -3146,7 +3153,8 @@ If ALL-HEADERS is non-nil, no headers are hidden." (cond (display (when move - (forward-line -2)) + (forward-line -2) + (setq beg (point))) (let ((mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets (save-excursion (set-buffer gnus-summary-buffer) @@ -3155,7 +3163,8 @@ If ALL-HEADERS is non-nil, no headers are hidden." (goto-char (point-max))) ((and text not-attachment) (when move - (forward-line -2)) + (forward-line -2) + (setq beg (point))) (gnus-article-insert-newline) (mm-insert-inline handle (mm-get-part handle)) (goto-char (point-max)))) @@ -4081,14 +4090,17 @@ specified by `gnus-button-alist'." (alist gnus-button-alist) beg entry regexp) ;; Remove all old markers. - (let (marker entry) + (let (marker entry new-list) (while (setq marker (pop gnus-button-marker-list)) - (goto-char marker) - (when (setq entry (gnus-button-entry)) - (put-text-property (match-beginning (nth 1 entry)) - (match-end (nth 1 entry)) - 'gnus-callback nil)) - (set-marker marker nil))) + (if (or (< marker (point-min)) (>= marker (point-max))) + (push marker new-list) + (goto-char marker) + (when (setq entry (gnus-button-entry)) + (put-text-property (match-beginning (nth 1 entry)) + (match-end (nth 1 entry)) + 'gnus-callback nil)) + (set-marker marker nil))) + (setq gnus-button-marker-list new-list)) ;; We skip the headers. (article-goto-body) (setq beg (point)) @@ -4499,7 +4511,7 @@ For example: ((eq pred 'and) (apply 'gnus-and (mapcar 'gnus-treat-predicate val))) ((eq pred 'not) - (not (gnus-treat-predicate val))) + (not (gnus-treat-predicate (car val)))) ((eq pred 'typep) (equal (cadr val) type)) (t diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index 9a3ce0f..30927d7 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -592,7 +592,7 @@ $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache" (when (or force (and gnus-cache-active-hashtb gnus-cache-active-altered)) - (gnus-write-active-file gnus-cache-active-file gnus-cache-active-hashtb) + (gnus-write-active-file gnus-cache-active-file gnus-cache-active-hashtb t) ;; Mark the active hashtb as unaltered. (setq gnus-cache-active-altered nil))) diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 5423962..cbc6735 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -3289,7 +3289,7 @@ and the second element is the address." (gnus-browse-foreign-server method)) (defun gnus-group-set-info (info &optional method-only-group part) - (when info + (when (or info part) (let* ((entry (gnus-gethash (or method-only-group (gnus-info-group info)) gnus-newsrc-hashtb)) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index fe632fc..fa842b4 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1092,7 +1092,7 @@ this is a reply." (unless gnus-inhibit-posting-styles (let ((group (or gnus-newsgroup-name "")) (styles gnus-posting-styles) - style match variable attribute value v styles results + style match variable attribute value v 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 @@ -1167,6 +1167,8 @@ this is a reply." (when (cdr result) (add-hook 'message-setup-hook (cond + ((eq 'eval (car result)) + 'ignore) ((eq 'body (car result)) `(lambda () (save-excursion diff --git a/lisp/gnus-nocem.el b/lisp/gnus-nocem.el index 391b8e0..7e8a862 100644 --- a/lisp/gnus-nocem.el +++ b/lisp/gnus-nocem.el @@ -121,7 +121,7 @@ matches an previously scanned and verified nocem message." (interactive) (let ((groups gnus-nocem-groups) (gnus-inhibit-demon t) - group active gactive articles) + group active gactive articles check-headers) (gnus-make-directory gnus-nocem-directory) ;; Load any previous NoCeM headers. (gnus-nocem-load-cache) @@ -173,7 +173,14 @@ matches an previously scanned and verified nocem message." (null (mail-header-references header))) (not (member (mail-header-message-id header) gnus-nocem-seen-message-ids)))) - (gnus-nocem-check-article group header))))))) + (push header check-headers))) + (let ((i 0) + (len (length check-headers))) + (dolist (h check-headers) + (gnus-message + 7 "Checking article %d in %s for NoCeM (%d of %d)..." + (mail-header-number h) group (incf i) len) + (gnus-nocem-check-article group h))))))) (setq gnus-nocem-active (cons (list group gactive) (delq (assoc group gnus-nocem-active) @@ -185,8 +192,6 @@ matches an previously scanned and verified nocem message." (defun gnus-nocem-check-article (group header) "Check whether the current article is an NCM article and that we want it." ;; Get the article. - (gnus-message 7 "Checking article %d in %s for NoCeM..." - (mail-header-number header) group) (let ((date (mail-header-date header)) issuer b e type) (when (or (not date) diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index a599ea0..a91729e 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -502,7 +502,7 @@ used as score." (?s "subject" nil nil string) (?b "body" "" nil body-string) (?h "head" "" nil body-string) - (?i "message-id" nil t string) + (?i "message-id" nil nil string) (?r "references" "message-id" nil string) (?x "xref" nil nil string) (?e "extra" nil nil string) @@ -1477,7 +1477,7 @@ EXTRA is the possible non-standard header." (let (score) (while (setq score (pop scores)) (while score - (when (listp (caar score)) + (when (consp (caar score)) (gnus-score-advanced (car score) trace)) (pop score)))) diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index 7d15a9f..50048bc 100644 --- a/lisp/gnus-srvr.el +++ b/lisp/gnus-srvr.el @@ -592,11 +592,12 @@ The following commands are available: (goto-char (point-min)) (unless (string= gnus-ignored-newsgroups "") (delete-matching-lines gnus-ignored-newsgroups)) - (while (and (not (eobp)) (forward-line)) + (while (not (eobp)) (ignore-errors (push (cons (read cur) (max 0 (- (1+ (read cur)) (read cur)))) - groups))))) + groups)) + (forward-line)))) (setq groups (sort groups (lambda (l1 l2) (string< (car l1) (car l2))))) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index e46b3a4..8ff0671 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -5316,8 +5316,7 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (unless quit-config ;; Do adaptive scoring, and possibly save score files. (when gnus-newsgroup-adaptive - (let ((gnus-newsgroup-adaptive gnus-use-adaptive-scoring)) - (gnus-score-adaptive))) + (gnus-score-adaptive)) (when gnus-use-scoring (gnus-score-save))) (gnus-run-hooks 'gnus-summary-prepare-exit-hook) @@ -6812,7 +6811,7 @@ to guess what the document format is." (gnus-group-read-ephemeral-group name `(nndoc ,name (nndoc-address ,(get-buffer dig)) (nndoc-article-type - ,(if force 'digest 'guess))) t)) + ,(if force 'mbox 'guess))) t)) ;; Make all postings to this group go to the parent group. (nconc (gnus-info-params (gnus-get-info name)) params) @@ -8410,7 +8409,7 @@ read." (interactive "P") (save-excursion (gnus-summary-catchup all)) - (gnus-summary-next-article t nil nil t)) + (gnus-summary-next-group t nil nil)) ;; Thread-based commands. diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index c998a65..532429b 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -939,7 +939,7 @@ ARG is passed to the first function." (throw 'found nil))) t)) -(defun gnus-write-active-file (file hashtb) +(defun gnus-write-active-file (file hashtb &optional full-names) (with-temp-file file (mapatoms (lambda (sym) @@ -947,7 +947,9 @@ ARG is passed to the first function." (boundp sym) (symbol-value sym)) (insert (format "%s %d %d y\n" - (gnus-group-real-name (symbol-name sym)) + (if full-names + (symbol-name sym) + (gnus-group-real-name (symbol-name sym))) (cdr (symbol-value sym)) (car (symbol-value sym)))))) hashtb))) diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 5da0611..90cb1e0 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -177,7 +177,7 @@ displayed, no centering will be performed." (sit-for 0)) (when gnus-auto-center-summary (let* ((height (if (fboundp 'window-displayed-height) - (1- (window-displayed-height)) + (window-displayed-height) (- (window-height) 2))) (top (cond ((< height 4) 0) ((< height 7) 1) diff --git a/lisp/gnus.el b/lisp/gnus.el index 437615e..4c3c359 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.96" +(defconst gnus-version-number "0.97" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) @@ -1607,6 +1607,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") ("browse-url" browse-url) ("message" :interactive t message-send-and-exit message-yank-original) + ("babel" babel-as-string) ("nnmail" nnmail-split-fancy nnmail-article-group) ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers) ("rmailout" rmail-output rmail-output-to-rmail-file) @@ -2581,32 +2582,32 @@ just the host name." (setq skip (match-end 0) depth (+ depth 1))) depth)))) - ;; separate foreign select method from group name and collapse. - ;; if method contains a server, collapse to non-domain server name, - ;; otherwise collapse to select method - (let* ((colon (string-match ":" group)) + ;; Separate foreign select method from group name and collapse. + ;; If method contains a server, collapse to non-domain server name, + ;; otherwise collapse to select method. + (let* ((colon (string-match ":" group)) (server (and colon (substring group 0 colon))) - (plus (and server (string-match "+" server)))) + (plus (and server (string-match "+" server)))) (when server - (cond (plus - (setq foreign (substring server (+ 1 plus) - (string-match "\\." server)) - group (substring group (+ 1 colon)))) - (t - (setq foreign server - group (substring group (+ 1 colon))))) - (setq foreign (concat foreign ":")))) - ;; collapse group name leaving LEVELS uncollapsed elements - (while group - (if (and (string-match "\\." group) (> levels 0)) - (setq name (concat name (substring group 0 1)) - group (substring group (match-end 0)) - levels (- levels 1) - name (concat name ".")) - (setq name (concat foreign name group) - group nil))) - name)) - + (if plus + (setq foreign (substring server (+ 1 plus) + (string-match "\\." server)) + group (substring group (+ 1 colon))) + (setq foreign server + group (substring group (+ 1 colon)))) + (setq foreign (concat foreign ":"))) + ;; Collapse group name leaving LEVELS uncollapsed elements + (let* ((glist (split-string group "\\.")) + (glen (length glist)) + res) + (setq levels (- glen levels)) + (dolist (g glist) + (push (if (>= (decf levels) 0) + (substring g 0 1) + g) + res)) + (concat foreign (mapconcat 'identity (nreverse res) ".")))))) + (defun gnus-narrow-to-body () "Narrow to the body of an article." (narrow-to-region diff --git a/lisp/lpath.el b/lisp/lpath.el index 920a29b..8a0ec4d 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -88,7 +88,7 @@ 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))) + babel-fetch babel-wash babel-as-string))) (setq load-path (cons "." load-path)) (require 'custom) diff --git a/lisp/mail-source.el b/lisp/mail-source.el index de61819..cc58f6f 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -368,9 +368,7 @@ If ARGS, PROMPT is used as an argument to `format'." (or password (cdr (assoc from mail-source-password-cache)) (mail-source-read-passwd - (format "Password for %s at %s: " user server)))) - (unless (assoc from mail-source-password-cache) - (push (cons from password) mail-source-password-cache))) + (format "Password for %s at %s: " user server))))) (when server (setenv "MAILHOST" server)) (setq result @@ -393,12 +391,16 @@ If ARGS, PROMPT is used as an argument to `format'." (if (eq authentication 'apop) 'apop 'pass))) (save-excursion (pop3-movemail mail-source-crash-box)))))) (if result - (prog1 - (mail-source-callback callback server) - (mail-source-run-script - postscript - (format-spec-make ?p password ?t mail-source-crash-box - ?s server ?P port ?u user))) + (progn + (when (eq authentication 'password) + (unless (assoc from mail-source-password-cache) + (push (cons from password) mail-source-password-cache))) + (prog1 + (mail-source-callback callback server) + (mail-source-run-script + 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/message.el b/lisp/message.el index 0a32d12..822a349 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -305,6 +305,13 @@ The provided functions are: :group 'message-interface :type 'regexp) + +(defcustom message-forward-ignored-headers nil + "*All headers that match this regexp will be deleted when forwarding a message." + :group 'message-forwarding + :type '(choice (const :tag "None" nil) + regexp)) + (defcustom message-ignored-cited-headers "." "*Delete these headers from the messages you yank." :group 'message-insertion @@ -649,6 +656,13 @@ Valid valued are `unique' and `unsent'." :group 'message :type 'symbol) +(defcustom message-dont-reply-to-names rmail-dont-reply-to-names + "*A regexp specifying names to prune when doing wide replies. +A value of nil means exclude your own name only." + :group 'message + :type '(choice (const :tag "Yourself" nil) + regexp)) + ;;; Internal variables. ;;; Well, not really internal. @@ -1071,6 +1085,7 @@ The cdr of ech entry is a function for applying the face to a region.") (insert (car headers) ?\n)))) (setq headers (cdr headers)))) + (defun message-fetch-reply-field (header) "Fetch FIELD from the message we're replying to." (when (and message-reply-buffer @@ -1432,12 +1447,12 @@ C-c C-a mml-attach-file (attach a file as MIME)." '(message-font-lock-keywords t))) (make-local-variable 'adaptive-fill-regexp) (setq adaptive-fill-regexp - (concat "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|" adaptive-fill-regexp)) + (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|" adaptive-fill-regexp)) (unless (boundp 'adaptive-fill-first-line-regexp) (setq adaptive-fill-first-line-regexp nil)) (make-local-variable 'adaptive-fill-first-line-regexp) (setq adaptive-fill-first-line-regexp - (concat "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|" + (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|" adaptive-fill-first-line-regexp)) (mm-enable-multibyte) (make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation. @@ -2001,21 +2016,19 @@ the user from the mailer." elem sent) (while (and success (setq elem (pop alist))) - (when (and (or (not (funcall (cadr elem))) - (and (or (not (memq (car elem) - message-sent-message-via)) - (y-or-n-p - (format - "Already sent message via %s; resend? " - (car elem)))) - (setq success (funcall (caddr elem) arg))))) + (when (or (not (funcall (cadr elem))) + (and (or (not (memq (car elem) + message-sent-message-via)) + (y-or-n-p + (format + "Already sent message via %s; resend? " + (car elem)))) + (setq success (funcall (caddr elem) arg)))) (setq sent t))) - (unless sent + (unless (or sent (not success)) (error "No methods specified to send by")) (when (and success sent) (message-do-fcc) - ;;(when (fboundp 'mail-hist-put-headers-into-history) - ;; (mail-hist-put-headers-into-history)) (save-excursion (run-hooks 'message-sent-hook)) (message "Sending...done") @@ -3455,8 +3468,9 @@ OTHER-HEADERS is an alist of header/value pairs." (while (re-search-forward "[ \t]+" nil t) (replace-match " " t t)) ;; Remove addresses that match `rmail-dont-reply-to-names'. - (insert (prog1 (rmail-dont-reply-to (buffer-string)) - (erase-buffer))) + (let ((rmail-dont-reply-to-names message-dont-reply-to-names)) + (insert (prog1 (rmail-dont-reply-to (buffer-string)) + (erase-buffer)))) (goto-char (point-min)) ;; Perhaps Mail-Copies-To: never removed the only address? (when (eobp) @@ -3802,8 +3816,16 @@ Optional NEWS will use news to forward instead of mail." ;; message. (message-goto-body) (insert "\n\n<#part type=message/rfc822 disposition=inline>\n") - (mml-insert-buffer cur) - (insert "<#/part>\n") + (let ((b (point)) + e) + (mml-insert-buffer cur) + (setq e (point)) + (insert "<#/part>\n") + (when message-forward-ignored-headers + (save-restriction + (narrow-to-region b e) + (message-narrow-to-head) + (message-remove-header message-forward-ignored-headers t)))) (message-position-point))) ;;;###autoload @@ -3861,7 +3883,7 @@ This only makes sense if the current message is a bounce message than contains some mail you have written which has been bounced back to you." (interactive) - (let ((handles (mm-dissect-buffer)) + (let ((handles (mm-dissect-buffer t)) boundary) (message-pop-to-buffer (message-buffer-name "bounce")) (if (stringp (car handles)) @@ -3869,7 +3891,7 @@ you." (mm-insert-part (car (last handles))) ;; This is a non-MIME bounce, so we try to remove things ;; manually. - (mm-insert-part (car (last handles))) + (mm-insert-part handles) (undo-boundary) (goto-char (point-min)) (search-forward "\n\n" nil t) diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index a658324..693c60e 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -139,8 +139,7 @@ "message/rfc822") "A list of MIME types to be displayed automatically.") -(defvar mm-attachment-override-types - '("text/plain" "text/x-vcard") +(defvar mm-attachment-override-types '("text/plain" "text/x-vcard") "Types that should have \"attachment\" ignored if they can be displayed inline.") (defvar mm-automatic-external-display nil @@ -437,17 +436,22 @@ external if displayed external." (defun mm-display-inline (handle) (let* ((type (mm-handle-media-type handle)) - (function (cadr (assoc type mm-inline-media-tests)))) + (function (cadr (mm-assoc-string-match mm-inline-media-tests type)))) (funcall function handle) (goto-char (point-min)))) +(defun mm-assoc-string-match (alist type) + (dolist (elem alist) + (when (string-match (car elem) type) + (return elem)))) + (defun mm-inlinable-p (handle) "Say whether HANDLE can be displayed inline." (let ((alist mm-inline-media-tests) (type (mm-handle-media-type handle)) test) (while alist - (when (equal type (caar alist)) + (when (string-match (caar alist) type) (setq test (caddar alist) alist nil) (setq test (funcall test handle))) diff --git a/lisp/mm-encode.el b/lisp/mm-encode.el index 908161a..cb30876 100644 --- a/lisp/mm-encode.el +++ b/lisp/mm-encode.el @@ -63,7 +63,7 @@ or base64 will be used, depending on what is more efficient.") (defun mm-encode-content-transfer-encoding (encoding &optional type) (cond ((eq encoding 'quoted-printable) - (quoted-printable-encode-region (point-min) (point-max))) + (quoted-printable-encode-region (point-min) (point-max) t)) ((eq encoding 'base64) (when (equal type "text/plain") (goto-char (point-min)) @@ -126,24 +126,17 @@ The encoding used is returned." (defun mm-qp-or-base64 () (save-excursion - (save-restriction - (narrow-to-region (point-min) (min (+ (point-min) 1000) (point-max))) + (let ((limit (min (point-max) (+ 2000 (point-min)))) + (n8bit 0)) (goto-char (point-min)) - (let ((8bit 0)) - (cond - ((not (featurep 'mule)) - (while (re-search-forward "[^\x20-\x7f\r\n\t]" nil t) - (incf 8bit))) - (t - ;; Mule version - (while (not (eobp)) - (skip-chars-forward "\x20-\x7f\r\n\t") - (unless (eobp) - (forward-char 1) - (incf 8bit))))) - (if (> (/ (* 8bit 1.0) (buffer-size)) 0.166) - 'base64 - 'quoted-printable))))) + (skip-chars-forward "\x20-\x7f\r\n\t" limit) + (while (< (point) limit) + (incf n8bit) + (forward-char 1) + (skip-chars-forward "\x20-\x7f\r\n\t" limit)) + (if (< (* 6 n8bit) (- limit (point-min))) + 'quoted-printable + 'base64)))) (provide 'mm-encode) diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 58131ac..43c94f2 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -206,7 +206,7 @@ used as the line break code type of the coding system." (defun mm-preferred-coding-system (charset) ;; A typo in some Emacs versions. (or (get-charset-property charset 'prefered-coding-system) - (get-charset-property charset 'preffered-coding-system))) + (get-charset-property charset 'preferred-coding-system))) (defun mm-mime-charset (charset) "Return the MIME charset corresponding to the MULE CHARSET." diff --git a/lisp/mml.el b/lisp/mml.el index 9f4ed01..771487d 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -31,6 +31,19 @@ (eval-and-compile (autoload 'message-make-message-id "message")) +(defvar mml-generate-multipart-alist + '(("signed" . rfc2015-generate-signed-multipart) + ("encrypted" . rfc2015-generate-encrypted-multipart)) + "*Alist of multipart generation functions. + +Each entry has the form (NAME . FUNCTION), where +NAME: is a string containing the name of the part (without the +leading \"/multipart/\"), +FUNCTION: is a Lisp function which is called to generate the part. + +The Lisp function has to supply the appropriate MIME headers and the +contents of this part.") + (defvar mml-syntax-table (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) (modify-syntax-entry ?\\ "/" table) @@ -271,16 +284,20 @@ (insert (or (cdr (assq 'contents cont)))) (insert "\n")) ((eq (car cont) 'multipart) - (let ((mml-boundary (mml-compute-boundary cont))) - (insert (format "Content-Type: multipart/%s; boundary=\"%s\"\n" - (or (cdr (assq 'type cont)) "mixed") - mml-boundary)) - (insert "\n") - (setq cont (cddr cont)) - (while cont - (insert "\n--" mml-boundary "\n") - (mml-generate-mime-1 (pop cont))) - (insert "\n--" mml-boundary "--\n"))) + (let* ((type (or (cdr (assq 'type cont)) "mixed")) + (handler (assoc type mml-generate-multipart-alist))) + (if handler + (funcall (cdr handler) cont) + ;; No specific handler. Use default one. + (let ((mml-boundary (mml-compute-boundary cont))) + (insert (format "Content-Type: multipart/%s; boundary=\"%s\"\n" + type mml-boundary)) + (insert "\n") + (setq cont (cddr cont)) + (while cont + (insert "\n--" mml-boundary "\n") + (mml-generate-mime-1 (pop cont))) + (insert "\n--" mml-boundary "--\n"))))) (t (error "Invalid element: %S" cont)))) @@ -502,6 +519,7 @@ (define-key map "p" 'mml-insert-part) (define-key map "v" 'mml-validate) (define-key map "P" 'mml-preview) + (define-key map "n" 'mml-narrow-to-part) (define-key main "\M-m" map) main)) @@ -515,6 +533,7 @@ ("Insert" ["Multipart" mml-insert-multipart t] ["Part" mml-insert-part t]) + ["Narrow" mml-narrow-to-part t] ["Quote" mml-quote-region t] ["Validate" mml-validate t] ["Preview" mml-preview t])) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 935b929..aa1ce27 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -814,8 +814,8 @@ If SOURCE is a directory spec, try to return the group name component." ;; if there is no head-body delimiter, we search a bit manually. (while (and (looking-at "From \\|[^ \t]+:") (not (eobp))) - (forward-line 1) - (point)))) + (forward-line 1)) + (point))) ;; Find the Message-ID header. (goto-char (point-min)) (if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t) diff --git a/lisp/nntp.el b/lisp/nntp.el index 32f3a39..507733a 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -1257,7 +1257,6 @@ password contained in '~/.nntp-authinfo'." (setq nntp-telnet-passwd (mail-source-read-passwd "Password: "))) "\n")) - (erase-buffer) (nntp-wait-for-string nntp-telnet-shell-prompt) (process-send-string proc (concat (mapconcat 'identity nntp-telnet-parameters " ") "\n")) diff --git a/lisp/qp.el b/lisp/qp.el index 50fd046..18c66b7 100644 --- a/lisp/qp.el +++ b/lisp/qp.el @@ -73,7 +73,7 @@ matched by that regexp." (save-excursion (save-restriction (narrow-to-region from to) - (mm-encode-body) +;; (mm-encode-body) ;; Encode all the non-ascii and control characters. (goto-char (point-min)) (while (and (skip-chars-forward @@ -95,13 +95,15 @@ matched by that regexp." (when fold ;; Fold long lines. (goto-char (point-min)) - (end-of-line) - (while (> (current-column) 72) - (beginning-of-line) - (forward-char 72) - (search-backward "=" (- (point) 2) t) - (insert "=\n") - (end-of-line)))))) + (while (not (eobp)) + (end-of-line) + (while (> (current-column) 72) + (beginning-of-line) + (forward-char 72) + (search-backward "=" (- (point) 2) t) + (insert "=\n") + (end-of-line)) + (forward-line)))))) (defun quoted-printable-encode-string (string) "QP-encode STRING and return the results." diff --git a/texi/ChangeLog b/texi/ChangeLog index 152302f..0667c43 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,25 @@ +1999-09-25 10:58:17 Lars Magne Ingebrigtsen + + * message.texi (Forwarding): Updated. + + * emacs-mime.texi (New Viewers): New. + +1999-09-24 18:52:34 Lars Magne Ingebrigtsen + + * gnus.texi (Group Line Specification): Doc fix. + +1999-09-24 18:06:33 Bill White + + * gnus.texi (Article Washing): Fix. + +1999-08-27 20:47:39 Lars Magne Ingebrigtsen + + * gnus.texi (Posting Styles): Doc fix. + +1999-08-27 18:51:42 Robin S. Socha + + * gnus.texi: Typo fix. + 1999-08-27 15:09:01 Jim Meyering * gnus.texi (The Active File): Typo fix. diff --git a/texi/emacs-mime.texi b/texi/emacs-mime.texi index 93e1d6e..08cd7fa 100644 --- a/texi/emacs-mime.texi +++ b/texi/emacs-mime.texi @@ -746,6 +746,7 @@ returned as a result of this analysis. * Handles:: Handle manipulations. * Display:: Displaying handles. * Customization:: Variables that affect display. +* New Viewers:: How to write your own viewers. @end menu @@ -902,6 +903,34 @@ their size. @end table +@node New Viewers +@section New Viewers + +Here's an example viewer for displaying @code{text/enriched} inline: + +@lisp +(defun mm-display-enriched-inline (handle) + (let (text) + (with-temp-buffer + (mm-insert-part handle) + (save-window-excursion + (enriched-decode (point-min) (point-max)) + (setq text (buffer-string)))) + (mm-insert-inline handle text))) +@end lisp + +We see that the function takes a @sc{mime} handle as its parameter. It +then goes to a temporary buffer, inserts the text of the part, does some +work on the text, stores the result, goes back to the buffer it was +called from and inserts the result. + +The two important helper functions here are @code{mm-insert-part} and +@code{mm-insert-inline}. The first function inserts the text of the +handle in the current buffer. It handles charset and/or content +transfer decoding. The second function just inserts whatever text you +tell it to insert, but it also sets things up so that the text can be +``undisplayed' in a convenient manner. + @node Composing @chapter Composing diff --git a/texi/gnus.texi b/texi/gnus.texi index 1cacdac..5b4ff1c 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ @c \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Pterodactyl Gnus 0.96 Manual +@settitle Pterodactyl Gnus 0.97 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -319,7 +319,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Gnus 0.96 Manual +@title Pterodactyl Gnus 0.97 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.96. +This manual corresponds to Pterodactyl Gnus 0.97. @end ifinfo @@ -1236,7 +1236,7 @@ Indentation based on the level of the topic (@pxref{Group Topics}). Short (collapsed) group name. The @code{gnus-group-uncollapsed-levels} variable says how many levels to leave at the end of the group name. The default is 1---this will mean that group names like -@samp{gnu.emacs.gnus} will be shortened to @samp{g.emacs.gnus}. +@samp{gnu.emacs.gnus} will be shortened to @samp{g.e.gnus}. @item m @vindex gnus-new-mail-mark @@ -6434,8 +6434,8 @@ default. @findex gnus-article-emphasize @kindex W e (Summary) People commonly add emphasis to words in news articles by writing things -like @samp{_this_} or @samp{*this*}. Gnus can make this look nicer by -running the article through the @kbd{W e} +like @samp{_this_} or @samp{*this*} or @samp{/this/}. Gnus can make +this look nicer by running the article through the @kbd{W e} (@code{gnus-article-emphasize}) command. @vindex gnus-emphasis-alist @@ -6454,6 +6454,12 @@ highlighting. ("\\*\\(\\w+\\)\\*" 0 1 gnus-emphasis-bold))) @end lisp +@cindex slash +@cindex asterisk +@cindex underline +@cindex / +@cindex * + @vindex gnus-emphasis-underline @vindex gnus-emphasis-bold @vindex gnus-emphasis-italic @@ -6727,9 +6733,9 @@ Do word wrap (@code{gnus-article-fill-cited-article}). You can give the command a numerical prefix to specify the width to use when filling. -@item W q -@kindex W q (Summary) -@findex gnus-article-fill-long-lines +@item W Q +@kindex W Q (Summary) +@findex gnus-article-fill-long-lines Fill long lines (@code{gnus-article-fill-long-lines}). @item W C @@ -8981,7 +8987,8 @@ can be one of @code{signature}, @code{signature-file}, @code{organization}, @code{address}, @code{name} or @code{body}. The attribute name can also be a string. In that case, this will be used as a header name, and the value will be inserted in the headers of the -article. +article. If the attribute name is @code{eval}, the form is evaluated, +and the result is thrown away. The attribute value can be a string (used verbatim), a function with zero arguments (the return value will be used), a variable (its value @@ -13536,7 +13543,7 @@ Suffix to add to the group name to arrive at the score file name @vindex gnus-score-uncacheable-files @cindex score cache All score files are normally cached to avoid excessive re-loading of -score files. However, if this might make you Emacs grow big and +score files. However, if this might make your Emacs grow big and bloated, so this regexp can be used to weed out score files unlikely to be needed again. It would be a bad idea to deny caching of @file{all.SCORE}, while it might be a good idea to not cache @file{comp.infosystems.www.authoring.misc.ADAPT}. In fact, this diff --git a/texi/message.texi b/texi/message.texi index a46d51d..2b6cc14 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Pterodactyl Message 0.96 Manual +@settitle Pterodactyl Message 0.97 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.96 Manual +@title Pterodactyl Message 0.97 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.96. Message is +This manual corresponds to Pterodactyl Message 0.97. Message is distributed with the Gnus distribution bearing the same version number as this manual. @@ -188,8 +188,8 @@ but you can change the behavior to suit your needs by fiddling with the @code{message-wide-reply-to-function}. It is used in the same way as @code{message-reply-to-function} (@pxref{Reply}). -@findex rmail-dont-reply-to-names -Addresses that match the @code{rmail-dont-reply-to-names} regular +@findex message-dont-reply-to-names +Addresses that match the @code{message-dont-reply-to-names} regular expression will be removed from the @code{Cc} header. @@ -246,26 +246,9 @@ the message in the current buffer. If given a prefix, forward using news. @table @code -@item message-forward-start-separator -@vindex message-forward-start-separator -Delimiter inserted before forwarded messages. The default is@* -@samp{------- Start of forwarded message -------\n}. - -@vindex message-forward-end-separator -@item message-forward-end-separator -@vindex message-forward-end-separator -Delimiter inserted after forwarded messages. The default is@* -@samp{------- End of forwarded message -------\n}. - -@item message-signature-before-forwarded-message -@vindex message-signature-before-forwarded-message -If this variable is @code{t}, which it is by default, your personal -signature will be inserted before the forwarded message. If not, the -forwarded message will be inserted first in the new mail. - -@item message-included-forward-headers -@vindex message-included-forward-headers -Regexp matching header lines to be included in forwarded messages. +@item message-ignored-forward-headers +@vindex message-ignored-forward-headers +All headers that match this regexp will be deleted when forwarding a message. @item message-make-forward-subject-function @vindex message-make-forward-subject-function -- 1.7.10.4