-Sun Sep 13 09:37:37 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+Mon Sep 14 18:55:38 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.31 is released.
+
+1998-09-14 15:12:59 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <conrad@stack.nl>
+
+ * mm-decode.el (mm-user-automatic-display): Use enriched.
+
+1998-09-14 15:09:12 Paul Fisher <rao@gnu.org>
+
+ * mm-decode.el (mm-dissect-multipart): Have the part start on the
+ right place.
+
+1998-09-14 14:33:34 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <larsi@gnus.org>
+
+ * 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 <pinard@iro.umontreal.ca>
+
+ * 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 <h.b.furuseth@usit.uio.no>
+
+ * mailcap.el (mailcap-command-p): New version.
+
+1998-09-13 Mike McEwan <mike@lotusland.demon.co.uk>
+
+ * gnus-agent.el (gnus-agent-expire): Stop expiry barfing on killed
+ groups.
+
+1998-09-13 18:34:06 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <h.b.furuseth@usit.uio.no>
+
+ * rfc2047.el (eval): Autoload.
+
+1998-09-13 12:22:40 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <zsh@cs.rochester.edu>
+
+ * 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 <larsi@gnus.org>
+
+ * 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 <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.30 is released.
(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.
1998-09-13 07:58:59 Shenghuo ZHU <zsh@cs.rochester.edu>
* gnus-sum.el (gnus-summary-move-article): Don't decode accepting
- articles.
+ articles.
1998-09-13 07:23:28 Lars Magne Ingebrigtsen <larsi@gnus.org>
* mm-util.el (mm-mime-charset): Try to use safe-charsets.
(mm-default-mime-charset): New variable.
- * rfc2047.el (rfc2047-dissect-region): Dissect using tspecials.
+ * rfc2047.el (rfc2047-dissect-region): Dissect using tspecials.
* drums.el (drums-quote-string): Reversed test.
1998-09-12 14:29:21 Lars Magne Ingebrigtsen <larsi@gnus.org>
* mm-util.el (mm-insert-rfc822-headers): Possibly not quote
- string.
+ string.
* drums.el (drums-quote-string): New function.
1998-09-12 11:30:01 Lars Magne Ingebrigtsen <larsi@gnus.org>
* drums.el (drums-parse-address): Returned a list instead of a
- string.
+ string.
(drums-remove-whitespace): Skip comments.
(drums-parse-addresses): Didn't work.
* 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.
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.
* 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 <larsi@menja.ifi.uio.no>
* 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.
* 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.
1998-09-11 07:38:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
* 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.
1998-09-10 01:58:24 Lars Magne Ingebrigtsen <larsi@gnus.org>
* 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.
1998-09-08 11:40:45 Lars Magne Ingebrigtsen <larsi@gnus.org>
* rfc2047.el (rfc2047-decode-region): Only decode when in
- multibyte.
+ multibyte.
* nnheader.el (nnheader-pathname-coding-system): Changed to binary.
(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.
* 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.
* 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.
1998-09-05 22:23:03 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-art.el (gnus-article-decode-charset): Only decode text
- things.
+ things.
* message.el (message-output): Use rmail.
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.
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.
* 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.
1998-09-02 14:38:18 Lars Magne Ingebrigtsen <larsi@gnus.org>
* 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 <h.b.furuseth@usit.uio.no>
1998-09-02 00:31:53 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-art.el (gnus-article-decode-charset): Use real
- read-coding-system.
+ read-coding-system.
1998-09-01 17:58:40 Lars Magne Ingebrigtsen <larsi@gnus.org>
* 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 <larsi@menja.ifi.uio.no>
1998-09-01 09:14:33 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-util.el (gnus-strip-whitespace): Already defined.
- Removed.
+ Removed.
* gnus-art.el (gnus-article-decode-charset): Strip whitespace.
* 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 <larsi@menja.ifi.uio.no>
* 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.
* 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.
* 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 <larsi@menja.ifi.uio.no>
* 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 <larsi@menja.ifi.uio.no>
1998-08-29 22:38:35 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * 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.
1998-08-29 20:53:29 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-art.el (gnus-article-decode-mime-words): New command and
- keystroke.
+ keystroke.
* qp.el (quoted-printable-decode-region): Don't use hexl.
* 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.
Sat Aug 29 19:32:06 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Gnus v0.2 is released.
-
;;; Boston, MA 02111-1307, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(require 'mm-util)
-
;; For non-MULE
(if (not (fboundp 'char-int))
(fset 'char-int 'identity))
(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)
(buffer-string)
(kill-buffer (current-buffer)))))
+(fset 'base64-decode-string 'base64-decode)
+
(provide 'base64)
(require 'cl)
(require 'bytecomp)
-(push "~/lisp/custom" load-path)
(push "." load-path)
(load "./lpath.el" nil t)
(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.
(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)
(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:"
"^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:"
(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)
" " gnus-article-goto-next-page
"\177" gnus-article-goto-prev-page
[delete] gnus-article-goto-prev-page
- "\r" widget-button-press
"\C-c^" gnus-article-refer-article
"h" gnus-article-show-summary
"s" gnus-article-show-summary
(or all-headers gnus-show-all-headers))))
(when (or (numberp article)
(stringp article))
- ;; Hooks for getting information from the article.
- ;; This hook must be called before being narrowed.
- (let (buffer-read-only)
- (gnus-run-hooks 'gnus-tmp-internal-hook)
- (gnus-run-hooks 'gnus-article-prepare-hook)
- (when gnus-display-mime-function
- (funcall gnus-display-mime-function))
- ;; 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
(set-window-point (get-buffer-window (current-buffer)) (point))
t))))))
+(defun gnus-article-prepare-display ()
+ "Make the current buffer look like a nice article."
+ ;; Hooks for getting information from the article.
+ ;; This hook must be called before being narrowed.
+ (let ((gnus-article-buffer (current-buffer))
+ buffer-read-only)
+ (gnus-run-hooks 'gnus-tmp-internal-hook)
+ (gnus-run-hooks 'gnus-article-prepare-hook)
+ (when gnus-display-mime-function
+ (funcall gnus-display-mime-function))
+ ;; 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")
+(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)))
+ (?d gnus-tmp-description ?s)
+ (?l gnus-tmp-length ?d)))
(defvar gnus-mime-button-map nil)
(unless gnus-mime-button-map
(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 ()
(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
gnus-callback mm-display-part
gnus-data ,handle))
(setq e (point))
- (widget-convert-text 'link b e b e :action 'gnus-widget-press-button)))
+ (widget-convert-button 'link b e :action 'gnus-widget-press-button)))
(defun gnus-widget-press-button (elems el)
(goto-char (widget-get elems :from))
(equal (car (mm-handle-disposition handle))
"inline")))
(forward-line -2)
- (mm-display-part handle)
+ (mm-display-part handle t)
(goto-char (point-max))))
;; Here we have multipart/alternative
(gnus-mime-display-alternative handles))))))
;; Decode charsets.
(run-hooks 'gnus-article-decode-hook))
-
+
;; Update sparse articles.
(when (and do-update-line
(or (numberp article)
("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
t gnus-button-message-id 3)
("\\(<URL: *\\)mailto: *\\([^> \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...
("<URL: *\\([^>]*\\)>" 0 t gnus-button-embedded-url 1)
(list gnus-mouse-face-prop gnus-article-mouse-face))
(list 'gnus-callback fun)
(and data (list 'gnus-data data))))
- (widget-convert-text 'link from to from to
- :action 'gnus-widget-press-button))
+ (widget-convert-button 'link from to :action 'gnus-widget-press-button))
;;; Internal functions:
(defun gnus-request-replace-article (article group buffer)
(save-restriction
- (message-narrow-to-headers)
+ (message-narrow-to-head)
(mail-encode-encoded-word-buffer))
(message-encode-message-body)
(let ((func (car (gnus-group-name-to-method group))))
(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.
((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)
(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")))
(and gnus-newsgroup-name
(gnus-group-find-parameter
gnus-newsgroup-name 'gcc-self)))
- result
+ result
(groups
(cond
((null gnus-message-archive-method)
(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.
(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))))
"*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."
;; 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)
"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)
(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)
(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.
(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)
;; 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)
(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
(setq group-point (point))
(if temporary
nil ;Nothing to do.
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (mapcar 'mm-destroy-part gnus-article-mime-handles))
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
- (save-excursion
- (set-buffer gnus-article-buffer)
- (mapcar 'mm-destroy-part gnus-article-mime-handles))
(gnus-kill-buffer gnus-article-buffer)
(gnus-kill-buffer gnus-original-article-buffer)
(setq gnus-article-current nil))
(gnus-y-or-n-p "Discard changes to this group and exit? "))
(gnus-async-halt-prefetch)
(gnus-run-hooks 'gnus-summary-prepare-exit-hook)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (mapcar 'mm-destroy-part gnus-article-mime-handles))
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(gnus-kill-buffer gnus-article-buffer)
(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.
(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)
;;;!!!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))))
"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)
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "0.30"
+(defconst gnus-version-number "0.31"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number)
(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.
:group 'gnus-files
:group 'gnus-server
:type 'file)
-
+
;; This function is used to check both the environment variable
;; NNTPSERVER and the /etc/nntpserver file to see whether one can find
;; an nntp server name default.
(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
--- /dev/null
+;;; ietf-drums.el --- Functions for parsing RFC822bis headers
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; 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:
+
+;; DRUMS is an IETF Working Group that works (or worked) on the
+;; successor to RFC822, "Standard For The Format Of Arpa Internet Text
+;; Messages". This library is based on
+;; draft-ietf-drums-msg-fmt-05.txt, released on 1998-08-05.
+
+;;; Code:
+
+(require 'time-date)
+(require 'mm-util)
+
+(defvar ietf-drums-no-ws-ctl-token "\001-\010\013\014\016-\037\177"
+ "US-ASCII control characters excluding CR, LF and white space.")
+(defvar ietf-drums-text-token "\001-\011\013\014\016-\177"
+ "US-ASCII characters exlcuding CR and LF.")
+(defvar ietf-drums-specials-token "()<>[]:;@\\,.\""
+ "Special characters.")
+(defvar ietf-drums-quote-token "\\"
+ "Quote character.")
+(defvar ietf-drums-wsp-token " \t"
+ "White space.")
+(defvar ietf-drums-fws-regexp
+ (concat "[" ietf-drums-wsp-token "]*\n[" ietf-drums-wsp-token "]+")
+ "Folding white space.")
+(defvar ietf-drums-atext-token "-^a-zA-Z0-9!#$%&'*+/=?_`{|}~"
+ "Textual token.")
+(defvar ietf-drums-dot-atext-token "-^a-zA-Z0-9!#$%&'*+/=?_`{|}~."
+ "Textual token including full stop.")
+(defvar ietf-drums-qtext-token
+ (concat ietf-drums-no-ws-ctl-token "\041\043-\133\135-\177")
+ "Non-white-space control characaters, plus the rest of ASCII excluding backslash and doublequote.")
+(defvar ietf-drums-tspecials "][()<>@,;:\\\"/?="
+ "Tspecials.")
+
+(defvar ietf-drums-syntax-table
+ (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
+ (modify-syntax-entry ?\\ "/" table)
+ (modify-syntax-entry ?< "(" table)
+ (modify-syntax-entry ?> ")" table)
+ (modify-syntax-entry ?@ "w" table)
+ (modify-syntax-entry ?/ "w" table)
+ (modify-syntax-entry ?= " " table)
+ (modify-syntax-entry ?* " " table)
+ (modify-syntax-entry ?\; " " table)
+ (modify-syntax-entry ?\' " " table)
+ table))
+
+(defun ietf-drums-token-to-list (token)
+ "Translate TOKEN into a list of characters."
+ (let ((i 0)
+ b e c out range)
+ (while (< i (length token))
+ (setq c (mm-char-int (aref token i)))
+ (incf i)
+ (cond
+ ((eq c (mm-char-int ?-))
+ (if b
+ (setq range t)
+ (push c out)))
+ (range
+ (while (<= b c)
+ (push (mm-make-char 'ascii b) out)
+ (incf b))
+ (setq range nil))
+ ((= i (length token))
+ (push (mm-make-char 'ascii c) out))
+ (t
+ (setq b c))))
+ (nreverse out)))
+
+(defsubst ietf-drums-init (string)
+ (set-syntax-table ietf-drums-syntax-table)
+ (insert string)
+ (ietf-drums-unfold-fws)
+ (goto-char (point-min)))
+
+(defun ietf-drums-remove-comments (string)
+ "Remove comments from STRING."
+ (with-temp-buffer
+ (let (c)
+ (ietf-drums-init string)
+ (while (not (eobp))
+ (setq c (following-char))
+ (cond
+ ((eq c ?\")
+ (forward-sexp 1))
+ ((eq c ?\()
+ (delete-region (point) (progn (forward-sexp 1) (point))))
+ (t
+ (forward-char 1))))
+ (buffer-string))))
+
+(defun ietf-drums-remove-whitespace (string)
+ "Remove comments from STRING."
+ (with-temp-buffer
+ (ietf-drums-init string)
+ (let (c)
+ (while (not (eobp))
+ (setq c (following-char))
+ (cond
+ ((eq c ?\")
+ (forward-sexp 1))
+ ((eq c ?\()
+ (forward-sexp 1))
+ ((memq c '(? ?\t ?\n))
+ (delete-char 1))
+ (t
+ (forward-char 1))))
+ (buffer-string))))
+
+(defun ietf-drums-get-comment (string)
+ "Return the first comment in STRING."
+ (with-temp-buffer
+ (ietf-drums-init string)
+ (let (result c)
+ (while (not (eobp))
+ (setq c (following-char))
+ (cond
+ ((eq c ?\")
+ (forward-sexp 1))
+ ((eq c ?\()
+ (setq result
+ (buffer-substring
+ (1+ (point))
+ (progn (forward-sexp 1) (1- (point))))))
+ (t
+ (forward-char 1))))
+ result)))
+
+(defun ietf-drums-parse-address (string)
+ "Parse STRING and return a MAILBOX / DISPLAY-NAME pair."
+ (with-temp-buffer
+ (let (display-name mailbox c display-string)
+ (ietf-drums-init string)
+ (while (not (eobp))
+ (setq c (following-char))
+ (cond
+ ((or (eq c ? )
+ (eq c ?\t))
+ (forward-char 1))
+ ((eq c ?\()
+ (forward-sexp 1))
+ ((eq c ?\")
+ (push (buffer-substring
+ (1+ (point)) (progn (forward-sexp 1) (1- (point))))
+ display-name))
+ ((looking-at (concat "[" ietf-drums-atext-token "@" "]"))
+ (push (buffer-substring (point) (progn (forward-sexp 1) (point)))
+ display-name))
+ ((eq c ?<)
+ (setq mailbox
+ (ietf-drums-remove-whitespace
+ (ietf-drums-remove-comments
+ (buffer-substring
+ (1+ (point))
+ (progn (forward-sexp 1) (1- (point))))))))
+ (t (error "Unknown symbol: %c" c))))
+ ;; If we found no display-name, then we look for comments.
+ (if display-name
+ (setq display-string
+ (mapconcat 'identity (reverse display-name) " "))
+ (setq display-string (ietf-drums-get-comment string)))
+ (if (not mailbox)
+ (when (string-match "@" display-string)
+ (cons
+ (mapconcat 'identity (nreverse display-name) "")
+ (ietf-drums-get-comment string)))
+ (cons mailbox display-string)))))
+
+(defun ietf-drums-parse-addresses (string)
+ "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs."
+ (with-temp-buffer
+ (ietf-drums-init string)
+ (let ((beg (point))
+ pairs c)
+ (while (not (eobp))
+ (setq c (following-char))
+ (cond
+ ((memq c '(?\" ?< ?\())
+ (forward-sexp 1))
+ ((eq c ?,)
+ (push (ietf-drums-parse-address (buffer-substring beg (point)))
+ pairs)
+ (forward-char 1)
+ (setq beg (point)))
+ (t
+ (forward-char 1))))
+ (push (ietf-drums-parse-address (buffer-substring beg (point)))
+ pairs)
+ (nreverse pairs))))
+
+(defun ietf-drums-unfold-fws ()
+ "Unfold folding white space in the current buffer."
+ (goto-char (point-min))
+ (while (re-search-forward ietf-drums-fws-regexp nil t)
+ (replace-match " " t t))
+ (goto-char (point-min)))
+
+(defun ietf-drums-parse-date (string)
+ "Return an Emacs time spec from STRING."
+ (apply 'encode-time (parse-time-string string)))
+
+(defun ietf-drums-narrow-to-header ()
+ "Narrow to the header section in the current buffer."
+ (narrow-to-region
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil 1)
+ (1- (point))
+ (point-max)))
+ (goto-char (point-min)))
+
+(defun ietf-drums-quote-string (string)
+ "Quote string if it needs quoting to be displayed in a header."
+ (if (string-match (concat "[^" ietf-drums-atext-token "]") string)
+ (concat "\"" string "\"")
+ string))
+
+(provide 'ietf-drums)
+
+;;; ietf-drums.el ends here
mule-write-region-no-coding-system char-int
annotationp delete-annotation make-image-specifier
make-annotation base64-decode-string
- w3-do-setup w3-region base64-decode)))
+ w3-do-setup w3-region)))
(setq load-path (cons "." load-path))
(require 'custom)
;;; Code:
-(require 'drums)
+(require 'ietf-drums)
(require 'rfc2231)
(require 'rfc2047)
(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)
(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))
(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"))
(viewer . view-mode)
(test . (fboundp 'view-mode))
(type . "message/rfc-822"))
- ("rfc-*822"
+ ("rfc-*822"
(viewer . fundamental-mode)
(type . "message/rfc-822")))
("image"
(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)
(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
(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
(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
(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)))))
;;; 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)
(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))))
("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))
("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/"
(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")
(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))))
(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
(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)
(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."
(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)
(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
(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"))
(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)
(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.")
t)))
(defun nndoc-transform-mime-parts (article)
- (unless (= article 1)
- ;; Ensure some MIME-Version.
+ (let* ((entry (cdr (assq article nndoc-dissection-alist)))
+ (headers (nth 5 entry)))
+ (when headers
(goto-char (point-min))
- (search-forward "\n\n")
- (let ((case-fold-search nil)
- (limit (point)))
- (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))
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)
(set-buffer (setq nnmbox-mbox-buffer
(nnheader-find-file-noselect
nnmbox-mbox-file nil 'raw)))
+ (mm-enable-multibyte)
(buffer-disable-undo (current-buffer))
;; Go through the group alist and compare against
(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.")
(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
(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")))))))
(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 ?_ ? )))
;;; Code:
-(require 'drums)
+(require 'ietf-drums)
(defun rfc2231-get-value (ct attribute)
"Return the value of ATTRIBUTE from CT."
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))
\input texinfo @c -*-texinfo-*-
@setfilename gnus
-@settitle Pterodactyl Gnus 0.30 Manual
+@settitle Pterodactyl Gnus 0.31 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Pterodactyl Gnus 0.30 Manual
+@title Pterodactyl Gnus 0.31 Manual
@author by Lars Magne Ingebrigtsen
@page
spool or your mbox file. All at the same time, if you want to push your
luck.
-This manual corresponds to Pterodactyl Gnus 0.30.
+This manual corresponds to Pterodactyl Gnus 0.31.
@end ifinfo
\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
@tex
@titlepage
-@title Pterodactyl Message 0.30 Manual
+@title Pterodactyl Message 0.31 Manual
@author by Lars Magne Ingebrigtsen
@page
* 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.
projects / elisp / gnus.git- / commitdiff