+Sun Jan 3 13:32:02 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.69 is released.
+
+1999-01-03 06:45:10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-picon.el (gnus-picons-setup-buffer): Run the hook.
+
+ * gnus-agent.el (gnus-agent-remove-group): New command and
+ keystroke.
+
+ * rfc2047.el (rfc2047-decode-region): Check for us-ascii.
+
+1999-01-02 14:12:41 Simon Josefsson <jas@pdc.kth.se>
+
+ * gnus-agent.el (gnus-agent-write-servers): Make directory.
+
+1998-12-26 02:38:01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-view.el (mm-inline-text): Bind current id.
+
+ * mm-decode.el (mm-handle-id): New macro.
+ (mm-make-handle): Accept id.
+ (mm-dissect-singlepart): Use it.
+
+1998-12-23 Matt Pharr <mmp@graphics.stanford.edu>
+
+ * message.el (message-cite-original-without-signature): Use
+ message-signature-separator when searching for signature in
+ message-cite-original-without-signature.
+
+1998-12-24 16:25:38 Simon Josefsson <jas@pdc.kth.se>
+
+ * gnus.el (gnus-server-to-method): Check named methods.
+
+1998-12-24 03:27:02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-view.el (mm-view-message): Goto point-min.
+
+ * nnmail.el (nnmail-article-group): Don't delete lines, only
+ shorten them.
+
+ * gnus-msg.el (gnus-configure-posting-styles): Also do nil
+ values.
+
+ * nnheader.el (nnheader-temp-directory): New variable.
+ (nnheader-temp-directory): Removed.
+
+1998-12-22 Jack Vinson <jvinson@chevax.ecs.umass.edu>
+
+ * mailcap.el (mailcap-parse-mailcaps): Add "~/.mailcaps" to the
+ list of files to check for mailcap entries under windows-nt.
+
+1998-12-24 03:02:15 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-article-maybe-hide-headers): Check whether the
+ summary buffer exists.
+
+1998-12-22 Aaron M. Ucko <amu@mit.edu>
+
+ * nnsoup.el (nnsoup-store-reply): Remove code to deal with
+ irrelevant Sun sendmail bug.
+ (nnsoup-store-reply): Stop mucking with mail-header-separator.
+
+ * message.el (message-send-news): Bind mail-header-separator to
+ "" when asking backend to post.
+
+1998-12-22 Karl Kleinpaste <karl@justresearch.com>
+
+ * mm-uu.el (mm-dissect-disposition): New variable.
+ (mm-uu-dissect): Use it.
+
+1998-12-21 21:34:22 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-view.el (mm-inline-text): Bind url-current-object.
+
+1998-12-06 03:05:41 Simon Josefsson <jas@pdc.kth.se>
+
+ * gnus-range.el (gnus-remove-from-range): Rewrite.
+
+1998-12-09 SL Baur <steve@altair.xemacs.org>
+
+ * gnus-picon.el (annotations): Remove bogus require 'xpm.
+
+1998-12-18 Hrvoje Niksic <hniksic@srce.hr>
+
+ * message.el (message-encode-message-body): Insert `MIME-Version'
+ instead of `Mime-Version'.
+
+1998-12-04 Hrvoje Niksic <hniksic@srce.hr>
+
+ * message.el (message-insert-mime-part): Add the attachment
+ disposition.
+ (message-insert-mime-part): Make TYPE and DESCRIPTION optional.
+ (message-mime-query-type): New function.
+ (message-mime-query-description): Ditto.
+ (message-mime-query-file): Ditto.
+ (message-insert-mime-part): Use them.
+ (message-mime-insert-external): Use the new stuff.
+
+1998-12-19 23:02:26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnmail.el (nnmail-split-header-length-limit): New variable.
+
+ * mm-decode.el (mm-dissect-buffer): Check syntax.
+
+ * rfc2231.el (rfc2231-parse-string): Remove check for syntax.
+
+ * rfc2047.el (rfc2047-encodable-p): Use mm-find-charset-region.
+ (rfc2047-dissect-region): Ditto.
+
+1998-12-17 18:36:43 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-view.el (mm-view-message): Decode charset.
+
+1998-12-16 16:01:22 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * rfc2231.el (rfc2231-parse-string): Ignore syntactically invalid
+ CT headers.
+
+Wed Dec 16 01:44:40 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-bodies.el (mm-decode-content-transfer-encoding): Use
+ mm-uu-*-function.
+ * mm-uu.el (mm-uu-dissect): Use x-uuencode.
+
+1998-12-16 10:20:52 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-send-mail): Do MML first.
+ (message-send-news): Ditto.
+
+1998-12-15 20:57:18 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-picon.el (gnus-picons-face): New face.
+ (gnus-picons-try-face): Use it.
+
Tue Dec 15 19:17:43 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.68 is released.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Create Date: Oct 1, 1998
-;; $Revision: 1.1.1.4 $
+;; $Revision: 1.1.1.5 $
;; Time-stamp: <Tue Oct 6 23:48:38 EDT 1998 zsh>
;; Keywords: binhex
"^[^:]...............................................................$")
(defconst binhex-end-line ":$")
-(defvar binhex-temporary-file-directory "/tmp/")
+(defvar binhex-temporary-file-directory
+ (cond ((fboundp 'temp-directory) (temp-directory))
+ ((boundp 'temporary-file-directory) temporary-file-directory)
+ ("/tmp/")))
(if (string-match "XEmacs" emacs-version)
(defalias 'binhex-insert-char 'insert-char)
"Jj" gnus-agent-toggle-plugged
"Js" gnus-agent-fetch-session
"JS" gnus-group-send-drafts
- "Ja" gnus-agent-add-group)
+ "Ja" gnus-agent-add-group
+ "Jr" gnus-agent-remove-group)
(defun gnus-agent-group-make-menu-bar ()
(unless (boundp 'gnus-agent-group-menu)
(setf (cadddr cat) (nconc (cadddr cat) groups))
(gnus-category-write)))
+(defun gnus-agent-remove-group (arg)
+ "Remove the current group from its agent category, if any."
+ (interactive "P")
+ (let (c)
+ (gnus-group-iterate arg
+ (lambda (group)
+ (when (cadddr (setq c (gnus-group-category group)))
+ (setf (cadddr c) (delete group (cadddr c))))))
+ (gnus-category-write)))
+
;;;
;;; Server mode commands
;;;
(defun gnus-agent-write-servers ()
"Write the alist of covered servers."
+ (gnus-make-directory (nnheader-concat gnus-agent-directory "lib"))
(with-temp-file (nnheader-concat gnus-agent-directory "lib/servers")
(prin1 gnus-agent-covered-methods (current-buffer))))
("\205" "...")
("\213" "<")
("\214" "OE")
- ("\205" "...")
("\221" "`")
("\222" "'")
("\223" "``")
("\224" "''")
("\225" "*")
("\226" "-")
- ("\227" "-")
+ ("\227" "-")
("\231" "(TM)")
("\233" ">")
("\234" "oe")
(defun gnus-article-maybe-hide-headers ()
"Hide unwanted headers if `gnus-have-all-headers' is nil.
Provided for backwards compatibility."
- (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers)
- gnus-inhibit-hiding
- (gnus-article-hide-headers)))
+ (when (and (or (not (gnus-buffer-live-p gnus-summary-buffer))
+ (not (save-excursion (set-buffer gnus-summary-buffer)
+ gnus-have-all-headers)))
+ (not gnus-inhibit-hiding))
+ (gnus-article-hide-headers)))
;;; Article savers.
(set (make-local-variable variable) value-value)
;; This is either a body or a header to be inserted in the
;; message.
- (when value-value
- (let ((attr (car attribute)))
- (make-local-variable 'message-setup-hook)
- (if (eq 'body attr)
- (add-hook 'message-setup-hook
- `(lambda ()
- (save-excursion
- (message-goto-body)
- (insert ,value-value))))
+ (let ((attr (car attribute)))
+ (make-local-variable 'message-setup-hook)
+ (if (eq 'body attr)
(add-hook 'message-setup-hook
- 'gnus-message-insert-stylings)
- (push (cons (if (stringp attr) attr
- (symbol-name attr))
- value-value)
- gnus-message-style-insertions))))))))))))
+ `(lambda ()
+ (save-excursion
+ (message-goto-body)
+ (insert ,value-value))))
+ (add-hook 'message-setup-hook
+ 'gnus-message-insert-stylings)
+ (push (cons (if (stringp attr) attr
+ (symbol-name attr))
+ value-value)
+ gnus-message-style-insertions)))))))))))
(defun gnus-message-insert-stylings ()
(let (val)
;;; Code:
(require 'gnus)
-(require 'xpm)
+;; (require 'xpm)
(require 'annotations)
(require 'custom)
(require 'gnus-art)
"Face to show xbm picons in."
:group 'picons)
+(defface gnus-picons-face '((t (:foreground "black" :background "white")))
+ "Face to show picons in."
+ :group 'picons)
+
(defcustom gnus-picons-setup-hook nil
"Hook run in Picons buffers."
:group 'picons
(defun gnus-picons-setup-buffer ()
(let ((name (gnus-picons-buffer-name)))
(save-excursion
- (if (get-buffer name)
+ (if (and (get-buffer name)
+ (with-current-buffer name
+ (eq major-mode 'gnus-picons-mode)))
(set-buffer name)
(set-buffer (gnus-get-buffer-create name))
(buffer-disable-undo)
(setq buffer-read-only t)
(run-hooks 'gnus-picons-setup-hook)
+ (setq major-mode 'gnus-picons-mode)
(add-hook 'gnus-summary-prepare-exit-hook 'gnus-picons-kill-buffer))
(current-buffer))))
dir)))
(setq suffixes nil
glyph (make-glyph f))
- (when (equal suf "xbm")
- (set-glyph-face glyph 'gnus-picons-xbm-face))
+ (if (equal suf "xbm")
+ (set-glyph-face glyph 'gnus-picons-xbm-face)
+ (set-glyph-face glyph 'gnus-picons-face))
(push (cons key glyph) gnus-picons-glyph-alist)))
glyph))
(setq ranges (cdr ranges)))
out)))
-(defun gnus-remove-from-range (ranges list)
- "Return a list of ranges that has all articles from LIST removed from RANGES.
-Note: LIST has to be sorted over `<'."
- ;; !!! This function shouldn't look like this, but I've got a headache.
- (gnus-compress-sequence
- (gnus-set-difference
- (gnus-uncompress-range ranges) list)))
+(defun gnus-remove-from-range (range1 range2)
+ "Return a range that has all articles from RANGE2 removed from
+RANGE1. The returned range is always a list."
+ (if (or (null range1) (null range2))
+ range1
+ (let (out r1 r2 r1_min r1_max r2_min r2_max)
+ (setq range1 (if (listp (cdr range1)) range1 (list range1))
+ range2 (if (listp (cdr range2)) range2 (list range2))
+ r1 (car range1)
+ r2 (car range2)
+ r1_min (if (consp r1) (car r1) r1)
+ r1_max (if (consp r1) (cdr r1) r1)
+ r2_min (if (consp r2) (car r2) r2)
+ r2_max (if (consp r2) (cdr r2) r2))
+ (while (and range1 range2)
+ (cond ((< r2_max r1_min) ; r2 < r1
+ (pop range2)
+ (setq r2 (car range2)
+ r2_min (if (consp r2) (car r2) r2)
+ r2_max (if (consp r2) (cdr r2) r2)))
+ ((and (<= r2_min r1_min) (<= r1_max r2_max)) ; r2 overlap r1
+ (pop range1)
+ (setq r1 (car range1)
+ r1_min (if (consp r1) (car r1) r1)
+ r1_max (if (consp r1) (cdr r1) r1)))
+ ((and (<= r2_min r1_min) (<= r2_max r1_max)) ; r2 overlap min r1
+ (pop range2)
+ (setq r1_min (1+ r2_max)
+ r2 (car range2)
+ r2_min (if (consp r2) (car r2) r2)
+ r2_max (if (consp r2) (cdr r2) r2)))
+ ((and (<= r1_min r2_min) (<= r2_max r1_max)) ; r2 contained in r1
+ (if (eq r1_min (1- r2_min))
+ (push r1_min out)
+ (push (cons r1_min (1- r2_min)) out))
+ (pop range2)
+ (if (< r2_max r1_max) ; finished with r1?
+ (setq r1_min (1+ r2_max))
+ (pop range1)
+ (setq r1 (car range1)
+ r1_min (if (consp r1) (car r1) r1)
+ r1_max (if (consp r1) (cdr r1) r1)))
+ (setq r2 (car range2)
+ r2_min (if (consp r2) (car r2) r2)
+ r2_max (if (consp r2) (cdr r2) r2)))
+ ((and (<= r2_min r1_max) (<= r1_max r2_max)) ; r2 overlap max r1
+ (if (eq r1_min (1- r2_min))
+ (push r1_min out)
+ (push (cons r1_min (1- r2_min)) out))
+ (pop range1)
+ (setq r1 (car range1)
+ r1_min (if (consp r1) (car r1) r1)
+ r1_max (if (consp r1) (cdr r1) r1)))
+ ((< r1_max r2_min) ; r2 > r1
+ (pop range1)
+ (if (eq r1_min r1_max)
+ (push r1_min out)
+ (push (cons r1_min r1_max) out))
+ (setq r1 (car range1)
+ r1_min (if (consp r1) (car r1) r1)
+ r1_max (if (consp r1) (cdr r1) r1)))))
+ (when r1
+ (if (eq r1_min r1_max)
+ (push r1_min out)
+ (push (cons r1_min r1_max) out))
+ (pop range1))
+ (while range1
+ (push (pop range1) out))
+ (nreverse out))))
(defun gnus-member-of-range (number ranges)
(if (not (listp (cdr ranges)))
;; Various variables users may set
-(defcustom gnus-uu-tmp-dir "/tmp/"
+(defcustom gnus-uu-tmp-dir
+ (cond ((fboundp 'temp-directory) (temp-directory))
+ ((boundp 'temporary-file-directory) temporary-file-directory)
+ ("/tmp/"))
"*Variable saying where gnus-uu is to do its work.
Default is \"/tmp/\"."
:group 'gnus-extract
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "0.68"
+(defconst gnus-version-number "0.69"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number)
(not (equal server (format "%s:%s" (caaar opened)
(cadaar opened)))))
(pop opened))
- (caar opened))))
+ (caar opened))
+ ;; It could be a named method, search all servers
+ (let ((servers gnus-secondary-select-methods))
+ (while (and servers
+ (not (equal server (format "%s:%s" (caar servers)
+ (cadar servers)))))
+ (pop servers))
+ (car servers))))
(defmacro gnus-method-equal (ss1 ss2)
"Say whether two servers are equal."
find-coding-systems-region get-charset-property
coding-system-get w3-region
rmail-summary-exists rmail-select-summary
- rmail-update-summary
+ rmail-update-summary url-retrieve
))
(maybe-bind '(global-face-data
mark-active transient-mark-mode mouse-selection-click-count
gnus-newsgroup-iso-8859-1-forced
mail-mode-hook enable-multibyte-characters
adaptive-fill-first-line-regexp adaptive-fill-regexp
- url-current-mime-headers buffer-file-coding-system)))
+ url-current-mime-headers buffer-file-coding-system
+ w3-image-mappings url-current-mime-type
+ url-current-callback-func url-current-callback-data
+ url-be-asynchronous temporary-file-directory)))
(maybe-bind '(mail-mode-hook
enable-multibyte-characters browse-url-browser-function
adaptive-fill-first-line-regexp adaptive-fill-regexp
- url-current-mime-headers))
- (maybe-fbind '(color-instance-rgb-components
+ url-current-mime-headers help-echo-owns-message))
+ (maybe-fbind '(color-instance-rgb-components temp-directory
glyph-width annotation-glyph window-pixel-width glyph-height
window-pixel-height
make-color-instance color-instance-name specifier-instance
make-annotation
w3-do-setup w3-region
rmail-summary-exists rmail-select-summary rmail-update-summary
+ url-generic-parse-url
)))
(setq load-path (cons "." load-path))
(defvar mailcap-download-directory nil
"*Where downloaded files should go by default.")
-(defvar mailcap-temporary-directory (or (getenv "TMPDIR") "/tmp")
+(defvar mailcap-temporary-directory
+ (cond ((fboundp 'temp-directory) (temp-directory))
+ ((boundp 'temporary-file-directory) temporary-file-directory)
+ ("/tmp/"))
"*Where temporary files go.")
;;;
(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")
+ (setq path (mapconcat 'expand-file-name
+ '("~/mail.cap" "~/etc/mail.cap" "~/.mailcap")
";")))
(t (setq path (mapconcat 'expand-file-name
'("~/.mailcap"
(define-key message-mode-map "\C-c\C-a" 'message-mime-attach-file)
(define-key message-mode-map "\C-c\C-m\C-a" 'message-mime-attach-file)
- (define-key message-mode-map "\C-c\C-m\C-e" 'message-mime-insert-external)
+ (define-key message-mode-map "\C-c\C-m\C-e" 'message-mime-attach-external)
(define-key message-mode-map "\C-c\C-m\C-q" 'mml-quote-region)
(define-key message-mode-map "\t" 'message-tab))
(eq force 0))
(save-excursion
(goto-char (point-max))
- (not (re-search-backward
- message-signature-separator nil t))))
+ (not (re-search-backward message-signature-separator nil t))))
((and (null message-signature)
force)
t)
(list message-indent-citation-function)))))
(mml-quote-region start end)
(goto-char end)
- (when (re-search-backward "^-- $" start t)
+ (when (re-search-backward message-signature-separator start t)
;; Also peel off any blank lines before the signature.
(forward-line -1)
(while (looking-at "^[ \t]*$")
(case-fold-search nil)
(news (message-news-p))
(mailbuf (current-buffer)))
+ (message-encode-message-body)
(save-restriction
(message-narrow-to-headers)
;; Insert some headers.
(mail-encode-encoded-word-buffer)
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
- (message-encode-message-body)
(unwind-protect
(save-excursion
(set-buffer tembuf)
result)
(if (not (message-check-news-body-syntax))
nil
+ (message-encode-message-body)
(save-restriction
(message-narrow-to-headers)
;; Insert some headers.
(mail-encode-encoded-word-buffer)
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
- (message-encode-message-body)
(message-cleanup-headers)
(if (not (message-check-news-syntax))
nil
;; (funcall (intern (format "%s-request-post" (car method)))
;; (cadr method)))
(gnus-open-server method)
- (setq result (gnus-request-post method)))
+ (setq result (let ((mail-header-separator ""))
+ (gnus-request-post method))))
(kill-buffer tembuf))
(set-buffer messbuf)
(if result
;;; MIME functions
;;;
-
-;; I really think this function should be renamed. It is only useful
-;; for inserting file attachments.
-
-(defun message-mime-attach-file (file type description)
+(defun message-mime-query-file (prompt)
+ (let ((file (read-file-name prompt nil nil t)))
+ ;; Prevent some common errors. This is inspired by similar code in
+ ;; VM.
+ (when (file-directory-p file)
+ (error "%s is a directory, cannot attach" file))
+ (unless (file-exists-p file)
+ (error "No such file: %s" file))
+ (unless (file-readable-p file)
+ (error "Permission denied: %s" file))
+ file))
+
+(defun message-mime-query-type (file)
+ (let* ((default (or (mm-default-file-encoding file)
+ ;; Perhaps here we should check what the file
+ ;; looks like, and offer text/plain if it looks
+ ;; like text/plain.
+ "application/octet-stream"))
+ (string (completing-read
+ (format "Content type (default %s): " default)
+ (delete-duplicates
+ (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions)
+ :test 'equal))))
+ (if (not (equal string ""))
+ string
+ default)))
+
+(defun message-mime-query-description ()
+ (let ((description (read-string "One line description: ")))
+ (when (string-match "\\`[ \t]*\\'" description)
+ (setq description nil))
+ description))
+
+(defun message-mime-attach-file (file &optional type description)
"Attach a file to the outgoing MIME message.
The file is not inserted or encoded until you send the message with
`\\[message-send-and-exit]' or `\\[message-send]'.
string of the form \"type/subtype\". DESCRIPTION is a one-line
description of the attachment."
(interactive
- (let* ((file (read-file-name "Attach file: " nil nil t))
- (type (completing-read
- (format "Content type (default %s): "
- (or (mm-default-file-encoding file)
- ;; Perhaps here we should check
- ;; what the file looks like, and
- ;; offer text/plain if it looks
- ;; like text/plain.
- "application/octet-stream"))
- (delete-duplicates
- (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions)
- :test 'equal)))
- (description (read-string "One line description: ")))
+ (let* ((file (message-mime-query-file "Attach file: "))
+ (type (message-mime-query-type file))
+ (description (message-mime-query-description)))
(list file type description)))
- (when (string-match "\\`[ \t]*\\'" description)
- (setq description nil))
- (when (string-match "\\`[ \t]*\\'" type)
- (setq type (mm-default-file-encoding file))) nil
- ;; Prevent some common errors. This is inspired by similar code in
- ;; VM.
- (when (file-directory-p file)
- (error "%s is a directory, cannot attach" file))
- (unless (file-exists-p file)
- (error "No such file: %s" file))
- (unless (file-readable-p file)
- (error "Permission denied: %s" file))
- (insert (format "<#part type=%s filename=%s%s><#/part>\n"
- type (prin1-to-string file)
- (if description
- (format " description=%s" (prin1-to-string description))
- ""))))
-
-(defun message-mime-insert-external (file type)
- "Insert a message/external-body part into the buffer."
+ (insert (format
+ "<#part type=%s filename=%s%s disposition=attachment><#/part>\n"
+ type (prin1-to-string file)
+ (if description
+ (format " description=%s" (prin1-to-string description))
+ ""))))
+
+(defun message-mime-attach-external (file &optional type description)
+ "Attach an external file into the buffer.
+FILE is an ange-ftp/efs specification of the part location.
+TYPE is the MIME type to use."
(interactive
- (let* ((file (read-file-name "Insert file: "))
- (type (mm-default-file-encoding file)))
- (list file
- (completing-read
- (format "MIME type for %s: " file)
- (delete-duplicates
- (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions))
- nil nil type))))
- (insert (format "<#external type=%s name=\"%s\"><#/external>\n"
- type file)))
+ (let* ((file (message-mime-query-file "Attach external file: "))
+ (type (message-mime-query-type file))
+ (description (message-mime-query-description)))
+ (list file type description)))
+ (insert (format
+ "<#external type=%s name=%s disposition=attachment><#/external>\n"
+ type (prin1-to-string file))))
(defun message-encode-message-body ()
(let ((mm-default-charset message-default-charset)
(message-narrow-to-headers-or-head)
(message-remove-header "Mime-Version")
(goto-char (point-max))
- (insert "Mime-Version: 1.0\n")
+ (insert "MIME-Version: 1.0\n")
(when lines
(insert lines))
(setq multipart-p
(re-search-backward "^Content-Type: multipart/" nil t)))
+ (save-restriction
+ (message-narrow-to-headers-or-head)
+ (message-remove-first-header "Content-Type")
+ (message-remove-first-header "Content-Transfer-Encoding"))
(when multipart-p
- (save-restriction
- (message-narrow-to-headers-or-head)
- (message-remove-first-header "Content-Type")
- (message-remove-first-header "Content-Transfer-Encoding"))
(message-goto-body)
(insert "This is a MIME multipart message. If you are reading\n")
(insert "this, you shouldn't.\n"))))
((null encoding)
)
((eq encoding 'x-uuencode)
- (uudecode-decode-region (point-min) (point-max)))
+ (funcall mm-uu-decode-function (point-min) (point-max)))
((eq encoding 'x-binhex)
- (binhex-decode-region (point-min) (point-max)))
+ (funcall mm-uu-binhex-decode-function (point-min) (point-max)))
((functionp encoding)
(funcall encoding (point-min) (point-max)))
(t
`(nth 6 ,handle))
(defmacro mm-handle-set-cache (handle contents)
`(setcar (nthcdr 6 ,handle) ,contents))
+(defmacro mm-handle-id (handle)
+ `(nth 7 ,handle))
(defmacro mm-make-handle (&optional buffer type encoding undisplayer
- disposition description cache)
+ disposition description cache
+ id)
`(list ,buffer ,type ,encoding ,undisplayer
- ,disposition ,description ,cache))
+ ,disposition ,description ,cache ,id))
(defvar mm-inline-media-tests
'(("image/jpeg" mm-inline-image
"text/richtext" "text/plain")
"List that describes the precedence of alternative parts.")
-(defvar mm-tmp-directory "/tmp/"
+(defvar mm-tmp-directory
+ (cond ((fboundp 'temp-directory) (temp-directory))
+ ((boundp 'temporary-file-directory) temporary-file-directory)
+ ("/tmp/"))
"Where mm will store its temporary files.")
(defvar mm-all-images-fit nil
cd (mail-fetch-field "content-disposition")
description (mail-fetch-field "content-description")
id (mail-fetch-field "content-id"))))
- (if (not ctl)
+ (if (or (not ctl)
+ (not (string-match "/" (car ctl))))
(mm-dissect-singlepart
'("text/plain") nil no-strict-mime
(and cd (condition-case ()
(and cd (condition-case ()
(mail-header-parse-content-disposition cd)
(error nil)))
- description))))
+ description id))))
(when id
(when (string-match " *<\\(.*\\)> *" id)
(setq id (match-string 1 id)))
(push (cons id result) mm-content-id-alist))
result))))
-(defun mm-dissect-singlepart (ctl cte &optional force cdl description)
+(defun mm-dissect-singlepart (ctl cte &optional force cdl description id)
(when (or force
(not (equal "text/plain" (car ctl))))
(let ((res (mm-make-handle
- (mm-copy-to-buffer) ctl cte nil cdl description)))
+ (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
(push (car res) mm-dissection-list)
res)))
(string-match "nt" system-configuration)))
(defvar mm-binary-coding-system
- (if mm-running-xemacs
- 'binary 'no-conversion)
- "100% binary coding system.")
+ (if mm-running-xemacs
+ 'binary 'no-conversion)
+ "100% binary coding system.")
(defvar mm-text-coding-system
(cond
;; Copyright (c) 1998 by Shenghuo Zhu <zsh@cs.rochester.edu>
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; $Revision: 1.1.1.7 $
+;; $Revision: 1.1.1.8 $
;; Keywords: news postscript uudecode binhex shar
;; This file is not part of GNU Emacs, but the same permissions
(defvar mm-uu-identifier-alist
'((?% . postscript) (?b . uu) (?: . binhex) (?# . shar)))
+(defvar mm-dissect-disposition "inline"
+ "The default disposition of uu parts.
+This can be either \"inline\" or \"attachment\".")
+
;;;### autoload
(defun mm-uu-dissect ()
(mailcap-extension-to-mime
(match-string 0 file-name)))
"application/octet-stream"))
- mm-uu-decode-function nil
+ 'x-uuencode nil
(if (and file-name (not (equal file-name "")))
- (list "inline" (cons 'filename file-name)))))
+ (list mm-dissect-disposition (cons 'filename file-name)))))
((eq type 'binhex)
(mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
(list (or (and file-name
(mailcap-extension-to-mime
(match-string 0 file-name)))
"application/octet-stream"))
- mm-uu-binhex-decode-function nil
+ 'x-binhex nil
(if (and file-name (not (equal file-name "")))
- (list "inline" (cons 'filename file-name)))))
+ (list mm-dissect-disposition (cons 'filename file-name)))))
((eq type 'shar)
(mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
'("application/x-shar"))))
(setq text (mm-get-part handle))
(let ((b (point))
(url-standalone-mode t)
+ (url-current-object
+ (url-generic-parse-url (format "cid:%s" (mm-handle-id handle))))
(width (window-width)))
(save-excursion
(insert text)
(defun mm-view-message ()
(gnus-article-prepare-display)
- (fundamental-mode))
+ (run-hooks 'gnus-article-decode-hook)
+ (fundamental-mode)
+ (goto-char (point-min)))
(provide 'mm-view)
:group 'nnmail
:type '(repeat symbol))
+(defcustom nnmail-split-header-length-limit 1024
+ "Header lines longer than this limit are excluded from the split function."
+ :group 'nnmail
+ :type 'integer)
+
;;; Internal variables.
(defvar nnmail-split-history nil
(goto-char (point-min))
(while (not (eobp))
(end-of-line)
- (if (> (current-column) 1024)
- (gnus-delete-line)
+ (if (> (current-column) nnmail-split-header-length-limit)
+ (delete-region (point) (progn (end-of-line) (point)))
(forward-line 1)))
;; Allow washing.
(goto-char (point-min))
(defvoo nnsoup-directory "~/SOUP/"
"*SOUP packet directory.")
-(defvoo nnsoup-tmp-directory "/tmp/"
+(defvoo nnsoup-tmp-directory
+ (cond ((fboundp 'temp-directory) (temp-directory))
+ ((boundp 'temporary-file-directory) temporary-file-directory)
+ ("/tmp/"))
"*Where nnsoup will store temporary files.")
(defvoo nnsoup-replies-directory (concat nnsoup-directory "replies/")
(require 'mail-utils)
(let ((tembuf (generate-new-buffer " message temp"))
(case-fold-search nil)
- (real-header-separator mail-header-separator)
- (mail-header-separator "")
delimline
(mailbuf (current-buffer)))
(unwind-protect
;; Change header-delimiter to be what sendmail expects.
(goto-char (point-min))
(re-search-forward
- (concat "^" (regexp-quote real-header-separator) "\n"))
+ (concat "^" (regexp-quote mail-header-separator) "\n"))
(replace-match "\n")
(backward-char 1)
(setq delimline (point-marker))
- ;; Insert an extra newline if we need it to work around
- ;; Sun's bug that swallows newlines.
(goto-char (1+ delimline))
- (when (eval message-mailer-swallows-blank-line)
- (newline))
(let ((msg-buf
(gnus-soup-store
nnsoup-replies-directory
"Say whether the current (narrowed) buffer contains characters that need encoding."
(let ((charsets (mapcar
'mm-mule-charset-to-mime-charset
- (find-charset-region (point-min) (point-max))))
+ (mm-find-charset-region (point-min) (point-max))))
(cs (list 'us-ascii rfc2047-default-charset))
found)
(while charsets
(concat "[^" ietf-drums-tspecials " \t\n]+") nil t)
(push
(list (match-beginning 0) (match-end 0)
- (car (delq 'ascii (find-charset-region
+ (car (delq 'ascii (mm-find-charset-region
(match-beginning 0) (match-end 0)))))
words))
words)))
(when (and (mm-multibyte-p) rfc2047-default-charset)
(mm-decode-coding-region b e rfc2047-default-charset))
(setq b (point)))
- (when (and (mm-multibyte-p) rfc2047-default-charset)
+ (when (and (mm-multibyte-p)
+ rfc2047-default-charset
+ (not (eq rfc2047-default-charset 'us-ascii)))
(mm-decode-coding-region b (point-max) rfc2047-default-charset))))))
(defun rfc2047-decode-string (string)
(when prev-attribute
(push (cons prev-attribute prev-value) parameters))
- `(,type ,@(nreverse parameters))))))
+ (when type
+ `(,type ,@(nreverse parameters)))))))
(defun rfc2231-decode-encoded-string (string)
"Decode an RFC2231-encoded string.
(setq str (concat str "[^a-z]")))
(concat str ".?$")))
-(defvar uudecode-temporary-file-directory "/tmp/")
+(defvar uudecode-temporary-file-directory
+ (cond ((fboundp 'temp-directory) (temp-directory))
+ ((boundp 'temporary-file-directory) temporary-file-directory)
+ ("/tmp/")))
;;;###autoload
(defun uudecode-decode-region-external (start end &optional file-name)
+1999-01-03 13:54:51 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Group Agent Commands): Addition.
+
+1998-12-19 23:29:50 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Splitting Mail): Addition.
+
1998-12-13 08:54:07 Lars Magne Ingebrigtsen <larsi@gnus.org>
* message.texi (Insertion): Add.
\input texinfo @c -*-texinfo-*-
@setfilename gnus
-@settitle Pterodactyl Gnus 0.68 Manual
+@settitle Pterodactyl Gnus 0.69 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Pterodactyl Gnus 0.68 Manual
+@title Pterodactyl Gnus 0.69 Manual
@author by Lars Magne Ingebrigtsen
@page
spool or your mbox file. All at the same time, if you want to push your
luck.
-This manual corresponds to Pterodactyl Gnus 0.68.
+This manual corresponds to Pterodactyl Gnus 0.69.
@end ifinfo
@code{nnmail-crosspost-link-function} to @code{copy-file}. (This
variable is @code{add-name-to-file} by default.)
+@findex nnmail-split-header-length-limit
+Header lines may be arbitrarily long. However, the longer a line is,
+the longer it takes to match them. Very long lines may lead to Gnus
+taking forever to split the mail, so Gnus excludes lines that are longer
+than @code{nnmail-split-header-length-limit} (which defaults to 1024).
+
@kindex M-x nnmail-split-history
@kindex nnmail-split-history
If you wish to see where the previous mail split put the messages, you
@kindex J s (Agent Group)
@findex gnus-agent-fetch-session
Fetch all eligible articles in all groups
-(@code{gnus-agent-fetch-session}).
+(@code{gnus-agent-fetch-session}).
@item J S
@kindex J S (Agent Group)
@kindex J a (Agent Group)
@findex gnus-agent-add-group
Add the current group to an Agent category
-(@code{gnus-agent-add-group}).
+(@code{gnus-agent-add-group}). This command understands the
+process/prefix convention (@pxref{Process/Prefix}).
+
+@item J r
+@kindex J r (Agent Group)
+@findex gnus-agent-remove-group
+Remove the current group from its category, if any
+(@code{gnus-agent-remove-group}). This command understands the
+process/prefix convention (@pxref{Process/Prefix}).
@end table
\input texinfo @c -*-texinfo-*-
@setfilename message
-@settitle Pterodactyl Message 0.68 Manual
+@settitle Pterodactyl Message 0.69 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Pterodactyl Message 0.68 Manual
+@title Pterodactyl Message 0.69 Manual
@author by Lars Magne Ingebrigtsen
@page
* Key Index:: List of Message mode keys.
@end menu
-This manual corresponds to Pterodactyl Message 0.68. Message is
+This manual corresponds to Pterodactyl Message 0.69. Message is
distributed with the Gnus distribution bearing the same version number
as this manual.
projects / elisp / gnus.git- / commitdiff