From 6056b913a529f7df94407b885ea6f6a626e68a2d Mon Sep 17 00:00:00 2001 From: yamaoka Date: Wed, 16 Sep 1998 00:18:36 +0000 Subject: [PATCH] Sync up with Pterodactyl Gnus 0.31. A snapshot is available from ftp://ftp.jpl.org/pub/tmp/semi-gnus-pgnus-ichikawa-19980916-1.tar.gz --- ChangeLog | 27 ++ lisp/ChangeLog | 198 ++++++-- lisp/base64.el | 6 +- lisp/date.el | 124 ----- lisp/dgnushack.el | 1 - lisp/gnus-agent.el | 14 +- lisp/gnus-art.el | 267 ++++++++++- lisp/gnus-mailcap.el | 26 +- lisp/gnus-msg.el | 15 +- lisp/gnus-salt.el | 6 +- lisp/gnus-sum.el | 47 +- lisp/gnus.el | 9 +- lisp/lpath.el | 9 +- lisp/mail-parse.el | 18 +- lisp/message.el | 32 +- lisp/mm-bodies.el | 9 +- lisp/mm-decode.el | 29 +- lisp/mm-view.el | 30 +- lisp/mm.el | 1283 -------------------------------------------------- lisp/nndoc.el | 203 ++++---- lisp/rfc2047.el | 16 +- lisp/rfc2231.el | 12 +- texi/gnus-ja.texi | 6 +- texi/gnus.texi | 6 +- texi/message.texi | 6 +- 25 files changed, 740 insertions(+), 1659 deletions(-) delete mode 100644 lisp/date.el delete mode 100644 lisp/mm.el diff --git a/ChangeLog b/ChangeLog index 6c681e6..7baa73a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,30 @@ +1998-09-16 Katsumi Yamaoka + + * lisp/gnus.el (gnus-version-number): Update to 6.10.020. + + * lisp/ietf-drums.el: New file. + * lisp/date.el: Abolished. + * lisp/mm.el: Abolished. + + * Sync up with Pterodactyl Gnus 0.31. + +1998-09-14 Katsumi Yamaoka + + * lisp/message.el (message-encode-message-body): Copied from + Pterodactyl Gnus 0.30. It is useless for Semi-gnus but usefull for + reducing differences while at work for synchronizing up. It will + be removed when the Gnus becomes stable. + * lisp/gnus-art.el (gnus-mime-display-alternative) + (gnus-display-mime) (gnus-widget-press-button) + (gnus-insert-mime-button) (gnus-mime-copy-part) + (gnus-mime-view-part) (gnus-mime-pipe-part) (gnus-mime-save-part) + (gnus-mime-button-map) (gnus-mime-button-line-format-alist) + (gnus-mime-button-line-format) + (article-mime-decode-quoted-printable-buffer) + (article-de-quoted-unreadable) (article-decode-charset) + (article-decode-mime-words) (gnus-decode-header-function) + (gnus-display-mime-function): Ditto. + 1998-09-14 Katsumi Yamaoka * lisp/gnus-art.el (article-decode-encoded-words): Renamed from diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3167492..7a63038 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,4 +1,113 @@ -Sun Sep 13 09:37:37 1998 Lars Magne Ingebrigtsen +Mon Sep 14 18:55:38 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.31 is released. + +1998-09-14 15:12:59 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-exit): Destroy MIME. + + * mm-decode.el (mm-display-part): Accept no-default. + + * gnus-art.el (gnus-insert-mime-button): buffer-size doesn't take + a parameter. + + * gnus-sum.el (gnus-summary-insert-line): Don't exclude faces. + (gnus-summary-prepare-threads): Ditto. + + * gnus.el (gnus-article-mode-map): Make sparse keymap. + + * gnus-art.el (gnus-mime-button-line-format-alist): Allow a %d spec. + (gnus-mime-button-line-format): Doc fix. + (gnus-insert-mime-button): Use it. + (gnus-article-add-button): Use widget-convert-button. + + * gnus.el ((featurep 'gnus-xmas)): Defalias gnus-decode-rfc1522 to + ignore. + + * mm-decode.el (mm-alternative-precedence): Ditto. + +1998-09-14 15:12:49 Conrad Sauerwald + + * mm-decode.el (mm-user-automatic-display): Use enriched. + +1998-09-14 15:09:12 Paul Fisher + + * mm-decode.el (mm-dissect-multipart): Have the part start on the + right place. + +1998-09-14 14:33:34 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-inews-add-send-actions): Mark silently. + + * gnus-art.el (article-update-date-lapsed): Only update header if + buffer is dispalyed in frame. + (gnus-article-prepare-display): New function. + (gnus-article-prepare): Use it. + +1998-09-14 08:16:43 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mime-inline-part): New command and keystroke. + + * mm-view.el (mm-insert-inline): New function. + + * mm-decode.el (mm-pipe-part): Bugged. + + * gnus-agent.el (gnus-agent-send-mail): Don't encode. + + * mm-bodies.el (mm-encode-body): Move over the body. + + * nnmbox.el (nnmbox-read-mbox): Enable multibyte. + + * rfc2047.el (rfc2047-q-encode-region): Would bug out. + +1998-09-13 François Pinard + + * nndoc.el: Make nndoc-dissection-alist simpler for MIME, adjust all + related functions. Handle message/rfc822 parts. Display subject on + multipart summary lines. Display name on sub-parts when available. + +1998-09-14 07:36:38 Hallvard B. Furuseth + + * mailcap.el (mailcap-command-p): New version. + +1998-09-13 Mike McEwan + + * gnus-agent.el (gnus-agent-expire): Stop expiry barfing on killed + groups. + +1998-09-13 18:34:06 Lars Magne Ingebrigtsen + + * message.el (message-make-date): Remove weekday name. + + * mm-decode.el (mm-dissect-buffer): Protect against broken + headers. + + * mailcap.el (mailcap-command-in-path-p): New function. + (mailcap-command-p): Renamed. + +1998-09-13 17:58:47 Hallvard B. Furuseth + + * rfc2047.el (eval): Autoload. + +1998-09-13 12:22:40 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-decode-encoded-word-functions): New variable. + (gnus-multi-decode-encoded-word-string): New function. + (gnus-encoded-word-method-alist): New variable. + (gnus-decode-encoded-word-functions): Removed. + +1998-09-13 Shenghuo ZHU + + * gnus-int.el (gnus-request-replace-article): Replace + message-narrow-to-headers with message-narrow-to-head + +1998-09-13 12:05:41 Lars Magne Ingebrigtsen + + * drums.el (drums-quote-string): Reversed match. + + * message.el (message-make-date): Use weekday name. + +Sun Sep 11 10:27:15 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.30 is released. @@ -11,7 +120,7 @@ Sun Sep 13 09:37:37 1998 Lars Magne Ingebrigtsen (gnus-decode-encoded-word-function): New variable. * gnus-msg.el (gnus-copy-article-buffer): Decode the right - buffer. + buffer. * gnus-art.el (gnus-insert-mime-button): Use widget. (gnus-widget-press-button): New function. @@ -32,21 +141,21 @@ Sun Sep 13 09:37:37 1998 Lars Magne Ingebrigtsen 1998-09-13 07:58:59 Shenghuo ZHU * gnus-sum.el (gnus-summary-move-article): Don't decode accepting - articles. + articles. 1998-09-13 07:23:28 Lars Magne Ingebrigtsen * 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. + * rfc2047.el (rfc2047-dissect-region): Dissect using tspecials. * drums.el (drums-quote-string): Reversed test. 1998-09-12 14:29:21 Lars Magne Ingebrigtsen * mm-util.el (mm-insert-rfc822-headers): Possibly not quote - string. + string. * drums.el (drums-quote-string): New function. @@ -65,7 +174,7 @@ Sat Sep 12 13:27:15 1998 Lars Magne Ingebrigtsen 1998-09-12 11:30:01 Lars Magne Ingebrigtsen * drums.el (drums-parse-address): Returned a list instead of a - string. + string. (drums-remove-whitespace): Skip comments. (drums-parse-addresses): Didn't work. @@ -82,10 +191,10 @@ Sat Sep 12 09:17:30 1998 Lars Magne Ingebrigtsen * message.el (message-narrow-to-headers-or-head): New function. * gnus-int.el (gnus-request-accept-article): Narrow to the right - region. + region. * message.el (message-send-news): Encode body after checking - syntax. + syntax. * gnus-art.el (gnus-mime-button-line-format): Allow descriptions. @@ -99,10 +208,10 @@ Sat Sep 12 09:17:30 1998 Lars Magne Ingebrigtsen text with annotations. * message.el (message-make-date): Fix sign for negative time - zones. + zones. * mm-view.el (mm-inline-image): Insert a space at the end of the - image. + image. * mail-parse.el: New file. @@ -111,7 +220,7 @@ Sat Sep 12 09:17:30 1998 Lars Magne Ingebrigtsen * drums.el (drums-content-type-get): Removed. (drums-parse-content-type): Ditto. - * mailcap.el (mailcap-mime-data): Use symbols instead of strings. + * mailcap.el (mailcap-mime-data): Use symbols instead of strings. Fri Sep 11 18:23:34 1998 Lars Magne Ingebrigtsen @@ -143,12 +252,12 @@ Fri Sep 11 12:32:50 1998 Lars Magne Ingebrigtsen * mm-decode.el (mm-last-shell-command): New variable. - * mailcap.el (mailcap-mime-info): Allow returning all matches. + * mailcap.el (mailcap-mime-info): Allow returning all matches. * mm-decode.el (mm-save-part): New function. * gnus-art.el (article-decode-charset): Protect against buggy - content-types. + content-types. (gnus-mime-pipe-part): New command. (gnus-mime-save-part): New command. (gnus-mime-button-map): New keymap. @@ -163,10 +272,10 @@ Fri Sep 11 12:32:50 1998 Lars Magne Ingebrigtsen * gnus-art.el (gnus-article-save): Comment fix. * gnus-int.el (gnus-start-news-server): When in batch, don't - prompt. + prompt. * gnus-cache.el (gnus-cache-possibly-enter-article): Don't - decode. + decode. * mm-decode.el (mm-inline-media-tests): Add audio. (mm-inline-audio): New function. @@ -184,7 +293,7 @@ Fri Sep 11 08:09:40 1998 Lars Magne Ingebrigtsen 1998-09-11 07:38:14 Lars Magne Ingebrigtsen * gnus-art.el (article-remove-trailing-blank-lines): Don't remove - annotations. + annotations. * gnus.el ((featurep 'gnus-xmas)): New 'gnus-annotation-in-region-p alias. @@ -232,22 +341,22 @@ Thu Sep 10 04:03:29 1998 Lars Magne Ingebrigtsen 1998-09-10 01:58:24 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-summary-show-article): Don't decode chars if - PREFIX. + PREFIX. * parse-time.el (parse-time-rules): Accept times that look like - "h:mm". + "h:mm". * message.el (message-make-date): Use zone properly. * gnus.el: Autoload gnus-batch. * gnus-art.el (article-de-quoted-unreadable): Do not do - gnus-article-decode-rfc1522. + gnus-article-decode-rfc1522. * gnus-msg.el (gnus-inews-do-gcc): Use it. * gnus-int.el (gnus-request-accept-article): Accept a no-encode - param. + param. * message.el (message-encode-message-body): Check for us-ascii. @@ -304,7 +413,7 @@ Tue Sep 8 21:43:03 1998 Lars Magne Ingebrigtsen 1998-09-08 11:40:45 Lars Magne Ingebrigtsen * rfc2047.el (rfc2047-decode-region): Only decode when in - multibyte. + multibyte. * nnheader.el (nnheader-pathname-coding-system): Changed to binary. @@ -312,10 +421,10 @@ Tue Sep 8 21:43:03 1998 Lars Magne Ingebrigtsen (gnus-request-accept-article): Encode. * gnus-art.el (gnus-request-article-this-buffer): Decode charsets - here. + here. * gnus.el (gnus-article-display-hook): Take the charset functions - out. + out. * time-date.el (safe-date-to-time): New function. @@ -364,7 +473,7 @@ Tue Sep 8 04:29:23 1998 Lars Magne Ingebrigtsen * time-date.el (time-to-seconds): Renamed. - * parse-time.el (parse-time-string): Downcase before handling. + * parse-time.el (parse-time-string): Downcase before handling. (parse-time-rules): Times without seconds have 0 seconds. * rfc2047.el (rfc2047-encode-region): New version. @@ -414,10 +523,10 @@ Sun Sep 6 21:19:26 1998 Lars Magne Ingebrigtsen * date.el (if): Use parse-time. * gnus-score.el (gnus-summary-score-entry): Make into a command - again. + again. * gnus-group.el (gnus-group-get-new-news-this-group): Only call if - gnus-agent. + gnus-agent. * gnus.el (gnus-agent-meta-information-header): Moved here. @@ -452,7 +561,7 @@ Sun Sep 6 21:19:26 1998 Lars Magne Ingebrigtsen 1998-09-05 22:23:03 Lars Magne Ingebrigtsen * gnus-art.el (gnus-article-decode-charset): Only decode text - things. + things. * message.el (message-output): Use rmail. @@ -460,7 +569,7 @@ Sun Sep 6 21:19:26 1998 Lars Magne Ingebrigtsen word part. * mm-util.el (mm-charset-to-coding-system): Use - rfc2047-default-charset. + rfc2047-default-charset. (mm-known-charsets): New variable. * message.el (message-caesar-region): Bugged out. @@ -484,7 +593,7 @@ Sat Sep 5 21:55:01 1998 Lars Magne Ingebrigtsen from the headers. * rfc2047.el (rfc2047-decode-region): Use the mm decoding - functions. + functions. * gnus-group.el (gnus-group-sort-selected-flat): Didn't work at all. @@ -527,7 +636,7 @@ Sat Sep 5 01:45:52 1998 Lars Magne Ingebrigtsen * gnus-util.el (gnus-output-to-rmail): Removed. * gnus-art.el (gnus-summary-save-in-rmail): Use - gnus-output-to-rmailrmail-output-to-rmail-file. + gnus-output-to-rmailrmail-output-to-rmail-file. * rfc2047.el (rfc2047-decode-region): Fold case. (rfc2047-decode): Use decode-string. @@ -546,10 +655,10 @@ Thu Sep 3 15:23:22 1998 Lars Magne Ingebrigtsen 1998-09-02 14:38:18 Lars Magne Ingebrigtsen * gnus-msg.el (gnus-post-method): Use opened servers, and remove - ducplicates. + ducplicates. (gnus-inews-insert-mime-headers): Removed. - * message.el (message-caesar-region): Protect against MULE chars. + * message.el (message-caesar-region): Protect against MULE chars. 1998-09-02 00:36:23 Hallvard B. Furuseth @@ -558,14 +667,14 @@ Thu Sep 3 15:23:22 1998 Lars Magne Ingebrigtsen 1998-09-02 00:31:53 Lars Magne Ingebrigtsen * gnus-art.el (gnus-article-decode-charset): Use real - read-coding-system. + read-coding-system. 1998-09-01 17:58:40 Lars Magne Ingebrigtsen * mm-bodies.el (mm-decode-body): Protect against malformed - base64. + base64. (mm-decode-body): Check that buffer-file-coding-system is - non-nil. + non-nil. Tue Sep 1 10:29:33 1998 Lars Magne Ingebrigtsen @@ -574,7 +683,7 @@ Tue Sep 1 10:29:33 1998 Lars Magne Ingebrigtsen 1998-09-01 09:14:33 Lars Magne Ingebrigtsen * gnus-util.el (gnus-strip-whitespace): Already defined. - Removed. + Removed. * gnus-art.el (gnus-article-decode-charset): Strip whitespace. @@ -594,7 +703,7 @@ Tue Sep 1 10:29:33 1998 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-summary-mode-line-format): Ditto. * gnus-art.el (gnus-article-mode-line-format): Use short group - format. + format. Mon Aug 31 23:03:13 1998 Lars Magne Ingebrigtsen @@ -618,7 +727,7 @@ Mon Aug 31 22:14:50 1998 Lars Magne Ingebrigtsen * message.el (message-encode-message-body): Ditto. * gnus-art.el (gnus-article-decode-mime-words): New command and - keystroke. + keystroke. (gnus-article-decode-charset): Ditto. (gnus-article-decode-charset): Only work under MULE. @@ -723,7 +832,7 @@ Sun Aug 30 17:46:01 1998 Lars Magne Ingebrigtsen * mm-encode.el (mm-q-encode-region): New function. * qp.el (quoted-printable-encode-region): Take an optional CLASS - param. + param. * mm-encode.el (mm-encode-word-region): Downcase. @@ -748,7 +857,7 @@ Sun Aug 30 15:28:01 1998 Lars Magne Ingebrigtsen * message.el (message-narrow-to-header): New function. - * gnus-art.el (gnus-article-decode-mime-words): Place point in the + * gnus-art.el (gnus-article-decode-mime-words): Place point in the right buffer. Sun Aug 30 12:15:54 1998 Lars Magne Ingebrigtsen @@ -781,7 +890,7 @@ Sun Aug 30 00:59:15 1998 Lars Magne Ingebrigtsen * nnheader.el (fboundp): Protect code-coding-string. - * gnus-art.el (gnus-article-mode): Check that set-buffer-multibyte + * gnus-art.el (gnus-article-mode): Check that set-buffer-multibyte is available. Sat Aug 29 23:24:31 1998 Lars Magne Ingebrigtsen @@ -790,7 +899,7 @@ Sat Aug 29 23:24:31 1998 Lars Magne Ingebrigtsen 1998-08-29 22:38:35 Lars Magne Ingebrigtsen - * gnus-art.el (gnus-article-mode): Make article buffer multibyte. + * gnus-art.el (gnus-article-mode): Make article buffer multibyte. (gnus-hack-decode-rfc1522): Removed. * mm-decode.el (mm-charset-coding-system-alist): Check better. @@ -802,7 +911,7 @@ Sat Aug 29 22:20:39 1998 Lars Magne Ingebrigtsen 1998-08-29 20:53:29 Lars Magne Ingebrigtsen * gnus-art.el (gnus-article-decode-mime-words): New command and - keystroke. + keystroke. * qp.el (quoted-printable-decode-region): Don't use hexl. @@ -825,7 +934,7 @@ Sat Aug 29 22:20:39 1998 Lars Magne Ingebrigtsen * gnus-ems.el (fboundp): Don't bind mail-file-babyl-p. * gnus-art.el (article-mime-decode-quoted-printable): Don't use - hexl. + hexl. * nnheader.el (nnheader-temp-write): Removed. @@ -836,4 +945,3 @@ Sat Aug 29 20:34:17 1998 Lars Magne Ingebrigtsen Sat Aug 29 19:32:06 1998 Lars Magne Ingebrigtsen * gnus.el: Gnus v0.2 is released. - diff --git a/lisp/base64.el b/lisp/base64.el index 3d89247..093673e 100644 --- a/lisp/base64.el +++ b/lisp/base64.el @@ -25,8 +25,6 @@ ;;; Boston, MA 02111-1307, USA. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(require 'mm-util) - ;; For non-MULE (if (not (fboundp 'char-int)) (fset 'char-int 'identity)) @@ -110,7 +108,7 @@ base64-encoder-program.") (base64-insert-char char count ignored buffer)))) (defun base64-xemacs-insert-char (char &optional count ignored buffer) - (if (and buffer (eq buffer (current-buffer))) + (if (or (null buffer) (eq buffer (current-buffer))) (insert-char char count) (save-excursion (set-buffer buffer) @@ -276,4 +274,6 @@ base64-encoder-program.") (buffer-string) (kill-buffer (current-buffer))))) +(fset 'base64-decode-string 'base64-decode) + (provide 'base64) diff --git a/lisp/date.el b/lisp/date.el deleted file mode 100644 index b593e1c..0000000 --- a/lisp/date.el +++ /dev/null @@ -1,124 +0,0 @@ -;;; date.el --- Date and time handling functions -;; Copyright (C) 1998 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Masanobu Umeda -;; 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: - -(require 'timezone) - -(defun parse-time-string (date) - "Convert DATE into time." - (decode-time - (condition-case () - (let* ((d1 (timezone-parse-date date)) - (t1 (timezone-parse-time (aref d1 3)))) - (apply 'encode-time - (mapcar (lambda (el) - (and el (string-to-number el))) - (list - (aref t1 2) (aref t1 1) (aref t1 0) - (aref d1 2) (aref d1 1) (aref d1 0) - (number-to-string - (* 60 (timezone-zone-to-minute (aref d1 4)))))))) - ;; If we get an error, then we just return a 0 time. - (error (list 0 0))))) - -(defun date-to-time (date) - "Convert DATE into time." - (apply 'encode-time (parse-time-string date))) - -(defun time-less-p (t1 t2) - "Say whether time T1 is less than time T2." - (or (< (car t1) (car t2)) - (and (= (car t1) (car t2)) - (< (nth 1 t1) (nth 1 t2))))) - -(defun days-to-time (days) - "Convert DAYS into time." - (let* ((seconds (* 1.0 days 60 60 24)) - (rest (expt 2 16)) - (ms (condition-case nil (floor (/ seconds rest)) - (range-error (expt 2 16))))) - (list ms (condition-case nil (round (- seconds (* ms rest))) - (range-error (expt 2 16)))))) - -(defun time-since (time) - "Return the time since TIME, which is either an internal time or a date." - (when (stringp time) - ;; Convert date strings to internal time. - (setq time (date-to-time time))) - (let* ((current (current-time)) - (rest (when (< (nth 1 current) (nth 1 time)) - (expt 2 16)))) - (list (- (+ (car current) (if rest -1 0)) (car time)) - (- (+ (or rest 0) (nth 1 current)) (nth 1 time))))) - -(defun subtract-time (t1 t2) - "Subtract two internal times." - (let ((borrow (< (cadr t1) (cadr t2)))) - (list (- (car t1) (car t2) (if borrow 1 0)) - (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2))))) - -(defun date-to-day (date) - "Return the number of days between year 1 and DATE." - (time-to-day (date-to-time date))) - -(defun days-between (date1 date2) - "Return the number of days between DATE1 and DATE2." - (- (date-to-day date1) (date-to-day date2))) - -(defun date-leap-year-p (year) - "Return t if YEAR is a leap year." - (or (and (zerop (% year 4)) - (not (zerop (% year 100)))) - (zerop (% year 400)))) - -(defun time-to-day-in-year (time) - "Return the day number within the year of the date month/day/year." - (let* ((tim (decode-time time)) - (month (nth 4 tim)) - (day (nth 3 tim)) - (year (nth 5 tim)) - (day-of-year (+ day (* 31 (1- month))))) - (when (> month 2) - (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10))) - (when (date-leap-year-p year) - (setq day-of-year (1+ day-of-year)))) - day-of-year)) - -(defun time-to-day (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)) - (month (nth 4 tim)) - (day (nth 3 tim)) - (year (nth 5 tim))) - (+ (time-to-day-in-year time) ; Days this year - (* 365 (1- year)) ; + Days in prior years - (/ (1- year) 4) ; + Julian leap years - (- (/ (1- year) 100)) ; - century years - (/ (1- year) 400)))) ; + Gregorian leap years - -(provide 'date) - -;;; date.el ends here diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index a5d1d65..c2b4f82 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -30,7 +30,6 @@ (require 'cl) (require 'bytecomp) -(push "~/lisp/custom" load-path) (push "." load-path) (load "./lpath.el" nil t) diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 479f601..1d7fd45 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -341,7 +341,7 @@ agent minor mode in all Gnus buffers." (concat "^" (regexp-quote mail-header-separator) "\n")) (replace-match "\n") (gnus-agent-insert-meta-information 'mail) - (gnus-request-accept-article "nndraft:queue"))) + (gnus-request-accept-article "nndraft:queue" nil t t))) (defun gnus-agent-insert-meta-information (type &optional method) "Insert meta-information into the message that says how it's to be posted. @@ -535,9 +535,13 @@ the actual number of articles toggled is returned." (gnus-make-directory (file-name-directory file)) (let ((coding-system-for-write gnus-agent-file-coding-system)) - (write-region (point-min) (point-max) file nil 'silent))) - (when (file-exists-p (gnus-agent-lib-file "active")) - (delete-file (gnus-agent-lib-file "active")))) + (write-region (point-min) (point-max) file nil 'silent)) + + );;<-- correct? + + (when (file-exists-p (gnus-agent-lib-file "active")) + (delete-file (gnus-agent-lib-file "active")))) +; ) (defun gnus-agent-save-group-info (method group active) (when (gnus-agent-method-p method) @@ -1421,7 +1425,7 @@ The following commands are available: (gnus-agent-save-alist group) ;; Mark all articles up to the first article ;; in `gnus-article-alist' as read. - (when (caar gnus-agent-article-alist) + (when (and info (caar gnus-agent-article-alist)) (setcar (nthcdr 2 info) (gnus-range-add (nth 2 info) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index d440f6d..521cd03 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -95,7 +95,7 @@ (defcustom gnus-ignored-headers '("^Path:" "^Expires:" "^Date-Received:" "^References:" "^Xref:" "^Lines:" - "^Relay-Version:" "^Message-ID:" "^Approved:" "^Sender:" "^Received:" + "^Relay-Version:" "^Message-ID:" "^Approved:" "^Sender:" "^Received:" "^X-UIDL:" "^MIME-Version:" "^Return-Path:" "^In-Reply-To:" "^Content-Type:" "^Content-Transfer-Encoding:" "^X-WebTV-Signature:" "^X-MimeOLE:" "^X-MSMail-Priority:" "^X-Priority:" "^X-Loop:" @@ -105,7 +105,7 @@ "^X-Complaints-To:" "^X-NNTP-Posting-Host:" "^X-Orig.*:" "^Abuse-Reports-To:" "^Cache-Post-Path:" "^X-Article-Creation-Date:" "^X-Poster:" "^X-Mail2News-Path:" "^X-Server-Date:" "^X-Cache:" - "^Originator:" "^X-Problems-To:" "^X-Auth-User:" "^X-Post-Time:" + "^Originator:" "^X-Problems-To:" "^X-Auth-User:" "^X-Post-Time:" "^X-Admin:" "^X-UID:" "^Resent-[-A-Za-z]+:" "^X-Mailing-List:" "^Precedence:" "^Original-[-A-Za-z]+:" "^X-filename:" "^X-Orcpt:" "^Old-Received:" "^X-Pgp-Fingerprint:" "^X-Pgp-Key-Id:" @@ -556,6 +556,14 @@ displayed by the first non-nil matching CONTENT face." :group 'gnus-article-headers :type 'hook) +(defcustom gnus-display-mime-function 'gnus-display-mime + "Function to display MIME articles." + :group 'gnus-article-headers + :type 'function) + +(defvar gnus-decode-header-function 'mail-decode-encoded-word-region + "Function used to decode headers.") + ;;; Internal variables (defvar article-lapsed-timer nil) @@ -958,6 +966,46 @@ characters to translate to." (process-send-region "article-x-face" beg end) (process-send-eof "article-x-face")))))))))) +(defun article-decode-mime-words () + "Decode all MIME-encoded words in the article." + (interactive) + (save-excursion + (set-buffer gnus-article-buffer) + (let ((inhibit-point-motion-hooks t) + buffer-read-only) + (mail-decode-encoded-word-region (point-min) (point-max))))) + +(defun article-decode-charset (&optional prompt) + "Decode charset-encoded text in the article. +If PROMPT (the prefix), prompt for a coding system to use." + (interactive "P") + (save-excursion + (save-restriction + (message-narrow-to-head) + (let* ((inhibit-point-motion-hooks t) + (ct (message-fetch-field "Content-Type" t)) + (cte (message-fetch-field "Content-Transfer-Encoding" t)) + (ctl (and ct (condition-case () + (mail-header-parse-content-type ct) + (error nil)))) + (charset (cond + (prompt + (mm-read-coding-system "Charset to decode: ")) + (ctl + (mail-content-type-get ctl 'charset)) + (gnus-newsgroup-name + (gnus-group-find-parameter + gnus-newsgroup-name 'charset)))) + buffer-read-only) + (goto-char (point-max)) + (widen) + (narrow-to-region (point) (point-max)) + (when (or (not ct) + (equal (car ctl) "text/plain")) + (mm-decode-body + charset (and cte (intern (downcase + (gnus-strip-whitespace cte)))))))))) + (defun article-decode-encoded-words () "Remove encoded-word encoding from headers." (let (buffer-read-only) @@ -967,6 +1015,24 @@ characters to translate to." (eword-decode-header charset) ))) +(defun article-de-quoted-unreadable (&optional force) + "Translate a quoted-printable-encoded article. +If FORCE, decode the article whether it is marked as quoted-printable +or not." + (interactive (list 'force)) + (save-excursion + (let ((buffer-read-only nil) + (type (gnus-fetch-field "content-transfer-encoding"))) + (when (or force + (and type (string-match "quoted-printable" (downcase type)))) + (goto-char (point-min)) + (search-forward "\n\n" nil 'move) + (quoted-printable-decode-region (point) (point-max)))))) + +(defun article-mime-decode-quoted-printable-buffer () + "Decode Quoted-Printable in the current buffer." + (quoted-printable-decode-region (point-min) (point-max))) + (defun article-hide-pgp (&optional arg) "Toggle hiding of any PGP headers and signatures in the current article. If given a negative prefix, always show; if given a positive prefix, @@ -1397,7 +1463,8 @@ function and want to see what the date was before converting." (let (deactivate-mark) (save-excursion (ignore-errors - (when (gnus-buffer-live-p gnus-article-buffer) + (when (and (gnus-buffer-live-p gnus-article-buffer) + (get-buffer-window gnus-article-buffer)) (set-buffer gnus-article-buffer) (goto-char (point-min)) (when (re-search-forward "^X-Sent:" nil t) @@ -2083,22 +2150,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (or all-headers gnus-show-all-headers)))) (when (or (numberp article) (stringp article)) - (let ((method - (if gnus-show-mime - (progn - (mime-parse-buffer) - gnus-article-display-method-for-mime) - gnus-article-display-method-for-traditional))) - ;; Hooks for getting information from the article. - ;; This hook must be called before being narrowed. - (gnus-run-hooks 'gnus-tmp-internal-hook) - (gnus-run-hooks 'gnus-article-prepare-hook) - ;; Display message. - (funcall method) - ;; Associate this article with the current summary buffer. - (setq gnus-article-current-summary summary-buffer) - ;; Perform the article display hooks. - (gnus-run-hooks 'gnus-article-display-hook)) + (gnus-article-prepare-display) ;; Do page break. (goto-char (point-min)) (setq gnus-page-broken @@ -2112,6 +2164,179 @@ If ALL-HEADERS is non-nil, no headers are hidden." (set-window-point (get-buffer-window (current-buffer)) (point)) t)))))) +(defun gnus-article-prepare-display () + "Make the current buffer look like a nice article." + (let ((method (if gnus-show-mime + (progn + (mime-parse-buffer) + gnus-article-display-method-for-mime) + gnus-article-display-method-for-traditional))) + ;; Hooks for getting information from the article. + ;; This hook must be called before being narrowed. + (gnus-run-hooks 'gnus-tmp-internal-hook) + (gnus-run-hooks 'gnus-article-prepare-hook) + ;; Display message. + (funcall method) + ;; Associate this article with the current summary buffer. + (setq gnus-article-current-summary summary-buffer) + ;; Perform the article display hooks. + (gnus-run-hooks 'gnus-article-display-hook))) + +;;; +;;; Gnus MIME viewing functions +;;; + +(defvar gnus-mime-button-line-format "%{%([%t%d%n]%)%}\n" + "The following specs can be used: +%t The MIME type +%n The `name' parameter +%n The description, if any +%l The length of the encoded part") + +(defvar gnus-mime-button-line-format-alist + '((?t gnus-tmp-type ?s) + (?n gnus-tmp-name ?s) + (?d gnus-tmp-description ?s) + (?l gnus-tmp-length ?d))) + +(defvar gnus-mime-button-map nil) +(unless gnus-mime-button-map + (setq gnus-mime-button-map (copy-keymap gnus-article-mode-map)) + (define-key gnus-mime-button-map gnus-mouse-2 'gnus-article-push-button) + (define-key gnus-mime-button-map "\r" 'gnus-article-press-button) + (define-key gnus-mime-button-map "\M-\r" 'gnus-mime-view-part) + (define-key gnus-mime-button-map "v" 'gnus-mime-view-part) + (define-key gnus-mime-button-map "o" 'gnus-mime-save-part) + (define-key gnus-mime-button-map "c" 'gnus-mime-copy-part) + (define-key gnus-mime-button-map "i" 'gnus-mime-inline-part) + (define-key gnus-mime-button-map "|" 'gnus-mime-pipe-part)) + +(defun gnus-mime-save-part () + "Save the MIME part under point." + (interactive) + (let ((data (get-text-property (point) 'gnus-data))) + (mm-save-part data))) + +(defun gnus-mime-pipe-part () + "Pipe the MIME part under point to a process." + (interactive) + (let ((data (get-text-property (point) 'gnus-data))) + (mm-pipe-part data))) + +(defun gnus-mime-view-part () + "Interactively choose a view method for the MIME part under point." + (interactive) + (let ((data (get-text-property (point) 'gnus-data))) + (mm-interactively-view-part data))) + +(defun gnus-mime-copy-part () + "Put the the MIME part under point into a new buffer." + (interactive) + (let* ((data (get-text-property (point) 'gnus-data)) + (contents (mm-get-part data))) + (switch-to-buffer (generate-new-buffer "*decoded*")) + (insert contents) + (goto-char (point-min)))) + +(defun gnus-mime-inline-part () + "Insert the MIME part under point into the current buffer." + (interactive) + (let* ((data (get-text-property (point) 'gnus-data)) + (contents (mm-get-part data)) + (b (point)) + buffer-read-only) + (forward-line 2) + (mm-insert-inline data contents) + (goto-char b))) + +(defun gnus-insert-mime-button (handle) + (let ((gnus-tmp-name (mail-content-type-get (mm-handle-type handle) 'name)) + (gnus-tmp-type (car (mm-handle-type handle))) + (gnus-tmp-description (mm-handle-description handle)) + (gnus-tmp-length (save-excursion + (set-buffer (mm-handle-buffer handle)) + (buffer-size))) + b e) + (setq gnus-tmp-name + (if gnus-tmp-name + (concat " (" gnus-tmp-name ")") + "")) + (setq gnus-tmp-description + (if gnus-tmp-description + (concat " (" gnus-tmp-description ")") + "")) + (setq b (point)) + (gnus-eval-format + gnus-mime-button-line-format gnus-mime-button-line-format-alist + `(local-map ,gnus-mime-button-map + keymap ,gnus-mime-button-map + gnus-callback mm-display-part + gnus-data ,handle)) + (setq e (point)) + (widget-convert-button 'link b e :action 'gnus-widget-press-button))) + +(defun gnus-widget-press-button (elems el) + (goto-char (widget-get elems :from)) + (gnus-article-press-button)) + +(defun gnus-display-mime () + "Insert MIME buttons in the buffer." + (let (ct ctl) + (save-restriction + (mail-narrow-to-head) + (when (setq ct (mail-fetch-field "content-type")) + (setq ctl (mail-header-parse-content-type ct)))) + (let* ((handles (mm-dissect-buffer)) + handle name type b e) + (mapcar 'mm-destroy-part gnus-article-mime-handles) + (setq gnus-article-mime-handles handles) + (when handles + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (delete-region (point) (point-max)) + (if (not (equal (car ctl) "multipart/alternative")) + (while (setq handle (pop handles)) + (gnus-insert-mime-button handle) + (insert "\n\n") + (when (and (mm-automatic-display-p (car (mm-handle-type handle))) + (or (not (mm-handle-disposition handle)) + (equal (car (mm-handle-disposition handle)) + "inline"))) + (forward-line -2) + (mm-display-part handle t) + (goto-char (point-max)))) + ;; Here we have multipart/alternative + (gnus-mime-display-alternative handles)))))) + +(defun gnus-mime-display-alternative (handles &optional preferred) + (let* ((preferred (mm-preferred-alternative handles preferred)) + (ihandles handles) + handle buffer-read-only) + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (delete-region (point) (point-max)) + (mapcar 'mm-remove-part gnus-article-mime-handles) + (setq gnus-article-mime-handles handles) + (while (setq handle (pop handles)) + (gnus-add-text-properties + (point) + (progn + (insert (format "[%c] %-18s" + (if (equal handle preferred) ?* ? ) + (car (mm-handle-type handle)))) + (point)) + `(local-map ,gnus-mime-button-map + keymap ,gnus-mime-button-map + gnus-callback + (lambda (handles) + (gnus-mime-display-alternative + ',ihandles ,(car (mm-handle-type handle)))) + gnus-data ,handle)) + (insert " ")) + (insert "\n\n") + (when preferred + (mm-display-part preferred)))) + (defun gnus-article-wash-status () "Return a string which display status of article washing." (save-excursion @@ -2522,7 +2747,7 @@ If given a prefix, show the hidden text instead." ;; Decode charsets. (run-hooks 'gnus-article-decode-hook)) - + ;; Update sparse articles. (when (and do-update-line (or (numberp article) @@ -2705,7 +2930,7 @@ groups." ("\\bin\$ +article\\| +message\$? +\$<\\([^\n @<>]+@[^\n @<>]+\$>\\)" 2 t gnus-button-message-id 3) ("\$ \n\t]+\$>" 0 t gnus-url-mailto 2) - ("mailto:\$[a-zA-Z.-@_+0-9%]+\$" 0 t gnus-url-mailto 1) + ("mailto:\$[-a-zA-Z.@_+0-9%]+\$" 0 t gnus-url-mailto 1) ("\\bmailto:\$[^ \n\t]+\$" 0 t gnus-url-mailto 1) ;; This is how URLs _should_ be embedded in text... ("]*\\)>" 0 t gnus-button-embedded-url 1) diff --git a/lisp/gnus-mailcap.el b/lisp/gnus-mailcap.el index 44ae372..0cf68b2 100644 --- a/lisp/gnus-mailcap.el +++ b/lisp/gnus-mailcap.el @@ -102,7 +102,7 @@ (viewer . "open %s") (type . "application/postscript") (test . (eq (mm-device-type) 'ns))) - ("postscript" + ("postscript" (viewer . "ghostview %s") (type . "application/postscript") (test . (eq (mm-device-type) 'x)) @@ -126,6 +126,11 @@ (type . "audio/*"))) ("message" ("rfc-*822" + (viewer . gnus-article-prepare-display) + (test . (and (featurep 'gnus) + (gnus-alive-p))) + (type . "message/rfc-822")) + ("rfc-*822" (viewer . vm-mode) (test . (fboundp 'vm-mode)) (type . "message/rfc-822")) @@ -137,7 +142,7 @@ (viewer . view-mode) (test . (fboundp 'view-mode)) (type . "message/rfc-822")) - ("rfc-*822" + ("rfc-*822" (viewer . fundamental-mode) (type . "message/rfc-822"))) ("image" @@ -182,7 +187,7 @@ (type . "text/plain")) ("enriched" (viewer . enriched-decode-region) - (test . (fboundp 'enriched-decode-region)) + (test . (fboundp 'enriched-decode)) (type . "text/enriched")) ("html" (viewer . mm-w3-prepare-buffer) @@ -425,7 +430,7 @@ If FORCE, re-parse even if already parsed." (setq done t)))) (setq value (buffer-substring val-pos (point)))) (setq results (cons (cons name value) results))) - results))) + results))) (defun mailcap-mailcap-entry-passes-test (info) ;; Return t iff a mailcap entry passes its test clause or no test @@ -591,7 +596,7 @@ If FORCE, re-parse even if already parsed." (defun mailcap-mime-info (string &optional request) "Get the MIME viewer command for STRING, return nil if none found. -Expects a complete content-type header line as its argument. +Expects a complete content-type header line as its argument. Second argument REQUEST specifies what information to return. If it is nil or the empty string, the viewer (second field of the mailcap @@ -815,6 +820,17 @@ correspond to.") (setq extn (concat "." extn))) (cdr (assoc (downcase extn) mailcap-mime-extensions))) +(defun mailcap-command-p (command) + "Say whether COMMAND is in the exec path." + (let ((path (if (file-name-absolute-p command) '(nil) exec-path)) + file) + (catch 'found + (while path + (when (and (file-executable-p + (setq file (expand-file-name command (pop path)))) + (not (file-directory-p file))) + (throw 'found file)))))) + (provide 'mailcap) ;;; mailcap.el ends here diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index a594c28..a23d93c 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -256,12 +256,12 @@ If ARG is 1, prompt for a group name to find the posting style." (let ((gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) - (completing-read "Use style of group: " gnus-active-hashtb nil + (completing-read "Use posting style of group: " + gnus-active-hashtb nil (gnus-read-active-file-p)) (gnus-group-group-name)) ""))) - (gnus-setup-message 'message (message-mail)) - )) + (gnus-setup-message 'message (message-mail)))) (defun gnus-group-post-news (&optional arg) "Start composing a news message. @@ -546,7 +546,7 @@ If SILENT, don't prompt the user." ((and (eq gnus-post-method 'current) (not (eq (car group-method) 'nndraft)) (not arg)) - group-method) + group-method) ((and gnus-post-method (not (eq gnus-post-method 'current))) gnus-post-method) @@ -690,7 +690,8 @@ The current group name will be inserted at \"%s\".") (gnus-summary-select-article) (set-buffer gnus-original-article-buffer) (if (and (<= (length (message-tokenize-header - (setq newsgroups (mail-fetch-field "newsgroups")) + (setq newsgroups + (mail-fetch-field "newsgroups")) ", ")) 1) (or (not (setq followup-to (mail-fetch-field "followup-to"))) @@ -997,7 +998,7 @@ this is a reply." (and gnus-newsgroup-name (gnus-group-find-parameter gnus-newsgroup-name 'gcc-self))) - result + result (groups (cond ((null gnus-message-archive-method) @@ -1101,7 +1102,7 @@ this is a reply." (if (and (not (stringp (car attribute))) (not (eq 'body (car attribute))) (not (setq variable - (cdr (assq (car attribute) + (cdr (assq (car attribute) gnus-posting-style-alist))))) (message "Couldn't find attribute %s" (car attribute)) ;; We get the value. diff --git a/lisp/gnus-salt.el b/lisp/gnus-salt.el index e98762e..9a73698 100644 --- a/lisp/gnus-salt.el +++ b/lisp/gnus-salt.el @@ -519,12 +519,14 @@ Two predefined functions are available: (defun gnus-tree-article-region (article) "Return a cons with BEG and END of the article region." - (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article))) + (let ((pos (text-property-any + (point-min) (point-max) 'gnus-number article))) (when pos (cons pos (next-single-property-change pos 'gnus-number))))) (defun gnus-tree-goto-article (article) - (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article))) + (let ((pos (text-property-any + (point-min) (point-max) 'gnus-number article))) (when pos (goto-char pos)))) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 6061845..28e87da 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -318,7 +318,7 @@ and non-`vertical', do both horizontal and vertical recentering." "*If non-nil, ignore articles with identical Message-ID headers." :group 'gnus-summary :type 'boolean) - + (defcustom gnus-single-article-buffer t "*If non-nil, display all articles in the same buffer. If nil, each group will get its own article buffer." @@ -1010,6 +1010,25 @@ variable (string, integer, character, etc).") ;; Byte-compiler warning. (defvar gnus-article-mode-map) +;; MIME stuff. + +(defvar gnus-encoded-word-method-alist + '(("chinese" mail-decode-encoded-word-string rfc1843-decode-string) + (".*" mail-decode-encoded-word-string)) + "Alist of regexps (to match group names) and lists of functions to be applied.") + +(defun gnus-multi-decode-encoded-word-string (string) + "Apply the functions from `gnus-encoded-word-method-alist' that match." + (let ((alist gnus-encoded-word-method-alist) + elem) + (while (setq elem (pop alist)) + (when (string-match (car elem) gnus-newsgroup-name) + (pop elem) + (while elem + (setq string (funcall (pop elem) string))) + (setq alist nil))) + string)) + ;; Subject simplification. (defun gnus-simplify-whitespace (str) @@ -1248,7 +1267,7 @@ increase the score of each group you read." "L" gnus-summary-lower-score "\M-i" gnus-symbolic-argument "h" gnus-summary-select-article-buffer - + "V" gnus-summary-score-map "X" gnus-uu-extract-map "S" gnus-summary-send-map) @@ -2442,7 +2461,7 @@ marks of articles." (setq gnus-tmp-name gnus-tmp-from)) (unless (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0)) - (gnus-put-text-property-excluding-characters-with-faces + (gnus-put-text-property (point) (progn (eval gnus-summary-line-format-spec) (point)) 'gnus-number gnus-tmp-number) @@ -2691,7 +2710,7 @@ If NO-DISPLAY, don't generate a summary buffer." (goto-char (point-min)) (gnus-summary-position-point) (gnus-configure-windows 'summary 'force) - (gnus-set-mode-line 'summary)) + (gnus-set-mode-line 'summary)) (when (get-buffer-window gnus-group-buffer t) ;; Gotta use windows, because recenter does weird stuff if ;; the current buffer ain't the displayed window. @@ -3798,7 +3817,7 @@ or a straight list of headers." (setq gnus-tmp-name gnus-tmp-from)) (unless (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0)) - (gnus-put-text-property-excluding-characters-with-faces + (gnus-put-text-property (point) (progn (eval gnus-summary-line-format-spec) (point)) 'gnus-number number) @@ -4336,7 +4355,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; Then we add the read articles to the range. (gnus-add-to-range ninfo (setq articles (sort articles '<)))))) - + (defun gnus-group-make-articles-read (group articles) "Update the info of GROUP to say that ARTICLES are read." (let* ((num 0) @@ -5051,7 +5070,7 @@ The prefix argument ALL means to select all articles." (gnus-update-read-articles group (append gnus-newsgroup-unreads gnus-newsgroup-unselected)) ;; Set the current article marks. - (let ((gnus-newsgroup-scored + (let ((gnus-newsgroup-scored (if (and (not gnus-save-score) (not non-destructive)) nil @@ -6192,7 +6211,7 @@ If ALL, mark even excluded ticked and dormants as read." (defsubst gnus-cut-thread (thread) "Go forwards in the thread until we find an article that we want to display." (when (or (eq gnus-fetch-old-headers 'some) - (eq gnus-fetch-old-headers 'invisible) + (eq gnus-fetch-old-headers 'invisible) (eq gnus-build-sparse-threads 'some) (eq gnus-build-sparse-threads 'more)) ;; Deal with old-fetched headers and sparse threads. @@ -6794,14 +6813,14 @@ to save in." (set-buffer buffer) (gnus-article-delete-invisible-text) (let ((ps-left-header - (list + (list (concat "(" (mail-header-subject gnus-current-headers) ")") (concat "(" (mail-header-from gnus-current-headers) ")"))) - (ps-right-header - (list - "/pagenumberstring load" + (ps-right-header + (list + "/pagenumberstring load" (concat "(" (mail-header-date gnus-current-headers) ")")))) (gnus-run-hooks 'gnus-ps-print-hook) @@ -7108,7 +7127,7 @@ and `request-accept' functions." ;;;!!!Why is this necessary? (set-buffer gnus-summary-buffer) - + (gnus-summary-goto-subject article) (when (eq action 'move) (gnus-summary-mark-article article gnus-canceled-mark)))) @@ -7568,7 +7587,7 @@ the actual number of articles marked is returned." "Mark ARTICLE replied and update the summary line." (push article gnus-newsgroup-replied) (let ((buffer-read-only nil)) - (when (gnus-summary-goto-subject article) + (when (gnus-summary-goto-subject article nil t) (gnus-summary-update-secondary-mark article)))) (defun gnus-summary-set-bookmark (article) diff --git a/lisp/gnus.el b/lisp/gnus.el index 51c0b3e..2e3c1b3 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -253,10 +253,10 @@ is restarted, and sometimes reloaded." (defconst gnus-product-name "T-gnus" "Product name of this version of gnus.") -(defconst gnus-version-number "6.10.019" +(defconst gnus-version-number "6.10.020" "Version number for this version of gnus.") -(defconst gnus-original-version-number "0.30" +(defconst gnus-original-version-number "0.31" "Version number for this version of Gnus.") (defconst gnus-original-product-name "Pterodactyl Gnus" @@ -300,7 +300,8 @@ be set in `.emacs' instead." (defalias 'gnus-deactivate-mark 'deactivate-mark) (defalias 'gnus-window-edges 'window-edges) (defalias 'gnus-key-press-event-p 'numberp) - (defalias 'gnus-annotation-in-region-p 'ignore)) + (defalias 'gnus-annotation-in-region-p 'ignore) + (defalias 'gnus-decode-rfc1522 'ignore)) ;; We define these group faces here to avoid the display ;; update forced when creating new faces. @@ -1817,7 +1818,7 @@ This restriction may disappear in later versions of Gnus." (define-key keymap (pop keys) 'undefined)))) (defvar gnus-article-mode-map - (let ((keymap (make-keymap))) + (let ((keymap (make-sparse-keymap))) (gnus-suppress-keymap keymap) keymap)) (defvar gnus-summary-mode-map diff --git a/lisp/lpath.el b/lisp/lpath.el index bcd48a3..ca8dc7a 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -40,8 +40,9 @@ set-buffer-multibyte find-non-ascii-charset-region char-charset find-charset-region base64-decode-string + base64-encode-string find-coding-systems-region get-charset-property - coding-system-get)) + coding-system-get w3-region)) (maybe-bind '(global-face-data mark-active transient-mark-mode mouse-selection-click-count mouse-selection-click-count-buffer buffer-display-table @@ -68,7 +69,11 @@ pp-to-string color-name gnus-mule-get-coding-system decode-coding-string mail-aliases-setup - url-view-url w3-prepare-buffer char-int))) + url-view-url w3-prepare-buffer + char-int + annotationp delete-annotation make-image-specifier + make-annotation base64-decode-string base64-encode-string + w3-do-setup w3-region))) (setq load-path (cons "." load-path)) (require 'custom) diff --git a/lisp/mail-parse.el b/lisp/mail-parse.el index 095e114..99bd017 100644 --- a/lisp/mail-parse.el +++ b/lisp/mail-parse.el @@ -36,7 +36,7 @@ ;;; Code: -(require 'drums) +(require 'ietf-drums) (require 'rfc2231) (require 'rfc2047) @@ -44,14 +44,14 @@ (defalias 'mail-header-parse-content-disposition 'rfc2231-parse-string) (defalias 'mail-content-type-get 'rfc2231-get-value) -(defalias 'mail-header-remove-comments 'drums-remove-comments) -(defalias 'mail-header-remove-whitespace 'drums-remove-whitespace) -(defalias 'mail-header-get-comment 'drums-get-comment) -(defalias 'mail-header-parse-address 'drums-parse-address) -(defalias 'mail-header-parse-addresses 'drums-parse-addresses) -(defalias 'mail-header-parse-date 'drums-parse-date) -(defalias 'mail-narrow-to-head 'drums-narrow-to-header) -(defalias 'mail-quote-string 'drums-quote-string) +(defalias 'mail-header-remove-comments 'ietf-drums-remove-comments) +(defalias 'mail-header-remove-whitespace 'ietf-drums-remove-whitespace) +(defalias 'mail-header-get-comment 'ietf-drums-get-comment) +(defalias 'mail-header-parse-address 'ietf-drums-parse-address) +(defalias 'mail-header-parse-addresses 'ietf-drums-parse-addresses) +(defalias 'mail-header-parse-date 'ietf-drums-parse-date) +(defalias 'mail-narrow-to-head 'ietf-drums-narrow-to-header) +(defalias 'mail-quote-string 'ietf-drums-quote-string) (defalias 'mail-header-narrow-to-field 'rfc2047-narrow-to-field) (defalias 'mail-encode-encoded-word-region 'rfc2047-encode-region) diff --git a/lisp/message.el b/lisp/message.el index f6b7146..e44e4ad 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -2853,7 +2853,8 @@ If NOW, use that time instead." (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))) + (concat (format-time-string + "%d %b %Y %H:%M:%S " (or now (current-time))) (format "%s%02d%02d" sign (/ zone 3600) (% zone 3600))))) @@ -4510,6 +4511,35 @@ regexp varstr." (setq idx (1+ idx))) string)) +;;; +;;; MIME functions +;;; + +(defun message-encode-message-body () + "Examine the message body, encode it, and add the requisite headers." + (when (featurep 'mule) + (save-excursion + (save-restriction + (message-narrow-to-headers-or-head) + (message-remove-header + "^Content-Transfer-Encoding:\\|^Content-Type:\\|^Mime-Version:" t) + (goto-char (point-max)) + (widen) + (narrow-to-region (point) (point-max)) + (let* ((charset (mm-encode-body)) + (encoding (mm-body-encoding))) + (when (consp charset) + (error "Can't encode messages with multiple charsets (yet)")) + (widen) + (message-narrow-to-headers-or-head) + (goto-char (point-max)) + (setq charset (or charset (mm-mule-charset-to-mime-charset 'ascii))) + ;; We don't insert MIME headers if they only say the default. + (unless (and (eq charset 'us-ascii) + (eq encoding '7bit)) + (mm-insert-rfc822-headers charset encoding)) + (mm-encode-body)))))) + (run-hooks 'message-load-hook) (provide 'message) diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index 2cc3dbb..a2699f5 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -25,8 +25,8 @@ ;;; Code: (eval-and-compile - (if (not (fboundp 'base64-encode-string)) - (require 'base64))) + (or (fboundp 'base64-encode-region) + (autoload 'base64-decode-region "base64" nil t))) (require 'mm-util) (require 'rfc2047) (require 'qp) @@ -62,7 +62,10 @@ If no encoding was done, nil is returned." (while (not (eobp)) (if (eq (char-charset (following-char)) 'ascii) (when start - (mm-encode-coding-region start (point) mime-charset) + (save-restriction + (narrow-to-region start (point)) + (mm-encode-coding-region start (point) mime-charset) + (goto-char (point-max))) (setq start nil)) (unless start (setq start (point)))) diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 3f0055f..027a46a 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -37,6 +37,8 @@ ("image/xpm" mm-inline-image (featurep 'xpm)) ("image/bmp" mm-inline-image (featurep 'bmp)) ("text/plain" mm-inline-text t) + ("text/enriched" mm-inline-text t) + ("text/richtext" mm-inline-text t) ("text/html" mm-inline-text (featurep 'w3)) ("audio/wav" mm-inline-audio (and (or (featurep 'nas-sound) (featurep 'native-sound)) @@ -51,9 +53,10 @@ ("text/.*" . inline))) (defvar mm-user-automatic-display - '("text/plain" "text/html" "image/gif")) + '("text/plain" "text/enriched" "text/richtext" "text/html" "image/gif")) -(defvar mm-alternative-precedence '("text/plain" "text/html") +(defvar mm-alternative-precedence + '("text/plain" "text/enriched" "text/richtext" "text/html") "List that describes the precedence of alternative parts.") (defvar mm-tmp-directory "/tmp/" @@ -93,7 +96,8 @@ (when (and (or no-strict-mime (mail-fetch-field "mime-version")) (setq ct (mail-fetch-field "content-type"))) - (setq ctl (mail-header-parse-content-type ct) + (setq ctl (condition-case () (mail-header-parse-content-type ct) + (error nil)) cte (mail-fetch-field "content-transfer-encoding") cd (mail-fetch-field "content-disposition") description (mail-fetch-field "content-description") @@ -114,7 +118,9 @@ (mail-header-remove-comments cte))))) no-strict-mime - (and cd (mail-header-parse-content-disposition cd)))))) + (and cd (condition-case () + (mail-header-parse-content-disposition cd) + (error nil))))))) (when id (push (cons id result) mm-content-id-alist)) result)))) @@ -137,7 +143,7 @@ (let ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary))) start parts end) (while (search-forward boundary nil t) - (forward-line -1) + (goto-char (match-beginning 0)) (when start (save-excursion (save-restriction @@ -159,7 +165,7 @@ (insert-buffer-substring obuf beg) (current-buffer)))) -(defun mm-display-part (handle) +(defun mm-display-part (handle &optional no-default) "Display the MIME part represented by HANDLE." (save-excursion (mailcap-parse-mailcaps) @@ -172,8 +178,11 @@ (progn (forward-line 1) (mm-display-inline handle)) - (mm-display-external - handle (or user-method method 'mailcap-save-binary-file))))))) + (when (or user-method + method + (not no-default)) + (mm-display-external + handle (or user-method method 'mailcap-save-binary-file)))))))) (defun mm-display-external (handle method) "Display HANDLE using METHOD." @@ -226,7 +235,7 @@ (let* ((type (car (mm-handle-type handle))) (function (cadr (assoc type mm-inline-media-tests)))) (funcall function handle))) - + (defun mm-inlinable-p (type) "Say whether TYPE can be displayed inline." (let ((alist mm-inline-media-tests) @@ -318,7 +327,7 @@ This overrides entries in the mailcap file." (defun mm-pipe-part (handle) "Pipe HANDLE to a process." - (let* ((name (mail-content-type-get (car (mm-handle-type handle)) 'name)) + (let* ((name (mail-content-type-get (mm-handle-type handle) 'name)) (command (read-string "Shell command on MIME part: " mm-last-shell-command))) (mm-with-unibyte-buffer diff --git a/lisp/mm-view.el b/lisp/mm-view.el index b9756e9..10ab086 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -79,16 +79,30 @@ (save-window-excursion (w3-region (point-min) (point-max)) (setq text (buffer-string)))) - (let ((b (point))) - (insert text) - (mm-handle-set-undisplayer - handle - `(lambda () - (let (buffer-read-only) - (delete-region ,(set-marker (make-marker) b) - ,(set-marker (make-marker) (point))))))))) + (mm-insert-inline handle text))) + ((or (equal type "enriched") + (equal type "richtext")) + (save-excursion + (mm-with-unibyte-buffer + (insert-buffer-substring (mm-handle-buffer handle)) + (mm-decode-content-transfer-encoding (mm-handle-encoding handle)) + (save-window-excursion + (enriched-decode (point-min) (point-max)) + (setq text (buffer-string)))) + (mm-insert-inline handle text))) ))) +(defun mm-insert-inline (handle text) + "Insert TEXT inline from HANDLE." + (let ((b (point))) + (insert text) + (mm-handle-set-undisplayer + handle + `(lambda () + (let (buffer-read-only) + (delete-region ,(set-marker (make-marker) b) + ,(set-marker (make-marker) (point)))))))) + (defun mm-inline-audio (handle) (message "Not implemented")) diff --git a/lisp/mm.el b/lisp/mm.el deleted file mode 100644 index 1b57cb1..0000000 --- a/lisp/mm.el +++ /dev/null @@ -1,1283 +0,0 @@ -;;; mm.el,v --- Mailcap parsing routines, and MIME handling -;; Author: wmperry -;; Created: 1996/05/28 02:46:51 -;; Version: 1.96 -;; Keywords: mail, news, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1994, 1995, 1996 by William M. Perry -;;; Copyright (c) 1996 - 1998 Free Software Foundation, Inc. -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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. -;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Generalized mailcap parsing and access routines -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Data structures -;;; --------------- -;;; 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) -;;; -;;; Which looks like: -;;; ----------------- -;;; ( -;;; ("application" -;;; ("postscript" . ) -;;; ) -;;; ("text" -;;; ("plain" . ) -;;; ) -;;; ) -;;; -;;; Where 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") -;;; ) -;;; -;;; Where viewerinfo specifies how the content-type is viewed. Can be -;;; a string, in which case it is run through a shell, with -;;; appropriate parameters, or a symbol, in which case the symbol is -;;; funcall'd, with the buffer as an argument. -;;; -;;; testinfo is a list of strings, or nil. If nil, it means the -;;; viewer specified is always valid. If it is a list of strings, -;;; these are used to determine whether a viewer passes the 'test' or -;;; not. -;;; -;;; The main interface to this code is: -;;; -;;; To set everything up: -;;; -;;; (mm-parse-mailcaps [path]) -;;; -;;; Where PATH is a unix-style path specification (: separated list -;;; of strings). If PATH is nil, the environment variable MAILCAPS -;;; will be consulted. If there is no environment variable, then a -;;; default list of paths is used. -;;; -;;; To retrieve the information: -;;; (mm-mime-info st [nd] [request]) -;;; -;;; Where st and nd are positions in a buffer that contain the -;;; content-type header information of a mail/news/whatever message. -;;; st can optionally be a string that contains the content-type -;;; information. -;;; -;;; Third argument REQUEST specifies what information to return. If -;;; it is nil or the empty string, the viewer (second field of the -;;; mailcap entry) will be returned. If it is a string, then the -;;; mailcap field corresponding to that string will be returned -;;; (print, description, whatever). If a number, then all the -;;; information for this specific viewer is returned. -;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Variables, etc -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(eval-and-compile - (require 'cl) -;LMI was here - ;;(require 'devices) - ) - -(defconst mm-version (let ((x "1.96")) - (if (string-match "Revision: \$[^ \t\n]+\$" x) - (substring x (match-beginning 1) (match-end 1)) - x)) - "Version # of MM package") - -(defvar mm-parse-args-syntax-table - (copy-syntax-table emacs-lisp-mode-syntax-table) - "A syntax table for parsing sgml attributes.") - -(modify-syntax-entry ?' "\"" mm-parse-args-syntax-table) -(modify-syntax-entry ?` "\"" mm-parse-args-syntax-table) -(modify-syntax-entry ?{ "(" mm-parse-args-syntax-table) -(modify-syntax-entry ?} ")" mm-parse-args-syntax-table) - -(defvar mm-mime-data - '( - ("multipart" . ( - ("alternative". (("viewer" . mm-multipart-viewer) - ("type" . "multipart/alternative"))) - ("mixed" . (("viewer" . mm-multipart-viewer) - ("type" . "multipart/mixed"))) - (".*" . (("viewer" . mm-save-binary-file) - ("type" . "multipart/*"))) - ) - ) - ("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"))) - ("octet-stream" . (("viewer" . mm-save-binary-file) - ("type" ."application/octet-stream"))) - ("dvi" . (("viewer" . "open %s") - ("type" . "application/dvi") - ("test" . (eq (device-type) 'ns)))) - ("dvi" . (("viewer" . "xdvi %s") - ("test" . (eq (device-type) 'x)) - ("needsx11") - ("type" . "application/dvi"))) - ("dvi" . (("viewer" . "dvitty %s") - ("test" . (not (getenv "DISPLAY"))) - ("type" . "application/dvi"))) - ("emacs-lisp" . (("viewer" . mm-maybe-eval) - ("type" . "application/emacs-lisp"))) -; ("x-tar" . (("viewer" . tar-mode) -; ("test" . (fboundp 'tar-mode)) -; ("type" . "application/x-tar"))) - ("x-tar" . (("viewer" . mm-save-binary-file) - ("type" . "application/x-tar"))) - ("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"))) - ("latex" . (("viewer" . tex-mode) - ("test" . (fboundp 'tex-mode)) - ("type" . "application/latex"))) - ("tex" . (("viewer" . tex-mode) - ("test" . (fboundp 'tex-mode)) - ("type" . "application/tex"))) - ("texinfo" . (("viewer" . texinfo-mode) - ("test" . (fboundp 'texinfo-mode)) - ("type" . "application/tex"))) - ("zip" . (("viewer" . mm-save-binary-file) - ("type" . "application/zip") - ("copiousoutput"))) - ("pdf" . (("viewer" . "acroread %s") - ("type" . "application/pdf"))) - ("postscript" . (("viewer" . "open %s") - ("type" . "application/postscript") - ("test" . (eq (device-type) 'ns)))) - ("postscript" . (("viewer" . "ghostview %s") - ("type" . "application/postscript") - ("test" . (eq (device-type) 'x)) - ("needsx11"))) - ("postscript" . (("viewer" . "ps2ascii %s") - ("type" . "application/postscript") - ("test" . (not (getenv "DISPLAY"))) - ("copiousoutput"))) - )) - ("audio" . ( - ("x-mpeg" . (("viewer" . "maplay %s") - ("type" . "audio/x-mpeg"))) - (".*" . (("viewer" . mm-play-sound-file) - ("test" . (or (featurep 'nas-sound) - (featurep 'native-sound))) - ("type" . "audio/*"))) - (".*" . (("viewer" . "showaudio") - ("type" . "audio/*"))) - )) - ("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"))) - ("rfc-*822" . (("viewer" . view-mode) - ("test" . (fboundp 'view-mode)) - ("type" . "message/rfc-822"))) - ("rfc-*822" . (("viewer" . fundamental-mode) - ("type" . "message/rfc-822"))) - )) - ("image" . ( - ("x-xwd" . (("viewer" . "xwud -in %s") - ("type" . "image/x-xwd") - ("compose" . "xwd -frame > %s") - ("test" . (eq (device-type) 'x)) - ("needsx11"))) - ("x11-dump" . (("viewer" . "xwud -in %s") - ("type" . "image/x-xwd") - ("compose" . "xwd -frame > %s") - ("test" . (eq (device-type) 'x)) - ("needsx11"))) - ("windowdump" . (("viewer" . "xwud -in %s") - ("type" . "image/x-xwd") - ("compose" . "xwd -frame > %s") - ("test" . (eq (device-type) 'x)) - ("needsx11"))) - (".*" . (("viewer" . "open %s") - ("type" . "image/*") - ("test" . (eq (device-type) 'ns)))) - (".*" . (("viewer" . "xv -perfect %s") - ("type" . "image/*") - ("test" . (eq (device-type) 'x)) - ("needsx11"))) - )) - ("text" . ( - ("plain" . (("viewer" . w3-mode) - ("test" . (fboundp 'w3-mode)) - ("type" . "text/plain"))) - ("plain" . (("viewer" . view-mode) - ("test" . (fboundp 'view-mode)) - ("type" . "text/plain"))) - ("plain" . (("viewer" . fundamental-mode) - ("type" . "text/plain"))) - ("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"))) - )) - ("video" . ( - ("mpeg" . (("viewer" . "mpeg_play %s") - ("type" . "video/mpeg") - ("test" . (eq (device-type) 'x)) - ("needsx11"))) - )) - ("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)))) - )) - ) - "*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) - -Which looks like: ------------------ -( - (\"application\" - (\"postscript\" . ) - ) - (\"text\" - (\"plain\" . ) - ) -) - -Where 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\") -) - -Where viewerinfo specifies how the content-type is viewed. Can be -a string, in which case it is run through a shell, with -appropriate parameters, or a symbol, in which case the symbol is -funcall'd, with the buffer as an argument. - -testinfo is a list of strings, or nil. If nil, it means the -viewer specified is always valid. If it is a list of strings, -these are used to determine whether a viewer passes the 'test' or -not.") - -(defvar mm-content-transfer-encodings - '(("base64" . base64-decode-region) - ("7bit" . ignore) - ("8bit" . ignore) - ("binary" . ignore) - ("x-compress" . ("uncompress" "-c")) - ("x-gzip" . ("gzip" "-dc")) - ("compress" . ("uncompress" "-c")) - ("gzip" . ("gzip" "-dc")) - ("x-hqx" . ("mcvert" "-P" "-s" "-S")) - ("quoted-printable" . mm-decode-quoted-printable) - ) - "*An assoc list of content-transfer-encodings and how to decode them.") - -(defvar mm-download-directory nil - "*Where downloaded files should go by default.") - -(defvar mm-temporary-directory (or (getenv "TMPDIR") "/tmp") - "*Where temporary files go.") - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; A few things from w3 and url, just in case this is used without them -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun mm-generate-unique-filename (&optional fmt) - "Generate a unique filename in mm-temporary-directory" - (if (not fmt) - (let ((base (format "mm-tmp.%d" (user-real-uid))) - (fname "") - (x 0)) - (setq fname (format "%s%d" base x)) - (while (file-exists-p - (expand-file-name fname mm-temporary-directory)) - (setq x (1+ x) - fname (concat base (int-to-string x)))) - (expand-file-name fname mm-temporary-directory)) - (let ((base (concat "mm" (int-to-string (user-real-uid)))) - (fname "") - (x 0)) - (setq fname (format fmt (concat base (int-to-string x)))) - (while (file-exists-p - (expand-file-name fname mm-temporary-directory)) - (setq x (1+ x) - fname (format fmt (concat base (int-to-string x))))) - (expand-file-name fname mm-temporary-directory)))) - -(if (and (fboundp 'copy-tree) - (subrp (symbol-function 'copy-tree))) - (fset 'mm-copy-tree 'copy-tree) - (defun mm-copy-tree (tree) - (if (consp tree) - (cons (mm-copy-tree (car tree)) - (mm-copy-tree (cdr tree))) - (if (vectorp tree) - (let* ((new (copy-sequence tree)) - (i (1- (length new)))) - (while (>= i 0) - (aset new i (mm-copy-tree (aref new i))) - (setq i (1- i))) - new) - tree)))) - -;LMI was here -;(require 'mule-sysdp) - -(if (not (fboundp 'w3-save-binary-file)) - (defun mm-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 mm-download-directory "~/") - (file-name-nondirectory (url-view-url t)) - nil - (file-name-nondirectory (url-view-url t)))) - (require-final-newline nil)) - (set-buffer old-buff) - (mule-write-region-no-coding-system (point-min) (point-max) file) - (kill-buffer (current-buffer)))) - (fset 'mm-save-binary-file 'w3-save-binary-file)) - -(defun mm-maybe-eval () - "Maybe evaluate a buffer of emacs lisp code" - (if (yes-or-no-p "This is emacs-lisp code, evaluate it? ") - (eval-buffer (current-buffer)) - (emacs-lisp-mode))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The mailcap parser -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun mm-viewer-unescape (format &optional filename url) - (save-excursion - (set-buffer (get-buffer-create " *mm-parse*")) - (erase-buffer) - (insert format) - (goto-char (point-min)) - (while (re-search-forward "%\$.\$" nil t) - (let ((escape (aref (match-string 1) 0))) - (replace-match "" t t) - (case escape - (?% (insert "%")) - (?s (insert (or filename "\"\""))) - (?u (insert (or url "\"\"")))))) - (buffer-string))) - -(defun mm-in-assoc (elt list) - ;; Check to see if ELT matches any of the regexps in the car elements of LIST - (let (rslt) - (while (and list (not rslt)) - (and (car (car list)) - (string-match (car (car list)) elt) - (setq rslt (car list))) - (setq list (cdr list))) - rslt)) - -(defun mm-replace-regexp (regexp to-string) - ;; Quiet replace-regexp. - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (replace-match to-string t nil))) - -(defun mm-parse-mailcaps (&optional path) - ;; Parse out all the mailcaps specified in a unix-style path string PATH - (cond - (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") - ";"))) - (t (setq path (mapconcat 'expand-file-name - '("~/.mailcap" - "/etc/mailcap:/usr/etc/mailcap" - "/usr/local/etc/mailcap") ":")))) - (let ((fnames (reverse - (mm-string-to-tokens 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)) - (mm-parse-mailcap (car fnames))) - (setq fnames (cdr fnames))))) - -(defun mm-parse-mailcap (fname) - ;; Parse out the mailcap file specified by FNAME - (let (major ; The major mime type (image/audio/etc) - minor ; The minor mime type (gif, basic, etc) - save-pos ; Misc saved positions used in parsing - viewer ; How to view this mime type - info ; Misc info about this mime type - ) - (save-excursion - (set-buffer (get-buffer-create " *mailcap*")) - (erase-buffer) - (insert-file-contents fname) - (set-syntax-table mm-parse-args-syntax-table) - (mm-replace-regexp "#.*" "") ; Remove all comments - (mm-replace-regexp "\n+" "\n") ; And blank lines - (mm-replace-regexp "\\\\[ \t\n]+" " ") ; And collapse spaces - (mm-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 "^/;") - (downcase-region save-pos (point)) - (setq major (buffer-substring save-pos (point))) - (skip-chars-forward "/ \t\n") - (setq save-pos (point)) - (skip-chars-forward "^;") - (downcase-region save-pos (point)) - (setq minor - (cond - ((= ?* (or (char-after save-pos) 0)) ".*") - ((= (point) save-pos) ".*") - (t (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) - (skip-chars-forward "; \t\n") - (setq save-pos (point)) - (skip-chars-forward "^;\n") - (if (= (or (char-after save-pos) 0) ?') - (setq viewer (progn - (narrow-to-region (1+ save-pos) (point)) - (goto-char (point-min)) - (prog1 - (read (current-buffer)) - (goto-char (point-max)) - (widen)))) - (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)))) - (mm-parse-mailcap-extras save-pos (point)))) - (mm-mailcap-entry-passes-test info) - (mm-add-mailcap-entry major minor info))))) - -(defun mm-parse-mailcap-extras (st nd) - ;; Grab all the extra stuff from a mailcap entry - (let ( - name ; From name= - value ; its value - results ; Assoc list of results - name-pos ; Start of XXXX= position - val-pos ; Start of value position - done ; Found end of \'d ;s? - ) - (save-restriction - (narrow-to-region st nd) - (goto-char (point-min)) - (skip-chars-forward " \n\t;") - (while (not (eobp)) - (setq done nil) - (skip-chars-forward " \";\n\t") - (setq name-pos (point)) - (skip-chars-forward "^ \n\t=") - (downcase-region name-pos (point)) - (setq name (buffer-substring name-pos (point))) - (skip-chars-forward " \t\n") - (if (/= (or (char-after (point)) 0) ?=) ; There is no value - (setq value nil) - (skip-chars-forward " \t\n=") - (setq val-pos (point)) - (if (memq (char-after val-pos) '(?\" ?')) - (progn - (setq val-pos (1+ val-pos)) - (condition-case nil - (progn - (forward-sexp 1) - (backward-char 1)) - (error (goto-char (point-max))))) - (while (not done) - (skip-chars-forward "^;") - (if (= (or (char-after (1- (point))) 0) ?\\ ) - (progn - (subst-char-in-region (1- (point)) (point) ?\\ ? ) - (skip-chars-forward ";")) - (setq done t)))) - (setq value (buffer-substring val-pos (point)))) - (setq results (cons (cons name value) results))) - results))) - -(defun mm-string-to-tokens (str &optional delim) - "Return a list of words from the string STR" - (setq delim (or delim ? )) - (let (results y) - (mapcar - (function - (lambda (x) - (cond - ((and (= x delim) y) (setq results (cons y results) y nil)) - ((/= x delim) (setq y (concat y (char-to-string x)))) - (t nil)))) str) - (nreverse (cons y results)))) - -(defun mm-mailcap-entry-passes-test (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 - ) - (setq status (and test (mm-string-to-tokens (cdr test)))) - (if (and (assoc "needsx11" info) (not (getenv "DISPLAY"))) - (setq status nil) - (cond - ((and (equal (nth 0 status) "test") - (equal (nth 1 status) "-n") - (or (equal (nth 2 status) "$DISPLAY") - (equal (nth 2 status) "\"$DISPLAY\""))) - (setq status (if (getenv "DISPLAY") t nil))) - ((and (equal (nth 0 status) "test") - (equal (nth 1 status) "-z") - (or (equal (nth 2 status) "$DISPLAY") - (equal (nth 2 status) "\"$DISPLAY\""))) - (setq status (if (getenv "DISPLAY") nil t))) - (test nil) - (t nil))) - (and test (listp test) (setcdr test status)))) - -(defun mm-parse-args (st &optional nd nodowncase) - ;; Return an assoc list of attribute/value pairs from an RFC822-type string - (let ( - name ; From name= - value ; its value - results ; Assoc list of results - name-pos ; Start of XXXX= position - val-pos ; Start of value position - ) - (save-excursion - (if (stringp st) - (progn - (set-buffer (get-buffer-create " *mm-temp*")) - (set-syntax-table mm-parse-args-syntax-table) - (erase-buffer) - (insert st) - (setq st (point-min) - nd (point-max))) - (set-syntax-table mm-parse-args-syntax-table)) - (save-restriction - (narrow-to-region st nd) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward "; \n\t") - (setq name-pos (point)) - (skip-chars-forward "^ \n\t=;") - (if (not nodowncase) - (downcase-region name-pos (point))) - (setq name (buffer-substring name-pos (point))) - (skip-chars-forward " \t\n") - (if (/= (or (char-after (point)) 0) ?=) ; There is no value - (setq value nil) - (skip-chars-forward " \t\n=") - (setq val-pos (point) - value - (cond - ((or (= (or (char-after val-pos) 0) ?\") - (= (or (char-after val-pos) 0) ?')) - (buffer-substring (1+ val-pos) - (condition-case () - (prog2 - (forward-sexp 1) - (1- (point)) - (skip-chars-forward "\"")) - (error - (skip-chars-forward "^ \t\n") - (point))))) - (t - (buffer-substring val-pos - (progn - (skip-chars-forward "^;") - (skip-chars-backward " \t") - (point))))))) - (setq results (cons (cons name value) results)) - (skip-chars-forward "; \n\t")) - results)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The action routines. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun mm-possible-viewers (major minor) - ;; Return a list of possible viewers from MAJOR for minor type MINOR - (let ((exact '()) - (wildcard '())) - (while major - (cond - ((equal (car (car major)) minor) - (setq exact (cons (cdr (car major)) exact))) - ((string-match (car (car major)) minor) - (setq wildcard (cons (cdr (car major)) wildcard)))) - (setq major (cdr major))) - (nconc (nreverse exact) (nreverse wildcard)))) - -(defun mm-unescape-mime-test (test type-info) - (let ((buff (get-buffer-create " *unescape*")) - save-pos save-chr subst) - (cond - ((symbolp test) test) - ((and (listp test) (symbolp (car test))) test) - ((or (stringp test) - (and (listp test) (stringp (car test)) - (setq test (mapconcat 'identity test " ")))) - (save-excursion - (set-buffer buff) - (erase-buffer) - (insert test) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward "^%") - (if (/= (- (point) - (progn (skip-chars-backward "\\\\") - (point))) - 0) ; It is an escaped % - (progn - (delete-char 1) - (skip-chars-forward "%.")) - (setq save-pos (point)) - (skip-chars-forward "%") - (setq save-chr (char-after (point))) - (cond - ((null save-chr) nil) - ((= save-chr ?t) - (delete-region save-pos (progn (forward-char 1) (point))) - (insert (or (cdr (assoc "type" type-info)) "\"\""))) - ((= save-chr ?M) - (delete-region save-pos (progn (forward-char 1) (point))) - (insert "\"\"")) - ((= save-chr ?n) - (delete-region save-pos (progn (forward-char 1) (point))) - (insert "\"\"")) - ((= save-chr ?F) - (delete-region save-pos (progn (forward-char 1) (point))) - (insert "\"\"")) - ((= save-chr ?{) - (forward-char 1) - (skip-chars-forward "^}") - (downcase-region (+ 2 save-pos) (point)) - (setq subst (buffer-substring (+ 2 save-pos) (point))) - (delete-region save-pos (1+ (point))) - (insert (or (cdr (assoc subst type-info)) "\"\""))) - (t nil)))) - (buffer-string))) - (t (error "Bad value to mm-unescape-mime-test. %s" test))))) - -(defun mm-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)) - (test (cdr test-info)) - (viewer (cdr (assoc "viewer" viewer-info))) - (default-directory (expand-file-name "~/")) - status - parsed-test - ) - (cond - ((not test-info) t) ; No test clause - ((not test) nil) ; Already failed test - ((eq test t) t) ; Already passed test - ((and (symbolp test) ; Lisp function as test - (fboundp test)) - (funcall test type-info)) - ((and (symbolp test) ; Lisp variable as test - (boundp test)) - (symbol-value test)) - ((and (listp test) ; List to be eval'd - (symbolp (car test))) - (eval test)) - (t - (setq test (mm-unescape-mime-test test type-info) - test (list shell-file-name nil nil nil shell-command-switch test) - status (apply 'call-process test)) - (= 0 status))))) - -(defun mm-add-mailcap-entry (major minor info) - (let ((old-major (assoc major mm-mime-data))) - (if (null old-major) ; New major area - (setq mm-mime-data - (cons (cons major (list (cons minor info))) - mm-mime-data)) - (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 - (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))) - (setcdr cur-minor info)) - (t - (setcdr old-major (cons (cons minor info) (cdr old-major))))))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The main whabbo -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun mm-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)) ""))))) - (cond - ((and x-lisp (not y-lisp)) - t) - ((and (not y-lisp) x-wild (not y-wild)) - t) - ((and (not x-wild) y-wild) - t) - (t nil)))) - -(defun mm-mime-info (st &optional nd request) - "Get the mime viewer command for HEADERLINE, return nil if none found. -Expects a complete content-type header line as its argument. This can -be simple like text/html, or complex like text/plain; charset=blah; foo=bar - -Third argument REQUEST specifies what information to return. If it is -nil or the empty string, the viewer (second field of the mailcap -entry) will be returned. If it is a string, then the mailcap field -corresponding to that string will be returned (print, description, -whatever). If a number, then all the information for this specific -viewer is returned." - (let ( - major ; Major encoding (text, etc) - minor ; Minor encoding (html, etc) - info ; Other info - save-pos ; Misc. position during parse - major-info ; (assoc major mm-mime-data) - minor-info ; (assoc minor major-info) - test ; current test proc. - viewers ; Possible viewers - passed ; Viewers that passed the test - viewer ; The one and only viewer - ) - (save-excursion - (cond - ((null st) - (set-buffer (get-buffer-create " *mimeparse*")) - (erase-buffer) - (insert "text/plain") - (setq st (point-min))) - ((stringp st) - (set-buffer (get-buffer-create " *mimeparse*")) - (erase-buffer) - (insert st) - (setq st (point-min))) - ((null nd) - (narrow-to-region st (progn (goto-char st) (end-of-line) (point)))) - (t (narrow-to-region st nd))) - (goto-char st) - (skip-chars-forward ": \t\n") - (buffer-enable-undo) - (setq viewer - (catch 'mm-exit - (setq save-pos (point)) - (skip-chars-forward "^/") - (downcase-region save-pos (point)) - (setq major (buffer-substring save-pos (point))) - (if (not (setq major-info (cdr (assoc major mm-mime-data)))) - (throw 'mm-exit nil)) - (skip-chars-forward "/ \t\n") - (setq save-pos (point)) - (skip-chars-forward "^ \t\n;") - (downcase-region save-pos (point)) - (setq minor (buffer-substring save-pos (point))) - (if (not - (setq viewers (mm-possible-viewers major-info minor))) - (throw 'mm-exit nil)) - (skip-chars-forward "; \t") - (if (eolp) - nil ; No qualifiers - (setq save-pos (point)) - (end-of-line) - (setq info (mm-parse-args save-pos (point))) - ) - (while viewers - (if (mm-viewer-passes-test (car viewers) info) - (setq passed (cons (car viewers) passed))) - (setq viewers (cdr viewers))) - (setq passed (sort (nreverse passed) 'mm-viewer-lessp)) - (car passed))) - (if (and (stringp (cdr (assoc "viewer" viewer))) - passed) - (setq viewer (car passed))) - (widen) - (cond - ((and (null viewer) (not (equal major "default"))) - (mm-mime-info "default" nil request)) - ((or (null request) (equal request "")) - (mm-unescape-mime-test (cdr (assoc "viewer" viewer)) info)) - ((stringp request) - (if (or (string= request "test") (string= request "viewer")) - (mm-unescape-mime-test (cdr-safe (assoc request viewer)) info))) - (t - ;; MUST make a copy *sigh*, else we modify mm-mime-data - (setq viewer (mm-copy-tree viewer)) - (let ((view (assoc "viewer" viewer)) - (test (assoc "test" viewer))) - (if view (setcdr view (mm-unescape-mime-test (cdr view) info))) - (if test (setcdr test (mm-unescape-mime-test (cdr test) info)))) - viewer))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Experimental MIME-types parsing -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar mm-mime-extensions - '( - ("" . "text/plain") - (".abs" . "audio/x-mpeg") - (".aif" . "audio/aiff") - (".aifc" . "audio/aiff") - (".aiff" . "audio/aiff") - (".ano" . "application/x-annotator") - (".au" . "audio/ulaw") - (".avi" . "video/x-msvideo") - (".bcpio" . "application/x-bcpio") - (".bin" . "application/octet-stream") - (".cdf" . "application/x-netcdr") - (".cpio" . "application/x-cpio") - (".csh" . "application/x-csh") - (".dvi" . "application/x-dvi") - (".el" . "application/emacs-lisp") - (".eps" . "application/postscript") - (".etx" . "text/x-setext") - (".exe" . "application/octet-stream") - (".fax" . "image/x-fax") - (".gif" . "image/gif") - (".hdf" . "application/x-hdf") - (".hqx" . "application/mac-binhex40") - (".htm" . "text/html") - (".html" . "text/html") - (".icon" . "image/x-icon") - (".ief" . "image/ief") - (".jpg" . "image/jpeg") - (".macp" . "image/x-macpaint") - (".man" . "application/x-troff-man") - (".me" . "application/x-troff-me") - (".mif" . "application/mif") - (".mov" . "video/quicktime") - (".movie" . "video/x-sgi-movie") - (".mp2" . "audio/x-mpeg") - (".mp2a" . "audio/x-mpeg2") - (".mpa" . "audio/x-mpeg") - (".mpa2" . "audio/x-mpeg2") - (".mpe" . "video/mpeg") - (".mpeg" . "video/mpeg") - (".mpega" . "audio/x-mpeg") - (".mpegv" . "video/mpeg") - (".mpg" . "video/mpeg") - (".mpv" . "video/mpeg") - (".ms" . "application/x-troff-ms") - (".nc" . "application/x-netcdf") - (".nc" . "application/x-netcdf") - (".oda" . "application/oda") - (".pbm" . "image/x-portable-bitmap") - (".pdf" . "application/pdf") - (".pgm" . "image/portable-graymap") - (".pict" . "image/pict") - (".png" . "image/png") - (".pnm" . "image/x-portable-anymap") - (".ppm" . "image/portable-pixmap") - (".ps" . "application/postscript") - (".qt" . "video/quicktime") - (".ras" . "image/x-raster") - (".rgb" . "image/x-rgb") - (".rtf" . "application/rtf") - (".rtx" . "text/richtext") - (".sh" . "application/x-sh") - (".sit" . "application/x-stuffit") - (".snd" . "audio/basic") - (".src" . "application/x-wais-source") - (".tar" . "archive/tar") - (".tcl" . "application/x-tcl") - (".tcl" . "application/x-tcl") - (".tex" . "application/x-tex") - (".texi" . "application/texinfo") - (".tga" . "image/x-targa") - (".tif" . "image/tiff") - (".tiff" . "image/tiff") - (".tr" . "application/x-troff") - (".troff" . "application/x-troff") - (".tsv" . "text/tab-separated-values") - (".txt" . "text/plain") - (".vbs" . "video/mpeg") - (".vox" . "audio/basic") - (".vrml" . "x-world/x-vrml") - (".wav" . "audio/x-wav") - (".wrl" . "x-world/x-vrml") - (".xbm" . "image/xbm") - (".xpm" . "image/x-pixmap") - (".xwd" . "image/windowdump") - (".zip" . "application/zip") - (".ai" . "application/postscript") - (".jpe" . "image/jpeg") - (".jpeg" . "image/jpeg") - ) - "*An assoc list of file extensions and the MIME content-types they -correspond to.") - -(defun mm-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" - "/etc/mime-types:/usr/etc/mime-types" - "/usr/local/etc/mime-types" - "/usr/local/www/conf/mime-types") ":")))) - (let ((fnames (reverse - (mm-string-to-tokens 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)) - (mm-parse-mimetype-file (car fnames))) - (setq fnames (cdr fnames))))) - -(defun mm-parse-mimetype-file (fname) - ;; Parse out a mime-types file - (let (type ; The MIME type for this line - extns ; The extensions for this line - save-pos ; Misc. saved buffer positions - ) - (save-excursion - (set-buffer (get-buffer-create " *mime-types*")) - (erase-buffer) - (insert-file-contents fname) - (mm-replace-regexp "#.*" "") - (mm-replace-regexp "\n+" "\n") - (mm-replace-regexp "[ \t]+$" "") - (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)) - (skip-chars-forward "^ \t") - (downcase-region save-pos (point)) - (setq type (buffer-substring save-pos (point))) - (while (not (eolp)) - (skip-chars-forward " \t") - (setq save-pos (point)) - (skip-chars-forward "^ \t\n") - (setq extns (cons (buffer-substring save-pos (point)) extns))) - (while extns - (setq mm-mime-extensions - (cons - (cons (if (= (string-to-char (car extns)) ?.) - (car extns) - (concat "." (car extns))) type) mm-mime-extensions) - extns (cdr extns))))))) - -(defun mm-extension-to-mime (extn) - "Return the MIME content type of the file extensions EXTN" - (if (and (stringp extn) - (not (eq (string-to-char extn) ?.))) - (setq extn (concat "." extn))) - (cdr (assoc (downcase extn) mm-mime-extensions))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Editing/Composition of body parts -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun mm-compose-type (type) - ;; Compose a body section of MIME-type TYPE. - (let* ((info (mm-mime-info type nil 5)) - (fnam (mm-generate-unique-filename)) - (comp (or (cdr (assoc "compose" info)))) - (ctyp (cdr (assoc "composetyped" info))) - (buff (get-buffer-create " *mimecompose*")) - (typeit (not ctyp)) - (retval "") - (usef nil)) - (setq comp (mm-unescape-mime-test (or comp ctyp) info)) - (while (string-match "\$[^\\\\]\$%s" comp) - (setq comp (concat (substring comp 0 (match-end 1)) fnam - (substring comp (match-end 0) nil)) - usef t)) - (call-process shell-file-name nil - (if usef nil buff) - nil shell-command-switch comp) - (setq retval - (concat - (if typeit (concat "Content-type: " type "\r\n\r\n") "") - (if usef - (save-excursion - (set-buffer buff) - (erase-buffer) - (insert-file-contents fnam) - (buffer-string)) - (save-excursion - (set-buffer buff) - (buffer-string))) - "\r\n")) - retval)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Misc. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun mm-type-to-file (type) - "Return the file extension for content-type TYPE" - (rassoc type mm-mime-extensions)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Miscellaneous MIME viewers written in elisp -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun mm-play-sound-file (&optional buff) - "Play a sound file in buffer BUFF (defaults to current buffer)" - (setq buff (or buff (current-buffer))) - (let ((fname (mm-generate-unique-filename "%s.au")) - (synchronous-sounds t)) ; Play synchronously - (mule-write-region-no-coding-system (point-min) (point-max) fname) - (kill-buffer (current-buffer)) - (play-sound-file fname) - (condition-case () - (delete-file fname) - (error nil)))) - -(defun mm-parse-mime-headers (&optional no-delete) - "Return a list of the MIME headers at the top of this buffer. If -optional argument NO-DELETE is non-nil, don't delete the headers." - (let* ((st (point-min)) - (nd (progn - (goto-char (point-min)) - (skip-chars-forward " \t\n") - (if (re-search-forward "^\r*$" nil t) - (1+ (point)) - (point-max)))) - save-pos - status - hname - hvalu - result - search - ) - (narrow-to-region st (min nd (point-max))) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward " \t\n\r") - (setq save-pos (point)) - (skip-chars-forward "^:\n\r") - (downcase-region save-pos (point)) - (setq hname (buffer-substring save-pos (point))) - (skip-chars-forward ": \t ") - (setq save-pos (point)) - (skip-chars-forward "^\n\r") - (setq search t) - (while search - (skip-chars-forward "^\n\r") - (save-excursion - (skip-chars-forward "\n\r") - - (setq search - (string-match "[ \t]" - (char-to-string - (or (char-after (point)) ?a))))) - (if search - (skip-chars-forward "\n\r"))) - (setq hvalu (buffer-substring save-pos (point)) - result (cons (cons hname hvalu) result))) - (or no-delete (delete-region st nd)) - result)) - -(defun mm-find-available-multiparts (separator &optional buf) - "Return a list of mime-headers for the various body parts of a -multipart message in buffer BUF with separator SEPARATOR. -The different multipart specs are put in `mm-temporary-directory'." - (let ((sep (concat "^--" separator "\r*$")) - headers - fname - results) - (save-excursion - (and buf (set-buffer buf)) - (goto-char (point-min)) - (while (re-search-forward sep nil t) - (let ((st (set-marker (make-marker) - (progn - (forward-line 1) - (beginning-of-line) - (point)))) - (nd (set-marker (make-marker) - (if (re-search-forward sep nil t) - (1- (match-beginning 0)) - (point-max))))) - (narrow-to-region st nd) - (goto-char st) - (if (looking-at "^\r*$") - (insert "Content-type: text/plain\n" - "Content-length: " (int-to-string (- nd st)) "\n")) - (setq headers (mm-parse-mime-headers) - fname (mm-generate-unique-filename)) - (let ((x (or (cdr (assoc "content-type" headers)) "text/plain"))) - (if (string-match "name=\"*\$[^ \"]+\$\"*" x) - (setq fname (expand-file-name - (substring x (match-beginning 1) - (match-end 1)) - mm-temporary-directory)))) - (widen) - (if (assoc "content-transfer-encoding" headers) - (let ((coding (cdr - (assoc "content-transfer-encoding" headers))) - (cmd nil)) - (setq coding (and coding (downcase coding)) - cmd (or (cdr (assoc coding - mm-content-transfer-encodings)) - (read-string - (concat "How shall I decode " coding "? ") - "cat"))) - (if (string= cmd "") (setq cmd "cat")) - (if (stringp cmd) - (shell-command-on-region st nd cmd t) - (funcall cmd st nd)) - (or (eq cmd 'ignore) (set-marker nd (point))))) - (write-region st nd fname nil 5) - (delete-region st nd) - (setq results (cons - (cons - (cons "mm-filename" fname) headers) results))))) - results)) - -(defun mm-format-multipart-as-html (&optional buf type) - (if buf (set-buffer buf)) - (let* ((boundary (if (string-match - "boundary[ \t]*=[ \t\"]*\$[^ \"\t\n]+\$" - type) - (regexp-quote - (substring type (match-beginning 1) (match-end 1))))) - (parts (mm-find-available-multiparts boundary))) - (erase-buffer) - (insert "\n" - " \n" - " Multipart Message\n" - " \n" - " \n" - "

