From f9c8170d647a9e61dd1d8bb7c4f7d4d8c6721280 Mon Sep 17 00:00:00 2001 From: ichikawa Date: Sat, 27 Feb 1999 04:37:44 +0000 Subject: [PATCH] Importing pgnus-0.79 --- lisp/ChangeLog | 99 ++++++++++++++++++++++++++++++ lisp/gnus-art.el | 29 +++++---- lisp/gnus-cite.el | 60 +++++++++--------- lisp/gnus-draft.el | 1 + lisp/gnus-ems.el | 21 ------- lisp/gnus-msg.el | 2 +- lisp/gnus-picon.el | 5 +- lisp/gnus-sum.el | 63 ++++++++++++------- lisp/gnus.el | 2 +- lisp/mail-source.el | 7 ++- lisp/message.el | 167 +++++++++++++++------------------------------------ lisp/mm-bodies.el | 2 +- lisp/mm-view.el | 4 +- lisp/mml.el | 145 +++++++++++++++++++++++++++++++++++++++++--- lisp/nndoc.el | 36 +++++------ lisp/nnheader.el | 1 + lisp/nnmail.el | 10 ++- texi/ChangeLog | 12 ++++ texi/Makefile.in | 6 +- texi/gnus.texi | 23 ++++--- texi/message.texi | 6 +- 21 files changed, 443 insertions(+), 258 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0b9cc8b..18aaf42 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,102 @@ +Fri Feb 26 18:54:16 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.79 is released. + +1999-02-26 18:11:04 Lars Magne Ingebrigtsen + + * gnus-cite.el (gnus-cite-toggle): Don't remove highlighting. + + * mml.el (mml-mode): Don't use add-minor-mode. + + * message.el (messgage-inhibit-body-encoding): New variable. + (message-encode-message-body): Use it. + +Fri Feb 26 17:00:25 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.78 is released. + +1999-02-26 07:45:30 Lars Magne Ingebrigtsen + + * message.el (message-mode): Switch on MML mode. + + * mml.el: Included commands and functions. + (mml-mode-map): New keymap. + + * message.el: Removed the insertion commands and functions. + + * gnus-ems.el (gnus-mule-cite-add-face): Removed. + + * gnus-sum.el (gnus-summary-sort-by-chars): New command and + keystroke. + + * gnus-art.el (gnus-narrow-to-page): Revert. + + * gnus-cite.el (gnus-cite-delete-overlays): New function. + (gnus-cite-parse-maybe): Always reparse. + + * message.el (message-encode-message-body): Don't insert + "multipart warning". + + * gnus-art.el (gnus-article-treat-head-custom): New variable. + +1999-02-25 Miles Bader + + * mail-source.el (mail-source-fetch-pop): Return 1 for success. + + * nnmail.el: Require mm-util. + +1999-02-26 07:39:33 Justin Sheehy + + * nnmail.el (nnmail-get-new-mail): Only get mail for the one + group. + +1999-02-26 07:38:08 SeokChan LEE + + * mm-bodies.el (mm-body-charset-encoding-alist): Add euc-kr. + +1999-02-21 Simon Josefsson + + * gnus-msg.el (gnus-extended-version): Better regexp. + +1999-02-25 Didier Verna + + * nnmail.el (nnmail-split-it): new syntax: `(! FUNC SPLIT)'. FUNC + is called with the result of SPLIT and should return a new split. + + * gnus.texi: update the doc. + +1999-02-23 Didier Verna + + * gnus-picon.el (gnus-picons-display-bar-p): when picons are + displayed in the article buffer, output bars if + `gnus-picons-display-article-move-p'. + +1999-02-20 Aaron M. Ucko + + * mail-source.el (mail-source-fetch-pop): Typo. + +1999-02-26 07:15:12 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-toggle-header): Save restriction. + +1999-02-23 03:07:58 Lars Magne Ingebrigtsen + + * gnus-cite.el (gnus-cite-parse-wrapper): Always parse. + +1999-02-21 11:11:39 Lars Magne Ingebrigtsen + + * mml.el (mml-insert-buffer): New function. + + * message.el (message-forward): Insert the buffer in the buffer. + +Sun Feb 21 01:20:50 1999 Shenghuo ZHU + + * mm-view.el (mm-inline-message): Insert part in narrowed region. + +Sat Feb 20 23:09:40 1999 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-toggle-header): Save restriction. + Sat Feb 20 21:34:28 1999 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.77 is released. diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 7d4cc63..81421c0 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -609,6 +609,10 @@ on parts -- for instance, adding Vcard info to a database." (integer :tag "Less") (sexp :tag "Predicate"))) +(defvar gnus-article-treat-head-custom + '(choice (const :tag "Off" nil) + (const :tag "Header" head))) + (defvar gnus-article-treat-types '("text/plain") "Parts to treat.") @@ -628,7 +632,7 @@ on parts -- for instance, adding Vcard info to a database." (defcustom gnus-treat-buttonize-head 'head "Add buttons to the head." :group 'gnus-article-treat - :type gnus-article-treat-custom) + :type gnus-article-treat-head-custom) (defcustom gnus-treat-emphasize t "Emphasize text." @@ -643,12 +647,12 @@ on parts -- for instance, adding Vcard info to a database." (defcustom gnus-treat-hide-headers 'head "Hide headers." :group 'gnus-article-treat - :type gnus-article-treat-custom) + :type gnus-article-treat-head-custom) (defcustom gnus-treat-hide-boring-headers nil "Hide boring headers." :group 'gnus-article-treat - :type gnus-article-treat-custom) + :type gnus-article-treat-head-custom) (defcustom gnus-treat-hide-signature nil "Hide the signature." @@ -684,7 +688,7 @@ The banner to be stripped is specified in the `banner' group parameter." (defcustom gnus-treat-highlight-headers 'head "Highlight the headers." :group 'gnus-article-treat - :type gnus-article-treat-custom) + :type gnus-article-treat-head-custom) (defcustom gnus-treat-highlight-citation t "Highlight cited text." @@ -694,33 +698,33 @@ The banner to be stripped is specified in the `banner' group parameter." (defcustom gnus-treat-date-ut nil "Display the Date in UT (GMT)." :group 'gnus-article-treat - :type gnus-article-treat-custom) + :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-local nil "Display the Date in the local timezone." :group 'gnus-article-treat - :type gnus-article-treat-custom) + :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-lapsed nil "Display the Date header in a way that says how much time has elapsed." :group 'gnus-article-treat - :type gnus-article-treat-custom) + :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-original nil "Display the date in the original timezone." :group 'gnus-article-treat - :type gnus-article-treat-custom) + :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-iso8601 nil "Display the date in the ISO8601 format." :group 'gnus-article-treat - :type gnus-article-treat-custom) + :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-user-defined nil "Display the date in a user-defined format. The format is defined by the `gnus-article-time-format' variable." :group 'gnus-article-treat - :type gnus-article-treat-custom) + :type gnus-article-treat-head-custom) (defcustom gnus-treat-strip-trailing-blank-lines nil "Strip trailing blank lines." @@ -751,7 +755,7 @@ The format is defined by the `gnus-article-time-format' variable." 'head nil) "Display X-Face headers." :group 'gnus-article-treat - :type gnus-article-treat-custom) + :type gnus-article-treat-head-custom) (defcustom gnus-treat-display-smileys (if (and gnus-xemacs (featurep 'xpm)) @@ -763,7 +767,7 @@ The format is defined by the `gnus-article-time-format' variable." (defcustom gnus-treat-display-picons (if gnus-xemacs 'head nil) "Display picons." :group 'gnus-article-treat - :type gnus-article-treat-custom) + :type gnus-article-treat-head-custom) (defcustom gnus-treat-capitalize-sentences nil "Capitalize sentence-starting words." @@ -3123,6 +3127,7 @@ If given a numerical ARG, move forward ARG pages." (save-excursion (set-buffer gnus-article-buffer) (goto-char (point-min)) + (widen) ;; Remove any old next/prev buttons. (when (gnus-visual-p 'page-marker) (let ((buffer-read-only nil)) diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el index 998a196..b8d4131 100644 --- a/lisp/gnus-cite.el +++ b/lisp/gnus-cite.el @@ -614,43 +614,41 @@ See also the documentation for `gnus-article-highlight-citation'." ;;; Internal functions: -(defun gnus-cite-parse-maybe (&optional force) - ;; Parse if the buffer has changes since last time. - (if (and (not force) - (equal gnus-cite-article gnus-article-current)) +(defun gnus-cite-parse-maybe (&optional force no-overlay) + "Always parse the buffer." + (gnus-cite-localize) + ;;Reset parser information. + (setq gnus-cite-prefix-alist nil + gnus-cite-attribution-alist nil + gnus-cite-loose-prefix-alist nil + gnus-cite-loose-attribution-alist nil) + (unless no-overlay + (gnus-cite-delete-overlays)) + ;; Parse if not too large. + (if (and gnus-cite-parse-max-size + (> (buffer-size) gnus-cite-parse-max-size)) () - (gnus-cite-localize) - ;;Reset parser information. - (setq gnus-cite-prefix-alist nil - gnus-cite-attribution-alist nil - gnus-cite-loose-prefix-alist nil - gnus-cite-loose-attribution-alist nil) - (while gnus-cite-overlay-list - (gnus-delete-overlay (pop gnus-cite-overlay-list))) - ;; Parse if not too large. - (if (and (not force) - gnus-cite-parse-max-size - (> (buffer-size) gnus-cite-parse-max-size)) - () - (setq gnus-cite-article (cons (car gnus-article-current) - (cdr gnus-article-current))) - (gnus-cite-parse-wrapper)))) + (setq gnus-cite-article (cons (car gnus-article-current) + (cdr gnus-article-current))) + (gnus-cite-parse-wrapper))) + +(defun gnus-cite-delete-overlays () + (dolist (overlay gnus-cite-overlay-list) + (when (or (not (gnus-overlay-end overlay)) + (and (>= (gnus-overlay-end overlay) (point-min)) + (<= (gnus-overlay-end overlay) (point-max)))) + (setq gnus-cite-overlay-list (delete overlay gnus-cite-overlay-list)) + (gnus-delete-overlay overlay)))) (defun gnus-cite-parse-wrapper () ;; Wrap chopped gnus-cite-parse (article-goto-body) (save-excursion (gnus-cite-parse-attributions)) - ;; Try to avoid check citation if there is no reason to believe - ;; that article has citations - (if (or gnus-cite-always-check - (save-excursion - (re-search-backward gnus-cite-reply-regexp nil t)) - gnus-cite-loose-attribution-alist) - (progn (save-excursion - (gnus-cite-parse)) - (save-excursion - (gnus-cite-connect-attributions))))) + (save-excursion + (gnus-cite-parse)) + (save-excursion + (gnus-cite-connect-attributions))) (defun gnus-cite-parse () ;; Parse and connect citation prefixes and attribution lines. @@ -921,7 +919,7 @@ See also the documentation for `gnus-article-highlight-citation'." (defun gnus-cite-toggle (prefix) (save-excursion (set-buffer gnus-article-buffer) - (gnus-cite-parse-maybe) + (gnus-cite-parse-maybe nil t) (let ((buffer-read-only nil) (numbers (cdr (assoc prefix gnus-cite-prefix-alist))) (inhibit-point-motion-hooks t) diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index 4edb37d..678f6d9 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -123,6 +123,7 @@ (gnus-draft-setup article (or group "nndraft:queue")) (let ((message-syntax-checks (if interactive nil 'dont-check-for-anything-just-trust-me)) + (messgage-inhibit-body-encoding t) message-send-hook type method) ;; We read the meta-information that says how and where ;; this message is to be sent. diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 4aa6036..6404b27 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -49,26 +49,6 @@ ;;; Mule functions. -(defun gnus-mule-cite-add-face (number prefix face) - ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line. - (when face - (let ((inhibit-point-motion-hooks t) - from to) - (goto-line number) - (unless (eobp) ; Sometimes things become confused (broken). - (if (boundp 'MULE) - (forward-char (chars-in-string prefix)) - (forward-char (length prefix))) - (skip-chars-forward " \t") - (setq from (point)) - (end-of-line 1) - (skip-chars-backward " \t") - (setq to (point)) - (when (< from to) - (push (setq overlay (gnus-make-overlay from to)) - gnus-cite-overlay-list) - (gnus-overlay-put (gnus-make-overlay from to) 'face face)))))) - (defun gnus-mule-max-width-function (el max-width) (` (let* ((val (eval (, el))) (valstr (if (numberp val) @@ -147,7 +127,6 @@ (defvar gnus-summary-display-table nil "Display table used in summary mode buffers.") - (fset 'gnus-cite-add-face 'gnus-mule-cite-add-face) (fset 'gnus-max-width-function 'gnus-mule-max-width-function) (fset 'gnus-summary-set-display-table (lambda ())) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 34f37c9..8f06100 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -584,7 +584,7 @@ If SILENT, don't prompt the user." " (" gnus-version ")" " " (cond - ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version) + ((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version) (concat "Emacs/" (match-string 1 emacs-version))) ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?" emacs-version) diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el index e059fdb..372bee6 100644 --- a/lisp/gnus-picon.el +++ b/lisp/gnus-picon.el @@ -664,8 +664,9 @@ none, and whose CDR is the corresponding element of DOMAINS." ;;; search job functions (defun gnus-picons-display-bar-p () - (and (not (eq gnus-picons-display-where 'article)) - gnus-picons-display-as-address)) + (if (eq gnus-picons-display-where 'article) + gnus-picons-display-article-move-p + gnus-picons-display-as-address)) (defun gnus-picons-network-search-internal (user addrs dbs sym-ann right-p marker &optional fnames) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 27d3f6e..bf22138 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -804,6 +804,7 @@ which it may alter in any way.") ("^relcom\\>" koi8-r) ("^\\(cz\\|hun\\|pl\\|sk\\)\\>" iso-8859-2) ("^israel\\>" iso-8859-1) + ("^han\\>" euc-kr) ("^\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1) (".*" iso-8859-1)) "Alist of regexps (to match group names) and default charsets to be used when reading." @@ -1274,6 +1275,7 @@ increase the score of each group you read." "\C-c\M-\C-s" gnus-summary-limit-include-expunged "\C-c\C-s\C-n" gnus-summary-sort-by-number "\C-c\C-s\C-l" gnus-summary-sort-by-lines + "\C-c\C-s\C-c" gnus-summary-sort-by-chars "\C-c\C-s\C-a" gnus-summary-sort-by-author "\C-c\C-s\C-s" gnus-summary-sort-by-subject "\C-c\C-s\C-d" gnus-summary-sort-by-date @@ -1830,7 +1832,8 @@ increase the score of each group you read." ["Sort by subject" gnus-summary-sort-by-subject t] ["Sort by date" gnus-summary-sort-by-date t] ["Sort by score" gnus-summary-sort-by-score t] - ["Sort by lines" gnus-summary-sort-by-lines t]) + ["Sort by lines" gnus-summary-sort-by-lines t] + ["Sort by characters" gnus-summary-sort-by-chars t]) ("Help" ["Fetch group FAQ" gnus-summary-fetch-faq t] ["Describe group" gnus-summary-describe-group t] @@ -3588,6 +3591,16 @@ If LINE, insert the rebuilt thread starting on line LINE." (gnus-article-sort-by-lines (gnus-thread-header h1) (gnus-thread-header h2))) +(defsubst gnus-article-sort-by-chars (h1 h2) + "Sort articles by octet length." + (< (mail-header-chars h1) + (mail-header-chars h2))) + +(defun gnus-thread-sort-by-chars (h1 h2) + "Sort threads by root article octet length." + (gnus-article-sort-by-chars + (gnus-thread-header h1) (gnus-thread-header h2))) + (defsubst gnus-article-sort-by-author (h1 h2) "Sort articles by root author." (string-lessp @@ -7013,26 +7026,28 @@ If ARG is a negative number, hide the unwanted header lines." (interactive "P") (save-excursion (set-buffer gnus-article-buffer) - (let* ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (hidden (gnus-article-hidden-text-p 'headers)) - e) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (delete-region (point-min) (1- (point)))) - (goto-char (point-min)) - (save-excursion - (set-buffer gnus-original-article-buffer) + (save-restriction + (let* ((buffer-read-only nil) + (inhibit-point-motion-hooks t) + (hidden (gnus-article-hidden-text-p 'headers)) + e) + (goto-char (point-min)) + (when (search-forward "\n\n" nil t) + (delete-region (point-min) (1- (point)))) (goto-char (point-min)) - (setq e (1- (or (search-forward "\n\n" nil t) (point-max))))) - (insert-buffer-substring gnus-original-article-buffer 1 e) - (narrow-to-region (point-min) (point)) - (if (or hidden - (and (numberp arg) (< arg 0))) - (let ((gnus-treat-hide-headers nil) - (gnus-treat-hide-boring-headers nil)) - (gnus-treat-article 'head)) - (gnus-treat-article 'head))))) + (save-excursion + (set-buffer gnus-original-article-buffer) + (goto-char (point-min)) + (setq e (1- (or (search-forward "\n\n" nil t) (point-max))))) + (insert-buffer-substring gnus-original-article-buffer 1 e) + (save-restriction + (narrow-to-region (point-min) (point)) + (if (or hidden + (and (numberp arg) (< arg 0))) + (let ((gnus-treat-hide-headers nil) + (gnus-treat-hide-boring-headers nil)) + (gnus-treat-article 'head)) + (gnus-treat-article 'head))))))) (defun gnus-summary-show-all-headers () "Make all header lines visible." @@ -8588,11 +8603,17 @@ Argument REVERSE means reverse order." (gnus-summary-sort 'score reverse)) (defun gnus-summary-sort-by-lines (&optional reverse) - "Sort the summary buffer by article length. + "Sort the summary buffer by the number of lines. Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort 'lines reverse)) +(defun gnus-summary-sort-by-chars (&optional reverse) + "Sort the summary buffer by article length. +Argument REVERSE means reverse order." + (interactive "P") + (gnus-summary-sort 'chars reverse)) + (defun gnus-summary-sort (predicate reverse) "Sort summary buffer by PREDICATE. REVERSE means reverse order." (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate))) diff --git a/lisp/gnus.el b/lisp/gnus.el index 2153901..540cfa9 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -259,7 +259,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.77" +(defconst gnus-version-number "0.79" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) diff --git a/lisp/mail-source.el b/lisp/mail-source.el index 4d9c958..87eebb5 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -353,8 +353,8 @@ 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 - (progn - (mail-source-callback callback server) + (prog1 + (mail-source-callback callback server) (when prescript (if (fboundp prescript) (funcall prescript) @@ -364,7 +364,8 @@ If ARGS, PROMPT is used as an argument to `format'." postscript (format-spec-make ?p password ?t mail-source-crash-box - ?s server ?P port ?u user)))))) + ?s server ?P port ?u user))))) + 1) ;; 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 882c2e1..b13b004 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1301,10 +1301,7 @@ Point is left at the beginning of the narrowed-to region." (define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature) (define-key message-mode-map "\M-\r" 'message-newline-and-reformat) - (define-key message-mode-map "\C-c\C-a" 'message-mime-attach-file) - (define-key message-mode-map "\C-c\C-m\C-a" 'message-mime-attach-file) - (define-key message-mode-map "\C-c\C-m\C-e" 'message-mime-attach-external) - (define-key message-mode-map "\C-c\C-m\C-q" 'mml-quote-region) + (define-key message-mode-map "\C-c\C-a" 'mml-attach-file) (define-key message-mode-map "\t" 'message-tab)) @@ -1448,6 +1445,7 @@ C-c C-a message-mime-attach-file (attach a file as MIME)." (mm-enable-multibyte) (make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation. (setq indent-tabs-mode nil) + (mml-mode) (run-hooks 'text-mode-hook 'message-mode-hook)) @@ -3786,9 +3784,9 @@ Optional NEWS will use news to forward instead of mail." ;; Put point where we want it before inserting the forwarded ;; message. (message-goto-body) - (insert (format - "\n\n<#part type=message/rfc822 buffer=%S disposition=inline><#/part>\n" - (buffer-name cur))) + (insert "\n\n<#part type=message/rfc822 disposition=inline>\n") + (mml-insert-buffer cur) + (insert "<#/part>\n") (message-position-point))) ;;;###autoload @@ -4108,122 +4106,51 @@ regexp varstr." ;;; MIME functions ;;; -(defun message-mime-query-file (prompt) - (let ((file (read-file-name prompt nil nil t))) - ;; Prevent some common errors. This is inspired by similar code in - ;; VM. - (when (file-directory-p file) - (error "%s is a directory, cannot attach" file)) - (unless (file-exists-p file) - (error "No such file: %s" file)) - (unless (file-readable-p file) - (error "Permission denied: %s" file)) - file)) - -(defun message-mime-query-type (file) - (let* ((default (or (mm-default-file-encoding file) - ;; Perhaps here we should check what the file - ;; looks like, and offer text/plain if it looks - ;; like text/plain. - "application/octet-stream")) - (string (completing-read - (format "Content type (default %s): " default) - (delete-duplicates - (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions) - :test 'equal)))) - (if (not (equal string "")) - string - default))) - -(defun message-mime-query-description () - (let ((description (read-string "One line description: "))) - (when (string-match "\\`[ \t]*\\'" description) - (setq description nil)) - description)) - -(defun message-mime-attach-file (file &optional type description) - "Attach a file to the outgoing MIME message. -The file is not inserted or encoded until you send the message with -`\\[message-send-and-exit]' or `\\[message-send]'. - -FILE is the name of the file to attach. TYPE is its content-type, a -string of the form \"type/subtype\". DESCRIPTION is a one-line -description of the attachment." - (interactive - (let* ((file (message-mime-query-file "Attach file: ")) - (type (message-mime-query-type file)) - (description (message-mime-query-description))) - (list file type description))) - (insert (format - "<#part type=%s name=%s filename=%s%s disposition=attachment><#/part>\n" - type (prin1-to-string (file-name-nondirectory file)) - (prin1-to-string file) - (if description - (format " description=%s" (prin1-to-string description)) - "")))) - -(defun message-mime-attach-external (file &optional type description) - "Attach an external file into the buffer. -FILE is an ange-ftp/efs specification of the part location. -TYPE is the MIME type to use." - (interactive - (let* ((file (message-mime-query-file "Attach external file: ")) - (type (message-mime-query-type file)) - (description (message-mime-query-description))) - (list file type description))) - (insert (format - "<#external type=%s name=%s disposition=attachment><#/external>\n" - type (prin1-to-string file)))) +(defvar messgage-inhibit-body-encoding nil) (defun message-encode-message-body () - (let ((mail-parse-charset (or mail-parse-charset - message-default-charset - message-posting-charset)) - (case-fold-search t) - lines multipart-p content-type-p) - (message-goto-body) - (save-restriction - (narrow-to-region (point) (point-max)) - (let ((new (mml-generate-mime))) - (when new - (delete-region (point-min) (point-max)) - (insert new) - (goto-char (point-min)) - (if (eq (aref new 0) ?\n) - (delete-char 1) - (search-forward "\n\n") - (setq lines (buffer-substring (point-min) (1- (point)))) - (delete-region (point-min) (point)))))) - (save-restriction - (message-narrow-to-headers-or-head) - (message-remove-header "Mime-Version") - (goto-char (point-max)) - (insert "MIME-Version: 1.0\n") - (when lines - (insert lines)) - (setq multipart-p - (re-search-backward "^Content-Type: multipart/" nil t)) - (goto-char (point-max)) - (setq content-type-p - (re-search-backward "^Content-Type:" nil t))) - (save-restriction - (message-narrow-to-headers-or-head) - (message-remove-first-header "Content-Type") - (message-remove-first-header "Content-Transfer-Encoding")) - (when multipart-p + (unless messgage-inhibit-body-encoding + (let ((mail-parse-charset (or mail-parse-charset + message-default-charset + message-posting-charset)) + (case-fold-search t) + lines content-type-p) (message-goto-body) - (insert "This is a MIME multipart message. If you are reading\n") - (insert "this, you shouldn't.\n")) - ;; We always make sure that the message has a Content-Type header. - ;; This is because some broken MTAs and MUAs get awfully confused - ;; when confronted with a message with a MIME-Version header and - ;; without a Content-Type header. For instance, Solaris' - ;; /usr/bin/mail. - (unless content-type-p - (goto-char (point-min)) - (re-search-forward "^MIME-Version:") - (forward-line 1) - (insert "Content-Type: text/plain; charset=us-ascii\n")))) + (save-restriction + (narrow-to-region (point) (point-max)) + (let ((new (mml-generate-mime))) + (when new + (delete-region (point-min) (point-max)) + (insert new) + (goto-char (point-min)) + (if (eq (aref new 0) ?\n) + (delete-char 1) + (search-forward "\n\n") + (setq lines (buffer-substring (point-min) (1- (point)))) + (delete-region (point-min) (point)))))) + (save-restriction + (message-narrow-to-headers-or-head) + (message-remove-header "Mime-Version") + (goto-char (point-max)) + (insert "MIME-Version: 1.0\n") + (when lines + (insert lines)) + (setq content-type-p + (re-search-backward "^Content-Type:" nil t))) + (save-restriction + (message-narrow-to-headers-or-head) + (message-remove-first-header "Content-Type") + (message-remove-first-header "Content-Transfer-Encoding")) + ;; We always make sure that the message has a Content-Type header. + ;; This is because some broken MTAs and MUAs get awfully confused + ;; when confronted with a message with a MIME-Version header and + ;; without a Content-Type header. For instance, Solaris' + ;; /usr/bin/mail. + (unless content-type-p + (goto-char (point-min)) + (re-search-forward "^MIME-Version:") + (forward-line 1) + (insert "Content-Type: text/plain; charset=us-ascii\n"))))) (provide 'message) diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index 64e6053..298a62d 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -54,7 +54,7 @@ (gb2312 . base64) (cn-gb . base64) (cn-gb-2312 . base64) - (euc-kr . base64) + (euc-kr . 8bit) (iso-2022-jp-2 . base64) (iso-2022-int-1 . base64)) "Alist of MIME charsets to encodings. diff --git a/lisp/mm-view.el b/lisp/mm-view.el index 9c20184..1fc7992 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -147,9 +147,9 @@ (defun mm-inline-message (handle) (let ((b (point))) (save-excursion - (mm-insert-part handle) (save-restriction - (narrow-to-region b (point)) + (narrow-to-region b b) + (mm-insert-part handle) (run-hooks 'gnus-article-decode-hook) (gnus-article-prepare-display) (mm-handle-set-undisplayer diff --git a/lisp/mml.el b/lisp/mml.el index 779997c..5c5efdc 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -380,16 +380,13 @@ (substring path (1+ (match-end 2)))) path)) -(defun mml-quote-region (beg end) - "Quote the MML tags in the region." - (interactive "r") - (save-excursion - (goto-char beg) - ;; Quote parts. - (while (re-search-forward - "<#/?!*\\(multipart\\|part\\|external\\)" end t) - (goto-char (match-beginning 1)) - (insert "!")))) +(defun mml-insert-buffer (buffer) + "Insert BUFFER at point and quote any MML markup." + (save-restriction + (narrow-to-region (point) (point)) + (insert-buffer-substring buffer) + (mml-quote-region (point-min) (point-max)) + (goto-char (point-max)))) ;;; ;;; Transforming MIME to MML @@ -456,6 +453,134 @@ (equal (split-string (car (mm-handle-type handle)) "/") "text") (insert ">\n"))) +;;; +;;; Mode for inserting and editing MML forms +;;; + +(defvar mml-mode-map + (let ((map (make-sparse-keymap)) + (main (make-sparse-keymap))) + (define-key map "f" 'mml-attach-file) + (define-key map "b" 'mml-attach-buffer) + (define-key map "q" 'mml-quote-region) + (define-key map "m" 'mml-insert-multipart) + (define-key map "q" 'mml-insert-part) + (define-key map "v" 'mml-validate) + (define-key main "\M-m" map) + main)) + +(easy-menu-define + mml-menu mml-mode-map "" + '("MML" + ("Attach" + ["File" mml-attach-file t] + ["Buffer" mml-attach-buffer t]) + ("Insert" + ["Multipart" mml-insert-multipart t] + ["Part" mml-insert-part t]) + ["Quote" mml-quote-region t] + ["Validate" mml-validate t])) + +(defvar mml-mode nil + "Minor mode for editing MML.") + +(defun mml-mode (&optional arg) + "Minor mode for editing MML. + +\\{mml-mode-map}" + (interactive "P") + (if (not (set (make-local-variable 'mml-mode) + (if (null arg) (not mml-mode) + (> (prefix-numeric-value arg) 0)))) + nil + (set (make-local-variable 'mml-mode) t) + (unless (assq 'mml-mode minor-mode-alist) + (push `(mml-mode " MML") minor-mode-alist)) + (unless (assq 'mml-mode minor-mode-map-alist) + (push (cons 'mml-mode mml-mode-map) + minor-mode-map-alist))) + (run-hooks 'mml-mode-hook)) + +(defun mml-read-file (prompt) + (let ((file (read-file-name prompt nil nil t))) + ;; Prevent some common errors. This is inspired by similar code in + ;; VM. + (when (file-directory-p file) + (error "%s is a directory, cannot attach" file)) + (unless (file-exists-p file) + (error "No such file: %s" file)) + (unless (file-readable-p file) + (error "Permission denied: %s" file)) + file)) + +(defun mml-read-type (file) + (let* ((default (or (mm-default-file-encoding file) + ;; Perhaps here we should check what the file + ;; looks like, and offer text/plain if it looks + ;; like text/plain. + "application/octet-stream")) + (string (completing-read + (format "Content type (default %s): " default) + (delete-duplicates + (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions) + :test 'equal)))) + (if (not (equal string "")) + string + default))) + +(defun mml-read-description () + (let ((description (read-string "One line description: "))) + (when (string-match "\\`[ \t]*\\'" description) + (setq description nil)) + description)) + +(defun mml-quote-region (beg end) + "Quote the MML tags in the region." + (interactive "r") + (save-excursion + (goto-char beg) + ;; Quote parts. + (while (re-search-forward + "<#/?!*\\(multipart\\|part\\|external\\)" end t) + (goto-char (match-beginning 1)) + (insert "!")))) + +(defun mml-attach-file (file &optional type description) + "Attach a file to the outgoing MIME message. +The file is not inserted or encoded until you send the message with +`\\[message-send-and-exit]' or `\\[message-send]'. + +FILE is the name of the file to attach. TYPE is its content-type, a +string of the form \"type/subtype\". DESCRIPTION is a one-line +description of the attachment." + (interactive + (let* ((file (mml-read-file "Attach file: ")) + (type (mml-read-type file)) + (description (mml-read-description))) + (list file type description))) + (insert + (format + "<#part type=%s name=%s filename=%s%s disposition=attachment><#/part>\n" + type (prin1-to-string (file-name-nondirectory file)) + (prin1-to-string file) + (if description + (format " description=%s" (prin1-to-string description)) + "")))) + +(defun mml-attach-external (file &optional type description) + "Attach an external file into the buffer. +FILE is an ange-ftp/efs specification of the part location. +TYPE is the MIME type to use." + (interactive + (let* ((file (mml-read-file "Attach external file: ")) + (type (mml-read-type file)) + (description (mml-read-description))) + (list file type description))) + (insert (format + "<#external type=%s name=%s disposition=attachment><#/external>\n" + type (prin1-to-string file)))) + + (provide 'mml) ;;; mml.el ends here diff --git a/lisp/nndoc.el b/lisp/nndoc.el index fc35e36..8124262 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -137,7 +137,7 @@ from the document.") (defvoo nndoc-head-begin-function nil) (defvoo nndoc-body-end nil) ;; nndoc-dissection-alist is a list of sublists. Each sublist holds the -;; following items. ARTICLE act as the association key and is an ordinal +;; following items. ARTICLE acts as the association key and is an ordinal ;; starting at 1. HEAD-BEGIN [0], HEAD-END [1], BODY-BEGIN [2] and BODY-END ;; [3] are positions in the `nndoc' buffer. LINE-COUNT [4] is a count of ;; lines in the body. For MIME dissections only, ARTICLE-INSERT [5] and @@ -646,16 +646,16 @@ PARENT is the message-ID of the parent summary line, or nil for none." (message-id (nnmail-message-id)) head-end body-begin summary-insert message-rfc822 multipart-any subject content-type type subtype boundary-regexp) - ;; Gracefully handle a missing body. - (goto-char head-begin) - (if (search-forward "\n\n" body-end t) - (setq head-end (1- (point)) - body-begin (point)) + ;; Gracefully handle a missing body. + (goto-char head-begin) + (if (search-forward "\n\n" body-end t) + (setq head-end (1- (point)) + body-begin (point)) (setq head-end body-end body-begin body-end)) (narrow-to-region head-begin head-end) - ;; Save MIME attributes. - (goto-char head-begin) + ;; Save MIME attributes. + (goto-char head-begin) (setq content-type (message-fetch-field "Content-Type")) (when content-type (when (string-match @@ -676,8 +676,8 @@ PARENT is the message-ID of the parent summary line, or nil for none." (when (or multipart-any (not article-insert)) (setq subject (message-fetch-field "Subject")))) (unless type - (setq type "text" - subtype "plain")) + (setq type "text" + subtype "plain")) ;; Prepare the article and summary inserts. (unless article-insert (setq article-insert (buffer-substring (point-min) (point-max)) @@ -689,8 +689,8 @@ PARENT is the message-ID of the parent summary line, or nil for none." (and position multipart-any ".") (and multipart-any "*") (and (or position multipart-any) " ") - (cond ((string= subtype "plain") type) - ((string= subtype "basic") type) + (cond ((string= subtype "plain") type) + ((string= subtype "basic") type) (t subtype)) ">" (and subject " ") @@ -713,13 +713,13 @@ PARENT is the message-ID of the parent summary line, or nil for none." summary-insert) (replace-match line t t summary-insert) (concat summary-insert line))))) - ;; Generate dissection information for this entity. - (push (list (incf nndoc-mime-split-ordinal) - head-begin head-end body-begin body-end - (count-lines body-begin body-end) + ;; Generate dissection information for this entity. + (push (list (incf nndoc-mime-split-ordinal) + head-begin head-end body-begin body-end + (count-lines body-begin body-end) article-insert summary-insert) - nndoc-dissection-alist) - ;; Recurse for all sub-entities, if any. + nndoc-dissection-alist) + ;; Recurse for all sub-entities, if any. (widen) (cond (message-rfc822 diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 24aa197..3b662a5 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -1,3 +1,4 @@ + ;;; nnheader.el --- header access macros for Gnus and its backends ;; Copyright (C) 1987-1990,1993-1999 Free Software Foundation, Inc. diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 54b25ad..3ae7f62 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -32,6 +32,7 @@ (require 'custom) (require 'gnus-util) (require 'mail-source) +(require 'mm-util) (eval-and-compile (autoload 'gnus-error "gnus-util") @@ -1099,6 +1100,10 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." ((eq (car split) ':) (nnmail-split-it (save-excursion (eval (cdr split))))) + ;; Builtin ! operation. + ((eq (car split) '!) + (funcall (cadr split) (nnmail-split-it (caddr split)))) + ;; Check the cache for the regexp for this split. ((setq cached-pair (assq split nnmail-split-cache)) (goto-char (point-max)) @@ -1374,8 +1379,9 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (setq source (append source (list :predicate `(lambda (file) - (string-match ,(regexp-quote group) - file)))))) + (string-match + ,(concat (regexp-quote group) "$") + file)))))) (when nnmail-fetched-sources (if (member source nnmail-fetched-sources) (setq source nil) diff --git a/texi/ChangeLog b/texi/ChangeLog index 2d732f8..e90be54 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,15 @@ +1999-02-26 08:26:10 Lars Magne Ingebrigtsen + + * gnus.texi (Mail Source Specifiers): Fix. + +Thu Feb 25 00:28:49 1999 Shenghuo ZHU + + * gnus.texi (Category Syntax): Typo fix. + +1999-02-21 11:42:54 Vladimir Volovich + + * Makefile.in (.texi): Fix check for MAKEINFO. + 1999-02-20 17:33:55 Lars Magne Ingebrigtsen * gnus.texi (Mail Source Specifiers): Addition. diff --git a/texi/Makefile.in b/texi/Makefile.in index c122828..8056fe7 100644 --- a/texi/Makefile.in +++ b/texi/Makefile.in @@ -25,10 +25,10 @@ most: texi2latex.elc latex latexps .SUFFIXES: .texi .dvi .ps .texi: - if test $(MAKEINFO) = no; then \ - $(EMACSINFO) -eval '(find-file "$<")' $(XINFOSWI); \ - else \ + if test -x $(MAKEINFO); then \ makeinfo -o $* $<; \ + else \ + $(EMACSINFO) -eval '(find-file "$<")' $(XINFOSWI); \ fi dvi: gnus.dvi message.dvi refcard.dvi emacs-mime.dvi diff --git a/texi/gnus.texi b/texi/gnus.texi index 5754dda..f872510 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Pterodactyl Gnus 0.77 Manual +@settitle Pterodactyl Gnus 0.79 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -318,7 +318,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Gnus 0.77 Manual +@title Pterodactyl Gnus 0.79 Manual @author by Lars Magne Ingebrigtsen @page @@ -354,7 +354,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.77. +This manual corresponds to Pterodactyl Gnus 0.79. @end ifinfo @@ -7122,6 +7122,11 @@ Sort by date (@code{gnus-summary-sort-by-date}). @findex gnus-summary-sort-by-lines Sort by lines (@code{gnus-summary-sort-by-lines}). +@item C-c C-s C-c +@kindex C-c C-s C-c (Summary) +@findex gnus-summary-sort-by-chars +Sort by article length (@code{gnus-summary-sort-by-chars}). + @item C-c C-s C-i @kindex C-c C-s C-i (Summary) @findex gnus-summary-sort-by-score @@ -10103,8 +10108,7 @@ Fetch from a named server with a named user and password: Use @samp{movemail} to move the mail: @lisp -(pop :program "movemail" - :args (format "po:%s %s %s" user mail-source-crash-box password)) +(pop :program "movemail po:%u %t %p") @end lisp @item maildir @@ -10356,6 +10360,11 @@ function with @var{args} given as arguments. The function should return a SPLIT. @item +@var{(! FUNC SPLIT)}: If the split is a list, and the first element +is @code{!}, then SPLIT will be processed, and FUNC will be called as a +function with the result of SPLIT as argument. FUNC should return a split. + +@item @code{nil}: If the split is @code{nil}, it is ignored. @end enumerate @@ -12154,8 +12163,8 @@ something along the lines of the following: @lisp (defun my-article-old-p () "Say whether an article is old." - (< (time-to-day (date-to-time (mail-header-date gnus-headers))) - (- (time-to-day (current-time)) gnus-agent-expire-days))) + (< (time-to-days (date-to-time (mail-header-date gnus-headers))) + (- (time-to-days (current-time)) gnus-agent-expire-days))) @end lisp with the predicate then defined as: diff --git a/texi/message.texi b/texi/message.texi index 2b3da2a..96e389e 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Pterodactyl Message 0.77 Manual +@settitle Pterodactyl Message 0.79 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.77 Manual +@title Pterodactyl Message 0.79 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.77. Message is +This manual corresponds to Pterodactyl Message 0.79. Message is distributed with the Gnus distribution bearing the same version number as this manual. -- 1.7.10.4