+1998-09-14 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * lisp/gnus-art.el (article-decode-encoded-words): Renamed from
+ `gnus-article-decode-rfc1522'.
+
+ * lisp/mail-parse.el: New file.
+ * lisp/mm-view.el: New file.
+ * lisp/rfc2231.el: New file.
+ * texi/emacs-mime.texi: New file.
+
+ * lisp/gnus.el (gnus-version-number): Update to 6.10.019.
+
+ * Sync up with Pterodactyl Gnus 0.30.
+
1998-09-11 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus.el (gnus-version-number): Update to 6.10.018.
1998-08-28 Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
- * lisp/message.el (message-make-in-reply-to):
+ * lisp/message.el (message-make-in-reply-to):
Use `std11-extract-address-components'.
(message-use-mail-reply-to): Doc fix.
1998-08-25 Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
* lisp/gnus-cache.el (gnus-cache-possibly-enter-article):
- (gnus-cache-save-buffers): Write file in raw-text
+ (gnus-cache-save-buffers): Write file in raw-text
coding system.
* lisp/gnus-cache.el (gnus-cache-write-file-coding-system): New variable.
* lisp/gnus-util.el (gnus-write-buffer): Undo change.
1998-08-24 Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
- * lisp/gnus-offline.el (gnus-offline-setup): Bug fix and version
+ * lisp/gnus-offline.el (gnus-offline-setup): Bug fix and version
changed to 1.53.
- * lisp/gnus-util.el (gnus-write-buffer): Write file in raw-text coding
+ * lisp/gnus-util.el (gnus-write-buffer): Write file in raw-text coding
system.
* lisp/gnus-util.el (gnus-write-file-coding-system): New variable.
* Sync up with Gnus 5.6.38.
- * lisp/gnus-offline.el (gnus-offline-enable-fetch-mail): Enable to get
+ * lisp/gnus-offline.el (gnus-offline-enable-fetch-mail): Enable to get
APOP server.
* lisp/pop3-fma.el (pop3-fma-movemail): Enable to get from APOP server.
* lisp/pop3-fma.el: Small bug fix.
* lisp/pop3-fma.el: Delete variable pop3-fma-cypher-key
- Use base64-encode-string , base64-decode-string instead.
+ Use base64-encode-string , base64-decode-string instead.
Both change by Yasuo OKABE <okabe@kuis.kyoto-u.ac.jp>
1998-06-13 Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
+Sun Sep 13 09:37:37 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.30 is released.
+
+1998-09-13 08:00:41 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (article-decode-encoded-words): Use it.
+ (gnus-decode-header-function): New variable.
+
+ * gnus-sum.el (gnus-nov-parse-line): Use it.
+ (gnus-decode-encoded-word-function): New variable.
+
+ * gnus-msg.el (gnus-copy-article-buffer): Decode the right
+ buffer.
+
+ * gnus-art.el (gnus-insert-mime-button): Use widget.
+ (gnus-widget-press-button): New function.
+ (gnus-article-prev-button): Removed.
+ (gnus-article-next-button): Ditto.
+ (gnus-article-add-button): Ditto.
+
+ * gnus.el (gnus-article-mode-map): Inherit from widget.
+ (gnus-article-mode-map): No, don't.
+
+ * mm-decode.el (mm-dissect-buffer): Store Content-ID things.
+ (mm-content-id-alist): New variable.
+ (mm-get-content-id): New function.
+
+ * gnus-art.el (gnus-request-article-this-buffer): Only decode
+ articles if we are fetching to the article buffer.
+
+1998-09-13 07:58:59 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-move-article): Don't decode accepting
+ articles.
+
+1998-09-13 07:23:28 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-util.el (mm-mime-charset): Try to use safe-charsets.
+ (mm-default-mime-charset): New variable.
+
+ * rfc2047.el (rfc2047-dissect-region): Dissect using tspecials.
+
+ * drums.el (drums-quote-string): Reversed test.
+
+1998-09-12 14:29:21 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-util.el (mm-insert-rfc822-headers): Possibly not quote
+ string.
+
+ * drums.el (drums-quote-string): New function.
+
+ * rfc2047.el (rfc2047-encode-message-header): Goto point-min.
+ (rfc2047-b-encode-region): Chop lines.
+ (rfc2047-q-encode-region): Ditto.
+
+Sat Sep 12 13:27:15 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.29 is released.
+
+1998-09-12 12:46:30 Istvan Marko <imarko@pacificnet.net>
+
+ * mm-decode.el (mm-save-part): Message right.
+
+1998-09-12 11:30:01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * drums.el (drums-parse-address): Returned a list instead of a
+ string.
+ (drums-remove-whitespace): Skip comments.
+ (drums-parse-addresses): Didn't work.
+
+Sat Sep 12 09:17:30 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.28 is released.
+
+1998-09-12 04:57:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-mime-button-map): Use the article keymap as a
+ starting point.
+ (article-decode-encoded-words): Rename.
+
+ * message.el (message-narrow-to-headers-or-head): New function.
+
+ * gnus-int.el (gnus-request-accept-article): Narrow to the right
+ region.
+
+ * message.el (message-send-news): Encode body after checking
+ syntax.
+
+ * gnus-art.el (gnus-mime-button-line-format): Allow descriptions.
+
+ * mm-decode.el (mm-save-part): Use Content-Disposition filename.
+
+ * gnus-art.el (gnus-display-mime): Respect disposition.
+
+ * mm-decode.el (mm-preferred-alternative): Respect disposition.
+
+ * gnus-art.el (article-strip-multiple-blank-lines): Don't delete
+ text with annotations.
+
+ * message.el (message-make-date): Fix sign for negative time
+ zones.
+
+ * mm-view.el (mm-inline-image): Insert a space at the end of the
+ image.
+
+ * mail-parse.el: New file.
+
+ * rfc2231.el: New file.
+
+ * drums.el (drums-content-type-get): Removed.
+ (drums-parse-content-type): Ditto.
+
+ * mailcap.el (mailcap-mime-data): Use symbols instead of strings.
+
+Fri Sep 11 18:23:34 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.27 is released.
+
+1998-09-11 12:42:07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-decode.el (mm-alternative-precedence): New variable.
+ (mm-preferred-alternative): New function.
+
+ * gnus-art.el (gnus-mime-copy-part): New command.
+
+ * mm-decode.el (mm-get-part): New function.
+
+ * mm-view.el: New file.
+
+ * mm-decode.el (mm-dissect-buffer): Downcase cte.
+ (mm-display-part): Default to mailcap-save-binary-file.
+
Fri Sep 11 12:32:50 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.26 is released.
(modify-syntax-entry ?@ "w" table)
(modify-syntax-entry ?/ "w" table)
(modify-syntax-entry ?= " " table)
+ (modify-syntax-entry ?* " " table)
(modify-syntax-entry ?\; " " table)
+ (modify-syntax-entry ?\' " " table)
table))
(defun drums-token-to-list (token)
(cond
((eq c ?\")
(forward-sexp 1))
+ ((eq c ?\()
+ (forward-sexp 1))
((memq c '(? ?\t ?\n))
(delete-char 1))
(t
(cons
(mapconcat 'identity (nreverse display-name) "")
(drums-get-comment string)))
- (cons mailbox display-name)))))
+ (cons mailbox display-string)))))
(defun drums-parse-addresses (string)
"Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs."
((memq c '(?\" ?< ?\())
(forward-sexp 1))
((eq c ?,)
- (push (drums-parse-address (buffer-substring beg (1- (point))))
+ (push (drums-parse-address (buffer-substring beg (point)))
pairs)
+ (forward-char 1)
(setq beg (point)))
(t
(forward-char 1))))
+ (push (drums-parse-address (buffer-substring beg (point)))
+ pairs)
(nreverse pairs))))
(defun drums-unfold-fws ()
"Return an Emacs time spec from STRING."
(apply 'encode-time (parse-time-string string)))
-(defun drums-content-type-get (ct attribute)
- "Return the value of ATTRIBUTE from CT."
- (cdr (assq attribute (cdr ct))))
-
-(defun drums-parse-content-type (string)
- "Parse STRING and return a list."
- (with-temp-buffer
- (let ((ttoken (drums-token-to-list drums-text-token))
- (stoken (drums-token-to-list drums-tspecials))
- display-name mailbox c display-string parameters
- attribute value type subtype)
- (drums-init (drums-remove-whitespace (drums-remove-comments string)))
- (setq c (following-char))
- (when (and (memq c ttoken)
- (not (memq c stoken)))
- (setq type (downcase (buffer-substring
- (point) (progn (forward-sexp 1) (point)))))
- ;; Do the params
- (while (not (eobp))
- (setq c (following-char))
- (unless (eq c ?\;)
- (error "Invalid header: %s" string))
- (forward-char 1)
- (setq c (following-char))
- (if (and (memq c ttoken)
- (not (memq c stoken)))
- (setq attribute
- (intern
- (downcase
- (buffer-substring
- (point) (progn (forward-sexp 1) (point))))))
- (error "Invalid header: %s" string))
- (setq c (following-char))
- (unless (eq c ?=)
- (error "Invalid header: %s" string))
- (forward-char 1)
- (setq c (following-char))
- (cond
- ((eq c ?\")
- (setq value
- (buffer-substring (1+ (point))
- (progn (forward-sexp 1) (1- (point))))))
- ((and (memq c ttoken)
- (not (memq c stoken)))
- (setq value (buffer-substring
- (point) (progn (forward-sexp 1) (point)))))
- (t
- (error "Invalid header: %s" string)))
- (push (cons attribute value) parameters))
- `(,type ,@(nreverse parameters))))))
-
(defun drums-narrow-to-header ()
- "Narrow to the header of the current buffer."
+ "Narrow to the header section in the current buffer."
(narrow-to-region
(goto-char (point-min))
(if (search-forward "\n\n" nil 1)
(point-max)))
(goto-char (point-min)))
+(defun drums-quote-string (string)
+ "Quote string if it needs quoting to be displayed in a header."
+ (if (not (string-match (concat "[^" drums-atext-token "]") string))
+ (concat "\"" string "\"")
+ string))
+
(provide 'drums)
;;; drums.el ends here
(require 'gnus-cache)
(require 'nnvirtual)
(require 'gnus-sum)
-(eval-when-compile (require 'cl)
- (require 'gnus-score))
+(eval-when-compile
+ (require 'cl)
+ (require 'gnus-score))
(defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/")
"Where the Gnus agent will store its files."
(let ((dir (concat
(gnus-agent-directory)
(gnus-agent-group-path group) "/"))
- (date (time-to-day (current-time)))
+ (date (time-to-days (current-time)))
(case-fold-search t)
pos crosses id elem)
(gnus-make-directory dir)
(gnus-agent-enter-history
"last-header-fetched-for-session"
(list (cons group (nth (- (length articles) 1) articles)))
- (time-to-day (current-time)))
+ (time-to-days (current-time)))
articles)))))
(defsubst gnus-agent-copy-nov-line (article)
"Expire all old articles."
(interactive)
(let ((methods gnus-agent-covered-methods)
- (day (- (time-to-day (current-time)) gnus-agent-expire-days))
+ (day (- (time-to-days (current-time)) gnus-agent-expire-days))
gnus-command-method sym group articles
history overview file histories elem art nov-file low info
unreads marked article)
(process-send-region "article-x-face" beg end)
(process-send-eof "article-x-face"))))))))))
-(defun gnus-article-decode-rfc1522 ()
- "Decode MIME encoded-words in header fields."
+(defun article-decode-encoded-words ()
+ "Remove encoded-word encoding from headers."
(let (buffer-read-only)
(let ((charset (save-excursion
(set-buffer gnus-summary-buffer)
(goto-char (point-min))
(search-forward "\n\n" nil t)
(while (re-search-forward "^[ \t]+$" nil t)
- (replace-match "" nil t))
+ (unless (gnus-annotation-in-region-p
+ (match-beginning 0) (match-end 0))
+ (replace-match "" nil t)))
;; Then replace multiple empty lines with a single empty line.
(goto-char (point-min))
(search-forward "\n\n" nil t)
(let (buffer-read-only)
(erase-buffer)
(insert-buffer-substring gnus-article-buffer))
- (setq gnus-original-article (cons group article))))
+ (setq gnus-original-article (cons group article)))
- ;; Decode charsets.
- (run-hooks 'gnus-article-decode-hook)
+ ;; Decode charsets.
+ (run-hooks 'gnus-article-decode-hook))
;; Update sparse articles.
(when (and do-update-line
(cons group
(set-buffer (gnus-get-buffer-create
" *gnus-cache-overview*"))))
- (buffer-disable-undo (current-buffer))
;; Insert the contents of this group's cache overview.
(erase-buffer)
(let ((file (gnus-cache-file-name group ".overview")))
(gnus-cache-save-buffers)
(save-excursion
(set-buffer cache-buf)
- (buffer-disable-undo (current-buffer))
(erase-buffer)
(nnheader-insert-file-contents (or file (gnus-cache-file-name group ".overview")))
(goto-char (point-min))
(let ((cache-buf (gnus-get-buffer-create " *gnus-cache*")))
(save-excursion
(set-buffer cache-buf)
- (buffer-disable-undo (current-buffer))
(erase-buffer))
(set-buffer nntp-server-buffer)
(goto-char (point-min))
(eval-and-compile
(require 'cl))
-(require 'drums)
+(require 'mail-parse)
(defvar mailcap-parse-args-syntax-table
(let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
"A syntax table for parsing sgml attributes.")
(defvar mailcap-mime-data
- '(("multipart"
- (".*"
- ("viewer" . mailcap-save-binary-file)
- ("type" . "multipart/*")))
- ("application"
+ '(("application"
("x-x509-ca-cert"
- ("viewer" . ssl-view-site-cert)
- ("test" . (fboundp 'ssl-view-site-cert))
- ("type" . "application/x-x509-ca-cert"))
+ (viewer . ssl-view-site-cert)
+ (test . (fboundp 'ssl-view-site-cert))
+ (type . "application/x-x509-ca-cert"))
("x-x509-user-cert"
- ("viewer" . ssl-view-user-cert)
- ("test" . (fboundp 'ssl-view-user-cert))
- ("type" . "application/x-x509-user-cert"))
+ (viewer . ssl-view-user-cert)
+ (test . (fboundp 'ssl-view-user-cert))
+ (type . "application/x-x509-user-cert"))
("octet-stream"
- ("viewer" . mailcap-save-binary-file)
- ("type" ."application/octet-stream"))
+ (viewer . mailcap-save-binary-file)
+ (type ."application/octet-stream"))
("dvi"
- ("viewer" . "open %s")
- ("type" . "application/dvi")
- ("test" . (eq (mm-device-type) 'ns)))
+ (viewer . "open %s")
+ (type . "application/dvi")
+ (test . (eq (mm-device-type) 'ns)))
("dvi"
- ("viewer" . "xdvi %s")
- ("test" . (eq (mm-device-type) 'x))
+ (viewer . "xdvi %s")
+ (test . (eq (mm-device-type) 'x))
("needsx11")
- ("type" . "application/dvi"))
+ (type . "application/dvi"))
("dvi"
- ("viewer" . "dvitty %s")
- ("test" . (not (getenv "DISPLAY")))
- ("type" . "application/dvi"))
+ (viewer . "dvitty %s")
+ (test . (not (getenv "DISPLAY")))
+ (type . "application/dvi"))
("emacs-lisp"
- ("viewer" . mailcap-maybe-eval)
- ("type" . "application/emacs-lisp"))
+ (viewer . mailcap-maybe-eval)
+ (type . "application/emacs-lisp"))
("x-tar"
- ("viewer" . mailcap-save-binary-file)
- ("type" . "application/x-tar"))
+ (viewer . mailcap-save-binary-file)
+ (type . "application/x-tar"))
("x-latex"
- ("viewer" . tex-mode)
- ("test" . (fboundp 'tex-mode))
- ("type" . "application/x-latex"))
+ (viewer . tex-mode)
+ (test . (fboundp 'tex-mode))
+ (type . "application/x-latex"))
("x-tex"
- ("viewer" . tex-mode)
- ("test" . (fboundp 'tex-mode))
- ("type" . "application/x-tex"))
+ (viewer . tex-mode)
+ (test . (fboundp 'tex-mode))
+ (type . "application/x-tex"))
("latex"
- ("viewer" . tex-mode)
- ("test" . (fboundp 'tex-mode))
- ("type" . "application/latex"))
+ (viewer . tex-mode)
+ (test . (fboundp 'tex-mode))
+ (type . "application/latex"))
("tex"
- ("viewer" . tex-mode)
- ("test" . (fboundp 'tex-mode))
- ("type" . "application/tex"))
+ (viewer . tex-mode)
+ (test . (fboundp 'tex-mode))
+ (type . "application/tex"))
("texinfo"
- ("viewer" . texinfo-mode)
- ("test" . (fboundp 'texinfo-mode))
- ("type" . "application/tex"))
+ (viewer . texinfo-mode)
+ (test . (fboundp 'texinfo-mode))
+ (type . "application/tex"))
("zip"
- ("viewer" . mailcap-save-binary-file)
- ("type" . "application/zip")
+ (viewer . mailcap-save-binary-file)
+ (type . "application/zip")
("copiousoutput"))
("pdf"
- ("viewer" . "acroread %s")
- ("type" . "application/pdf"))
+ (viewer . "acroread %s")
+ (type . "application/pdf"))
("postscript"
- ("viewer" . "open %s")
- ("type" . "application/postscript")
- ("test" . (eq (mm-device-type) 'ns)))
+ (viewer . "open %s")
+ (type . "application/postscript")
+ (test . (eq (mm-device-type) 'ns)))
("postscript"
- ("viewer" . "ghostview %s")
- ("type" . "application/postscript")
- ("test" . (eq (mm-device-type) 'x))
+ (viewer . "ghostview %s")
+ (type . "application/postscript")
+ (test . (eq (mm-device-type) 'x))
("needsx11"))
("postscript"
- ("viewer" . "ps2ascii %s")
- ("type" . "application/postscript")
- ("test" . (not (getenv "DISPLAY")))
+ (viewer . "ps2ascii %s")
+ (type . "application/postscript")
+ (test . (not (getenv "DISPLAY")))
("copiousoutput")))
("audio"
("x-mpeg"
- ("viewer" . "maplay %s")
- ("type" . "audio/x-mpeg"))
+ (viewer . "maplay %s")
+ (type . "audio/x-mpeg"))
(".*"
- ("viewer" . mailcap-play-sound-file)
- ("test" . (or (featurep 'nas-sound)
+ (viewer . mm-view-sound-file)
+ (test . (or (featurep 'nas-sound)
(featurep 'native-sound)))
- ("type" . "audio/*"))
+ (type . "audio/*"))
(".*"
- ("viewer" . "showaudio")
- ("type" . "audio/*")))
+ (viewer . "showaudio")
+ (type . "audio/*")))
("message"
("rfc-*822"
- ("viewer" . vm-mode)
- ("test" . (fboundp 'vm-mode))
- ("type" . "message/rfc-822"))
+ (viewer . vm-mode)
+ (test . (fboundp 'vm-mode))
+ (type . "message/rfc-822"))
("rfc-*822"
- ("viewer" . w3-mode)
- ("test" . (fboundp 'w3-mode))
- ("type" . "message/rfc-822"))
+ (viewer . w3-mode)
+ (test . (fboundp 'w3-mode))
+ (type . "message/rfc-822"))
("rfc-*822"
- ("viewer" . view-mode)
- ("test" . (fboundp 'view-mode))
- ("type" . "message/rfc-822"))
+ (viewer . view-mode)
+ (test . (fboundp 'view-mode))
+ (type . "message/rfc-822"))
("rfc-*822"
- ("viewer" . fundamental-mode)
- ("type" . "message/rfc-822")))
+ (viewer . fundamental-mode)
+ (type . "message/rfc-822")))
("image"
("x-xwd"
- ("viewer" . "xwud -in %s")
- ("type" . "image/x-xwd")
+ (viewer . "xwud -in %s")
+ (type . "image/x-xwd")
("compose" . "xwd -frame > %s")
- ("test" . (eq (mm-device-type) 'x))
+ (test . (eq (mm-device-type) 'x))
("needsx11"))
("x11-dump"
- ("viewer" . "xwud -in %s")
- ("type" . "image/x-xwd")
+ (viewer . "xwud -in %s")
+ (type . "image/x-xwd")
("compose" . "xwd -frame > %s")
- ("test" . (eq (mm-device-type) 'x))
+ (test . (eq (mm-device-type) 'x))
("needsx11"))
("windowdump"
- ("viewer" . "xwud -in %s")
- ("type" . "image/x-xwd")
+ (viewer . "xwud -in %s")
+ (type . "image/x-xwd")
("compose" . "xwd -frame > %s")
- ("test" . (eq (mm-device-type) 'x))
+ (test . (eq (mm-device-type) 'x))
("needsx11"))
(".*"
- ("viewer" . "aopen %s")
- ("type" . "image/*")
- ("test" . (eq (mm-device-type) 'ns)))
+ (viewer . "aopen %s")
+ (type . "image/*")
+ (test . (eq (mm-device-type) 'ns)))
(".*"
- ("viewer" . "xv -perfect %s")
- ("type" . "image/*")
- ("test" . (eq (mm-device-type) 'x))
+ (viewer . "xv -perfect %s")
+ (type . "image/*")
+ (test . (eq (mm-device-type) 'x))
("needsx11")))
("text"
("plain"
- ("viewer" . w3-mode)
- ("test" . (fboundp 'w3-mode))
- ("type" . "text/plain"))
+ (viewer . w3-mode)
+ (test . (fboundp 'w3-mode))
+ (type . "text/plain"))
("plain"
- ("viewer" . view-mode)
- ("test" . (fboundp 'view-mode))
- ("type" . "text/plain"))
+ (viewer . view-mode)
+ (test . (fboundp 'view-mode))
+ (type . "text/plain"))
("plain"
- ("viewer" . fundamental-mode)
- ("type" . "text/plain"))
+ (viewer . fundamental-mode)
+ (type . "text/plain"))
("enriched"
- ("viewer" . enriched-decode-region)
- ("test" . (fboundp 'enriched-decode-region))
- ("type" . "text/enriched"))
+ (viewer . enriched-decode-region)
+ (test . (fboundp 'enriched-decode-region))
+ (type . "text/enriched"))
("html"
- ("viewer" . w3-prepare-buffer)
- ("test" . (fboundp 'w3-prepare-buffer))
- ("type" . "text/html")))
+ (viewer . mm-w3-prepare-buffer)
+ (test . (fboundp 'w3-prepare-buffer))
+ (type . "text/html")))
("video"
("mpeg"
- ("viewer" . "mpeg_play %s")
- ("type" . "video/mpeg")
- ("test" . (eq (mm-device-type) 'x))
+ (viewer . "mpeg_play %s")
+ (type . "video/mpeg")
+ (test . (eq (mm-device-type) 'x))
("needsx11")))
("x-world"
("x-vrml"
- ("viewer" . "webspace -remote %s -URL %u")
- ("type" . "x-world/x-vrml")
+ (viewer . "webspace -remote %s -URL %u")
+ (type . "x-world/x-vrml")
("description"
"VRML document")))
("archive"
("tar"
- ("viewer" . tar-mode)
- ("type" . "archive/tar")
- ("test" . (fboundp 'tar-mode)))))
+ (viewer . tar-mode)
+ (type . "archive/tar")
+ (test . (fboundp 'tar-mode)))))
"*The mailcap structure is an assoc list of assoc lists.
1st assoc list is keyed on the major content-type
2nd assoc list is keyed on the minor content-type (which can be a regexp)
Where <info> is another assoc list of the various information
related to the mailcap RFC. This is keyed on the lowercase
attribute name (viewer, test, etc). This looks like:
- ((\"viewer\" . viewerinfo)
- (\"test\" . testinfo)
- (\"xxxx\" . \"string\"))
+ ((viewer . viewerinfo)
+ (test . testinfo)
+ (xxxx . \"string\"))
Where viewerinfo specifies how the content-type is viewed. Can be
a string, in which case it is run through a shell, with
(expand-file-name fname mailcap-temporary-directory))))
(defun mailcap-save-binary-file ()
- ;; Ok, this is truly fucked. In XEmacs, if you use the mouse to select
- ;; a URL that gets saved via this function, read-file-name will pop up a
- ;; dialog box for file selection. For some reason which buffer we are in
- ;; gets royally screwed (even with save-excursions and the whole nine
- ;; yards). SO, we just keep the old buffer name around and away we go.
- (let ((old-buff (current-buffer))
- (file (read-file-name "Filename to save as: "
- (or mailcap-download-directory "~/")
- (file-name-nondirectory (url-view-url t))
- nil
- (file-name-nondirectory (url-view-url t))))
+ (let ((file (read-file-name
+ "Filename to save as: "
+ (or mailcap-download-directory "~/")))
(require-final-newline nil))
- (set-buffer old-buff)
- (mule-write-region-no-coding-system (point-min) (point-max) file)
+ (write-region (point-min) (point-max) file)
(kill-buffer (current-buffer))))
(defun mailcap-maybe-eval ()
(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)
(when (or (not mailcap-parsed-p)
force)
(cond
(setq viewer (buffer-substring save-pos (point))))
(setq save-pos (point))
(end-of-line)
- (setq info (nconc (list (cons "viewer" viewer)
- (cons "type" (concat major "/"
- (if (string= minor ".*")
- "*" minor))))
+ (setq info (nconc (list (cons 'viewer viewer)
+ (cons 'type (concat major "/"
+ (if (string= minor ".*")
+ "*" minor))))
(mailcap-parse-mailcap-extras save-pos (point))))
(mailcap-mailcap-entry-passes-test info)
(mailcap-add-mailcap-entry major minor info)))))
;; Return t iff a mailcap entry passes its test clause or no test
;; clause is present.
(let (status ; Call-process-regions return value
- (test (assoc "test" info)) ; The test clause
+ (test (assq 'test info)) ; The test clause
)
(setq status (and test (split-string (cdr test) " ")))
(if (and (assoc "needsx11" info) (not (getenv "DISPLAY")))
((null save-chr) nil)
((= save-chr ?t)
(delete-region save-pos (progn (forward-char 1) (point)))
- (insert (or (cdr (assoc "type" type-info)) "\"\"")))
+ (insert (or (cdr (assq 'type type-info)) "\"\"")))
((= save-chr ?M)
(delete-region save-pos (progn (forward-char 1) (point)))
(insert "\"\""))
(defun mailcap-viewer-passes-test (viewer-info type-info)
;; Return non-nil iff the viewer specified by VIEWER-INFO passes its
;; test clause (if any).
- (let* ((test-info (assoc "test" viewer-info))
+ (let* ((test-info (assq 'test viewer-info))
(test (cdr test-info))
(otest test)
- (viewer (cdr (assoc "viewer" viewer-info)))
+ (viewer (cdr (assoc 'viewer viewer-info)))
(default-directory (expand-file-name "~/"))
status parsed-test cache result)
(if (setq cache (assoc test mailcap-viewer-test-cache))
(let ((cur-minor (assoc minor old-major)))
(cond
((or (null cur-minor) ; New minor area, or
- (assoc "test" info)) ; Has a test, insert at beginning
+ (assq 'test info)) ; Has a test, insert at beginning
(setcdr old-major (cons (cons minor info) (cdr old-major))))
- ((and (not (assoc "test" info)) ; No test info, replace completely
- (not (assoc "test" cur-minor)))
+ ((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-viewer-lessp (x y)
;; Return t iff viewer X is more desirable than viewer Y
- (let ((x-wild (string-match "[*?]" (or (cdr-safe (assoc "type" x)) "")))
- (y-wild (string-match "[*?]" (or (cdr-safe (assoc "type" y)) "")))
- (x-lisp (not (stringp (or (cdr-safe (assoc "viewer" x)) ""))))
- (y-lisp (not (stringp (or (cdr-safe (assoc "viewer" y)) "")))))
+ (let ((x-wild (string-match "[*?]" (or (cdr-safe (assq 'type x)) "")))
+ (y-wild (string-match "[*?]" (or (cdr-safe (assq 'type y)) "")))
+ (x-lisp (not (stringp (or (cdr-safe (assq 'viewer x)) ""))))
+ (y-lisp (not (stringp (or (cdr-safe (assq 'viewer y)) "")))))
(cond
((and x-lisp (not y-lisp))
t)
viewer ; The one and only viewer
ctl)
(save-excursion
- (setq ctl (drums-parse-content-type (or string "text/plain")))
+ (setq ctl (mail-header-parse-content-type (or string "text/plain")))
(setq major (split-string (car ctl) "/"))
(setq minor (cadr major)
major (car major))
(setq viewers (cdr viewers)))
(setq passed (sort (nreverse passed) 'mailcap-viewer-lessp))
(setq viewer (car passed))))
- (when (and (stringp (cdr (assoc "viewer" viewer)))
+ (when (and (stringp (cdr (assq 'viewer viewer)))
passed)
(setq viewer (car passed)))
(cond
- ((and (null viewer) (not (equal major "default")))
+ ((and (null viewer) (not (equal major "default")) request)
(mailcap-mime-info "default" request))
((or (null request) (equal request ""))
- (mailcap-unescape-mime-test (cdr (assoc "viewer" viewer)) info))
+ (mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info))
((stringp request)
- (if (or (string= request "test") (string= request "viewer"))
+ (if (or (eq request 'test) (eq request 'viewer))
(mailcap-unescape-mime-test
(cdr-safe (assoc request viewer)) info)))
((eq request 'all)
(t
;; MUST make a copy *sigh*, else we modify mailcap-mime-data
(setq viewer (copy-tree viewer))
- (let ((view (assoc "viewer" viewer))
- (test (assoc "test" viewer)))
+ (let ((view (assq 'viewer viewer))
+ (test (assq 'test viewer)))
(if view (setcdr view (mailcap-unescape-mime-test (cdr view) info)))
(if test (setcdr test (mailcap-unescape-mime-test (cdr test) info))))
viewer)))))
;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
;; this buffer should be passed to all mail/news reply/post routines.
(setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*"))
- (buffer-disable-undo gnus-article-copy)
(let ((article-buffer (or article-buffer gnus-article-buffer))
end beg)
(if (not (and (get-buffer article-buffer)
(or (search-forward "\n\n" nil t) (point)))
;; Insert the original article headers.
(insert-buffer-substring gnus-original-article-buffer beg end)
- (gnus-article-decode-rfc1522)))
+ (article-decode-encoded-words)))
gnus-article-copy)))
(defun gnus-post-news (post &optional group header article-buffer yank subject
;; Go through all the files looking for non-default values for variables.
(save-excursion
(set-buffer (gnus-get-buffer-create " *gnus bug info*"))
- (buffer-disable-undo (current-buffer))
(while files
(erase-buffer)
(when (and (setq file (locate-library (pop files)))
(or (not decay)
(gnus-decay-scores alist decay)))
(gnus-score-set 'touched '(t) alist)
- (gnus-score-set 'decay (list (time-to-day (current-time))) alist))
+ (gnus-score-set 'decay (list (time-to-days (current-time))) alist))
;; We do not respect eval and files atoms from global score
;; files.
(when (and files (not global))
(defun gnus-decay-scores (alist day)
"Decay non-permanent scores in ALIST."
- (let ((times (- (time-to-day (current-time)) day))
+ (let ((times (- (time-to-days (current-time)) day))
kill entry updated score n)
(unless (zerop times) ;Done decays today already?
(while (setq entry (pop alist))
(gnus-message 7 "Reading slave newsrcs...")
(save-excursion
(set-buffer (gnus-get-buffer-create " *gnus slave*"))
- (buffer-disable-undo (current-buffer))
(setq slave-files
(sort (mapcar (lambda (file)
(list (nth 5 (file-attributes file)) file))
(set-buffer copy-buf)
(when (gnus-request-article-this-buffer article gnus-newsgroup-name)
(gnus-request-accept-article
- to-newsgroup select-method (not articles)))))
+ to-newsgroup select-method (not articles) t))))
;; Crosspost the article.
((eq action 'crosspost)
(let ((xref (message-tokenize-header
(error "Can't read %s" file))
(save-excursion
(set-buffer (gnus-get-buffer-create " *import file*"))
- (buffer-disable-undo (current-buffer))
(erase-buffer)
(nnheader-insert-file-contents file)
(goto-char (point-min))
(defconst gnus-product-name "T-gnus"
"Product name of this version of gnus.")
-(defconst gnus-version-number "6.10.018"
+(defconst gnus-version-number "6.10.019"
"Version number for this version of gnus.")
-(defconst gnus-original-version-number "0.26"
+(defconst gnus-original-version-number "0.30"
"Version number for this version of Gnus.")
(defconst gnus-original-product-name "Pterodactyl Gnus"
(and (file-readable-p gnus-nntpserver-file)
(save-excursion
(set-buffer (gnus-get-buffer-create " *gnus nntp*"))
- (buffer-disable-undo (current-buffer))
(insert-file-contents gnus-nntpserver-file)
(let ((name (buffer-string)))
(prog1
gnus-article-next-page gnus-article-prev-page
gnus-request-article-this-buffer gnus-article-mode
gnus-article-setup-buffer gnus-narrow-to-page
- gnus-article-delete-invisible-text gnus-hack-decode-rfc1522)
+ gnus-article-delete-invisible-text)
("gnus-art" :interactive t
gnus-article-hide-headers gnus-article-hide-boring-headers
gnus-article-treat-overstrike gnus-article-word-wrap
gnus-article-date-original gnus-article-date-lapsed
gnus-article-show-all-headers
gnus-article-edit-mode gnus-article-edit-article
- gnus-article-edit-done
+ gnus-article-edit-done article-decode-encoded-words
gnus-start-date-timer gnus-stop-date-timer)
("gnus-int" gnus-request-type)
("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1
(point-max)))
(goto-char (point-min)))
+(defun message-narrow-to-headers-or-head ()
+ "Narrow the buffer to the head of the message."
+ (widen)
+ (narrow-to-region
+ (goto-char (point-min))
+ (cond
+ ((re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
+ (match-beginning 0))
+ ((search-forward "\n\n" nil t)
+ (1- (point)))
+ (t
+ (point-max))))
+ (goto-char (point-min)))
+
(defun message-news-p ()
"Say whether the current buffer contains a news message."
(and (not message-this-is-mail)
list file)
(save-excursion
(set-buffer (get-buffer-create " *message temp*"))
- (buffer-disable-undo (current-buffer))
(erase-buffer)
(insert-buffer-substring message-encoding-buffer)
(save-restriction
(let* ((now (or now (current-time)))
(zone (nth 8 (decode-time now)))
(sign "+"))
+ (when (< zone 0)
+ (setq sign ""))
;; We do all of this because XEmacs doesn't have the %z spec.
(concat (format-time-string "%d %b %Y %H:%M:%S " (or now (current-time)))
(format "%s%02d%02d"
(error "This article is not yours"))
;; Make control message.
(setq buf (set-buffer (get-buffer-create " *message cancel*")))
- (buffer-disable-undo (current-buffer))
(erase-buffer)
(insert "Newsgroups: " newsgroups "\n"
"From: " (message-make-from) "\n"
beg)
;; We first set up a normal mail buffer.
(set-buffer (get-buffer-create " *message resend*"))
- (buffer-disable-undo (current-buffer))
(erase-buffer)
;; avoid to turn-on-mime-edit
(let (message-setup-hook)
(if (not (fboundp 'base64-encode-string))
(require 'base64)))
(require 'mm-util)
+(require 'rfc2047)
(require 'qp)
(defun mm-encode-body ()
;;; Code:
-(require 'drums)
+(require 'mail-parse)
(require 'mailcap)
(require 'mm-bodies)
("text/.*" . inline)))
(defvar mm-user-automatic-display
- '("text/plain" "image/gif"))
+ '("text/plain" "text/html" "image/gif"))
+
+(defvar mm-alternative-precedence '("text/plain" "text/html")
+ "List that describes the precedence of alternative parts.")
(defvar mm-tmp-directory "/tmp/"
"Where mm will store its temporary files.")
(defvar mm-dissection-list nil)
(defvar mm-last-shell-command "")
+(defvar mm-content-id-alist nil)
+
+;;; Convenience macros.
+
+(defmacro mm-handle-buffer (handle)
+ `(nth 0 ,handle))
+(defmacro mm-handle-type (handle)
+ `(nth 1 ,handle))
+(defmacro mm-handle-encoding (handle)
+ `(nth 2 ,handle))
+(defmacro mm-handle-undisplayer (handle)
+ `(nth 3 ,handle))
+(defmacro mm-handle-set-undisplayer (handle function)
+ `(setcar (nthcdr 3 ,handle) ,function))
+(defmacro mm-handle-disposition (handle)
+ `(nth 4 ,handle))
+(defmacro mm-handle-description (handle)
+ `(nth 5 ,handle))
+
+;;; The functions.
(defun mm-dissect-buffer (&optional no-strict-mime)
"Dissect the current buffer and return a list of MIME handles."
(save-excursion
- (let (ct ctl type subtype cte)
+ (let (ct ctl type subtype cte cd description id result)
(save-restriction
- (drums-narrow-to-header)
+ (mail-narrow-to-head)
(when (and (or no-strict-mime
(mail-fetch-field "mime-version"))
(setq ct (mail-fetch-field "content-type")))
- (setq ctl (drums-parse-content-type ct))
- (setq cte (mail-fetch-field "content-transfer-encoding"))))
+ (setq ctl (mail-header-parse-content-type ct)
+ cte (mail-fetch-field "content-transfer-encoding")
+ cd (mail-fetch-field "content-disposition")
+ description (mail-fetch-field "content-description")
+ id (mail-fetch-field "content-id"))))
(when ctl
(setq type (split-string (car ctl) "/"))
(setq subtype (cadr type)
type (pop type))
- (cond
- ((equal type "multipart")
- (mm-dissect-multipart ctl))
- (t
- (mm-dissect-singlepart ctl (and cte (intern cte))
- no-strict-mime)))))))
-
-(defun mm-dissect-singlepart (ctl cte &optional force)
+ (setq
+ result
+ (cond
+ ((equal type "multipart")
+ (mm-dissect-multipart ctl))
+ (t
+ (mm-dissect-singlepart
+ ctl
+ (and cte (intern (downcase (mail-header-remove-whitespace
+ (mail-header-remove-comments
+ cte)))))
+ no-strict-mime
+ (and cd (mail-header-parse-content-disposition cd))))))
+ (when id
+ (push (cons id result) mm-content-id-alist))
+ result))))
+
+(defun mm-dissect-singlepart (ctl cte &optional force cdl description)
(when (or force
(not (equal "text/plain" (car ctl))))
- (let ((res (list (list (mm-copy-to-buffer) ctl cte nil))))
+ (let ((res (list (list (mm-copy-to-buffer) ctl cte nil cdl description))))
(push (car res) mm-dissection-list)
res)))
(defun mm-dissect-multipart (ctl)
(goto-char (point-min))
- (let ((boundary (concat "\n--" (drums-content-type-get ctl 'boundary)))
+ (let ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary)))
start parts end)
(while (search-forward boundary nil t)
(forward-line -1)
"Display the MIME part represented by HANDLE."
(save-excursion
(mailcap-parse-mailcaps)
- (if (nth 3 handle)
+ (if (mm-handle-undisplayer handle)
(mm-remove-part handle)
- (let* ((type (caadr handle))
+ (let* ((type (car (mm-handle-type handle)))
(method (mailcap-mime-info type))
(user-method (mm-user-method type)))
(if (eq user-method 'inline)
(progn
(forward-line 1)
(mm-display-inline handle))
- (mm-display-external handle (or user-method method)))))))
+ (mm-display-external
+ handle (or user-method method 'mailcap-save-binary-file)))))))
(defun mm-display-external (handle method)
"Display HANDLE using METHOD."
(mm-with-unibyte-buffer
- (insert-buffer-substring (car handle))
- (mm-decode-content-transfer-encoding (nth 2 handle))
+ (insert-buffer-substring (mm-handle-buffer handle))
+ (mm-decode-content-transfer-encoding (mm-handle-encoding handle))
(if (functionp method)
(let ((cur (current-buffer)))
(switch-to-buffer (generate-new-buffer "*mm*"))
(insert-buffer-substring cur)
(funcall method)
- (setcar (nthcdr 3 handle) (current-buffer)))
+ (mm-handle-set-undisplayer handle (current-buffer)))
(let* ((file (make-temp-name (expand-file-name "emm." mm-tmp-directory)))
process)
(write-region (point-min) (point-max)
(setq process
(start-process "*display*" nil shell-file-name
"-c" (format method file)))
- (setcar (nthcdr 3 handle) (cons file process))
+ (mm-handle-set-undisplayer handle (cons file process))
(message "Displaying %s..." (format method file))))))
(defun mm-remove-part (handle)
"Remove the displayed MIME part represented by HANDLE."
- (let ((object (nth 3 handle)))
- (cond
- ;; Internally displayed part.
- ((mm-annotationp object)
- (delete-annotation object))
- ((or (functionp object)
- (and (listp object)
- (eq (car object) 'lambda)))
- (funcall object))
- ;; Externally displayed part.
- ((consp object)
- (condition-case ()
- (delete-file (car object))
- (error nil))
- (condition-case ()
- (kill-process (cdr object))
- (error nil)))
- ((bufferp object)
- (when (buffer-live-p object)
- (kill-buffer object))))
- (setcar (nthcdr 3 handle) nil)))
+ (let ((object (mm-handle-undisplayer handle)))
+ (condition-case ()
+ (cond
+ ;; Internally displayed part.
+ ((mm-annotationp object)
+ (delete-annotation object))
+ ((or (functionp object)
+ (and (listp object)
+ (eq (car object) 'lambda)))
+ (funcall object))
+ ;; Externally displayed part.
+ ((consp object)
+ (condition-case ()
+ (delete-file (car object))
+ (error nil))
+ (condition-case ()
+ (kill-process (cdr object))
+ (error nil)))
+ ((bufferp object)
+ (when (buffer-live-p object)
+ (kill-buffer object))))
+ (error nil))
+ (mm-handle-set-undisplayer handle nil)))
(defun mm-display-inline (handle)
- (let* ((type (caadr handle))
+ (let* ((type (car (mm-handle-type handle)))
(function (cadr (assoc type mm-inline-media-tests))))
(funcall function handle)))
(defun mm-destroy-part (handle)
"Destroy the data structures connected to HANDLE."
(mm-remove-part handle)
- (when (buffer-live-p (car handle))
- (kill-buffer (car handle))))
+ (when (buffer-live-p (mm-handle-buffer handle))
+ (kill-buffer (mm-handle-buffer handle))))
(defun mm-quote-arg (arg)
"Return a version of ARG that is safe to evaluate in a shell."
(apply 'concat (nconc (nreverse accum) (list (substring arg pos)))))))
;;;
-;;; Functions for displaying various formats inline
-;;;
-
-(defun mm-inline-image (handle)
- (let ((type (cadr (split-string (caadr handle) "/")))
- image)
- (mm-with-unibyte-buffer
- (insert-buffer-substring (car handle))
- (mm-decode-content-transfer-encoding (nth 2 handle))
- (setq image (make-image-specifier
- (vector (intern type) :data (buffer-string)))))
- (let ((annot (make-annotation image nil 'text)))
- (set-extent-property annot 'mm t)
- (set-extent-property annot 'duplicable t)
- (setcar (nthcdr 3 handle) annot))))
-
-(defun mm-inline-text (handle)
- (let ((type (cadr (split-string (caadr handle) "/")))
- text buffer-read-only)
- (mm-with-unibyte-buffer
- (insert-buffer-substring (car handle))
- (mm-decode-content-transfer-encoding (nth 2 handle))
- (setq text (buffer-string)))
- (cond
- ((equal type "plain")
- (let ((b (point)))
- (insert text)
- (save-restriction
- (narrow-to-region b (point))
- (let ((charset (drums-content-type-get (nth 1 handle) 'charset)))
- (when charset
- (mm-decode-body charset nil)))
- (setcar
- (nthcdr 3 handle)
- `(lambda ()
- (let (buffer-read-only)
- (delete-region ,(set-marker (make-marker) (point-min))
- ,(set-marker (make-marker) (point-max)))))))))
- )))
-
-(defun mm-inline-audio (handle)
- (message "Not implemented"))
-
-;;;
;;; Functions for outputting parts
;;;
+(defun mm-get-part (handle)
+ "Return the contents of HANDLE as a string."
+ (mm-with-unibyte-buffer
+ (insert-buffer-substring (mm-handle-buffer handle))
+ (mm-decode-content-transfer-encoding (mm-handle-encoding handle))
+ (buffer-string)))
+
(defun mm-save-part (handle)
"Write HANDLE to a file."
- (let* ((name (drums-content-type-get (cadr handle) 'name))
- (file (read-file-name "Save MIME part to: "
- (expand-file-name
- (or name "") default-directory))))
+ (let* ((name (mail-content-type-get (mm-handle-type handle) 'name))
+ (filename (mail-content-type-get
+ (mm-handle-disposition handle) 'filename))
+ file)
+ (when filename
+ (setq filename (file-name-nondirectory filename)))
+ (setq file
+ (read-file-name "Save MIME part to: "
+ (expand-file-name
+ (or filename name "") default-directory)))
(mm-with-unibyte-buffer
- (insert-buffer-substring (car handle))
- (mm-decode-content-transfer-encoding (nth 2 handle))
+ (insert-buffer-substring (mm-handle-buffer handle))
+ (mm-decode-content-transfer-encoding (mm-handle-encoding handle))
(when (or (not (file-exists-p file))
- (yes-or-no-p (format "File %s already exists; overwrite? ")))
+ (yes-or-no-p (format "File %s already exists; overwrite? "
+ file)))
(write-region (point-min) (point-max) file)))))
(defun mm-pipe-part (handle)
"Pipe HANDLE to a process."
- (let* ((name (drums-content-type-get (cadr handle) 'name))
+ (let* ((name (mail-content-type-get (car (mm-handle-type handle)) 'name))
(command
(read-string "Shell command on MIME part: " mm-last-shell-command)))
(mm-with-unibyte-buffer
- (insert-buffer-substring (car handle))
- (mm-decode-content-transfer-encoding (nth 2 handle))
+ (insert-buffer-substring (mm-handle-buffer handle))
+ (mm-decode-content-transfer-encoding (mm-handle-encoding handle))
(shell-command-on-region (point-min) (point-max) command nil))))
(defun mm-interactively-view-part (handle)
"Display HANDLE using METHOD."
- (let* ((type (caadr handle))
+ (let* ((type (car (mm-handle-type handle)))
(methods
(mapcar (lambda (i) (list (cdr (assoc "viewer" i))))
(mailcap-mime-info type 'all)))
(method (completing-read "Viewer: " methods)))
(mm-display-external (copy-sequence handle) method)))
+(defun mm-preferred-alternative (handles &optional preferred)
+ "Say which of HANDLES are preferred."
+ (let ((prec (if preferred (list preferred) mm-alternative-precedence))
+ p h result type)
+ (while (setq p (pop prec))
+ (setq h handles)
+ (while h
+ (setq type (car (mm-handle-type (car h))))
+ (when (and (equal p type)
+ (mm-automatic-display-p type)
+ (or (not (mm-handle-disposition (car h)))
+ (equal (car (mm-handle-disposition (car h)))
+ "inline")))
+ (setq result (car h)
+ h nil
+ prec nil))
+ (pop h)))
+ result))
+
+(defun mm-get-content-id (id)
+ "Return the handle(s) referred to by ID."
+ (cdr (assoc id mm-content-id-alist)))
+
(provide 'mm-decode)
;; mm-decode.el ends here
;;; Code:
+(require 'mail-parse)
+
+(defun mm-insert-rfc822-headers (charset encoding)
+ "Insert text/plain headers with CHARSET and ENCODING."
+ (insert "MIME-Version: 1.0\n")
+ (insert "Content-Type: text/plain; charset="
+ (mail-quote-string (downcase (symbol-name charset))) "\n")
+ (insert "Content-Transfer-Encoding: "
+ (downcase (symbol-name encoding)) "\n"))
+
(provide 'mm-encode)
;;; mm-encode.el ends here
;;; Code:
+(defvar mm-default-coding-system nil
+ "The default coding system to use.")
+
(defvar mm-known-charsets '(iso-8859-1)
"List of known charsets.")
(when (fboundp 'set-buffer-multibyte)
(set-buffer-multibyte t)))
-(defun mm-insert-rfc822-headers (charset encoding)
- "Insert text/plain headers with CHARSET and ENCODING."
- (insert "MIME-Version: 1.0\n")
- (insert "Content-Type: text/plain; charset=\""
- (downcase (symbol-name charset)) "\"\n")
- (insert "Content-Transfer-Encoding: "
- (downcase (symbol-name encoding)) "\n"))
-
(defun mm-mime-charset (charset b e)
(if (fboundp 'coding-system-get)
(or
+ (and
+ mm-default-coding-system
+ (let ((safe (coding-system-get mm-default-coding-system
+ 'safe-charsets)))
+ (or (eq safe t) (memq charset safe)))
+ (coding-system-get mm-default-coding-system 'mime-charset))
(coding-system-get
(get-charset-property charset 'prefered-coding-system)
'mime-charset)
(setq nndoc-dissection-alist nil)
(save-excursion
(set-buffer nndoc-current-buffer)
- (buffer-disable-undo (current-buffer))
(erase-buffer)
(if (stringp nndoc-address)
(nnheader-insert-file-contents nndoc-address)
(let* ((buf (get-buffer-create " *draft headers*"))
article)
(set-buffer buf)
- (buffer-disable-undo (current-buffer))
(erase-buffer)
;; We don't support fetching by Message-ID.
(if (stringp (car articles))
(nnfolder-request-article article group server)
(save-excursion
(set-buffer buf)
- (buffer-disable-undo (current-buffer))
(erase-buffer)
(insert-buffer-substring nntp-server-buffer)
(goto-char (point-min))
`(let ((new (generate-new-buffer " *nnheader replace*"))
(cur (current-buffer))
(start (point-min)))
- (set-buffer new)
- (buffer-disable-undo (current-buffer))
(set-buffer cur)
(goto-char (point-min))
(while (,(if regexp 're-search-forward 'search-forward)
(save-excursion
;; Insert the incoming file.
(set-buffer (get-buffer-create " *nnmail incoming*"))
- (buffer-disable-undo (current-buffer))
(erase-buffer)
(nnheader-insert-file-contents incoming)
(unless (zerop (buffer-size))
(set-buffer
(setq nnmail-cache-buffer
(get-buffer-create " *nnmail message-id cache*")))
- (buffer-disable-undo (current-buffer))
(when (file-exists-p nnmail-message-id-cache-file)
(nnheader-insert-file-contents nnmail-message-id-cache-file))
(set-buffer-modified-p nil)
(nnmbox-request-article article group server)
(save-excursion
(set-buffer buf)
- (buffer-disable-undo (current-buffer))
(erase-buffer)
(insert-buffer-substring nntp-server-buffer)
(goto-char (point-min))
(defun nnml-find-group-number (id)
(save-excursion
(set-buffer (get-buffer-create " *nnml id*"))
- (buffer-disable-undo (current-buffer))
(let ((alist nnml-group-alist)
number)
;; We want to look through all .overview files, but we want to
(string-to-int (match-string 1 f2)))))))
active group lines ident elem min)
(set-buffer (get-buffer-create " *nnsoup work*"))
- (buffer-disable-undo (current-buffer))
(while files
(nnheader-message 5 "Doing %s..." (car files))
(erase-buffer)
(defun nnspool-find-id (id)
(save-excursion
(set-buffer (get-buffer-create " *nnspool work*"))
- (buffer-disable-undo (current-buffer))
(erase-buffer)
(ignore-errors
(call-process "grep" nil t nil (regexp-quote id) nnspool-history-file))
-;;; qp.el --- Quoted-printable functions
+;;; qp.el --- Quoted-Printable functions
;; Copyright (C) 1998 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(require 'base64))))
(require 'qp)
(require 'mm-util)
+(require 'drums)
(defvar rfc2047-default-charset 'iso-8859-1
"Default MIME charset -- does not need encoding.")
(point-max))))
(goto-char (point-min)))
-;;;###autoload
(defun rfc2047-encode-message-header ()
"Encode the message header according to `rfc2047-header-encoding-alist'.
Should be called narrowed to the head of the message."
(interactive "*")
(when (featurep 'mule)
(save-excursion
+ (goto-char (point-min))
(let ((alist rfc2047-header-encoding-alist)
elem method)
(while (not (eobp))
(save-restriction
(narrow-to-region b e)
(goto-char (point-min))
- (while (re-search-forward "[^ \t\n]+" nil t)
+ (while (re-search-forward (concat "[^" drums-tspecials " \t\n]+") nil t)
(push
(list (match-beginning 0) (match-end 0)
(car
'B))
(start (concat
"=?" (downcase (symbol-name mime-charset)) "?"
- (downcase (symbol-name encoding)) "?")))
+ (downcase (symbol-name encoding)) "?"))
+ (first t))
(save-restriction
(narrow-to-region b e)
(mm-encode-coding-region b e mime-charset)
(funcall (cdr (assq encoding rfc2047-encoding-function-alist))
(point-min) (point-max))
(goto-char (point-min))
- (insert start)
- (goto-char (point-max))
- (insert "?=")
- ;; Encoded words can't be more than 75 chars long, so we have to
- ;; split the long ones up.
- (end-of-line)
- (while (> (current-column) 74)
- (beginning-of-line)
- (forward-char 73)
- (insert "?=\n " start)
- (end-of-line)))))
+ (while (not (eobp))
+ (unless first
+ (insert " "))
+ (setq first nil)
+ (insert start)
+ (end-of-line)
+ (insert "?=")
+ (forward-line 1)))))
(defun rfc2047-b-encode-region (b e)
"Encode the header contained in REGION with the B encoding."
- (base64-encode-region b e t))
+ (base64-encode-region b e t)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (goto-char (min (point-max) (+ 64 (point))))
+ (unless (eobp)
+ (insert "\n"))))
(defun rfc2047-q-encode-region (b e)
"Encode the header contained in REGION with the Q encoding."
(while alist
(when (looking-at (caar alist))
(quoted-printable-encode-region b e nil (cdar alist))
- (subst-char-in-region (point-min) (point-max) ? ?_))
- (pop alist))))))
+ (subst-char-in-region (point-min) (point-max) ? ?_)
+ (setq alist nil))
+ (pop alist))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (forward-char 64)
+ (search-backward "=" nil (- (point) 2))
+ (unless (eobp)
+ (insert "\n")))))))
;;;
;;; Functions for decoding RFC2047 messages
;;;
(defvar rfc2047-encoded-word-regexp
- "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ ]+\\)\\?=")
+ "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ +]+\\)\\?=")
-;;;###autoload
(defun rfc2047-decode-region (start end)
"Decode MIME-encoded words in region between START and END."
(interactive "r")
(when (mm-multibyte-p)
(mm-decode-coding-region b (point-max) rfc2047-default-charset))))))
-;;;###autoload
(defun rfc2047-decode-string (string)
"Decode the quoted-printable-encoded STRING and return the results."
(let ((m (mm-multibyte-p)))
(defun gnus-score-edit-insert-date ()
"Insert date in numerical format."
(interactive)
- (princ (time-to-day (current-time)) (current-buffer)))
+ (princ (time-to-days (current-time)) (current-buffer)))
(defun gnus-score-pretty-print ()
"Format the current score file."
(defun date-to-day (date)
"Return the number of days between year 1 and DATE."
- (time-to-day (date-to-time date)))
+ (time-to-days (date-to-time date)))
(defun days-between (date1 date2)
"Return the number of days between DATE1 and DATE2."
(setq day-of-year (1+ day-of-year))))
day-of-year))
-(defun time-to-day (time)
+(defun time-to-days (time)
"The number of days between the Gregorian date 0001-12-31bce and TIME.
The Gregorian date Sunday, December 31, 1bce is imaginary."
(let* ((tim (decode-time time))
+1998-09-13 08:58:56 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * dir (File): Updated.
+
+1998-09-12 08:53:05 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * emacs-mime.texi: New file.
+
+ * gnus.texi (Misc Article): Addition.
+
1998-09-11 08:52:50 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus.texi (Group Score Commands): Fix.
(Saving Articles): Fix.
(Agent Expiry): Fix.
+ (Using MIME): Change.
1998-09-10 03:19:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
SHELL = /bin/sh
PAPERTYPE=a4
-all: gnus message
+all: gnus message emacs-mime
most: texi2latex.elc latex latexps
makeinfo -o $* $<; \
fi
-dvi: gnus.dvi message.dvi refcard.dvi
+dvi: gnus.dvi message.dvi refcard.dvi emacs-mime.dvi
.texi.dvi :
$(PERL) -n -e 'print unless (/\@iflatex/ .. /\@end iflatex/)' $< > gnustmp.texi
install:
$(SHELL) $(top_srcdir)/mkinstalldirs $(infodir)
- @for file in gnus message; do \
+ @for file in gnus message emacs-info; do \
for ifile in `echo $$file $$file-[0-9] $$file-[0-9][0-9]`; do \
if test -f $$ifile; then \
echo " $(INSTALL_DATA) $$ifile $(infodir)/$$ifile"; \
* Menu:
-* Gnus: (gnus). The news reader Gnus.
-* Message: (message). The Message sending thingamabob.
+* Gnus: (gnus). The news reader Gnus.
+* Message: (message). The Message sending thingamabob.
+* Emacs MIME: (emacs-mime). Libraries for handling MIME.
\input texinfo @c -*-texinfo-*-
@setfilename gnus-ja
-@settitle Semi-gnus 6.10.018 Manual
+@settitle Semi-gnus 6.10.019 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Semi-gnus 6.10.018 Manual
+@title Semi-gnus 6.10.019 Manual
@author by Lars Magne Ingebrigtsen
@author by members of Semi-gnus mailing-list
\e$B$J8@8l7w$r:9JL$7$^$;$s!#$"$"!"%/%j%s%4%s$NJ}$O\e(B Unicode Next Generation\e$B$r\e(B
\e$B$*BT$A$/$@$5$$!#\e(B
-\e$B$3$N@bL@=q$O\e(B Semi-gnus 6.10.018 \e$B$KBP1~$7$^$9!#\e(B
+\e$B$3$N@bL@=q$O\e(B Semi-gnus 6.10.019 \e$B$KBP1~$7$^$9!#\e(B
@end ifinfo
\input texinfo @c -*-texinfo-*-
@setfilename gnus
-@settitle Semi-gnus 6.10.018 Manual
+@settitle Semi-gnus 6.10.019 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
\thispagestyle{empty}
-Copyright \copyright{} 1995,96,97 Free Software Foundation, Inc.
+Copyright \copyright{} 1995,96,97,98 Free Software Foundation, Inc.
Permission is granted to make and distribute verbatim copies of
this manual provided the copyright notice and this permission notice
@tex
@titlepage
-@title Semi-gnus 6.10.018 Manual
+@title Semi-gnus 6.10.019 Manual
@author by Lars Magne Ingebrigtsen
@page
API. So Semi-gnus does not discriminate various language communities.
Oh, if you are a Klingon, please wait Unicode Next Generation.
-This manual corresponds to Semi-gnus 6.10.018.
+This manual corresponds to Semi-gnus 6.10.019.
@end ifinfo
(This is the default.) If @code{nil}, each group will have its own
article buffer.
+@vindex gnus-article-decode-hook
+@item gnus-article-decode-hook
+@cindex MIME
+Hook used to decode @sc{mime} articles. The default value is
+@code{(article-decode-charset article-decode-encoded-words)}
+
@vindex gnus-article-prepare-hook
@item gnus-article-prepare-hook
This hook is called right after the article has been inserted into the
@vindex nnmail-split-hook
@item nnmail-split-hook
-@findex article-decode-rfc1522
+@findex article-decode-encoded-words
@findex RFC1522 decoding
+@findex RFC2047 decoding
Hook run in the buffer where the mail headers of each message is kept
just before the splitting based on these headers is done. The hook is
free to modify the buffer contents in any way it sees fit---the buffer
is discarded after the splitting has been done, and no changes performed
-in the buffer will show up in any files. @code{gnus-article-decode-rfc1522}
-is one likely function to add to this hook.
+in the buffer will show up in any files.
+@code{gnus-article-decode-encoded-words} is one likely function to add
+to this hook.
@vindex nnmail-pre-get-new-mail-hook
@vindex nnmail-post-get-new-mail-hook
\input texinfo @c -*-texinfo-*-
@setfilename message
-@settitle Pterodactyl Message 0.26 Manual
+@settitle Pterodactyl Message 0.30 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
This file documents Message, the Emacs message composition mode.
-Copyright (C) 1996 Free Software Foundation, Inc.
+Copyright (C) 1996,97,98 Free Software Foundation, Inc.
Permission is granted to make and distribute verbatim copies of
this manual provided the copyright notice and this permission notice
@tex
@titlepage
-@title Pterodactyl Message 0.26 Manual
+@title Pterodactyl Message 0.30 Manual
@author by Lars Magne Ingebrigtsen
@page
* Key Index:: List of Message mode keys.
@end menu
-This manual corresponds to Pterodactyl Message 0.26. Message is
+This manual corresponds to Pterodactyl Message 0.30. Message is
distributed with the Gnus distribution bearing the same version number
as this manual.
projects / elisp / gnus.git- / commitdiff