Multipart message encountered

\n" - "

I have encountered a multipart MIME message.\n" - " The following parts have been detected. Please\n" - " select which one you want to view.\n" - "

\n" - "

" - (or (cdr (assoc "content-description" x)) "") - "--" - (or (cdr (assoc "content-type" x)) - "unknown type") - "

\n" - " \n" - "\n" - "\n"))) - -(defun mm-multipart-viewer () - (mm-format-multipart-as-html - (current-buffer) - (cdr (assoc "content-type" url-current-mime-headers))) - (let ((w3-working-buffer (current-buffer))) - (w3-prepare-buffer))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Transfer encodings we can decrypt automatically -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun mm-decode-quoted-printable (&optional st nd) - (interactive) - (setq st (or st (point-min)) - nd (or nd (point-max))) - (save-restriction - (narrow-to-region st nd) - (save-excursion - (let ((buffer-read-only nil)) - (goto-char (point-min)) - (while (re-search-forward "=[0-9A-F][0-9A-F]" nil t) - (replace-match - (char-to-string - (+ - (* 16 (mm-hex-char-to-integer - (char-after (1+ (match-beginning 0))))) - (mm-hex-char-to-integer - (char-after (1- (match-end 0)))))))))) - (goto-char (point-max)))) - -;; Taken from hexl.el. -(defun mm-hex-char-to-integer (character) - "Take a char and return its value as if it was a hex digit." - (if (and (>= character ?0) (<= character ?9)) - (- character ?0) - (let ((ch (logior character 32))) - (if (and (>= ch ?a) (<= ch ?f)) - (- ch (- ?a 10)) - (error (format "Invalid hex digit `%c'." ch)))))) - - - -(require 'base64) -(provide 'mm) diff --git a/lisp/nndoc.el b/lisp/nndoc.el index f885c46..f417484 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -143,10 +143,13 @@ from the document.") (defvoo nndoc-head-begin-function nil) (defvoo nndoc-body-end nil) ;; nndoc-dissection-alist is a list of sublists. Each sublist holds the -;; following items. ARTICLE is an ordinal starting at 1. HEAD-BEGIN, -;; HEAD-END, BODY-BEGIN and BODY-END are positions in the `nndoc' buffer. -;; LINE-COUNT is a count of lines in the body. SUBJECT, MESSAGE-ID and -;; REFERENCES, only present for MIME dissections, are field values. +;; following items. ARTICLE act as the association key and is an ordinal +;; starting at 1. HEAD-BEGIN [0], HEAD-END [1], BODY-BEGIN [2] and BODY-END +;; [3] are positions in the `nndoc' buffer. LINE-COUNT [4] is a count of +;; lines in the body. For MIME dissections only, ARTICLE-INSERT [5] and +;; SUMMARY-INSERT [6] give headers to insert for full article or summary line +;; generation, respectively. Other headers usually follow directly from the +;; buffer. Value `nil' means no insert. (defvoo nndoc-dissection-alist nil) (defvoo nndoc-prepare-body-function nil) (defvoo nndoc-generate-head-function nil) @@ -158,8 +161,6 @@ from the document.") (defvoo nndoc-current-buffer nil "Current nndoc news buffer.") (defvoo nndoc-address nil) -(defvoo nndoc-mime-header nil) -(defvoo nndoc-mime-subject nil) (defconst nndoc-version "nndoc 1.0" "nndoc version.") @@ -459,30 +460,19 @@ from the document.") t))) (defun nndoc-transform-mime-parts (article) - (unless (= article 1) - ;; Ensure some MIME-Version. - (goto-char (point-min)) - (search-forward "\n\n") - (let ((case-fold-search nil) - (limit (point))) + (let* ((entry (cdr (assq article nndoc-dissection-alist))) + (headers (nth 5 entry))) + (when headers (goto-char (point-min)) - (or (save-excursion (re-search-forward "^MIME-Version:" limit t)) - (insert "MIME-Version: 1.0\n"))) - ;; Generate default header before entity fields. - (goto-char (point-min)) - (nndoc-generate-mime-parts-head article t))) - -(defun nndoc-generate-mime-parts-head (article &optional body-present) - (let ((entry (cdr (assq (if body-present 1 article) nndoc-dissection-alist)))) - (let ((subject (if body-present - nndoc-mime-subject - (concat "<" (nth 5 entry) ">"))) - (message-id (nth 6 entry)) - (references (nth 7 entry))) - (insert nndoc-mime-header) - (and subject (insert "Subject: " subject "\n")) - (and message-id (insert "Message-ID: " message-id "\n")) - (and references (insert "References: " references "\n"))))) + (insert headers)))) + +(defun nndoc-generate-mime-parts-head (article) + (let* ((entry (cdr (assq article nndoc-dissection-alist))) + (headers (nth 6 entry))) + (when headers + (insert headers)) + (insert-buffer-substring + nndoc-current-buffer (car entry) (nth 1 entry)))) (defun nndoc-clari-briefs-type-p () (when (let ((case-fold-search nil)) @@ -668,92 +658,127 @@ the header of this entity, and one article per sub-entity." nndoc-mime-split-ordinal 0) (save-excursion (set-buffer nndoc-current-buffer) - (message-narrow-to-head) - (let ((case-fold-search t) - (message-id (message-fetch-field "Message-ID")) - (references (message-fetch-field "References"))) - (setq nndoc-mime-header (buffer-substring (point-min) (point-max)) - nndoc-mime-subject (message-fetch-field "Subject")) - (while (string-match "\ -^\$Subject\\|Message-ID\\|References\\|Lines\\|\ -MIME-Version\\|Content-Type\\|Content-Transfer-Encoding\\|\ -\$:.*\n\$[ \t].*\n\$*" - nndoc-mime-header) - (setq nndoc-mime-header (replace-match "" t t nndoc-mime-header))) - (widen) - (nndoc-dissect-mime-parts-sub (point-min) (point-max) - nil message-id references)))) - -(defun nndoc-dissect-mime-parts-sub (begin end position message-id references) - "Dissect an entity within a composite MIME message. -The article, which corresponds to a MIME entity, extends from BEGIN to END. + (nndoc-dissect-mime-parts-sub (point-min) (point-max) nil nil nil))) + +(defun nndoc-dissect-mime-parts-sub (head-begin body-end article-insert + position parent) + "Dissect an entity, within a composite MIME message. +The complete message or MIME entity extends from HEAD-BEGIN to BODY-END. +ARTICLE-INSERT should be added at beginning for generating a full article. The string POSITION holds a dotted decimal representation of the article position in the hierarchical structure, it is nil for the outer entity. -The generated article should use MESSAGE-ID and REFERENCES field values." - ;; Note: `case-fold-search' is already `t' from the calling function. - (let ((head-begin begin) - (body-end end) - head-end body-begin type subtype composite comment) - (save-excursion +PARENT is the message-ID of the parent summary line, or nil for none." + (let ((case-fold-search t) + (message-id (nnmail-message-id)) + head-end body-begin summary-insert message-rfc822 multipart-any + subject content-type type subtype boundary-regexp) ;; Gracefully handle a missing body. (goto-char head-begin) (if (search-forward "\n\n" body-end t) (setq head-end (1- (point)) body-begin (point)) - (setq head-end end - body-begin end)) + (setq head-end body-end + body-begin body-end)) + (narrow-to-region head-begin head-end) ;; Save MIME attributes. (goto-char head-begin) - (if (re-search-forward "\ -^Content-Type: *\$[^ \t\n/;]+\$/\$[^ \t\n/;]+\$" - head-end t) - (setq type (downcase (match-string 1)) - subtype (downcase (match-string 2))) + (setq content-type (message-fetch-field "Content-Type")) + (when content-type + (when (string-match "^ *\$[^ \t\n/;]+\$/\$[^ \t\n/;]+\$" content-type) + (setq type (downcase (match-string 1 content-type)) + subtype (downcase (match-string 2 content-type)) + message-rfc822 (and (string= type "message") + (string= subtype "rfc822")) + multipart-any (string= type "multipart"))) + (when (string-match ";[ \t\n]*name=\$[^ \t\n;]+\$" content-type) + (setq subject (match-string 1 content-type))) + (when (string-match "boundary=\"?\$[^\"\n]*[^\" \t\n]\$" content-type) + (setq boundary-regexp (concat "\n--" + (regexp-quote + (match-string 1 content-type)) + "\$--\$?[ \t]*\n")))) + (unless subject + (when (or multipart-any (not article-insert)) + (setq subject (message-fetch-field "Subject")))) + (unless type (setq type "text" subtype "plain")) - (setq composite (string= type "multipart") - comment (concat position - (when (and position composite) ".") - (when composite "*") - (when (or position composite) " ") + ;; Prepare the article and summary inserts. + (unless article-insert + (setq article-insert (buffer-substring (point-min) (point-max)) + head-end head-begin)) + (setq summary-insert article-insert) + ;; - summary Subject. + (setq summary-insert + (let ((line (concat "Subject: <" position + (and position multipart-any ".") + (and multipart-any "*") + (and (or position multipart-any) " ") (cond ((string= subtype "plain") type) ((string= subtype "basic") type) - (t subtype)))) + (t subtype)) + ">" + (and subject " ") + subject + "\n"))) + (if (string-match "Subject:.*\n\$[ \t].*\n\$*" summary-insert) + (replace-match line t t summary-insert) + (concat summary-insert line)))) + ;; - summary Message-ID. + (setq summary-insert + (let ((line (concat "Message-ID: " message-id "\n"))) + (if (string-match "Message-ID:.*\n\$[ \t].*\n\$*" summary-insert) + (replace-match line t t summary-insert) + (concat summary-insert line)))) + ;; - summary References. + (when parent + (setq summary-insert + (let ((line (concat "References: " parent "\n"))) + (if (string-match "References:.*\n\$[ \t].*\n\$*" + summary-insert) + (replace-match line t t summary-insert) + (concat summary-insert line))))) ;; Generate dissection information for this entity. (push (list (incf nndoc-mime-split-ordinal) head-begin head-end body-begin body-end (count-lines body-begin body-end) - comment message-id references) + article-insert summary-insert) nndoc-dissection-alist) ;; Recurse for all sub-entities, if any. - (goto-char head-begin) - (when (re-search-forward - (concat "\ -^Content-Type: *multipart/\$[a-z]+\$;\$.*;\$*" - "[ \t\n]*[ \t]boundary=\"?\$[^\"\n]*[^\" \t\n]\$") - head-end t) - (let ((boundary (concat "\n--" (match-string 3) "\$--\$?[ \t]*\n")) - (part-counter 0) - begin end eof-flag) - (goto-char head-end) - (setq eof-flag (not (re-search-forward boundary body-end t))) + (widen) + (cond + (message-rfc822 + (save-excursion + (nndoc-dissect-mime-parts-sub body-begin body-end nil + position message-id))) + ((and multipart-any boundary-regexp) + (let ((part-counter 0) + part-begin part-end eof-flag) + (while (string-match "\ +^\$Lines\\|Content-\\(Type\\|Transfer-Encoding\$\\):.*\n\$[ \t].*\n\$*" + article-insert) + (setq article-insert (replace-match "" t t article-insert))) + (let ((case-fold-search nil)) + (goto-char body-begin) + (setq eof-flag (not (re-search-forward boundary-regexp body-end t))) (while (not eof-flag) - (setq begin (point)) - (cond ((re-search-forward boundary body-end t) + (setq part-begin (point)) + (cond ((re-search-forward boundary-regexp body-end t) (or (not (match-string 1)) (string= (match-string 1) "") (setq eof-flag t)) (forward-line -1) - (setq end (point)) + (setq part-end (point)) (forward-line 1)) - (t (setq end body-end + (t (setq part-end body-end eof-flag t))) - (nndoc-dissect-mime-parts-sub begin end - (concat position (when position ".") - (format "%d" - (incf part-counter))) - (nnmail-message-id) - message-id))))))) + (save-excursion + (nndoc-dissect-mime-parts-sub + part-begin part-end article-insert + (concat position + (and position ".") + (format "%d" (incf part-counter))) + message-id))))))))) ;;;###autoload (defun nndoc-add-type (definition &optional position) diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index fdeb989..8878a78 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -26,11 +26,12 @@ (eval-and-compile (eval - '(if (not (fboundp 'base64-encode-string)) - (require 'base64)))) + '(unless (fboundp 'base64-decode-string) + (autoload 'base64-decode-string "base64") + (autoload 'base64-encode-region "base64" nil t)))) (require 'qp) (require 'mm-util) -(require 'drums) +(require 'ietf-drums) (defvar rfc2047-default-charset 'iso-8859-1 "Default MIME charset -- does not need encoding.") @@ -148,7 +149,8 @@ Should be called narrowed to the head of the message." (save-restriction (narrow-to-region b e) (goto-char (point-min)) - (while (re-search-forward (concat "[^" drums-tspecials " \t\n]+") nil t) + (while (re-search-forward + (concat "[^" ietf-drums-tspecials " \t\n]+") nil t) (push (list (match-beginning 0) (match-end 0) (car @@ -229,7 +231,7 @@ Should be called narrowed to the head of the message." (pop alist)) (goto-char (point-min)) (while (not (eobp)) - (forward-char 64) + (goto-char (min (point-max) (+ 64 (point)))) (search-backward "=" nil (- (point) 2)) (unless (eobp) (insert "\n"))))))) @@ -305,9 +307,7 @@ If your Emacs implementation can't decode CHARSET, it returns nil." (mm-decode-coding-string (cond ((equal "B" encoding) - (if (fboundp 'base64-decode-string) - (base64-decode-string string) - (base64-decode string))) + (base64-decode-string string)) ((equal "Q" encoding) (quoted-printable-decode-string (mm-replace-chars-in-string string ?_ ? ))) diff --git a/lisp/rfc2231.el b/lisp/rfc2231.el index 2998472..e7a0417 100644 --- a/lisp/rfc2231.el +++ b/lisp/rfc2231.el @@ -23,7 +23,7 @@ ;;; Code: -(require 'drums) +(require 'ietf-drums) (defun rfc2231-get-value (ct attribute) "Return the value of ATTRIBUTE from CT." @@ -34,16 +34,16 @@ The list will be on the form `(name (attribute . value) (attribute . value)...)" (with-temp-buffer - (let ((ttoken (drums-token-to-list drums-text-token)) - (stoken (drums-token-to-list drums-tspecials)) - (ntoken (drums-token-to-list "0-9")) + (let ((ttoken (ietf-drums-token-to-list ietf-drums-text-token)) + (stoken (ietf-drums-token-to-list ietf-drums-tspecials)) + (ntoken (ietf-drums-token-to-list "0-9")) (prev-value "") display-name mailbox c display-string parameters attribute value type subtype number encoded prev-attribute) - (drums-init (mail-header-remove-whitespace + (ietf-drums-init (mail-header-remove-whitespace (mail-header-remove-comments string))) - (let ((table (copy-syntax-table drums-syntax-table))) + (let ((table (copy-syntax-table ietf-drums-syntax-table))) (modify-syntax-entry ?\' "w" table) (set-syntax-table table)) (setq c (following-char)) diff --git a/texi/gnus-ja.texi b/texi/gnus-ja.texi index f98699f..923d4b1 100644 --- a/texi/gnus-ja.texi +++ b/texi/gnus-ja.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus-ja -@settitle Semi-gnus 6.10.019 Manual +@settitle Semi-gnus 6.10.020 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -345,7 +345,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Semi-gnus 6.10.019 Manual +@title Semi-gnus 6.10.020 Manual @author by Lars Magne Ingebrigtsen @author by members of Semi-gnus mailing-list @@ -399,7 +399,7 @@ Semi-gnus $B$O!"Bg$-$J3($,F~$C$F$$$?$j$5$^$6$^$J7A<0$rMQ$$$?$j$7$F$$$k$A$g$C(B $B$J8@8l7w$r:9JL$7$^$;$s!#$"$"!"%/%j%s%4%s$NJ}$O(B Unicode Next Generation$B$r(B $B$*BT$A$/$@$5$$!#(B -$B$3$N@bL@=q$O(B Semi-gnus 6.10.019 $B$KBP1~$7$^$9!#(B +$B$3$N@bL@=q$O(B Semi-gnus 6.10.020 $B$KBP1~$7$^$9!#(B @end ifinfo diff --git a/texi/gnus.texi b/texi/gnus.texi index d1af82a..abc4dbd 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Semi-gnus 6.10.019 Manual +@settitle Semi-gnus 6.10.020 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -318,7 +318,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Semi-gnus 6.10.019 Manual +@title Semi-gnus 6.10.020 Manual @author by Lars Magne Ingebrigtsen @page @@ -361,7 +361,7 @@ internationalization/localization and multiscript features based on MULE 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.019. +This manual corresponds to Semi-gnus 6.10.020. @end ifinfo diff --git a/texi/message.texi b/texi/message.texi index c9d2568..a048867 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Pterodactyl Message 0.30 Manual +@settitle Pterodactyl Message 0.31 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -42,7 +42,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Message 0.30 Manual +@title Pterodactyl Message 0.31 Manual @author by Lars Magne Ingebrigtsen @page @@ -83,7 +83,7 @@ Message mode buffers. * Key Index:: List of Message mode keys. @end menu -This manual corresponds to Pterodactyl Message 0.30. Message is +This manual corresponds to Pterodactyl Message 0.31. Message is distributed with the Gnus distribution bearing the same version number as this manual. -- 1.7.10.4