*** pub/pgnus/lisp/gnus-art.el Mon Apr 24 21:01:26 2000 --- pgnus/lisp/gnus-art.el Mon May 1 14:58:50 2000 *************** *** 27,38 **** (eval-when-compile (require 'cl)) - (require 'custom) (require 'gnus) (require 'gnus-sum) (require 'gnus-spec) (require 'gnus-int) - (require 'browse-url) (require 'mm-bodies) (require 'mail-parse) (require 'mm-decode) --- 27,36 ---- *************** *** 201,211 **** :group 'gnus-article-hiding) (defcustom gnus-article-x-face-command ! "{ 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." ! :type 'string ;Leave function case to Lisp. :group 'gnus-article-washing) (defcustom gnus-article-x-face-too-ugly nil --- 199,215 ---- :group 'gnus-article-hiding) (defcustom gnus-article-x-face-command ! (if (and (fboundp 'image-type-available-p) ! (or (image-type-available-p 'xpm) ! (image-type-available-p 'xbm))) ! 'gnus-article-display-xface ! "{ 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." ! :type '(choice string ! (function-item gnus-article-display-xface) ! function) :group 'gnus-article-washing) (defcustom gnus-article-x-face-too-ugly nil *************** *** 2817,2823 **** (cons (caddr c) (car c))) gnus-mime-button-commands)))))) (if response ! (funcall response)))))) (defun gnus-mime-view-all-parts (&optional handles) "View all the MIME parts." --- 2821,2827 ---- (cons (caddr c) (car c))) gnus-mime-button-commands)))))) (if response ! (call-interactively response)))))) (defun gnus-mime-view-all-parts (&optional handles) "View all the MIME parts." *************** *** 4581,4587 **** (while (setq elem (pop alist)) (setq val (save-excursion ! (set-buffer gnus-summary-buffer) (symbol-value (car elem)))) (when (and (or (consp val) treated-type) --- 4585,4592 ---- (while (setq elem (pop alist)) (setq val (save-excursion ! (if (gnus-buffer-live-p gnus-summary-buffer) ! (set-buffer gnus-summary-buffer)) (symbol-value (car elem)))) (when (and (or (consp val) treated-type) *** pub/pgnus/lisp/gnus-draft.el Mon Apr 24 21:01:27 2000 --- pgnus/lisp/gnus-draft.el Mon May 1 14:58:50 2000 *************** *** 96,102 **** (interactive) (let ((article (gnus-summary-article-number))) (gnus-summary-mark-as-read article gnus-canceled-mark) ! (gnus-draft-setup article gnus-newsgroup-name) (set-buffer-modified-p t) (save-buffer) (let ((gnus-verbose-backends nil)) --- 96,102 ---- (interactive) (let ((article (gnus-summary-article-number))) (gnus-summary-mark-as-read article gnus-canceled-mark) ! (gnus-draft-setup article gnus-newsgroup-name t) (set-buffer-modified-p t) (save-buffer) (let ((gnus-verbose-backends nil)) *************** *** 122,128 **** (defun gnus-draft-send (article &optional group interactive) "Send message ARTICLE." - (gnus-draft-setup article (or group "nndraft:queue")) (let ((message-syntax-checks (if interactive nil 'dont-check-for-anything-just-trust-me)) (message-inhibit-body-encoding (or (not group) --- 122,127 ---- *************** *** 130,137 **** message-inhibit-body-encoding)) (message-send-hook (and group (not (equal group "nndraft:queue")) message-send-hook)) ! (message-setup-hook nil) type method) ;; We read the meta-information that says how and where ;; this message is to be sent. (save-restriction --- 129,138 ---- message-inhibit-body-encoding)) (message-send-hook (and group (not (equal group "nndraft:queue")) message-send-hook)) ! (message-setup-hook (and group (not (equal group "nndraft:queue")) ! message-setup-hook)) type method) + (gnus-draft-setup article (or group "nndraft:queue")) ;; We read the meta-information that says how and where ;; this message is to be sent. (save-restriction *************** *** 187,202 **** ;;;!!!but for the time being, we'll just run this tiny function uncompiled. (progn ! (defun gnus-draft-setup (narticle group) (gnus-setup-message 'forward (let ((article narticle)) (message-mail) (erase-buffer) (if (not (gnus-request-restore-buffer article group)) (error "Couldn't restore the article") ! ;; Insert the separator. ! (if (equal group "nndraft:queue") (mime-to-mml)) (goto-char (point-min)) (search-forward "\n\n") (forward-char -1) --- 188,203 ---- ;;;!!!but for the time being, we'll just run this tiny function uncompiled. (progn ! (defun gnus-draft-setup (narticle group &optional restore) (gnus-setup-message 'forward (let ((article narticle)) (message-mail) (erase-buffer) (if (not (gnus-request-restore-buffer article group)) (error "Couldn't restore the article") ! (if (and restore (equal group "nndraft:queue")) (mime-to-mml)) + ;; Insert the separator. (goto-char (point-min)) (search-forward "\n\n") (forward-char -1) *** pub/pgnus/lisp/gnus-ems.el Mon Apr 24 21:01:27 2000 --- pgnus/lisp/gnus-ems.el Mon May 1 14:58:50 2000 *************** *** 30,37 **** ;;; Function aliases later to be redefined for XEmacs usage. ! (defvar gnus-xemacs (string-match "XEmacs\\|Lucid" emacs-version) ! "Non-nil if running under XEmacs.") (defvar gnus-mouse-2 [mouse-2]) (defvar gnus-down-mouse-3 [down-mouse-3]) --- 30,38 ---- ;;; Function aliases later to be redefined for XEmacs usage. ! (eval-and-compile ! (defvar gnus-xemacs (string-match "XEmacs" emacs-version) ! "Non-nil if running under XEmacs.")) (defvar gnus-mouse-2 [mouse-2]) (defvar gnus-down-mouse-3 [down-mouse-3]) *************** *** 59,76 **** valstr))) (eval-and-compile ! (if (string-match "XEmacs\\|Lucid" emacs-version) ! nil ! (defvar gnus-mouse-face-prop 'mouse-face ! "Property used for highlighting mouse regions.")) ! ! (cond ! ((string-match "XEmacs\\|Lucid" emacs-version) ! (gnus-xmas-define)) ! ! ((boundp 'MULE) ! (provide 'gnusutil)))) (eval-and-compile (cond --- 60,69 ---- valstr))) (eval-and-compile ! (if gnus-xemacs ! (gnus-xmas-define) (defvar gnus-mouse-face-prop 'mouse-face ! "Property used for highlighting mouse regions."))) (eval-and-compile (cond *************** *** 80,86 **** set-face-background x-popup-menu))) (while funcs (unless (fboundp (car funcs)) ! (fset (car funcs) 'gnus-dummy-func)) (setq funcs (cdr funcs))))))) (eval-and-compile --- 73,79 ---- set-face-background x-popup-menu))) (while funcs (unless (fboundp (car funcs)) ! (defalias (car funcs) 'gnus-dummy-func)) (setq funcs (cdr funcs))))))) (eval-and-compile *************** *** 106,137 **** (defun gnus-ems-redefine () (cond ! ((string-match "XEmacs\\|Lucid" emacs-version) (gnus-xmas-redefine)) ((featurep 'mule) ;; Mule and new Emacs definitions ;; [Note] Now there are three kinds of mule implementations, ! ;; original MULE, XEmacs/mule and beta version of Emacs including ! ;; some mule features. Unfortunately these API are different. In ;; particular, Emacs (including original MULE) and XEmacs are ! ;; quite different. ;; Predicates to check are following: ;; (boundp 'MULE) is t only if MULE (original; anything older than ;; Mule 2.3) is running. ;; (featurep 'mule) is t when every mule variants are running. ! ;; These implementations may be able to share between original ! ;; MULE and beta version of new Emacs. In addition, it is able to ! ;; detect XEmacs/mule by (featurep 'mule) and to check variable ! ;; `emacs-version'. In this case, implementation for XEmacs/mule ! ;; may be able to share between XEmacs and XEmacs/mule. (defvar gnus-summary-display-table nil "Display table used in summary mode buffers.") ! (fset 'gnus-max-width-function 'gnus-mule-max-width-function) ! (fset 'gnus-summary-set-display-table (lambda ())) (when (boundp 'gnus-check-before-posting) (setq gnus-check-before-posting --- 99,130 ---- (defun gnus-ems-redefine () (cond ! (gnus-xemacs (gnus-xmas-redefine)) ((featurep 'mule) ;; Mule and new Emacs definitions ;; [Note] Now there are three kinds of mule implementations, ! ;; original MULE, XEmacs/mule and Emacs 20+ including ! ;; MULE features. Unfortunately these API are different. In ;; particular, Emacs (including original MULE) and XEmacs are ! ;; quite different. Howvere, this version of Gnus doesn't support ! ;; anything other than XEmacs 20+ and Emacs 20.3+. ! ;; Predicates to check are following: ;; (boundp 'MULE) is t only if MULE (original; anything older than ;; Mule 2.3) is running. ;; (featurep 'mule) is t when every mule variants are running. ! ;; It is possible to detect XEmacs/mule by (featurep 'mule) and ! ;; checking `emacs-version'. In this case, the implementation for ! ;; XEmacs/mule may be shareable between XEmacs and XEmacs/mule. (defvar gnus-summary-display-table nil "Display table used in summary mode buffers.") ! (defalias 'gnus-max-width-function 'gnus-mule-max-width-function) ! (defalias 'gnus-summary-set-display-table (lambda ())) (when (boundp 'gnus-check-before-posting) (setq gnus-check-before-posting *************** *** 206,211 **** --- 199,239 ---- (decf i)) (goto-char (point-min)) (sit-for 0)))))) + + (defun gnus-article-display-xface (beg end) + "Display an XFace header from between BEG and END in the current article. + This requires support for XPM or XBM images in your Emacs and the + external programs `uncompface', `icontopbm' and either `ppmtoxpm' (for + XPM support) or `ppmtoxbm' (for XBM support). On a GNU/Linux system + these might be in packages with names like `compface' or `faces-xface' + and `netpbm' or `libgr-progs', for instance. + + This function is for Emacs 21+. See `gnus-xmas-article-display-xface' + for XEmacs." + (save-excursion + (let ((cur (current-buffer)) + image type) + (when (and (fboundp 'image-type-available-p) + (cond ((image-type-available-p 'xpm) (setq type 'xpm)) + ((image-type-available-p 'xbm) (setq type 'xbm)))) + (with-temp-buffer + (insert-buffer-substring cur beg end) + (call-process-region (point-min) (point-max) "uncompface" + 'delete '(t nil)) + (goto-char (point-min)) + (insert "/* Width=48, Height=48 */\n") + (and (eq 0 (call-process-region (point-min) (point-max) "icontopbm" + 'delete '(t nil))) + (eq 0 (call-process-region (point-min) (point-max) + (if (eq type 'xpm) + "ppmtoxpm" + "pbmtoxbm") + 'delete '(t nil))) + (setq image (create-image (buffer-string) type t)))) + (when image + (goto-char (point-min)) + (re-search-forward "^From:" nil 'move) + (insert-image image " ")))))) (provide 'gnus-ems) *** pub/pgnus/lisp/gnus-msg.el Mon Apr 24 21:01:29 2000 --- pgnus/lisp/gnus-msg.el Mon May 1 14:58:50 2000 *************** *** 103,108 **** --- 103,109 ---- (defcustom gnus-group-posting-charset-alist '(("^\\(no\\|fr\\|dk\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\|dk\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1)) + ("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r)) (message-this-is-mail nil nil) (message-this-is-news nil t)) "Alist of regexps and permitted unencoded charsets for posting. *************** *** 660,684 **** (interactive "P") (gnus-summary-reply-with-original n t)) ! (defun gnus-summary-mail-forward (&optional not-used post) ! "Forward the current message to another user. If POST, post instead of mail." (interactive "P") ! (gnus-setup-message 'forward ! (gnus-summary-select-article) ! (let (text) ! (save-excursion ! (set-buffer gnus-original-article-buffer) ! (setq text (buffer-string))) ! (set-buffer (gnus-get-buffer-create ! (generate-new-buffer-name " *Gnus forward*"))) ! (erase-buffer) ! (insert text) ! (goto-char (point-min)) ! (when (looking-at "From ") ! (replace-match "X-From-Line: ") ) ! (run-hooks 'gnus-article-decode-hook) ! (message-forward post)))) (defun gnus-summary-resend-message (address n) "Resend the current article to ADDRESS." --- 661,713 ---- (interactive "P") (gnus-summary-reply-with-original n t)) ! (defun gnus-summary-mail-forward (&optional arg post) ! "Forward the current message to another user. ! If ARG is nil, see `message-forward-as-mime' and `message-forward-show-mml'; ! if ARG is 1, decode the message and forward directly inline; ! if ARG is 2, foward message as an rfc822 MIME section; ! if ARG is 3, decode message and forward as an rfc822 MIME section; ! if ARG is 4, foward message directly inline; ! otherwise, use flipped `message-forward-as-mime'. If POST, post instead of mail." (interactive "P") ! (let ((message-forward-as-mime message-forward-as-mime) ! (message-forward-show-mml message-forward-show-mml)) ! (cond ! ((null arg)) ! ((eq arg 1) (setq message-forward-as-mime nil ! message-forward-show-mml t)) ! ((eq arg 2) (setq message-forward-as-mime t ! message-forward-show-mml nil)) ! ((eq arg 3) (setq message-forward-as-mime t ! message-forward-show-mml t)) ! ((eq arg 4) (setq message-forward-as-mime nil ! message-forward-show-mml nil)) ! (t (setq message-forward-as-mime (not message-forward-as-mime)))) ! (gnus-setup-message 'forward ! (gnus-summary-select-article) ! (let ((mail-parse-charset gnus-newsgroup-charset) ! (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) ! text) ! (save-excursion ! (set-buffer gnus-original-article-buffer) ! (setq text (buffer-string))) ! (set-buffer ! (if message-forward-show-mml ! (gnus-get-buffer-create ! (generate-new-buffer-name " *Gnus forward*")) ! (mm-with-unibyte-current-buffer ! ;; create an unibyte buffer ! (gnus-get-buffer-create ! (generate-new-buffer-name " *Gnus forward*"))))) ! (erase-buffer) ! (insert text) ! (goto-char (point-min)) ! (when (looking-at "From ") ! (replace-match "X-From-Line: ") ) ! (if message-forward-show-mml ! (mime-to-mml)) ! (message-forward post))))) (defun gnus-summary-resend-message (address n) "Resend the current article to ADDRESS." *************** *** 691,701 **** (set-buffer gnus-original-article-buffer) (message-resend address))))) ! (defun gnus-summary-post-forward (&optional full-headers) "Forward the current article to a newsgroup. ! If FULL-HEADERS (the prefix), include full headers when forwarding." (interactive "P") ! (gnus-summary-mail-forward full-headers t)) (defvar gnus-nastygram-message "The following article was inappropriately posted to %s.\n\n" --- 720,730 ---- (set-buffer gnus-original-article-buffer) (message-resend address))))) ! (defun gnus-summary-post-forward (&optional arg) "Forward the current article to a newsgroup. ! See `gnus-summary-mail-forward' for ARG." (interactive "P") ! (gnus-summary-mail-forward arg t)) (defvar gnus-nastygram-message "The following article was inappropriately posted to %s.\n\n" *************** *** 868,877 **** (stringp nntp-server-type)) (insert nntp-server-type)) (insert "\n\n\n\n\n") ! (save-excursion ! (set-buffer (gnus-get-buffer-create " *gnus environment info*")) ! (gnus-debug)) ! (insert "<#part type=application/x-emacs-lisp buffer=\" *gnus environment info*\" disposition=inline description=\"User settings\"><#/part>") (goto-char (point-min)) (search-forward "Subject: " nil t) (message ""))) --- 897,908 ---- (stringp nntp-server-type)) (insert nntp-server-type)) (insert "\n\n\n\n\n") ! (let (text) ! (save-excursion ! (set-buffer (gnus-get-buffer-create " *gnus environment info*")) ! (gnus-debug) ! (setq text (buffer-string))) ! (insert "<#part type=application/x-emacs-lisp disposition=inline description=\"User settings\">\n" text "\n<#/part>")) (goto-char (point-min)) (search-forward "Subject: " nil t) (message ""))) *************** *** 1232,1239 **** `(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 () --- 1263,1272 ---- `(lambda () (save-excursion (message-remove-header ,header) ! (let ((value ,(cdr result))) ! (when value ! (message-goto-eoh) ! (insert ,header ": " value "\n")))))))))) (when (or name address) (add-hook 'message-setup-hook `(lambda () *** pub/pgnus/lisp/gnus-score.el Mon Apr 24 21:01:29 2000 --- pgnus/lisp/gnus-score.el Mon May 1 14:58:51 2000 *************** *** 1462,1467 **** --- 1462,1471 ---- (when (setq new (funcall (nth 2 entry) scores header now expire trace)) (push new news)))) + (when (gnus-buffer-live-p gnus-summary-buffer) + (let ((scored gnus-newsgroup-scored)) + (with-current-buffer gnus-summary-buffer + (setq gnus-newsgroup-scored scored)))) ;; Remove the buffer. (kill-buffer (current-buffer))) *** pub/pgnus/lisp/gnus-start.el Mon Apr 24 21:01:29 2000 --- pgnus/lisp/gnus-start.el Mon May 1 14:58:51 2000 *************** *** 732,748 **** ;;;###autoload (defun gnus-unload () ! "Unload all Gnus features." (interactive) ! (unless (boundp 'load-history) ! (error "Sorry, `gnus-unload' is not implemented in this Emacs version")) ! (let ((history load-history) ! feature) ! (while history ! (and (string-match "^\\(gnus\\|nn\\)" (caar history)) ! (setq feature (cdr (assq 'provide (car history)))) ! (unload-feature feature 'force)) ! (setq history (cdr history))))) ;;; --- 732,745 ---- ;;;###autoload (defun gnus-unload () ! "Unload all Gnus features. ! \(For some value of `all' or `Gnus'.) Currently, features whose names ! have prefixes `gnus-', `nn', `mm-' or `rfc' are unloaded. Use ! cautiously -- unloading may cause trouble." (interactive) ! (dolist (feature features) ! (if (string-match "^\\(gnus-\\|nn\\|mm-\\|rfc\\)" (symbol-name feature)) ! (unload-feature feature 'force)))) ;;; *** pub/pgnus/lisp/gnus-util.el Mon Apr 24 21:01:32 2000 --- pgnus/lisp/gnus-util.el Mon May 1 14:58:51 2000 *************** *** 165,172 **** (and (string-match "(.*" from) (setq name (substring from (1+ (match-beginning 0)) (match-end 0))))) ! ;; Fix by Hallvard B Furuseth . ! (list (or name from) (or address from)))) (defun gnus-fetch-field (field) "Return the value of the header FIELD of current article." --- 165,172 ---- (and (string-match "(.*" from) (setq name (substring from (1+ (match-beginning 0)) (match-end 0))))) ! (list (if (string= name "") nil name) (or address from)))) ! (defun gnus-fetch-field (field) "Return the value of the header FIELD of current article." *************** *** 873,879 **** (setq result (nreverse result)) (while (and result (not (equal (or port "nntp") ! (gnus-netrc-get (car result) "port")))) (pop result)) (car result)))) --- 873,880 ---- (setq result (nreverse result)) (while (and result (not (equal (or port "nntp") ! (or (gnus-netrc-get (car result) "port") ! "nntp")))) (pop result)) (car result)))) *** pub/pgnus/lisp/gnus.el Mon Apr 24 21:01:35 2000 --- pgnus/lisp/gnus.el Mon May 1 14:58:51 2000 *************** *** 1,7 **** ;;; gnus.el --- a newsreader for GNU Emacs ;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, ! ;; 1997, 1998, 2000 ! ;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen --- 1,6 ---- ;;; gnus.el --- a newsreader for GNU Emacs ;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, ! ;; 1997, 1998, 2000 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen *************** *** 258,264 **** :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "5.8.5" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) --- 257,263 ---- :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "5.8.6" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) *************** *** 748,755 **** "Insert startup message in current buffer." ;; Insert the message. (erase-buffer) ! (insert ! (format " %s _ ___ _ _ _ ___ __ ___ __ _ ___ __ _ ___ __ ___ --- 747,769 ---- "Insert startup message in current buffer." ;; Insert the message. (erase-buffer) ! (cond ! ((and (fboundp 'find-image) ! (display-graphic-p) ! (let ((image (find-image '((:type xpm :file "gnus.xpm") ! (:type xbm :file "gnus.xbm"))))) ! (when image ! (insert-image image " ") ! (goto-char (point-min)) ! (while (not (eobp)) ! (insert (make-string (/ (max (- (window-width) (or x 35)) 0) 2) ! ?\ )) ! (forward-line 1)) ! (setq gnus-simple-splash nil) ! t)))) ! (t ! (insert ! (format " %s _ ___ _ _ _ ___ __ ___ __ _ ___ __ _ ___ __ ___ *************** *** 769,789 **** __ " ! "")) ! ;; And then hack it. ! (gnus-indent-rigidly (point-min) (point-max) ! (/ (max (- (window-width) (or x 46)) 0) 2)) ! (goto-char (point-min)) ! (forward-line 1) ! (let* ((pheight (count-lines (point-min) (point-max))) ! (wheight (window-height)) ! (rest (- wheight pheight))) ! (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) ! ;; Fontify some. ! (put-text-property (point-min) (point-max) 'face 'gnus-splash-face) (goto-char (point-min)) (setq mode-line-buffer-identification (concat " " gnus-version)) - (setq gnus-simple-splash t) (set-buffer-modified-p t)) (eval-when (load) --- 783,803 ---- __ " ! "")) ! ;; And then hack it. ! (gnus-indent-rigidly (point-min) (point-max) ! (/ (max (- (window-width) (or x 46)) 0) 2)) ! (goto-char (point-min)) ! (forward-line 1) ! (let* ((pheight (count-lines (point-min) (point-max))) ! (wheight (window-height)) ! (rest (- wheight pheight))) ! (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) ! ;; Fontify some. ! (put-text-property (point-min) (point-max) 'face 'gnus-splash-face) ! (setq gnus-simple-splash t))) (goto-char (point-min)) (setq mode-line-buffer-identification (concat " " gnus-version)) (set-buffer-modified-p t)) (eval-when (load) *************** *** 909,915 **** "*Method used for archiving messages you've sent. This should be a mail method. ! It's probably not a very effective to change this variable once you've run Gnus once. After doing that, you must edit this server from the server buffer." :group 'gnus-server --- 923,929 ---- "*Method used for archiving messages you've sent. This should be a mail method. ! It's probably not very effective to change this variable once you've run Gnus once. After doing that, you must edit this server from the server buffer." :group 'gnus-server *** pub/pgnus/lisp/lpath.el Mon Apr 24 21:01:36 2000 --- pgnus/lisp/lpath.el Mon May 1 14:58:51 2000 *************** *** 43,48 **** --- 43,50 ---- temp-directory babel-fetch babel-wash find-coding-systems-for-charsets sc-cite-regexp vcard-pretty-print image-type-available-p + put-image create-image display-graphic-p + find-image insert-image make-overlay overlay-put)) (maybe-bind '(global-face-data mark-active transient-mark-mode mouse-selection-click-count *************** *** 95,100 **** --- 97,104 ---- rmail-summary-exists rmail-select-summary rmail-update-summary url-generic-parse-url valid-image-instantiator-format-p babel-fetch babel-wash babel-as-string sc-cite-regexp + put-image create-image display-graphic-p + find-image insert-image vcard-pretty-print image-type-available-p))) (setq load-path (cons "." load-path)) *** pub/pgnus/lisp/mailcap.el Mon Apr 24 21:01:38 2000 --- pgnus/lisp/mailcap.el Mon May 1 14:58:52 2000 *************** *** 52,58 **** ("octet-stream" (viewer . mailcap-save-binary-file) (non-viewer . t) ! (type ."application/octet-stream")) ("dvi" (viewer . "open %s") (type . "application/dvi") --- 52,58 ---- ("octet-stream" (viewer . mailcap-save-binary-file) (non-viewer . t) ! (type . "application/octet-stream")) ("dvi" (viewer . "open %s") (type . "application/dvi") *************** *** 305,312 **** (defvar mailcap-parsed-p nil) (defun mailcap-parse-mailcaps (&optional path force) ! "Parse out all the mailcaps specified in a unix-style path string PATH. ! If FORCE, re-parse even if already parsed." (interactive (list nil t)) (when (or (not mailcap-parsed-p) force) --- 305,316 ---- (defvar mailcap-parsed-p nil) (defun mailcap-parse-mailcaps (&optional path force) ! "Parse out all the mailcaps specified in a path string PATH. ! Components of PATH are separated by the `path-separator' character ! appropriate for this system. If FORCE, re-parse even if already ! parsed. If PATH is omitted, use the value of environment variable ! MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus ! /usr/local/etc/mailcap." (interactive (list nil t)) (when (or (not mailcap-parsed-p) force) *************** *** 314,340 **** (path nil) ((getenv "MAILCAPS") (setq path (getenv "MAILCAPS"))) ((memq system-type '(ms-dos ms-windows windows-nt)) ! (setq path (mapconcat 'expand-file-name ! '("~/mail.cap" "~/etc/mail.cap" "~/.mailcap") ! ";"))) ! (t (setq path (mapconcat 'expand-file-name ! '("~/.mailcap" ! "/etc/mailcap:/usr/etc/mailcap" ! "/usr/local/etc/mailcap") ":")))) (let ((fnames (reverse ! (split-string ! path (if (memq system-type ! '(ms-dos ms-windows windows-nt)) ! ";" ! ":")))) fname) (while fnames (setq fname (car fnames)) ! (if (and (file-exists-p fname) (file-readable-p fname) (file-regular-p fname)) ! (mailcap-parse-mailcap (car fnames))) (setq fnames (cdr fnames)))) ! (setq mailcap-parsed-p t))) (defun mailcap-parse-mailcap (fname) ;; Parse out the mailcap file specified by FNAME --- 318,341 ---- (path nil) ((getenv "MAILCAPS") (setq path (getenv "MAILCAPS"))) ((memq system-type '(ms-dos ms-windows windows-nt)) ! (setq path '("~/.mailcap" "~/mail.cap" "~/etc/mail.cap"))) ! (t (setq path ! ;; This is per RFC 1524, specifically ! ;; with /usr before /usr/local. ! '("~/.mailcap" "/etc/mailcap" "/usr/etc/mailcap" ! "/usr/local/etc/mailcap")))) (let ((fnames (reverse ! (if (stringp path) ! (parse-colon-path path) ! path))) fname) (while fnames (setq fname (car fnames)) ! (if (and (file-readable-p fname) (file-regular-p fname)) ! (mailcap-parse-mailcap fname)) (setq fnames (cdr fnames)))) ! (setq mailcap-parsed-p t))) (defun mailcap-parse-mailcap (fname) ;; Parse out the mailcap file specified by FNAME *************** *** 348,372 **** (insert-file-contents fname) (set-syntax-table mailcap-parse-args-syntax-table) (mailcap-replace-regexp "#.*" "") ; Remove all comments (mailcap-replace-regexp "\n+" "\n") ; And blank lines - (mailcap-replace-regexp "\\\\[ \t\n]+" " ") ; And collapse spaces - (mailcap-replace-regexp (concat (regexp-quote "\\") "[ \t]*\n") "") (goto-char (point-max)) (skip-chars-backward " \t\n") (delete-region (point) (point-max)) ! (goto-char (point-min)) ! (while (not (eobp)) ! (skip-chars-forward " \t\n") (setq save-pos (point) info nil) (skip-chars-forward "^/; \t\n") (downcase-region save-pos (point)) (setq major (buffer-substring save-pos (point))) ! (skip-chars-forward " \t\n") (setq minor "") (when (eq (char-after) ?/) (forward-char) ! (skip-chars-forward " \t\n") (setq save-pos (point)) (skip-chars-forward "^; \t\n") (downcase-region save-pos (point)) --- 349,372 ---- (insert-file-contents fname) (set-syntax-table mailcap-parse-args-syntax-table) (mailcap-replace-regexp "#.*" "") ; Remove all comments + (mailcap-replace-regexp "\\\\[ \t]*\n" " ") ; And collapse spaces (mailcap-replace-regexp "\n+" "\n") ; And blank lines (goto-char (point-max)) (skip-chars-backward " \t\n") (delete-region (point) (point-max)) ! (while (not (bobp)) ! (skip-chars-backward " \t\n") ! (beginning-of-line) (setq save-pos (point) info nil) (skip-chars-forward "^/; \t\n") (downcase-region save-pos (point)) (setq major (buffer-substring save-pos (point))) ! (skip-chars-forward " \t") (setq minor "") (when (eq (char-after) ?/) (forward-char) ! (skip-chars-forward " \t") (setq save-pos (point)) (skip-chars-forward "^; \t\n") (downcase-region save-pos (point)) *************** *** 375,388 **** ((eq ?* (or (char-after save-pos) 0)) ".*") ((= (point) save-pos) ".*") (t (regexp-quote (buffer-substring save-pos (point))))))) ! (skip-chars-forward " \t\n") ;;; Got the major/minor chunks, now for the viewers/etc ;;; The first item _must_ be a viewer, according to the ;;; RFC for mailcap files (#1343) (setq viewer "") (when (eq (char-after) ?\;) (forward-char) ! (skip-chars-forward " \t\n") (setq save-pos (point)) (skip-chars-forward "^;\n") ;; skip \; --- 375,388 ---- ((eq ?* (or (char-after save-pos) 0)) ".*") ((= (point) save-pos) ".*") (t (regexp-quote (buffer-substring save-pos (point))))))) ! (skip-chars-forward " \t") ;;; Got the major/minor chunks, now for the viewers/etc ;;; The first item _must_ be a viewer, according to the ;;; RFC for mailcap files (#1343) (setq viewer "") (when (eq (char-after) ?\;) (forward-char) ! (skip-chars-forward " \t") (setq save-pos (point)) (skip-chars-forward "^;\n") ;; skip \; *************** *** 408,414 **** "*" minor)))) (mailcap-parse-mailcap-extras save-pos (point)))) (mailcap-mailcap-entry-passes-test info) ! (mailcap-add-mailcap-entry major minor info)))))) (defun mailcap-parse-mailcap-extras (st nd) ;; Grab all the extra stuff from a mailcap entry --- 408,415 ---- "*" minor)))) (mailcap-parse-mailcap-extras save-pos (point)))) (mailcap-mailcap-entry-passes-test info) ! (mailcap-add-mailcap-entry major minor info)) ! (beginning-of-line))))) (defun mailcap-parse-mailcap-extras (st nd) ;; Grab all the extra stuff from a mailcap entry *************** *** 497,503 **** ((and minor (string-match (car (car major)) minor)) (setq wildcard (cons (cdr (car major)) wildcard)))) (setq major (cdr major))) ! (nconc (nreverse exact) (nreverse wildcard)))) (defun mailcap-unescape-mime-test (test type-info) (let (save-pos save-chr subst) --- 498,504 ---- ((and minor (string-match (car (car major)) minor)) (setq wildcard (cons (cdr (car major)) wildcard)))) (setq major (cdr major))) ! (nconc exact wildcard))) (defun mailcap-unescape-mime-test (test type-info) (let (save-pos save-chr subst) *************** *** 590,605 **** (setq mailcap-mime-data (cons (cons major (list (cons minor info))) mailcap-mime-data)) ! (let ((cur-minor (assoc minor old-major))) ! (cond ! ((or (null cur-minor) ; New minor area, or ! (assq 'test info)) ; Has a test, insert at beginning ! (setcdr old-major (cons (cons minor info) (cdr old-major)))) ! ((and (not (assq 'test info)) ; No test info, replace completely ! (not (assq 'test cur-minor))) ! (setcdr cur-minor info)) ! (t ! (setcdr old-major (cons (cons minor info) (cdr old-major))))))))) (defun mailcap-add (type viewer &optional test) "Add VIEWER as a handler for TYPE. --- 591,609 ---- (setq mailcap-mime-data (cons (cons major (list (cons minor info))) mailcap-mime-data)) ! (let ((cur-minor (assoc minor old-major))) ! (cond ! ((or (null cur-minor) ; New minor area, or ! (assq 'test info)) ; Has a test, insert at beginning ! (setcdr old-major (cons (cons minor info) (cdr old-major)))) ! ((and (not (assq 'test info)) ; No test info, replace completely ! (not (assq 'test cur-minor)) ! (equal (assq 'viewer info) ; Keep alternative viewer ! (assq 'viewer cur-minor))) ! (setcdr cur-minor info)) ! (t ! (setcdr old-major (cons (cons minor info) (cdr old-major)))))) ! ))) (defun mailcap-add (type viewer &optional test) "Add VIEWER as a handler for TYPE. *************** *** 670,678 **** (if (mailcap-viewer-passes-test (car viewers) info) (setq passed (cons (car viewers) passed))) (setq viewers (cdr viewers))) ! (setq passed (sort (nreverse passed) 'mailcap-viewer-lessp)) (setq viewer (car passed)))) - (setq passed (nreverse passed)) (when (and (stringp (cdr (assq 'viewer viewer))) passed) (setq viewer (car passed))) --- 674,681 ---- (if (mailcap-viewer-passes-test (car viewers) info) (setq passed (cons (car viewers) passed))) (setq viewers (cdr viewers))) ! (setq passed (sort passed 'mailcap-viewer-lessp)) (setq viewer (car passed)))) (when (and (stringp (cdr (assq 'viewer viewer))) passed) (setq viewer (car passed))) *************** *** 796,833 **** "An assoc list of file extensions and corresponding MIME content-types.") (defun mailcap-parse-mimetypes (&optional path) ! ;; Parse out all the mimetypes specified in a unix-style path string PATH (cond (path nil) ((getenv "MIMETYPES") (setq path (getenv "MIMETYPES"))) ((memq system-type '(ms-dos ms-windows windows-nt)) ! (setq path (mapconcat 'expand-file-name ! '("~/mime.typ" "~/etc/mime.typ") ";"))) ! (t (setq path (mapconcat ! 'expand-file-name ! ;; mime.types seems to be the normal name, ! ;; definitely so on current GNUish systems. The ! ;; ordering follows that for mailcap. ! '("~/.mime.types" ! "/etc/mime.types" ! "/usr/etc/mime.types" ! "/usr/local/etc/mime.types" ! "/usr/local/www/conf/mime.types" ! "~/.mime-types" ! "/etc/mime-types" ! "/usr/etc/mime-types" ! "/usr/local/etc/mime-types" ! "/usr/local/www/conf/mime-types") ":")))) ! (let ((fnames (reverse ! (split-string path ! (if (memq system-type ! '(ms-dos ms-windows windows-nt)) ! ";" ":")))) fname) (while fnames (setq fname (car fnames)) ! (if (and (file-exists-p fname) (file-readable-p fname)) ! (mailcap-parse-mimetype-file (car fnames))) (setq fnames (cdr fnames))))) (defun mailcap-parse-mimetype-file (fname) --- 799,835 ---- "An assoc list of file extensions and corresponding MIME content-types.") (defun mailcap-parse-mimetypes (&optional path) ! "Parse out all the mimetypes specified in a unix-style path string PATH. ! Components of PATH are separated by the `path-separator' character ! appropriate for this system. If PATH is omitted, use the value of ! environment variable MIMETYPES if set; otherwise use a default path." (cond (path nil) ((getenv "MIMETYPES") (setq path (getenv "MIMETYPES"))) ((memq system-type '(ms-dos ms-windows windows-nt)) ! (setq path '("~/mime.typ" "~/etc/mime.typ"))) ! (t (setq path ! ;; mime.types seems to be the normal name, definitely so ! ;; on current GNUish systems. The search order follows ! ;; that for mailcap. ! '("~/.mime.types" ! "/etc/mime.types" ! "/usr/etc/mime.types" ! "/usr/local/etc/mime.types" ! "/usr/local/www/conf/mime.types" ! "~/.mime-types" ! "/etc/mime-types" ! "/usr/etc/mime-types" ! "/usr/local/etc/mime-types" ! "/usr/local/www/conf/mime-types")))) ! (let ((fnames (reverse (if (stringp path) ! (parse-colon-path path) ! path))) fname) (while fnames (setq fname (car fnames)) ! (if (and (file-readable-p fname)) ! (mailcap-parse-mimetype-file fname)) (setq fnames (cdr fnames))))) (defun mailcap-parse-mimetype-file (fname) *** pub/pgnus/lisp/message.el Mon Apr 24 21:01:39 2000 --- pgnus/lisp/message.el Mon May 1 14:58:52 2000 *************** *** 299,304 **** --- 299,309 ---- :group 'message-forwarding :type 'boolean) + (defcustom message-forward-show-mml t + "*If non-nil, forward messages are shown as mml. Otherwise, forward messages are unchanged." + :group 'message-forwarding + :type 'boolean) + (defcustom message-forward-before-signature t "*If non-nil, put forwarded message before signature, else after." :group 'message-forwarding *************** *** 844,850 **** "\\([" cite-prefix "]+[" cite-suffix "]*\\)?" "[:>|}].*") (0 'message-cited-text-face)) ! ("<#/?\\(multipart\\|part\\|external\\).*>" (0 'message-mml-face)))) "Additional expressions to highlight in Message mode.") --- 849,855 ---- "\\([" cite-prefix "]+[" cite-suffix "]*\\)?" "[:>|}].*") (0 'message-cited-text-face)) ! ("<#/?\\(multipart\\|part\\|external\\|mml\\).*>" (0 'message-mml-face)))) "Additional expressions to highlight in Message mode.") *************** *** 889,894 **** --- 894,907 ---- mm-auto-save-coding-system "Coding system to compose mail.") + (defcustom message-send-mail-partially-limit 1000000 + "The limitation of messages sent as message/partial. + The lower bound of message size in characters, beyond which the message + should be sent in several parts. If it is nil, the size is unlimited." + :group 'message-buffers + :type '(choice (const :tag "unlimited" nil) + (integer 1000000))) + ;;; Internal variables. (defvar message-buffer-list nil) *************** *** 2146,2151 **** --- 2159,2229 ---- (eval (car actions))))) (pop actions))) + (defun message-send-mail-partially () + "Sendmail as message/partial." + (let ((p (goto-char (point-min))) + (tembuf (message-generate-new-buffer-clone-locals " message temp")) + (curbuf (current-buffer)) + (id (message-make-message-id)) (n 1) + plist total header required-mail-headers) + (while (not (eobp)) + (if (< (point-max) (+ p message-send-mail-partially-limit)) + (goto-char (point-max)) + (goto-char (+ p message-send-mail-partially-limit)) + (beginning-of-line) + (if (<= (point) p) (forward-line 1))) ;; In case of bad message. + (push p plist) + (setq p (point))) + (setq total (length plist)) + (push (point-max) plist) + (setq plist (nreverse plist)) + (unwind-protect + (save-excursion + (setq p (pop plist)) + (while plist + (set-buffer curbuf) + (copy-to-buffer tembuf p (car plist)) + (set-buffer tembuf) + (goto-char (point-min)) + (if header + (progn + (goto-char (point-min)) + (narrow-to-region (point) (point)) + (insert header)) + (message-goto-eoh) + (setq header (buffer-substring (point-min) (point))) + (goto-char (point-min)) + (narrow-to-region (point) (point)) + (insert header) + (message-remove-header "Mime-Version") + (message-remove-header "Content-Type") + (message-remove-header "Content-Transfer-Encoding") + (message-remove-header "Message-ID") + (message-remove-header "Lines") + (goto-char (point-max)) + (insert "Mime-Version: 1.0\n") + (setq header (buffer-substring (point-min) (point-max)))) + (goto-char (point-max)) + (insert (format "Content-Type: message/partial; id=\"%s\"; number=%d; total=%d\n" + id n total)) + (let ((mail-header-separator "")) + (when (memq 'Message-ID message-required-mail-headers) + (insert "Message-ID: " (message-make-message-id) "\n")) + (when (memq 'Lines message-required-mail-headers) + (let ((mail-header-separator "")) + (insert "Lines: " (message-make-lines) "\n"))) + (message-goto-subject) + (end-of-line) + (insert (format " (%d/%d)" n total)) + (goto-char (point-max)) + (insert "\n") + (widen) + (funcall message-send-mail-function)) + (setq n (+ n 1)) + (setq p (pop plist)) + (erase-buffer))) + (kill-buffer tembuf)))) + (defun message-send-mail (&optional arg) (require 'mail-utils) (let* ((tembuf (message-generate-new-buffer-clone-locals " message temp")) *************** *** 2192,2198 **** (or (message-fetch-field "cc") (message-fetch-field "to"))) (message-insert-courtesy-copy)) ! (funcall message-send-mail-function)) (kill-buffer tembuf)) (set-buffer mailbuf) (push 'mail message-sent-message-via))) --- 2270,2280 ---- (or (message-fetch-field "cc") (message-fetch-field "to"))) (message-insert-courtesy-copy)) ! (if (or (not message-send-mail-partially-limit) ! (< (point-max) message-send-mail-partially-limit) ! (not (y-or-n-p "The message size is too large, should it be sent partially?"))) ! (funcall message-send-mail-function) ! (message-send-mail-partially))) (kill-buffer tembuf)) (set-buffer mailbuf) (push 'mail message-sent-message-via))) *************** *** 3921,3929 **** "Forward the current message via mail. Optional NEWS will use news to forward instead of mail." (interactive "P") ! (let ((cur (current-buffer)) ! (subject (message-make-forward-subject)) ! art-beg) (if news (message-news nil subject) (message-mail nil subject)) --- 4003,4014 ---- "Forward the current message via mail. Optional NEWS will use news to forward instead of mail." (interactive "P") ! (let* ((cur (current-buffer)) ! (subject (if message-forward-show-mml ! (message-make-forward-subject) ! (mail-decode-encoded-word-string ! (message-make-forward-subject)))) ! art-beg) (if news (message-news nil subject) (message-mail nil subject)) *************** *** 3933,3949 **** (message-goto-body) (goto-char (point-max))) (if message-forward-as-mime ! (insert "\n\n<#part type=message/rfc822 disposition=inline>\n") (insert "\n-------------------- Start of forwarded message --------------------\n")) (let ((b (point)) e) ! (mml-insert-buffer cur) (setq e (point)) (if message-forward-as-mime ! (insert "<#/part>\n") (insert "\n-------------------- End of forwarded message --------------------\n")) ! (when (and (not current-prefix-arg) ! message-forward-ignored-headers) (save-restriction (narrow-to-region b e) (goto-char b) --- 4018,4044 ---- (message-goto-body) (goto-char (point-max))) (if message-forward-as-mime ! (if message-forward-show-mml ! (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n") ! (insert "\n\n<#part type=message/rfc822 disposition=inline" ! " buffer=\"" (buffer-name cur) "\">\n")) (insert "\n-------------------- Start of forwarded message --------------------\n")) (let ((b (point)) e) ! (if message-forward-show-mml ! (insert-buffer-substring cur) ! (unless message-forward-as-mime ! (mml-insert-buffer cur))) (setq e (point)) (if message-forward-as-mime ! (if message-forward-show-mml ! (insert "<#/mml>\n") ! (insert "<#/part>\n")) (insert "\n-------------------- End of forwarded message --------------------\n")) ! (when (and (or message-forward-show-mml ! (not message-forward-as-mime)) ! (not current-prefix-arg) ! message-forward-ignored-headers) (save-restriction (narrow-to-region b e) (goto-char b) *** pub/pgnus/lisp/mm-bodies.el Mon Apr 24 21:01:39 2000 --- pgnus/lisp/mm-bodies.el Mon May 1 14:58:53 2000 *************** *** 60,66 **** If no encoding was done, nil is returned." (if (not (featurep 'mule)) ;; In the non-Mule case, we search for non-ASCII chars and ! ;; return the value of `mm-default-charset' if any are found. (save-excursion (goto-char (point-min)) (if (re-search-forward "[^\x0-\x7f]" nil t) --- 60,66 ---- If no encoding was done, nil is returned." (if (not (featurep 'mule)) ;; In the non-Mule case, we search for non-ASCII chars and ! ;; return the value of `mail-parse-charset' if any are found. (save-excursion (goto-char (point-min)) (if (re-search-forward "[^\x0-\x7f]" nil t) *************** *** 168,179 **** ;; have been added by mailing list software. (save-excursion (goto-char (point-min)) ! (if (re-search-forward "^[\t ]*$" nil t) ! (delete-region (point) (point-max)) ! (goto-char (point-max))) ! (skip-chars-backward "\n\t ") ! (delete-region (point) (point-max)) ! (point)))) ((memq encoding '(7bit 8bit binary)) ;; Do nothing. ) --- 168,176 ---- ;; have been added by mailing list software. (save-excursion (goto-char (point-min)) ! (while (re-search-forward "^[\t ]*\r?\n" nil t) ! (delete-region (match-beginning 0) (match-end 0))) ! (point-max)))) ((memq encoding '(7bit 8bit binary)) ;; Do nothing. ) *** pub/pgnus/lisp/mm-decode.el Mon Apr 24 21:01:40 2000 --- pgnus/lisp/mm-decode.el Mon May 1 14:58:53 2000 *************** *** 27,34 **** (require 'mail-parse) (require 'mailcap) (require 'mm-bodies) ! (defvar mm-xemacs-p (string-match "XEmacs" (emacs-version))) (defgroup mime-display () "Display of MIME in mail and news articles." --- 27,36 ---- (require 'mail-parse) (require 'mailcap) (require 'mm-bodies) + (eval-when-compile (require 'cl)) ! (eval-and-compile ! (autoload 'mm-inline-partial "mm-partial")) (defgroup mime-display () "Display of MIME in mail and news articles." *************** *** 126,131 **** --- 128,134 ---- (locate-library "vcard")))) ("message/delivery-status" mm-inline-text identity) ("message/rfc822" mm-inline-message identity) + ("message/partial" mm-inline-partial identity) ("text/.*" mm-inline-text identity) ("audio/wav" mm-inline-audio (lambda (handle) *************** *** 148,153 **** --- 151,157 ---- (defcustom mm-inlined-types '("image/.*" "text/.*" "message/delivery-status" "message/rfc822" + "message/partial" "application/pgp-signature") "List of media types that are to be displayed inline." :type '(repeat string) *************** *** 181,187 **** Viewing agents are supposed to view the last possible part of a message, as that is supposed to be the richest. However, users may prefer other types instead, and this list says what types are most unwanted. If, ! for instance, text/html parts are very unwanted, and text/richtech are somewhat unwanted, then the value of this variable should be set to: --- 185,191 ---- Viewing agents are supposed to view the last possible part of a message, as that is supposed to be the richest. However, users may prefer other types instead, and this list says what types are most unwanted. If, ! for instance, text/html parts are very unwanted, and text/richtext are somewhat unwanted, then the value of this variable should be set to: *************** *** 227,233 **** (if (or (not ctl) (not (string-match "/" (car ctl)))) (mm-dissect-singlepart ! '("text/plain") (and cte (intern (downcase (mail-header-remove-whitespace (mail-header-remove-comments cte))))) --- 231,237 ---- (if (or (not ctl) (not (string-match "/" (car ctl)))) (mm-dissect-singlepart ! '("text/plain") (and cte (intern (downcase (mail-header-remove-whitespace (mail-header-remove-comments cte))))) *************** *** 392,398 **** (unwind-protect (start-process "*display*" nil "xterm" ! "-e" shell-file-name shell-command-switch (mm-mailcap-command method file (mm-handle-type handle))) --- 396,402 ---- (unwind-protect (start-process "*display*" nil "xterm" ! "-e" shell-file-name shell-command-switch (mm-mailcap-command method file (mm-handle-type handle))) *************** *** 407,413 **** (unwind-protect (progn (call-process shell-file-name nil ! (setq buffer (generate-new-buffer "*mm*")) nil shell-command-switch --- 411,417 ---- (unwind-protect (progn (call-process shell-file-name nil ! (setq buffer (generate-new-buffer "*mm*")) nil shell-command-switch *************** *** 464,470 **** (mapconcat 'identity (nreverse out) ""))) (defun mm-remove-parts (handles) ! "Remove the displayed MIME parts represented by HANDLE." (if (and (listp handles) (bufferp (car handles))) (mm-remove-part handles) --- 468,474 ---- (mapconcat 'identity (nreverse out) ""))) (defun mm-remove-parts (handles) ! "Remove the displayed MIME parts represented by HANDLES." (if (and (listp handles) (bufferp (car handles))) (mm-remove-part handles) *************** *** 481,487 **** (mm-remove-part handle))))))) (defun mm-destroy-parts (handles) ! "Remove the displayed MIME parts represented by HANDLE." (if (and (listp handles) (bufferp (car handles))) (mm-destroy-part handles) --- 485,491 ---- (mm-remove-part handle))))))) (defun mm-destroy-parts (handles) ! "Remove the displayed MIME parts represented by HANDLES." (if (and (listp handles) (bufferp (car handles))) (mm-destroy-part handles) *************** *** 720,728 **** result)) (defun mm-preferred-alternative-precedence (handles) ! "Return the precedence based on HANDLES and mm-discouraged-alternatives." ! (let ((seq (nreverse (mapcar (lambda (h) ! (mm-handle-media-type h)) handles)))) (dolist (disc (reverse mm-discouraged-alternatives)) (dolist (elem (copy-sequence seq)) --- 724,731 ---- result)) (defun mm-preferred-alternative-precedence (handles) ! "Return the precedence based on HANDLES and `mm-discouraged-alternatives'." ! (let ((seq (nreverse (mapcar #'mm-handle-media-type handles)))) (dolist (disc (reverse mm-discouraged-alternatives)) (dolist (elem (copy-sequence seq)) *************** *** 734,770 **** "Return the handle(s) referred to by ID." (cdr (assoc id mm-content-id-alist))) ! (defun mm-get-image-emacs (handle) ! "Return an image instance based on HANDLE." ! (let ((type (mm-handle-media-subtype handle)) ! spec) ! ;; Allow some common translations. ! (setq type ! (cond ! ((equal type "x-pixmap") ! "xpm") ! ((equal type "x-xbitmap") ! "xbm") ! (t type))) ! (or (mm-handle-cache handle) ! (mm-with-unibyte-buffer ! (mm-insert-part handle) ! (prog1 ! (setq spec ! (ignore-errors ! (cond ! ((equal type "xbm") ! ;; xbm images require special handling, since ! ;; the only way to create glyphs from these ! ;; (without a ton of work) is to write them ! ;; out to a file, and then create a file ! ;; specifier. ! (error "Don't know what to do for XBMs right now.")) ! (t ! (list 'image :type (intern type) :data (buffer-string)))))) ! (mm-handle-set-cache handle spec)))))) ! ! (defun mm-get-image-xemacs (handle) "Return an image instance based on HANDLE." (let ((type (mm-handle-media-subtype handle)) spec) --- 737,743 ---- "Return the handle(s) referred to by ID." (cdr (assoc id mm-content-id-alist))) ! (defun mm-get-image (handle) "Return an image instance based on HANDLE." (let ((type (mm-handle-media-subtype handle)) spec) *************** *** 782,813 **** (prog1 (setq spec (ignore-errors ! (cond ! ((equal type "xbm") ! ;; xbm images require special handling, since ! ;; the only way to create glyphs from these ! ;; (without a ton of work) is to write them ! ;; out to a file, and then create a file ! ;; specifier. ! (let ((file (make-temp-name ! (expand-file-name "emm.xbm" ! mm-tmp-directory)))) ! (unwind-protect ! (progn ! (write-region (point-min) (point-max) file) ! (make-glyph (list (cons 'x file)))) ! (ignore-errors ! (delete-file file))))) ! (t ! (make-glyph ! (vector (intern type) :data (buffer-string))))))) (mm-handle-set-cache handle spec)))))) - (defun mm-get-image (handle) - (if mm-xemacs-p - (mm-get-image-xemacs handle) - (mm-get-image-emacs handle))) - (defun mm-image-fit-p (handle) "Say whether the image in HANDLE will fit the current window." (let ((image (mm-get-image handle))) --- 755,783 ---- (prog1 (setq spec (ignore-errors ! (if (fboundp 'make-glyph) ! (cond ! ((equal type "xbm") ! ;; xbm images require special handling, since ! ;; the only way to create glyphs from these ! ;; (without a ton of work) is to write them ! ;; out to a file, and then create a file ! ;; specifier. ! (let ((file (make-temp-name ! (expand-file-name "emm.xbm" ! mm-tmp-directory)))) ! (unwind-protect ! (progn ! (write-region (point-min) (point-max) file) ! (make-glyph (list (cons 'x file)))) ! (ignore-errors ! (delete-file file))))) ! (t ! (make-glyph ! (vector (intern type) :data (buffer-string))))) ! (create-image (buffer-string) (intern type) 'data-p)))) (mm-handle-set-cache handle spec)))))) (defun mm-image-fit-p (handle) "Say whether the image in HANDLE will fit the current window." (let ((image (mm-get-image handle))) *************** *** 830,836 **** (valid-image-instantiator-format-p format)) ;; Handle Emacs 21 ((fboundp 'image-type-available-p) ! (image-type-available-p format)) ;; Nobody else can do images yet. (t nil))) --- 800,807 ---- (valid-image-instantiator-format-p format)) ;; Handle Emacs 21 ((fboundp 'image-type-available-p) ! (and (display-graphic-p) ! (image-type-available-p format))) ;; Nobody else can do images yet. (t nil))) *************** *** 843,846 **** (provide 'mm-decode) ! ;; mm-decode.el ends here --- 814,817 ---- (provide 'mm-decode) ! ;;; mm-decode.el ends here *** pub/pgnus/lisp/mm-partial.el Mon May 1 14:59:09 2000 --- pgnus/lisp/mm-partial.el Mon May 1 14:58:53 2000 *************** *** 0 **** --- 1,153 ---- + ;;; mm-partial.el --- showing message/partial + ;; Copyright (C) 2000 Free Software Foundation, Inc. + + ;; Author: Shenghuo Zhu + ;; Keywords: message partial + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published + ;; by the Free Software Foundation; either version 2, or (at your + ;; option) any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, but + ;; WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + ;; General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to the + ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (eval-when-compile + (require 'cl)) + + (require 'gnus-sum) + (require 'mm-util) + (require 'mm-decode) + + (defun mm-partial-find-parts (id &optional art) + (let ((headers (save-excursion + (set-buffer gnus-summary-buffer) + gnus-newsgroup-headers)) + phandles handles header) + (while (setq header (pop headers)) + (unless (eq (aref header 0) art) + (mm-with-unibyte-buffer + (gnus-request-article-this-buffer (aref header 0) + gnus-newsgroup-name) + (when (search-forward id nil t) + (let ((nhandles (mm-dissect-buffer)) nid) + (setq handles gnus-article-mime-handles) + (if (consp (car nhandles)) + (mm-destroy-parts nhandles) + (setq nid (cdr (assq 'id + (cdr (mm-handle-type nhandles))))) + (if (not (equal id nid)) + (mm-destroy-parts nhandles) + (push nhandles phandles)))))))) + phandles)) + + ;;;###autoload + (defun mm-inline-partial (handle &optional no-display) + "Show the partial part of HANDLE. + This function replaces the buffer of HANDLE with a buffer contains + the entire message. + If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." + (let ((id (cdr (assq 'id (cdr (mm-handle-type handle))))) + phandles + (b (point)) (n 1) total + phandle nn ntotal + gnus-displaying-mime handles buffer) + (unless (mm-handle-cache handle) + (unless id + (error "Can not find message/partial id.")) + (setq phandles + (sort (cons handle + (mm-partial-find-parts + id + (save-excursion + (set-buffer gnus-summary-buffer) + (gnus-summary-article-number)))) + #'(lambda (a b) + (let ((anumber (string-to-number + (cdr (assq 'number + (cdr (mm-handle-type a)))))) + (bnumber (string-to-number + (cdr (assq 'number + (cdr (mm-handle-type b))))))) + (< anumber bnumber))))) + (setq gnus-article-mime-handles + (append (if (listp (car gnus-article-mime-handles)) + gnus-article-mime-handles + (list gnus-article-mime-handles)) + phandles)) + (save-excursion + (set-buffer (generate-new-buffer "*mm*")) + (while (setq phandle (pop phandles)) + (setq nn (string-to-number + (cdr (assq 'number + (cdr (mm-handle-type phandle)))))) + (setq ntotal (string-to-number + (cdr (assq 'total + (cdr (mm-handle-type phandle)))))) + (if ntotal + (if total + (unless (eq total ntotal) + (error "The numbers of total are different.")) + (setq total ntotal))) + (unless (< nn n) + (unless (eq nn n) + (error "Missing part %d" n)) + (mm-insert-part phandle) + (goto-char (point-max)) + (when (not (eq 0 (skip-chars-backward "\r\n"))) + ;; remove tail blank spaces except one + (if (looking-at "\r?\n") + (goto-char (match-end 0))) + (delete-region (point) (point-max))) + (setq n (+ n 1)))) + (unless total + (error "Don't known the total number of")) + (if (<= n total) + (error "Missing part %d" n)) + (kill-buffer (mm-handle-buffer handle)) + (setcar handle (current-buffer)) + (mm-handle-set-cache handle t))) + (unless no-display + (save-excursion + (save-restriction + (narrow-to-region b b) + (mm-insert-part handle) + (let (gnus-article-mime-handles) + (run-hooks 'gnus-article-decode-hook) + (gnus-article-prepare-display) + (setq handles gnus-article-mime-handles)) + (when handles + ;; It is in article buffer. + (setq gnus-article-mime-handles + (nconc (if (listp (car gnus-article-mime-handles)) + gnus-article-mime-handles + (list gnus-article-mime-handles)) + (if (listp (car handles)) + handles (list handles))))) + (mm-handle-set-undisplayer + handle + `(lambda () + (let (buffer-read-only) + (condition-case nil + ;; This is only valid on XEmacs. + (mapcar (lambda (prop) + (remove-specifier + (face-property 'default prop) (current-buffer))) + '(background background-pixmap foreground)) + (error nil)) + (delete-region ,(point-min-marker) ,(point-max-marker)))))))))) + + ;; mm-partial.el ends here *** pub/pgnus/lisp/mm-view.el Mon Apr 24 21:01:41 2000 --- pgnus/lisp/mm-view.el Mon May 1 14:58:53 2000 *************** *** 40,62 **** ;;; Functions for displaying various formats inline ;;; (defun mm-inline-image-emacs (handle) ! (let ((b (point)) ! (overlay nil) ! (string (copy-sequence "[MM-INLINED-IMAGE]")) buffer-read-only) (insert "\n") ! (buffer-name) ! (setq overlay (make-overlay (point) (point) (current-buffer))) ! (put-text-property 0 (length string) 'display (mm-get-image handle) string) ! (overlay-put overlay 'before-string string) ! (mm-handle-set-undisplayer handle ! `(lambda () ! (let (buffer-read-only) ! (delete-overlay ,overlay) ! (delete-region ,(set-marker (make-marker) b) ! ,(set-marker (make-marker) (point)))))))) (defun mm-inline-image-xemacs (handle) (let ((b (point)) --- 40,52 ---- ;;; Functions for displaying various formats inline ;;; (defun mm-inline-image-emacs (handle) ! (let ((b (point-marker)) buffer-read-only) (insert "\n") ! (put-image (mm-get-image handle) b "x") (mm-handle-set-undisplayer handle ! `(lambda () (remove-images ,b (1+ ,b)))))) (defun mm-inline-image-xemacs (handle) (let ((b (point)) *************** *** 73,82 **** (set-extent-property annot 'mm t) (set-extent-property annot 'duplicable t))) ! (defun mm-inline-image (handle) ! (if mm-xemacs-p ! (mm-inline-image-xemacs handle) ! (mm-inline-image-emacs handle))) (defvar mm-w3-setup nil) (defun mm-setup-w3 () --- 63,72 ---- (set-extent-property annot 'mm t) (set-extent-property annot 'duplicable t))) ! (eval-and-compile ! (if (string-match "XEmacs" (emacs-version)) ! (fset 'mm-inline-image 'mm-inline-image-xemacs) ! (fset 'mm-inline-image 'mm-inline-image-emacs))) (defvar mm-w3-setup nil) (defun mm-setup-w3 () *************** *** 157,167 **** (vcard-parse-string (mm-get-part handle) 'vcard-standard-filter)))))) (t - (setq text (mm-get-part handle)) (let ((b (point)) (charset (mail-content-type-get (mm-handle-type handle) 'charset))) ! (insert (mm-decode-string text charset)) (when (and (equal type "plain") (equal (cdr (assoc 'format (mm-handle-type handle))) "flowed")) --- 147,158 ---- (vcard-parse-string (mm-get-part handle) 'vcard-standard-filter)))))) (t (let ((b (point)) (charset (mail-content-type-get (mm-handle-type handle) 'charset))) ! (if (eq charset 'gnus-decoded) ! (mm-insert-part handle) ! (insert (mm-decode-string (mm-get-part handle) charset))) (when (and (equal type "plain") (equal (cdr (assoc 'format (mm-handle-type handle))) "flowed")) *** pub/pgnus/lisp/mml.el Mon Apr 24 21:01:41 2000 --- pgnus/lisp/mml.el Mon May 1 14:58:53 2000 *************** *** 27,35 **** (require 'mm-bodies) (require 'mm-encode) (require 'mm-decode) (eval-and-compile ! (autoload 'message-make-message-id "message")) (defvar mml-generate-multipart-alist nil "*Alist of multipart generation functions. --- 27,39 ---- (require 'mm-bodies) (require 'mm-encode) (require 'mm-decode) + (eval-when-compile 'cl) (eval-and-compile ! (autoload 'message-make-message-id "message") ! (autoload 'gnus-setup-posting-charset "gnus-msg") ! (autoload 'message-fetch-field "message") ! (autoload 'message-posting-charset "message")) (defvar mml-generate-multipart-alist nil "*Alist of multipart generation functions. *************** *** 80,86 **** (defun mml-parse-1 () "Parse the current buffer as an MML document." ! (let (struct tag point contents charsets warn use-ascii) (while (and (not (eobp)) (not (looking-at "<#/multipart"))) (cond --- 84,90 ---- (defun mml-parse-1 () "Parse the current buffer as an MML document." ! (let (struct tag point contents charsets warn use-ascii no-markup-p) (while (and (not (eobp)) (not (looking-at "<#/multipart"))) (cond *************** *** 90,101 **** (push (nconc (mml-read-tag) (list (cons 'contents (mml-read-part)))) struct)) (t ! (if (looking-at "<#part") (setq tag (mml-read-tag)) (setq tag (list 'part '(type . "text/plain")) warn t)) (setq point (point) ! contents (mml-read-part) charsets (mm-find-mime-charset-region point (point))) (when (memq nil charsets) (if (or (memq 'unknown-encoding mml-confirmation-set) --- 94,106 ---- (push (nconc (mml-read-tag) (list (cons 'contents (mml-read-part)))) struct)) (t ! (if (or (looking-at "<#part") (looking-at "<#mml")) (setq tag (mml-read-tag)) (setq tag (list 'part '(type . "text/plain")) + no-markup-p t warn t)) (setq point (point) ! contents (mml-read-part (eq 'mml (car tag))) charsets (mm-find-mime-charset-region point (point))) (when (memq nil charsets) (if (or (memq 'unknown-encoding mml-confirmation-set) *************** *** 108,115 **** (setq warn nil)) (error "Edit your message to remove those characters"))) (if (< (length charsets) 2) ! (push (nconc tag (list (cons 'contents contents))) ! struct) (let ((nstruct (mml-parse-singlepart-with-multiple-charsets tag point (point) use-ascii))) (when (and warn --- 113,123 ---- (setq warn nil)) (error "Edit your message to remove those characters"))) (if (< (length charsets) 2) ! (if (or (not no-markup-p) ! (string-match "[^ \t\r\n]" contents)) ! ;; Don't create blank parts. ! (push (nconc tag (list (cons 'contents contents))) ! struct)) (let ((nstruct (mml-parse-singlepart-with-multiple-charsets tag point (point) use-ascii))) (when (and warn *************** *** 200,221 **** (skip-chars-forward " \t\n") (cons (intern name) (nreverse contents)))) ! (defun mml-read-part () ! "Return the buffer up till the next part, multipart or closing part or multipart." ! (let ((beg (point))) ;; If the tag ended at the end of the line, we go to the next line. (when (looking-at "[ \t]*\n") (forward-line 1)) ! (if (re-search-forward ! "<#\\(/\\)?\\(multipart\\|part\\|external\\)." nil t) ! (prog1 ! (buffer-substring-no-properties beg (match-beginning 0)) ! (if (or (not (match-beginning 1)) ! (equal (match-string 2) "multipart")) ! (goto-char (match-beginning 0)) ! (when (looking-at "[ \t]*\n") ! (forward-line 1)))) ! (buffer-substring-no-properties beg (goto-char (point-max)))))) (defvar mml-boundary nil) (defvar mml-base-boundary "-=-=") --- 208,239 ---- (skip-chars-forward " \t\n") (cons (intern name) (nreverse contents)))) ! (defun mml-read-part (&optional mml) ! "Return the buffer up till the next part, multipart or closing part or multipart. ! If MML is non-nil, return the buffer up till the correspondent mml tag." ! (let ((beg (point)) (count 1)) ;; If the tag ended at the end of the line, we go to the next line. (when (looking-at "[ \t]*\n") (forward-line 1)) ! (if mml ! (progn ! (while (and (> count 0) (not (eobp))) ! (if (re-search-forward "<#\\(/\\)?mml." nil t) ! (setq count (+ count (if (match-beginning 1) -1 1))) ! (goto-char (point-max)))) ! (buffer-substring-no-properties beg (if (> count 0) ! (point) ! (match-beginning 0)))) ! (if (re-search-forward ! "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t) ! (prog1 ! (buffer-substring-no-properties beg (match-beginning 0)) ! (if (or (not (match-beginning 1)) ! (equal (match-string 2) "multipart")) ! (goto-char (match-beginning 0)) ! (when (looking-at "[ \t]*\n") ! (forward-line 1)))) ! (buffer-substring-no-properties beg (goto-char (point-max))))))) (defvar mml-boundary nil) (defvar mml-base-boundary "-=-=") *************** *** 224,230 **** (defun mml-generate-mime () "Generate a MIME message based on the current MML document." (let ((cont (mml-parse)) ! (mml-multipart-number 0)) (if (not cont) nil (with-temp-buffer --- 242,248 ---- (defun mml-generate-mime () "Generate a MIME message based on the current MML document." (let ((cont (mml-parse)) ! (mml-multipart-number mml-multipart-number)) (if (not cont) nil (with-temp-buffer *************** *** 237,243 **** (defun mml-generate-mime-1 (cont) (cond ! ((eq (car cont) 'part) (let (coded encoding charset filename type) (setq type (or (cdr (assq 'type cont)) "text/plain")) (if (member (car (split-string type "/")) '("text" "message")) --- 255,261 ---- (defun mml-generate-mime-1 (cont) (cond ! ((or (eq (car cont) 'part) (eq (car cont) 'mml)) (let (coded encoding charset filename type) (setq type (or (cdr (assq 'type cont)) "text/plain")) (if (member (car (split-string type "/")) '("text" "message")) *************** *** 248,253 **** --- 266,273 ---- ((and (setq filename (cdr (assq 'filename cont))) (not (equal (cdr (assq 'nofile cont)) "yes"))) (mm-insert-file-contents filename)) + ((eq 'mml (car cont)) + (insert (cdr (assq 'contents cont)))) (t (save-restriction (narrow-to-region (point) (point)) *************** *** 255,276 **** ;; Remove quotes from quoted tags. (goto-char (point-min)) (while (re-search-forward ! "<#!+/?\\(part\\|multipart\\|external\\)" nil t) (delete-region (+ (match-beginning 0) 2) (+ (match-beginning 0) 3)))))) ! (when (string= (car (split-string type "/")) "message") ! ;; message/rfc822 parts have to have their heads encoded. ! (save-restriction ! (message-narrow-to-head) ! (let ((rfc2047-header-encoding-alist nil)) ! (mail-encode-encoded-word-buffer)))) ! (setq charset (mm-encode-body)) ! (setq encoding (mm-body-encoding ! charset ! (if (string= (car (split-string type "/")) ! "message") ! '8bit ! (cdr (assq 'encoding cont))))) (setq coded (buffer-string))) (mm-with-unibyte-buffer (cond --- 275,299 ---- ;; Remove quotes from quoted tags. (goto-char (point-min)) (while (re-search-forward ! "<#!+/?\\(part\\|multipart\\|external\\|mml\\)" nil t) (delete-region (+ (match-beginning 0) 2) (+ (match-beginning 0) 3)))))) ! (cond ! ((eq (car cont) 'mml) ! (let ((mml-boundary (funcall mml-boundary-function ! (incf mml-multipart-number)))) ! (mml-to-mime)) ! (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b"))) ! ;; ignore 0x1b, it is part of iso-2022-jp ! (setq encoding (mm-body-7-or-8)))) ! ((string= (car (split-string type "/")) "message") ! (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b"))) ! ;; ignore 0x1b, it is part of iso-2022-jp ! (setq encoding (mm-body-7-or-8)))) ! (t ! (setq charset (mm-encode-body)) ! (setq encoding (mm-body-encoding ! charset (cdr (assq 'encoding cont)))))) (setq coded (buffer-string))) (mm-with-unibyte-buffer (cond *************** *** 479,485 **** (if (stringp (car handles)) (mml-insert-mime handles) (mml-insert-mime handles t)) ! (mm-destroy-parts handles))) (defun mml-to-mime () "Translate the current buffer from MML to MIME." --- 502,514 ---- (if (stringp (car handles)) (mml-insert-mime handles) (mml-insert-mime handles t)) ! (mm-destroy-parts handles)) ! (save-restriction ! (message-narrow-to-head) ! ;; Remove them, they are confusing. ! (message-remove-header "Content-Type") ! (message-remove-header "MIME-Version") ! (message-remove-header "Content-Transfer-Encoding"))) (defun mml-to-mime () "Translate the current buffer from MML to MIME." *************** *** 489,505 **** (mail-encode-encoded-word-buffer))) (defun mml-insert-mime (handle &optional no-markup) ! (let (textp buffer) ;; Determine type and stuff. (unless (stringp (car handle)) ! (unless (setq textp (equal (mm-handle-media-supertype handle) ! "text")) (save-excursion (set-buffer (setq buffer (generate-new-buffer " *mml*"))) ! (mm-insert-part handle)))) ! (unless no-markup ! (mml-insert-mml-markup handle buffer textp)) (cond ((stringp (car handle)) (mapcar 'mml-insert-mime (cdr handle)) (insert "<#/multipart>\n")) --- 518,543 ---- (mail-encode-encoded-word-buffer))) (defun mml-insert-mime (handle &optional no-markup) ! (let (textp buffer mmlp) ;; Determine type and stuff. (unless (stringp (car handle)) ! (unless (setq textp (equal (mm-handle-media-supertype handle) "text")) (save-excursion (set-buffer (setq buffer (generate-new-buffer " *mml*"))) ! (mm-insert-part handle) ! (if (setq mmlp (equal (mm-handle-media-type handle) ! "message/rfc822")) ! (mime-to-mml))))) ! (if mmlp ! (mml-insert-mml-markup handle nil t t) ! (unless (and no-markup ! (equal (mm-handle-media-type handle) "text/plain")) ! (mml-insert-mml-markup handle buffer textp))) (cond + (mmlp + (insert-buffer buffer) + (goto-char (point-max)) + (insert "<#/mml>\n")) ((stringp (car handle)) (mapcar 'mml-insert-mime (cdr handle)) (insert "<#/multipart>\n")) *************** *** 512,523 **** (t (insert "<#/part>\n"))))) ! (defun mml-insert-mml-markup (handle &optional buffer nofile) "Take a MIME handle and insert an MML tag." (if (stringp (car handle)) (insert "<#multipart type=" (mm-handle-media-subtype handle) ">\n") ! (insert "<#part type=" (mm-handle-media-type handle)) (dolist (elem (append (cdr (mm-handle-type handle)) (cdr (mm-handle-disposition handle)))) (insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\"")) --- 550,563 ---- (t (insert "<#/part>\n"))))) ! (defun mml-insert-mml-markup (handle &optional buffer nofile mmlp) "Take a MIME handle and insert an MML tag." (if (stringp (car handle)) (insert "<#multipart type=" (mm-handle-media-subtype handle) ">\n") ! (if mmlp ! (insert "<#mml type=" (mm-handle-media-type handle)) ! (insert "<#part type=" (mm-handle-media-type handle))) (dolist (elem (append (cdr (mm-handle-type handle)) (cdr (mm-handle-disposition handle)))) (insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\"")) *************** *** 626,633 **** 'list (mm-delete-duplicates (nconc ! (mapcar (lambda (m) (cdr m)) ! mailcap-mime-extensions) (apply 'nconc (mapcar --- 666,672 ---- 'list (mm-delete-duplicates (nconc ! (mapcar 'cdr mailcap-mime-extensions) (apply 'nconc (mapcar *************** *** 663,669 **** (goto-char (point-min)) ;; Quote parts. (while (re-search-forward ! "<#/?!*\\(multipart\\|part\\|external\\)" nil t) ;; Insert ! after the #. (goto-char (+ (match-beginning 0) 2)) (insert "!"))))) --- 702,708 ---- (goto-char (point-min)) ;; Quote parts. (while (re-search-forward ! "<#/?!*\\(multipart\\|part\\|external\\|mml\\)" nil t) ;; Insert ! after the #. (goto-char (+ (match-beginning 0) 2)) (insert "!"))))) *************** *** 678,684 **** (value (pop plist))) (when value ;; Quote VALUE if it contains suspicious characters. ! (when (string-match "[\"\\~/* \t\n]" value) (setq value (prin1-to-string value))) (insert (format " %s=%s" key value))))) (insert ">\n")) --- 717,723 ---- (value (pop plist))) (when value ;; Quote VALUE if it contains suspicious characters. ! (when (string-match "[\"'\\~/*;() \t\n]" value) (setq value (prin1-to-string value))) (insert (format " %s=%s" key value))))) (insert ">\n")) *************** *** 751,757 **** "Display current buffer with Gnus, in a new buffer. If RAW, don't highlight the article." (interactive "P") ! (let ((buf (current-buffer))) (switch-to-buffer (get-buffer-create (concat (if raw "*Raw MIME preview of " "*MIME preview of ") (buffer-name)))) --- 790,799 ---- "Display current buffer with Gnus, in a new buffer. If RAW, don't highlight the article." (interactive "P") ! (let ((buf (current-buffer)) ! (message-posting-charset (or (gnus-setup-posting-charset ! (message-fetch-field "Newsgroups")) ! message-posting-charset))) (switch-to-buffer (get-buffer-create (concat (if raw "*Raw MIME preview of " "*MIME preview of ") (buffer-name)))) *************** *** 762,770 **** (replace-match "\n")) (mml-to-mime) (unless raw ! (run-hooks 'gnus-article-decode-hook) ! (let ((gnus-newsgroup-name "dummy")) ! (gnus-article-prepare-display))) (fundamental-mode) (setq buffer-read-only t) (goto-char (point-min)))) --- 804,813 ---- (replace-match "\n")) (mml-to-mime) (unless raw ! (let ((gnus-newsgroup-charset (car message-posting-charset))) ! (run-hooks 'gnus-article-decode-hook) ! (let ((gnus-newsgroup-name "dummy")) ! (gnus-article-prepare-display)))) (fundamental-mode) (setq buffer-read-only t) (goto-char (point-min)))) *** pub/pgnus/lisp/nndoc.el Mon Apr 24 21:01:41 2000 --- pgnus/lisp/nndoc.el Mon May 1 14:58:53 2000 *************** *** 71,78 **** (body-begin-function . nndoc-babyl-body-begin) (head-begin-function . nndoc-babyl-head-begin)) (forward ! (article-begin . "^-+ Start of forwarded message -+\n+") ! (body-end . "^-+ End of forwarded message -+$") (prepare-body-function . nndoc-unquote-dashes)) (rfc934 (article-begin . "^--.*\n+") --- 71,78 ---- (body-begin-function . nndoc-babyl-body-begin) (head-begin-function . nndoc-babyl-head-begin)) (forward ! (article-begin . "^-+ \\(Start of \\)?forwarded message -+\n+") ! (body-end . "^-+ End \\(of \\)?forwarded message -+$") (prepare-body-function . nndoc-unquote-dashes)) (rfc934 (article-begin . "^--.*\n+") *** pub/pgnus/lisp/nnmbox.el Wed Jan 5 17:09:50 2000 --- pgnus/lisp/nnmbox.el Mon May 1 14:58:54 2000 *************** *** 519,525 **** (defun nnmbox-create-mbox () (when (not (file-exists-p nnmbox-mbox-file)) (let ((nnmail-file-coding-system ! nnmbox-file-coding-system-for-write)) (nnmail-write-region 1 1 nnmbox-mbox-file t 'nomesg)))) (defun nnmbox-read-mbox () --- 519,526 ---- (defun nnmbox-create-mbox () (when (not (file-exists-p nnmbox-mbox-file)) (let ((nnmail-file-coding-system ! (or nnmbox-file-coding-system-for-write ! nnmbox-file-coding-system))) (nnmail-write-region 1 1 nnmbox-mbox-file t 'nomesg)))) (defun nnmbox-read-mbox () *** pub/pgnus/lisp/rfc2047.el Mon Apr 24 21:01:47 2000 --- pgnus/lisp/rfc2047.el Mon May 1 14:58:54 2000 *************** *** 80,86 **** (defvar rfc2047-q-encoding-alist '(("\\(From\\|Cc\\|To\\|Bcc\||Reply-To\\):" . "-A-Za-z0-9!*+/=_") ! ("." . "^\000-\007\013\015-\037\200-\377=_?")) "Alist of header regexps and valid Q characters.") ;;; --- 80,86 ---- (defvar rfc2047-q-encoding-alist '(("\\(From\\|Cc\\|To\\|Bcc\||Reply-To\\):" . "-A-Za-z0-9!*+/=_") ! ("." . "^\000-\007\011\013\015-\037\200-\377=_?")) "Alist of header regexps and valid Q characters.") ;;; *************** *** 112,118 **** (while (not (eobp)) (save-restriction (rfc2047-narrow-to-field) ! (when (rfc2047-encodable-p) ;; We found something that may perhaps be encoded. (while (setq elem (pop alist)) (when (or (and (stringp (car elem)) --- 112,124 ---- (while (not (eobp)) (save-restriction (rfc2047-narrow-to-field) ! (if (not (rfc2047-encodable-p)) ! (if (mm-body-7-or-8) ! ;; 8 bit must be decoded. ! (if (car message-posting-charset) ! ;; Is message-posting-charset a coding system? ! (mm-encode-coding-region (point-min) (point-max) ! (car message-posting-charset)))) ;; We found something that may perhaps be encoded. (while (setq elem (pop alist)) (when (or (and (stringp (car elem)) *************** *** 128,134 **** (t))) (goto-char (point-max))))) (when mail-parse-charset ! (encode-coding-region (point-min) (point-max) mail-parse-charset)))) (defun rfc2047-encodable-p (&optional header) --- 134,140 ---- (t))) (goto-char (point-max))))) (when mail-parse-charset ! (mm-encode-coding-region (point-min) (point-max) mail-parse-charset)))) (defun rfc2047-encodable-p (&optional header) *************** *** 158,168 **** (while (not (eobp)) (cond ((not state) ! (if (memq (char-after) blank-list) ! (setq state 'blank) ! (setq state 'word) ! (if (not (eq (setq cs (mm-charset-after)) 'ascii)) ! (setq current cs))) (setq b (point))) ((eq state 'blank) (cond --- 164,172 ---- (while (not (eobp)) (cond ((not state) ! (setq state 'word) ! (if (not (eq (setq cs (mm-charset-after)) 'ascii)) ! (setq current cs)) (setq b (point))) ((eq state 'blank) (cond *************** *** 171,176 **** --- 175,182 ---- ((memq (char-after) blank-list)) (t (setq state 'word) + (unless b + (setq b (point))) (if (not (eq (setq cs (mm-charset-after)) 'ascii)) (setq current cs))))) ((eq state 'word) *************** *** 181,189 **** (setq current nil)) ((memq (char-after) blank-list) (setq state 'blank) ! (push (list b (point) current) words) ! (setq current nil) ! (setq b (point))) ((or (eq (setq cs (mm-charset-after)) 'ascii) (if current (eq current cs) --- 187,197 ---- (setq current nil)) ((memq (char-after) blank-list) (setq state 'blank) ! (if (not current) ! (setq b nil) ! (push (list b (point) current) words) ! (setq b (point)) ! (setq current nil))) ((or (eq (setq cs (mm-charset-after)) 'ascii) (if current (eq current cs) *************** *** 207,213 **** (if (equal (nth 2 word) current) (setq beg (nth 0 word)) (when current ! (rfc2047-encode beg end current)) (setq current (nth 2 word) beg (nth 0 word) end (nth 1 word)))) --- 215,224 ---- (if (equal (nth 2 word) current) (setq beg (nth 0 word)) (when current ! (when (prog1 (and (eq beg (nth 1 word)) (nth 2 word)) ! (rfc2047-encode beg end current)) ! (goto-char beg) ! (insert " "))) (setq current (nth 2 word) beg (nth 0 word) end (nth 1 word)))) *** pub/pgnus/lisp/webmail.el Mon Apr 24 21:01:48 2000 --- pgnus/lisp/webmail.el Mon May 1 14:58:54 2000 *************** *** 23,28 **** --- 23,31 ---- ;;; Commentary: + ;; Note: Now mail.yahoo.com provides POP3 service, the webmail + ;; fetching is not going to be supported. + ;; Note: You need to have `url' and `w3' installed for this backend to ;; work. `w3' must be 4.0pre46+one-line-cookie patch or standalone ;; `url'. *************** *** 82,102 **** "%s&login=%s&f=33792&curmbox=ACTIVE&_lang=&foo=inbox&js=&page=&%s=on&_HMaction=MoveTo&tobox=trAsH&nullbox=" webmail-aux user id)) (yahoo ! (paranoid cookie post) (address . "mail.yahoo.com") (open-url "http://mail.yahoo.com/") (open-snarf . webmail-yahoo-open) (login-url;; yahoo will not accept GET content ("%s" webmail-aux) ! ".tries=1&.src=ym&.last=&promo=&lg=us&.intl=us&.bypass=&.chkP=Y&.done=http%%253a%%2F%%2Fedit.yahoo.com%%2Fconfig%%2Fmail%%253f.intl%%3D&login=%s&passwd=%s" user password) (login-snarf . webmail-yahoo-login) (list-url "%s&rb=Inbox&YN=1" webmail-aux) (list-snarf . webmail-yahoo-list) (article-snarf . webmail-yahoo-article) (trash-url ! "%s/ym/us/ShowFolder?YY=52107&inc=50&order=down&sort=date&pos=0&box=Inbox&DEL=Delete&destBox=&Mid=%s&destBox2=" webmail-aux id)) (netaddress (paranoid cookie post) --- 85,105 ---- "%s&login=%s&f=33792&curmbox=ACTIVE&_lang=&foo=inbox&js=&page=&%s=on&_HMaction=MoveTo&tobox=trAsH&nullbox=" webmail-aux user id)) (yahoo ! (paranoid agent cookie post) (address . "mail.yahoo.com") (open-url "http://mail.yahoo.com/") (open-snarf . webmail-yahoo-open) (login-url;; yahoo will not accept GET content ("%s" webmail-aux) ! ".tries=&.src=ym&.last=&promo=&.intl=&.bypass=&.partner=&.chkP=Y&.done=&login=%s&passwd=%s" user password) (login-snarf . webmail-yahoo-login) (list-url "%s&rb=Inbox&YN=1" webmail-aux) (list-snarf . webmail-yahoo-list) (article-snarf . webmail-yahoo-article) (trash-url ! "%s/ym/ShowFolder?YY=52107&inc=50&order=down&sort=date&pos=0&box=Inbox&DEL=Delete&destBox=&Mid=%s&destBox2=" webmail-aux id)) (netaddress (paranoid cookie post) *************** *** 580,590 **** (defun webmail-yahoo-login () (goto-char (point-min)) ! (if (re-search-forward "http://[a-zA-Z][0-9]\\.mail\\.yahoo\\.com/" nil t) (setq webmail-aux (match-string 0)) (webmail-error "login@1")) (if (re-search-forward "YY=[0-9]+" nil t) ! (setq webmail-aux (concat webmail-aux "ym/us/ShowFolder?" (match-string 0))) (webmail-error "login@2"))) --- 583,593 ---- (defun webmail-yahoo-login () (goto-char (point-min)) ! (if (re-search-forward "http://[^/]+[0-9]\\.mail\\.yahoo\\.com/" nil t) (setq webmail-aux (match-string 0)) (webmail-error "login@1")) (if (re-search-forward "YY=[0-9]+" nil t) ! (setq webmail-aux (concat webmail-aux "ym/ShowFolder?" (match-string 0))) (webmail-error "login@2"))) *************** *** 600,606 **** (webmail-error "list@1")) (goto-char (point-min)) (while (re-search-forward ! "bgcolor=\"#eeeeee\"\\|href=\"\\(/ym/us/ShowLetter\\?MsgId=\\([^&]+\\)&[^\"]*\\)\"" nil t) (if (setq url (match-string 1)) (progn --- 603,609 ---- (webmail-error "list@1")) (goto-char (point-min)) (while (re-search-forward ! "bgcolor=\"#eeeeee\"\\|href=\"\\(/ym/ShowLetter\\?MsgId=\\([^&]+\\)&[^\"]*\\)\"" nil t) (if (setq url (match-string 1)) (progn *** pub/pgnus/lisp/ChangeLog Mon Apr 24 21:01:25 2000 --- pgnus/lisp/ChangeLog Mon May 1 14:58:49 2000 *************** *** 1,3 **** --- 1,210 ---- + Mon May 1 15:09:46 2000 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.8.6 is released. + + 2000-04-28 21:14:21 Shenghuo ZHU + + * rfc2047.el (rfc2047-q-encoding-alist): Encode HTAB. + + 2000-04-28 16:37:09 Shenghuo ZHU + + * message.el (message-send-mail-partially): Use forward-line. + + 2000-04-28 16:01:09 Shenghuo ZHU + + * gnus-art.el (gnus-mime-button-menu): Use call-interactively. + + 2000-04-28 15:30:17 Shenghuo ZHU + + * mml.el (mml-generate-mime-1): Ignore 0x1b. + (mml-insert-mime): No markup only for text/plain. + (mime-to-mml): Remove MIME headers. + + 2000-04-28 14:23:14 Shenghuo ZHU + + * mml.el (mml-preview): Set gnus-newsgroup-charset. + * rfc2047.el (rfc2047-encode-message-header): Encode non-ascii + as 8-bit. + * lpath.el: Fbind image functions. + + 2000-04-28 Dave Love + + * gnus.el (gnus-group-startup-message): Maybe use image in Emacs + 21. + + * mailcap.el (mailcap-parse-mailcaps): Revert last change to + search order. Use parse-colon-path and remove some redundancy. + Doc fix. + (mailcap-parse-mimetypes): Code consistently with + mailcap-parse-mailcaps. Doc fix. + + * gnus-start.el (gnus-unload): Iterate over `features', not + `load-history'. + + 2000-04-28 09:52:21 Shenghuo ZHU + + * mml.el (mml-parse-1): Don't create blank parts. + (mml-read-part): Fix mml tag. + (mml-insert-mime): Convert message/rfc822. + (mml-insert-mml-markup): Add mmlp parameter. + + 2000-04-28 01:16:10 Shenghuo ZHU + + * message.el (message-send-mail-partially): Remove CTE. + + 2000-04-28 00:31:53 Shenghuo ZHU + + * lpath.el: Fbind put-image for XEmacs. + * mm-view.el (mm-inline-image): Fset it. + + 2000-04-27 23:23:37 Shenghuo ZHU + + * nndoc.el (nndoc-type-alist): Change forward regexp. + + 2000-04-27 21:57:10 Shenghuo ZHU + + * message.el (message-send-mail-partially-limit): Change the + default value. + + 2000-04-27 21:53:32 Erik Toubro Nielsen + + * gnus-util.el (gnus-extract-address-components): Name might be + "". + + 2000-04-27 20:32:06 Shenghuo ZHU + + * gnus-msg.el (gnus-summary-mail-forward): Use ARG. + (gnus-summary-post-forward): Ditto. + * message.el (message-forward-show-mml): New variable. + (message-forward): Use it. + * mml.el (mml-parse-1): Add tag mml. + (mml-read-part): Ditto. + (mml-generate-mime): Support reentance. + (mml-generate-mime-1): Support mml tag. + + 2000-04-27 Dave Love + + * gnus-art.el: Don't bother to require custom, browse-url. + (gnus-article-x-face-command): Include gnus-article-display-xface. + + * gnus-ems.el: Assume only (X)Emacs 20+. Simplify XEmacs checks. + Use defalias, not fset. + (gnus-article-display-xface): New function. + + * mm-view.el (mm-inline-image-emacs): Use put-image, remove-images. + + * mm-decode.el: Small doc fixes. Require cl when compiling. + (mm-xemacs-p): Deleted. + (mm-get-image-emacs, mm-get-image-xemacs): Deleted. + (mm-get-image): Amalgamate Emacs and XEmacs code here; for Emacs, + use create-image and don't special-case xbm. + (mm-valid-image-format-p): Use display-graphic-p. + + 2000-04-27 15:27:54 Shenghuo ZHU + + * message.el (message-send-mail-partially-limit): New variable. + (message-send-mail-partially): New function. + (message-send-mail): Use it. + * mm-bodies.el (mm-decode-content-transfer-encoding): Remove + all blank lines inside of base64. + * mm-partial.el (mm-inline-partial): Add an option. Remove tail + blank lines. + + 2000-04-27 10:03:36 Shenghuo ZHU + + * mml.el (mml-insert-tag): Match more special characters. + + 2000-04-27 09:06:29 Shenghuo ZHU + + * gnus-msg.el (gnus-bug): Avoid attaching the external buffer. + + 2000-04-27 00:58:43 Shenghuo ZHU + + * mm-decode.el (mm-inline-media-tests): Add message/partial. + (mm-inlined-types): Ditto. + * mm-partial.el: New file. + + 2000-04-27 Dave Love + + * mailcap.el (mailcap-mime-data): Fix octet-stream syntax -- might + matter in Emacs 21. + + 2000-04-26 Florian Weimer + + * mm-bodies.el (mm-encode-body): Remove reference to + mm-default-charset in comment. + + 2000-04-24 00:56:00 Björn Torkelsson + + * rfc2047.el (rfc2047-encode-message-header): Fixing typo. + + 2000-04-26 12:27:41 Shenghuo ZHU + + * gnus-draft.el (gnus-draft-send): Move gnus-draft-setup inside of + let. + + 2000-04-26 12:26:10 Pavel Janik ml. + + * gnus-draft.el (gnus-draft-setup): Fix comments. + + 2000-04-26 10:06:12 Shenghuo ZHU + + * nnmbox.el (nnmbox-create-mbox): Use nnmbox-file-coding-system, + if nnmbox-file-coding-system-for-write is nil. + + 2000-04-26 02:17:44 Shenghuo ZHU + + * gnus-msg.el (gnus-configure-posting-styles): Just remove the + header if nil. + + 2000-04-26 00:23:46 Shenghuo ZHU + + * mm-view.el (mm-inline-text): Insert directly if decoded. + * mml.el (autoload): Typo. + + 2000-04-25 22:46:36 Shenghuo ZHU + + * mml.el (mml-preview): Set up posting-charset. + * gnus-msg.el (gnus-group-posting-charset-alist): Add koi8-r. + + 2000-04-25 21:23:54 Shenghuo ZHU + + * webmail.el: Fix yahoo mail. + + 2000-04-25 20:12:17 Shenghuo ZHU + + * rfc2047.el (rfc2047-dissect-region): Don't include LWS ahead of + word if not necessary. + (rfc2047-encode-region): Put space between encoded words. + + 2000-04-24 21:11:48 Shenghuo ZHU + + * gnus-util.el (gnus-netrc-machine): Another default to nntp. + + 2000-04-24 18:14:12 Shenghuo ZHU + + * gnus-draft.el (gnus-draft-setup): Restore mml only when + required. + (gnus-draft-edit-message): Require restoration. + + 2000-04-24 16:51:04 Shenghuo ZHU + + * gnus-score.el (gnus-score-headers): Copy gnus-newsgrou-scored + back. + + 2000-04-24 16:01:15 Shenghuo ZHU + + * gnus-art.el (gnus-treat-article): Make sure that the summary + buffer is live. + + 2000-04-24 15:42:53 Shenghuo ZHU + + * mailcap.el (mailcap-parse-mailcaps): Reorder. + (mailcap-parse-mailcap): Backwards parsing. + (mailcap-possible-viewers): Remove nreverse. + (mailcap-mime-info): Ditto. + (mailcap-add-mailcap-entry): Keep alternative viewer. + Mon Apr 24 21:12:06 2000 Lars Magne Ingebrigtsen * gnus.el: Gnus v5.8.5 is released. *** pub/pgnus/texi/Makefile.in Mon Apr 24 21:01:48 2000 --- pgnus/texi/Makefile.in Mon May 1 14:58:54 2000 *************** *** 69,78 **** makeinfo -o message message.texi texi2latex.elc: texi2latex.el ! $(EMACS) -batch -l bytecomp --eval '(byte-compile-file "texi2latex.el")' latex: gnus.texi texi2latex.elc ! $(EMACS) -batch -q -no-site-file gnus.texi -l ./texi2latex.elc -f latexi-translate latexps: make texi2latex.elc --- 69,78 ---- makeinfo -o message message.texi texi2latex.elc: texi2latex.el ! $(EMACSINFO) -batch -l bytecomp --eval '(byte-compile-file "texi2latex.el")' latex: gnus.texi texi2latex.elc ! $(EMACSINFO) -batch -q -no-site-file gnus.texi -l ./texi2latex.elc -f latexi-translate latexps: make texi2latex.elc *** pub/pgnus/texi/emacs-mime.texi Wed Jan 5 17:09:54 2000 --- pgnus/texi/emacs-mime.texi Mon May 1 14:58:54 2000 *************** *** 960,965 **** --- 960,966 ---- * Simple MML Example:: An example MML document. * MML Definition:: All valid MML elements. * Advanced MML Example:: Another example MML document. + * Charset Translation:: How charsets are mapped from @sc{mule} to MIME. * Conversion:: Going from @sc{mime} to MML and vice versa. @end menu *************** *** 1181,1186 **** --- 1182,1224 ---- --=-=-=-- @end example + @node Charset Translation + @section Charset Translation + @cindex charsets + + During translation from MML to @sc{mime}, for each @sc{mime} part which + has been composed inside Emacs, an appropriate charset has to be chosen. + + @vindex mail-parse-charset + If you are running a non-@sc{mule} Emacs, this process is simple: If the + part contains any non-ASCII (8-bit) characters, the @sc{mime} charset + given by @code{mail-parse-charset} (a symbol) is used. (Never set this + variable directly, though. If you want to change the default charset, + please consult the documentation of the package which you use to process + @sc{mime} messages. + @xref{Various Message Variables, , Various Message Variables, message, + Message Manual}, for example.) + If there are only ASCII characters, the @sc{mime} charset US-ASCII is + used, of course. + + @cindex MULE + @cindex UTF-8 + @cindex Unicode + @vindex mm-mime-mule-charset-alist + Things are slightly more complicated when running Emacs with @sc{mule} + support. In this case, a list of the @sc{mule} charsets used in the + part is obtained, and the @sc{mule} charsets are translated to @sc{mime} + charsets by consulting the variable @code{mm-mime-mule-charset-alist}. + If this results in a single @sc{mime} charset, this is used to encode + the part. But if the resulting list of @sc{mime} charsets contains more + than one element, two things can happen: If it is possible to encode the + part via UTF-8, this charset is used. (For this, Emacs must support + the @code{utf-8} coding system, and the part must consist entirely of + characters which have Unicode counterparts.) If UTF-8 is not available + for some reason, the part is split into several ones, so that each one + can be encoded with a single @sc{mime} charset. The part can only be + split at line boundaries, though---if more than one @sc{mime} charset is + required to encode a single line, it is not possible to encode the part. @node Conversion @section Conversion *** pub/pgnus/texi/gnus.texi Mon Apr 24 21:01:50 2000 --- pgnus/texi/gnus.texi Mon May 1 14:58:56 2000 *************** *** 355,361 **** spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Gnus 5.8.5. @end ifinfo --- 355,361 ---- spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Gnus 5.8.6. @end ifinfo *************** *** 7332,7343 **** sub-shell. If it is a function, this function will be called with the face as the argument. If the @code{gnus-article-x-face-too-ugly} (which is a regexp) matches the @code{From} header, the face will not be shown. ! The default action under Emacs is to fork off an @code{xv} to view the ! face; under XEmacs the default action is to display the face before the @code{From} header. (It's nicer if XEmacs has been compiled with X-Face support---that will make display somewhat faster. If there's no native X-Face support, Gnus will try to convert the @code{X-Face} header using ! external programs from the @code{pbmplus} package and friends.) If you want to have this function in the display hook, it should probably come last. --- 7332,7349 ---- sub-shell. If it is a function, this function will be called with the face as the argument. If the @code{gnus-article-x-face-too-ugly} (which is a regexp) matches the @code{From} header, the face will not be shown. ! The default action under Emacs is to fork off the @code{display} ! program@footnote{@code{display} is from the ImageMagick package. For the ! @code{uncompface} and @code{icontopbm} programs look for a package ! like `compface' or `faces-xface' on a GNU/Linux system.} ! to view the face. Under XEmacs or Emacs 21+ with suitable image ! support, the default action is to display the face before the @code{From} header. (It's nicer if XEmacs has been compiled with X-Face support---that will make display somewhat faster. If there's no native X-Face support, Gnus will try to convert the @code{X-Face} header using ! external programs from the @code{pbmplus} package and ! friends.@footnote{On a GNU/Linux system look for packages with names ! like @code{netpbm} or @code{libgr-progs}.}) If you want to have this function in the display hook, it should probably come last. *************** *** 9700,9707 **** @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. 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 --- 9706,9714 ---- @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; if the value is @code{nil}, the header name will be removed. ! 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 *************** *** 11193,11203 **** @end lisp @item webmail ! Get mail from a webmail server, such as www.hotmail.com, ! mail.yahoo.com, www.netaddress.com and www.my-deja.com. ! NOTE: Webmail largely depends on w3 (url) package, whose version of "WWW ! 4.0pre.46 1999/10/01" or previous ones may not work. WARNING: Mails may lost. NO WARRANTY. --- 11200,11213 ---- @end lisp @item webmail ! Get mail from a webmail server, such as www.hotmail.com, ! webmail.netscape.com, www.netaddress.com, www.my-deja.com. ! NOTE: Now mail.yahoo.com provides POP3 service, so @sc{pop} mail source ! is suggested. ! ! NOTE: Webmail largely depends cookies. A "one-line-cookie" patch is ! required for url "4.0pre.46". WARNING: Mails may lost. NO WARRANTY. *************** *** 11206,11212 **** @table @code @item :subtype The type of the webmail server. The default is @code{hotmail}. The ! alternatives are @code{yahoo}, @code{netaddress}, @code{my-deja}. @item :user The user name to give to the webmail server. The default is the login --- 11216,11222 ---- @table @code @item :subtype The type of the webmail server. The default is @code{hotmail}. The ! alternatives are @code{netscape}, @code{netaddress}, @code{my-deja}. @item :user The user name to give to the webmail server. The default is the login *************** *** 11225,11231 **** An example webmail source: @lisp ! (webmail :subtype 'yahoo :user "user-name" :password "secret") @end lisp @end table --- 11235,11241 ---- An example webmail source: @lisp ! (webmail :subtype 'hotmail :user "user-name" :password "secret") @end lisp @end table *** pub/pgnus/texi/message.texi Mon Apr 24 21:01:50 2000 --- pgnus/texi/message.texi Mon May 1 14:58:56 2000 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Message 5.8.5 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Message 5.8.6 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 42,48 **** @tex @titlepage ! @title Message 5.8.5 Manual @author by Lars Magne Ingebrigtsen @page --- 42,48 ---- @tex @titlepage ! @title Message 5.8.6 Manual @author by Lars Magne Ingebrigtsen @page *************** *** 83,89 **** * Key Index:: List of Message mode keys. @end menu ! This manual corresponds to Message 5.8.5. Message is distributed with the Gnus distribution bearing the same version number as this manual. --- 83,89 ---- * Key Index:: List of Message mode keys. @end menu ! This manual corresponds to Message 5.8.6. Message is distributed with the Gnus distribution bearing the same version number as this manual. *************** *** 1028,1033 **** --- 1028,1044 ---- @section Various Message Variables @table @code + @item message-default-charset + @vindex message-default-charset + @cindex charset + Symbol naming a @sc{mime} charset. Non-ASCII characters in messages are + assumed to be encoded using this charset. The default is @code{nil}, + which means ask the user. (This variable is used only on non-@sc{mule} + Emacsen. + @xref{Charset Translation, , Charset Translation, emacs-mime, + Emacs MIME Manual}, for details on the @sc{mule}-to-@sc{mime} + translation process. + @item message-signature-separator @vindex message-signature-separator Regexp matching the signature separator. It is @samp{^-- *$} by *** pub/pgnus/texi/ChangeLog Mon Apr 24 21:01:50 2000 --- pgnus/texi/ChangeLog Mon May 1 14:58:56 2000 *************** *** 1,3 **** --- 1,18 ---- + 2000-04-27 Dave Love + + * gnus.texi (Article Washing): Update x-face bit. + + 2000-04-26 Florian Weimer + + * message.texi (Various Message Variables): Document + message-default-charset. + + * emacs-mime.texi (Charset Translation): New section. + + 2000-04-26 02:30:06 Shenghuo ZHU + + * gnus.texi (Posting Styles): Addition. + 2000-04-24 17:09:17 Felix Natter * gnusref.tex: New version.