+Sun Sep 13 09:37:37 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.30 is released.
+
+1998-09-13 08:00:41 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (article-decode-encoded-words): Use it.
+ (gnus-decode-header-function): New variable.
+
+ * gnus-sum.el (gnus-nov-parse-line): Use it.
+ (gnus-decode-encoded-word-function): New variable.
+
+ * gnus-msg.el (gnus-copy-article-buffer): Decode the right
+ buffer.
+
+ * gnus-art.el (gnus-insert-mime-button): Use widget.
+ (gnus-widget-press-button): New function.
+ (gnus-article-prev-button): Removed.
+ (gnus-article-next-button): Ditto.
+ (gnus-article-add-button): Ditto.
+
+ * gnus.el (gnus-article-mode-map): Inherit from widget.
+ (gnus-article-mode-map): No, don't.
+
+ * mm-decode.el (mm-dissect-buffer): Store Content-ID things.
+ (mm-content-id-alist): New variable.
+ (mm-get-content-id): New function.
+
+ * gnus-art.el (gnus-request-article-this-buffer): Only decode
+ articles if we are fetching to the article buffer.
+
+1998-09-13 07:58:59 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-move-article): Don't decode accepting
+ articles.
+
+1998-09-13 07:23:28 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-util.el (mm-mime-charset): Try to use safe-charsets.
+ (mm-default-mime-charset): New variable.
+
+ * rfc2047.el (rfc2047-dissect-region): Dissect using tspecials.
+
+ * drums.el (drums-quote-string): Reversed test.
+
+1998-09-12 14:29:21 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-util.el (mm-insert-rfc822-headers): Possibly not quote
+ string.
+
+ * drums.el (drums-quote-string): New function.
+
+ * rfc2047.el (rfc2047-encode-message-header): Goto point-min.
+ (rfc2047-b-encode-region): Chop lines.
+ (rfc2047-q-encode-region): Ditto.
+
+Sat Sep 12 13:27:15 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.29 is released.
+
+1998-09-12 12:46:30 Istvan Marko <imarko@pacificnet.net>
+
+ * mm-decode.el (mm-save-part): Message right.
+
+1998-09-12 11:30:01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * drums.el (drums-parse-address): Returned a list instead of a
+ string.
+ (drums-remove-whitespace): Skip comments.
+ (drums-parse-addresses): Didn't work.
+
+Sat Sep 12 09:17:30 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.28 is released.
+
+1998-09-12 04:57:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-mime-button-map): Use the article keymap as a
+ starting point.
+ (article-decode-encoded-words): Rename.
+
+ * message.el (message-narrow-to-headers-or-head): New function.
+
+ * gnus-int.el (gnus-request-accept-article): Narrow to the right
+ region.
+
+ * message.el (message-send-news): Encode body after checking
+ syntax.
+
+ * gnus-art.el (gnus-mime-button-line-format): Allow descriptions.
+
+ * mm-decode.el (mm-save-part): Use Content-Disposition filename.
+
+ * gnus-art.el (gnus-display-mime): Respect disposition.
+
+ * mm-decode.el (mm-preferred-alternative): Respect disposition.
+
+ * gnus-art.el (article-strip-multiple-blank-lines): Don't delete
+ text with annotations.
+
+ * message.el (message-make-date): Fix sign for negative time
+ zones.
+
+ * mm-view.el (mm-inline-image): Insert a space at the end of the
+ image.
+
+ * mail-parse.el: New file.
+
+ * rfc2231.el: New file.
+
+ * drums.el (drums-content-type-get): Removed.
+ (drums-parse-content-type): Ditto.
+
+ * mailcap.el (mailcap-mime-data): Use symbols instead of strings.
+
+Fri Sep 11 18:23:34 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.27 is released.
+
+1998-09-11 12:42:07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-decode.el (mm-alternative-precedence): New variable.
+ (mm-preferred-alternative): New function.
+
+ * gnus-art.el (gnus-mime-copy-part): New command.
+
+ * mm-decode.el (mm-get-part): New function.
+
+ * mm-view.el: New file.
+
+ * mm-decode.el (mm-dissect-buffer): Downcase cte.
+ (mm-display-part): Default to mailcap-save-binary-file.
+
Fri Sep 11 12:32:50 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.26 is released.
(modify-syntax-entry ?@ "w" table)
(modify-syntax-entry ?/ "w" table)
(modify-syntax-entry ?= " " table)
+ (modify-syntax-entry ?* " " table)
(modify-syntax-entry ?\; " " table)
+ (modify-syntax-entry ?\' " " table)
table))
(defun drums-token-to-list (token)
(cond
((eq c ?\")
(forward-sexp 1))
+ ((eq c ?\()
+ (forward-sexp 1))
((memq c '(? ?\t ?\n))
(delete-char 1))
(t
(cons
(mapconcat 'identity (nreverse display-name) "")
(drums-get-comment string)))
- (cons mailbox display-name)))))
+ (cons mailbox display-string)))))
(defun drums-parse-addresses (string)
"Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs."
((memq c '(?\" ?< ?\())
(forward-sexp 1))
((eq c ?,)
- (push (drums-parse-address (buffer-substring beg (1- (point))))
+ (push (drums-parse-address (buffer-substring beg (point)))
pairs)
+ (forward-char 1)
(setq beg (point)))
(t
(forward-char 1))))
+ (push (drums-parse-address (buffer-substring beg (point)))
+ pairs)
(nreverse pairs))))
(defun drums-unfold-fws ()
"Return an Emacs time spec from STRING."
(apply 'encode-time (parse-time-string string)))
-(defun drums-content-type-get (ct attribute)
- "Return the value of ATTRIBUTE from CT."
- (cdr (assq attribute (cdr ct))))
-
-(defun drums-parse-content-type (string)
- "Parse STRING and return a list."
- (with-temp-buffer
- (let ((ttoken (drums-token-to-list drums-text-token))
- (stoken (drums-token-to-list drums-tspecials))
- display-name mailbox c display-string parameters
- attribute value type subtype)
- (drums-init (drums-remove-whitespace (drums-remove-comments string)))
- (setq c (following-char))
- (when (and (memq c ttoken)
- (not (memq c stoken)))
- (setq type (downcase (buffer-substring
- (point) (progn (forward-sexp 1) (point)))))
- ;; Do the params
- (while (not (eobp))
- (setq c (following-char))
- (unless (eq c ?\;)
- (error "Invalid header: %s" string))
- (forward-char 1)
- (setq c (following-char))
- (if (and (memq c ttoken)
- (not (memq c stoken)))
- (setq attribute
- (intern
- (downcase
- (buffer-substring
- (point) (progn (forward-sexp 1) (point))))))
- (error "Invalid header: %s" string))
- (setq c (following-char))
- (unless (eq c ?=)
- (error "Invalid header: %s" string))
- (forward-char 1)
- (setq c (following-char))
- (cond
- ((eq c ?\")
- (setq value
- (buffer-substring (1+ (point))
- (progn (forward-sexp 1) (1- (point))))))
- ((and (memq c ttoken)
- (not (memq c stoken)))
- (setq value (buffer-substring
- (point) (progn (forward-sexp 1) (point)))))
- (t
- (error "Invalid header: %s" string)))
- (push (cons attribute value) parameters))
- `(,type ,@(nreverse parameters))))))
-
(defun drums-narrow-to-header ()
- "Narrow to the header of the current buffer."
+ "Narrow to the header section in the current buffer."
(narrow-to-region
(goto-char (point-min))
(if (search-forward "\n\n" nil 1)
(point-max)))
(goto-char (point-min)))
+(defun drums-quote-string (string)
+ "Quote string if it needs quoting to be displayed in a header."
+ (if (not (string-match (concat "[^" drums-atext-token "]") string))
+ (concat "\"" string "\"")
+ string))
+
(provide 'drums)
;;; drums.el ends here
(require 'gnus-cache)
(require 'nnvirtual)
(require 'gnus-sum)
-(eval-when-compile (require 'cl)
- (require 'gnus-score))
+(eval-when-compile
+ (require 'cl)
+ (require 'gnus-score))
(defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/")
"Where the Gnus agent will store its files."
(let ((dir (concat
(gnus-agent-directory)
(gnus-agent-group-path group) "/"))
- (date (time-to-day (current-time)))
+ (date (time-to-days (current-time)))
(case-fold-search t)
pos crosses id elem)
(gnus-make-directory dir)
(gnus-agent-enter-history
"last-header-fetched-for-session"
(list (cons group (nth (- (length articles) 1) articles)))
- (time-to-day (current-time)))
+ (time-to-days (current-time)))
articles)))))
(defsubst gnus-agent-copy-nov-line (article)
"Expire all old articles."
(interactive)
(let ((methods gnus-agent-covered-methods)
- (day (- (time-to-day (current-time)) gnus-agent-expire-days))
+ (day (- (time-to-days (current-time)) gnus-agent-expire-days))
gnus-command-method sym group articles
history overview file histories elem art nov-file low info
unreads marked article)
(require 'gnus-int)
(require 'browse-url)
(require 'mm-bodies)
-(require 'drums)
+(require 'mail-parse)
(require 'mm-decode)
+(require 'mm-view)
+(require 'wid-edit)
(defgroup gnus-article nil
"Article display."
(face :value default)))))
(defcustom gnus-article-decode-hook
- '(article-decode-charset article-decode-rfc1522)
+ '(article-decode-charset article-decode-encoded-words)
"*Hook run to decode charsets in articles."
:group 'gnus-article-headers
:type 'hook)
: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)
(set-buffer gnus-article-buffer)
(let ((inhibit-point-motion-hooks t)
buffer-read-only)
- (rfc2047-decode-region (point-min) (point-max)))))
+ (mail-decode-encoded-word-region (point-min) (point-max)))))
(defun article-decode-charset (&optional prompt)
"Decode charset-encoded text in the article.
(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 () (drums-parse-content-type ct)
+ (ctl (and ct (condition-case ()
+ (mail-header-parse-content-type ct)
(error nil))))
(charset (cond
(prompt
(mm-read-coding-system "Charset to decode: "))
(ctl
- (drums-content-type-get ctl 'charset))
+ (mail-content-type-get ctl 'charset))
(gnus-newsgroup-name
(gnus-group-find-parameter
gnus-newsgroup-name 'charset))))
charset (and cte (intern (downcase
(gnus-strip-whitespace cte))))))))))
-(defalias 'gnus-decode-rfc1522 'article-decode-rfc1522)
-(defalias 'gnus-article-decode-rfc1522 'article-decode-rfc1522)
-(defun article-decode-rfc1522 ()
- "Remove QP encoding from headers."
+(defun article-decode-encoded-words ()
+ "Remove encoded-word encoding from headers."
(let ((inhibit-point-motion-hooks t)
(buffer-read-only nil))
(save-restriction
(message-narrow-to-head)
- (rfc2047-decode-region (point-min) (point-max)))))
+ (funcall gnus-decode-header-function (point-min) (point-max)))))
(defun article-de-quoted-unreadable (&optional force)
"Translate a quoted-printable-encoded article.
(save-excursion
(let ((buffer-read-only nil)
(type (gnus-fetch-field "content-transfer-encoding")))
- ;;(gnus-article-decode-rfc1522)
(when (or force
(and type (string-match "quoted-printable" (downcase type))))
(goto-char (point-min))
(goto-char (point-min))
(search-forward "\n\n" nil t)
(while (re-search-forward "^[ \t]+$" nil t)
- (replace-match "" nil t))
+ (unless (gnus-annotation-in-region-p
+ (match-beginning 0) (match-end 0))
+ (replace-match "" nil t)))
;; Then replace multiple empty lines with a single empty line.
(goto-char (point-min))
(search-forward "\n\n" nil t)
article-date-original
article-date-ut
article-decode-mime-words
+ article-decode-charset
+ article-decode-encoded-words
article-date-user
article-date-lapsed
article-emphasize
(put 'gnus-article-mode 'mode-class 'special)
+(set-keymap-parent gnus-article-mode-map widget-keymap)
+
(gnus-define-keys gnus-article-mode-map
" " 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
"\C-c\C-m" gnus-article-mail
"?" gnus-article-describe-briefly
- gnus-mouse-2 gnus-article-push-button
- "\r" gnus-article-press-button
- "\t" gnus-article-next-button
- "\M-\t" gnus-article-prev-button
"e" gnus-article-edit
"<" beginning-of-buffer
">" end-of-buffer
;;; Gnus MIME viewing functions
;;;
-(defvar gnus-mime-button-line-format "%{%([%t%n]%)%}\n")
+(defvar gnus-mime-button-line-format "%{%([%t%d%n]%)%}\n")
(defvar gnus-mime-button-line-format-alist
'((?t gnus-tmp-type ?s)
- (?n gnus-tmp-name ?s)))
+ (?n gnus-tmp-name ?s)
+ (?d gnus-tmp-description ?s)))
(defvar gnus-mime-button-map nil)
(unless gnus-mime-button-map
- (setq gnus-mime-button-map (make-sparse-keymap))
+ (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 "|" 'gnus-mime-pipe-part))
(defun gnus-mime-save-part ()
(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-insert-mime-button (handle)
- (let ((gnus-tmp-name (drums-content-type-get (cadr handle) 'name))
- (gnus-tmp-type (caadr handle)))
- (when gnus-tmp-name
- (setq gnus-tmp-name (concat " (" gnus-tmp-name ")")))
+ (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))
+ 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))))
+ gnus-data ,handle))
+ (setq e (point))
+ (widget-convert-text 'link b e 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 ()
- (let ((handles (mm-dissect-buffer))
- handle name type b e)
- (mapcar 'mm-destroy-part gnus-article-mime-handles)
- (setq gnus-article-mime-handles nil)
- (setq gnus-article-mime-handles (nconc gnus-article-mime-handles handles))
- (when handles
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
- (delete-region (point) (point-max))
- (while (setq handle (pop handles))
- (gnus-insert-mime-button handle)
- (insert "\n\n")
- (when (mm-automatic-display-p (caadr handle))
- (forward-line -2)
- (mm-display-part handle)
- (goto-char (point-max)))))))
+ "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)
+ (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."
(let (buffer-read-only)
(erase-buffer)
(insert-buffer-substring gnus-article-buffer))
- (setq gnus-original-article (cons group article))))
+ (setq gnus-original-article (cons group article)))
- ;; Decode charsets.
- (run-hooks 'gnus-article-decode-hook)
+ ;; Decode charsets.
+ (run-hooks 'gnus-article-decode-hook))
;; Update sparse articles.
(when (and do-update-line
(when fun
(funcall fun data))))
-(defun gnus-article-prev-button (n)
- "Move point to N buttons backward.
-If N is negative, move forward instead."
- (interactive "p")
- (gnus-article-next-button (- n)))
-
-(defun gnus-article-next-button (n)
- "Move point to N buttons forward.
-If N is negative, move backward instead."
- (interactive "p")
- (let ((function (if (< n 0) 'previous-single-property-change
- 'next-single-property-change))
- (inhibit-point-motion-hooks t)
- (backward (< n 0))
- (limit (if (< n 0) (point-min) (point-max))))
- (setq n (abs n))
- (while (and (not (= limit (point)))
- (> n 0))
- ;; Skip past the current button.
- (when (get-text-property (point) 'gnus-callback)
- (goto-char (funcall function (point) 'gnus-callback nil limit)))
- ;; Go to the next (or previous) button.
- (gnus-goto-char (funcall function (point) 'gnus-callback nil limit))
- ;; Put point at the start of the button.
- (when (and backward (not (get-text-property (point) 'gnus-callback)))
- (goto-char (funcall function (point) 'gnus-callback nil limit)))
- ;; Skip past intangible buttons.
- (when (get-text-property (point) 'intangible)
- (incf n))
- (decf n))
- (unless (zerop n)
- (gnus-message 5 "No more buttons"))
- n))
-
(defun gnus-article-highlight (&optional force)
"Highlight current article.
This function calls `gnus-article-highlight-headers',
(nconc (and gnus-article-mouse-face
(list gnus-mouse-face-prop gnus-article-mouse-face))
(list 'gnus-callback fun)
- (and data (list 'gnus-data data)))))
+ (and data (list 'gnus-data data))))
+ (widget-convert-text 'link from to from to
+ :action 'gnus-widget-press-button))
;;; Internal functions:
(cons group
(set-buffer (gnus-get-buffer-create
" *gnus-cache-overview*"))))
- (buffer-disable-undo (current-buffer))
;; Insert the contents of this group's cache overview.
(erase-buffer)
(let ((file (gnus-cache-file-name group ".overview")))
(gnus-cache-save-buffers)
(save-excursion
(set-buffer cache-buf)
- (buffer-disable-undo (current-buffer))
(erase-buffer)
(insert-file-contents (or file (gnus-cache-file-name group ".overview")))
(goto-char (point-min))
(let ((cache-buf (gnus-get-buffer-create " *gnus-cache*")))
(save-excursion
(set-buffer cache-buf)
- (buffer-disable-undo (current-buffer))
(erase-buffer))
(set-buffer nntp-server-buffer)
(goto-char (point-min))
(insert "\n"))
(unless no-encode
(save-restriction
- (message-narrow-to-headers)
- (rfc2047-encode-message-header))
+ (message-narrow-to-head)
+ (mail-encode-encoded-word-buffer))
(message-encode-message-body))
(let ((func (car (or gnus-command-method
(gnus-find-method-for-group group)))))
(defun gnus-request-replace-article (article group buffer)
(save-restriction
(message-narrow-to-headers)
- (rfc2047-encode-message-header))
+ (mail-encode-encoded-word-buffer))
(message-encode-message-body)
(let ((func (car (gnus-group-name-to-method group))))
(funcall (intern (format "%s-request-replace-article" func))
;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
;; this buffer should be passed to all mail/news reply/post routines.
(setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*"))
- (buffer-disable-undo gnus-article-copy)
(save-excursion
(set-buffer gnus-article-copy)
(mm-enable-multibyte))
(or (search-forward "\n\n" nil t) (point)))
;; Insert the original article headers.
(insert-buffer-substring gnus-original-article-buffer beg end)
- (gnus-article-decode-rfc1522)))
+ (article-decode-encoded-words)))
gnus-article-copy)))
(defun gnus-post-news (post &optional group header article-buffer yank subject
;; Go through all the files looking for non-default values for variables.
(save-excursion
(set-buffer (gnus-get-buffer-create " *gnus bug info*"))
- (buffer-disable-undo (current-buffer))
(while files
(erase-buffer)
(when (and (setq file (locate-library (pop files)))
(or (not decay)
(gnus-decay-scores alist decay)))
(gnus-score-set 'touched '(t) alist)
- (gnus-score-set 'decay (list (time-to-day (current-time))) alist))
+ (gnus-score-set 'decay (list (time-to-days (current-time))) alist))
;; We do not respect eval and files atoms from global score
;; files.
(when (and files (not global))
(defun gnus-decay-scores (alist day)
"Decay non-permanent scores in ALIST."
- (let ((times (- (time-to-day (current-time)) day))
+ (let ((times (- (time-to-days (current-time)) day))
kill entry updated score n)
(unless (zerop times) ;Done decays today already?
(while (setq entry (pop alist))
(gnus-message 7 "Reading slave newsrcs...")
(save-excursion
(set-buffer (gnus-get-buffer-create " *gnus slave*"))
- (buffer-disable-undo (current-buffer))
(setq slave-files
(sort (mapcar (lambda (file)
(list (nth 5 (file-attributes file)) file))
The function is called with one parameter, the article header vector,
which it may alter in any way.")
+(defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string
+ "Variable that says which function should be used to decode a string with encoded words.")
+
;;; Internal variables
(defvar gnus-article-mime-handles nil)
(setq header
(make-full-mail-header
number ; number
- (rfc2047-decode-string (gnus-nov-field)) ; subject
- (rfc2047-decode-string (gnus-nov-field)) ; from
+ (funcall gnus-decode-encoded-word-function
+ (gnus-nov-field)) ; subject
+ (funcall gnus-decode-encoded-word-function
+ (gnus-nov-field)) ; from
(gnus-nov-field) ; date
(or (gnus-nov-field)
(nnheader-generate-fake-message-id)) ; id
(progn
(goto-char p)
(if (search-forward "\nsubject: " nil t)
- (rfc2047-decode-string (nnheader-header-value))
+ (funcall gnus-decode-encoded-word-function
+ (nnheader-header-value))
"(none)"))
;; From.
(progn
(goto-char p)
(if (search-forward "\nfrom: " nil t)
- (rfc2047-decode-string (nnheader-header-value))
+ (funcall gnus-decode-encoded-word-function
+ (nnheader-header-value))
"(nobody)"))
;; Date.
(progn
(set-buffer copy-buf)
(when (gnus-request-article-this-buffer article gnus-newsgroup-name)
(gnus-request-accept-article
- to-newsgroup select-method (not articles)))))
+ to-newsgroup select-method (not articles) t))))
;; Crosspost the article.
((eq action 'crosspost)
(let ((xref (message-tokenize-header
(error "Can't read %s" file))
(save-excursion
(set-buffer (gnus-get-buffer-create " *import file*"))
- (buffer-disable-undo (current-buffer))
(erase-buffer)
(insert-file-contents file)
(goto-char (point-min))
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "0.26"
+(defconst gnus-version-number "0.30"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number)
(and (file-readable-p gnus-nntpserver-file)
(save-excursion
(set-buffer (gnus-get-buffer-create " *gnus nntp*"))
- (buffer-disable-undo (current-buffer))
(insert-file-contents gnus-nntpserver-file)
(let ((name (buffer-string)))
(prog1
("info" Info-goto-node)
("pp" pp pp-to-string pp-eval-expression)
("qp" quoted-printable-decode-region quoted-printable-decode-string)
- ("rfc2047" rfc2047-decode-region rfc2047-decode-string)
("ps-print" ps-print-preprint)
("mail-extr" mail-extract-address-components)
("browse-url" browse-url)
gnus-article-next-page gnus-article-prev-page
gnus-request-article-this-buffer gnus-article-mode
gnus-article-setup-buffer gnus-narrow-to-page
- gnus-article-delete-invisible-text gnus-hack-decode-rfc1522)
+ gnus-article-delete-invisible-text)
("gnus-art" :interactive t
gnus-article-hide-headers gnus-article-hide-boring-headers
gnus-article-treat-overstrike gnus-article-word-wrap
gnus-article-date-original gnus-article-date-lapsed
gnus-article-show-all-headers
gnus-article-edit-mode gnus-article-edit-article
- gnus-article-edit-done gnus-decode-rfc1522 article-decode-rfc1522
+ gnus-article-edit-done gnus-article-decode-encoded-words
gnus-start-date-timer gnus-stop-date-timer)
("gnus-int" gnus-request-type)
("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1
mule-write-region-no-coding-system
find-charset-region base64-decode-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
mm-copy-tree url-view-url w3-prepare-buffer
mule-write-region-no-coding-system char-int
annotationp delete-annotation make-image-specifier
- make-annotation)))
+ make-annotation base64-decode-string
+ w3-do-setup w3-region base64-decode)))
(setq load-path (cons "." load-path))
(require 'custom)
--- /dev/null
+;;; mail-parse.el --- Interface functions for parsing mail
+;; 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:
+
+;; This file contains wrapper functions for a wide range of mail
+;; parsing functions. The idea is that there are low-level libraries
+;; that impement according to various specs (RFC2231, DRUMS, USEFOR),
+;; but that programmers that want to parse some header (say,
+;; Content-Type) will want to use the latest spec.
+;;
+;; So while each low-level library (rfc2231.el, for instance) decodes
+;; faithfully according to that (proposed) standard, this library is
+;; the interface library. If some later RFC supersedes RFC2231, one
+;; would just have to write a new low-level library, adjust the
+;; aliases in this library, and the users and programmers won't notice
+;; any changes.
+
+;;; Code:
+
+(require 'drums)
+(require 'rfc2231)
+(require 'rfc2047)
+
+(defalias 'mail-header-parse-content-type 'rfc2231-parse-string)
+(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-narrow-to-field 'rfc2047-narrow-to-field)
+(defalias 'mail-encode-encoded-word-region 'rfc2047-encode-region)
+(defalias 'mail-encode-encoded-word-buffer 'rfc2047-encode-message-header)
+(defalias 'mail-encode-encoded-word-string 'rfc2047-encode-string)
+(defalias 'mail-decode-encoded-word-region 'rfc2047-decode-region)
+(defalias 'mail-decode-encoded-word-string 'rfc2047-decode-string)
+
+(provide 'mail-parse)
+
+;;; mail-parse.el ends here
(eval-and-compile
(require 'cl))
-(require 'drums)
+(require 'mail-parse)
(defvar mailcap-parse-args-syntax-table
(let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
"A syntax table for parsing sgml attributes.")
(defvar mailcap-mime-data
- '(("multipart"
- (".*"
- ("viewer" . mailcap-save-binary-file)
- ("type" . "multipart/*")))
- ("application"
+ '(("application"
("x-x509-ca-cert"
- ("viewer" . ssl-view-site-cert)
- ("test" . (fboundp 'ssl-view-site-cert))
- ("type" . "application/x-x509-ca-cert"))
+ (viewer . ssl-view-site-cert)
+ (test . (fboundp 'ssl-view-site-cert))
+ (type . "application/x-x509-ca-cert"))
("x-x509-user-cert"
- ("viewer" . ssl-view-user-cert)
- ("test" . (fboundp 'ssl-view-user-cert))
- ("type" . "application/x-x509-user-cert"))
+ (viewer . ssl-view-user-cert)
+ (test . (fboundp 'ssl-view-user-cert))
+ (type . "application/x-x509-user-cert"))
("octet-stream"
- ("viewer" . mailcap-save-binary-file)
- ("type" ."application/octet-stream"))
+ (viewer . mailcap-save-binary-file)
+ (type ."application/octet-stream"))
("dvi"
- ("viewer" . "open %s")
- ("type" . "application/dvi")
- ("test" . (eq (mm-device-type) 'ns)))
+ (viewer . "open %s")
+ (type . "application/dvi")
+ (test . (eq (mm-device-type) 'ns)))
("dvi"
- ("viewer" . "xdvi %s")
- ("test" . (eq (mm-device-type) 'x))
+ (viewer . "xdvi %s")
+ (test . (eq (mm-device-type) 'x))
("needsx11")
- ("type" . "application/dvi"))
+ (type . "application/dvi"))
("dvi"
- ("viewer" . "dvitty %s")
- ("test" . (not (getenv "DISPLAY")))
- ("type" . "application/dvi"))
+ (viewer . "dvitty %s")
+ (test . (not (getenv "DISPLAY")))
+ (type . "application/dvi"))
("emacs-lisp"
- ("viewer" . mailcap-maybe-eval)
- ("type" . "application/emacs-lisp"))
+ (viewer . mailcap-maybe-eval)
+ (type . "application/emacs-lisp"))
("x-tar"
- ("viewer" . mailcap-save-binary-file)
- ("type" . "application/x-tar"))
+ (viewer . mailcap-save-binary-file)
+ (type . "application/x-tar"))
("x-latex"
- ("viewer" . tex-mode)
- ("test" . (fboundp 'tex-mode))
- ("type" . "application/x-latex"))
+ (viewer . tex-mode)
+ (test . (fboundp 'tex-mode))
+ (type . "application/x-latex"))
("x-tex"
- ("viewer" . tex-mode)
- ("test" . (fboundp 'tex-mode))
- ("type" . "application/x-tex"))
+ (viewer . tex-mode)
+ (test . (fboundp 'tex-mode))
+ (type . "application/x-tex"))
("latex"
- ("viewer" . tex-mode)
- ("test" . (fboundp 'tex-mode))
- ("type" . "application/latex"))
+ (viewer . tex-mode)
+ (test . (fboundp 'tex-mode))
+ (type . "application/latex"))
("tex"
- ("viewer" . tex-mode)
- ("test" . (fboundp 'tex-mode))
- ("type" . "application/tex"))
+ (viewer . tex-mode)
+ (test . (fboundp 'tex-mode))
+ (type . "application/tex"))
("texinfo"
- ("viewer" . texinfo-mode)
- ("test" . (fboundp 'texinfo-mode))
- ("type" . "application/tex"))
+ (viewer . texinfo-mode)
+ (test . (fboundp 'texinfo-mode))
+ (type . "application/tex"))
("zip"
- ("viewer" . mailcap-save-binary-file)
- ("type" . "application/zip")
+ (viewer . mailcap-save-binary-file)
+ (type . "application/zip")
("copiousoutput"))
("pdf"
- ("viewer" . "acroread %s")
- ("type" . "application/pdf"))
+ (viewer . "acroread %s")
+ (type . "application/pdf"))
("postscript"
- ("viewer" . "open %s")
- ("type" . "application/postscript")
- ("test" . (eq (mm-device-type) 'ns)))
+ (viewer . "open %s")
+ (type . "application/postscript")
+ (test . (eq (mm-device-type) 'ns)))
("postscript"
- ("viewer" . "ghostview %s")
- ("type" . "application/postscript")
- ("test" . (eq (mm-device-type) 'x))
+ (viewer . "ghostview %s")
+ (type . "application/postscript")
+ (test . (eq (mm-device-type) 'x))
("needsx11"))
("postscript"
- ("viewer" . "ps2ascii %s")
- ("type" . "application/postscript")
- ("test" . (not (getenv "DISPLAY")))
+ (viewer . "ps2ascii %s")
+ (type . "application/postscript")
+ (test . (not (getenv "DISPLAY")))
("copiousoutput")))
("audio"
("x-mpeg"
- ("viewer" . "maplay %s")
- ("type" . "audio/x-mpeg"))
+ (viewer . "maplay %s")
+ (type . "audio/x-mpeg"))
(".*"
- ("viewer" . mailcap-play-sound-file)
- ("test" . (or (featurep 'nas-sound)
+ (viewer . mm-view-sound-file)
+ (test . (or (featurep 'nas-sound)
(featurep 'native-sound)))
- ("type" . "audio/*"))
+ (type . "audio/*"))
(".*"
- ("viewer" . "showaudio")
- ("type" . "audio/*")))
+ (viewer . "showaudio")
+ (type . "audio/*")))
("message"
("rfc-*822"
- ("viewer" . vm-mode)
- ("test" . (fboundp 'vm-mode))
- ("type" . "message/rfc-822"))
+ (viewer . vm-mode)
+ (test . (fboundp 'vm-mode))
+ (type . "message/rfc-822"))
("rfc-*822"
- ("viewer" . w3-mode)
- ("test" . (fboundp 'w3-mode))
- ("type" . "message/rfc-822"))
+ (viewer . w3-mode)
+ (test . (fboundp 'w3-mode))
+ (type . "message/rfc-822"))
("rfc-*822"
- ("viewer" . view-mode)
- ("test" . (fboundp 'view-mode))
- ("type" . "message/rfc-822"))
+ (viewer . view-mode)
+ (test . (fboundp 'view-mode))
+ (type . "message/rfc-822"))
("rfc-*822"
- ("viewer" . fundamental-mode)
- ("type" . "message/rfc-822")))
+ (viewer . fundamental-mode)
+ (type . "message/rfc-822")))
("image"
("x-xwd"
- ("viewer" . "xwud -in %s")
- ("type" . "image/x-xwd")
+ (viewer . "xwud -in %s")
+ (type . "image/x-xwd")
("compose" . "xwd -frame > %s")
- ("test" . (eq (mm-device-type) 'x))
+ (test . (eq (mm-device-type) 'x))
("needsx11"))
("x11-dump"
- ("viewer" . "xwud -in %s")
- ("type" . "image/x-xwd")
+ (viewer . "xwud -in %s")
+ (type . "image/x-xwd")
("compose" . "xwd -frame > %s")
- ("test" . (eq (mm-device-type) 'x))
+ (test . (eq (mm-device-type) 'x))
("needsx11"))
("windowdump"
- ("viewer" . "xwud -in %s")
- ("type" . "image/x-xwd")
+ (viewer . "xwud -in %s")
+ (type . "image/x-xwd")
("compose" . "xwd -frame > %s")
- ("test" . (eq (mm-device-type) 'x))
+ (test . (eq (mm-device-type) 'x))
("needsx11"))
(".*"
- ("viewer" . "aopen %s")
- ("type" . "image/*")
- ("test" . (eq (mm-device-type) 'ns)))
+ (viewer . "aopen %s")
+ (type . "image/*")
+ (test . (eq (mm-device-type) 'ns)))
(".*"
- ("viewer" . "xv -perfect %s")
- ("type" . "image/*")
- ("test" . (eq (mm-device-type) 'x))
+ (viewer . "xv -perfect %s")
+ (type . "image/*")
+ (test . (eq (mm-device-type) 'x))
("needsx11")))
("text"
("plain"
- ("viewer" . w3-mode)
- ("test" . (fboundp 'w3-mode))
- ("type" . "text/plain"))
+ (viewer . w3-mode)
+ (test . (fboundp 'w3-mode))
+ (type . "text/plain"))
("plain"
- ("viewer" . view-mode)
- ("test" . (fboundp 'view-mode))
- ("type" . "text/plain"))
+ (viewer . view-mode)
+ (test . (fboundp 'view-mode))
+ (type . "text/plain"))
("plain"
- ("viewer" . fundamental-mode)
- ("type" . "text/plain"))
+ (viewer . fundamental-mode)
+ (type . "text/plain"))
("enriched"
- ("viewer" . enriched-decode-region)
- ("test" . (fboundp 'enriched-decode-region))
- ("type" . "text/enriched"))
+ (viewer . enriched-decode-region)
+ (test . (fboundp 'enriched-decode-region))
+ (type . "text/enriched"))
("html"
- ("viewer" . w3-prepare-buffer)
- ("test" . (fboundp 'w3-prepare-buffer))
- ("type" . "text/html")))
+ (viewer . mm-w3-prepare-buffer)
+ (test . (fboundp 'w3-prepare-buffer))
+ (type . "text/html")))
("video"
("mpeg"
- ("viewer" . "mpeg_play %s")
- ("type" . "video/mpeg")
- ("test" . (eq (mm-device-type) 'x))
+ (viewer . "mpeg_play %s")
+ (type . "video/mpeg")
+ (test . (eq (mm-device-type) 'x))
("needsx11")))
("x-world"
("x-vrml"
- ("viewer" . "webspace -remote %s -URL %u")
- ("type" . "x-world/x-vrml")
+ (viewer . "webspace -remote %s -URL %u")
+ (type . "x-world/x-vrml")
("description"
"VRML document")))
("archive"
("tar"
- ("viewer" . tar-mode)
- ("type" . "archive/tar")
- ("test" . (fboundp 'tar-mode)))))
+ (viewer . tar-mode)
+ (type . "archive/tar")
+ (test . (fboundp 'tar-mode)))))
"*The mailcap structure is an assoc list of assoc lists.
1st assoc list is keyed on the major content-type
2nd assoc list is keyed on the minor content-type (which can be a regexp)
Where <info> is another assoc list of the various information
related to the mailcap RFC. This is keyed on the lowercase
attribute name (viewer, test, etc). This looks like:
- ((\"viewer\" . viewerinfo)
- (\"test\" . testinfo)
- (\"xxxx\" . \"string\"))
+ ((viewer . viewerinfo)
+ (test . testinfo)
+ (xxxx . \"string\"))
Where viewerinfo specifies how the content-type is viewed. Can be
a string, in which case it is run through a shell, with
(expand-file-name fname mailcap-temporary-directory))))
(defun mailcap-save-binary-file ()
- ;; Ok, this is truly fucked. In XEmacs, if you use the mouse to select
- ;; a URL that gets saved via this function, read-file-name will pop up a
- ;; dialog box for file selection. For some reason which buffer we are in
- ;; gets royally screwed (even with save-excursions and the whole nine
- ;; yards). SO, we just keep the old buffer name around and away we go.
- (let ((old-buff (current-buffer))
- (file (read-file-name "Filename to save as: "
- (or mailcap-download-directory "~/")
- (file-name-nondirectory (url-view-url t))
- nil
- (file-name-nondirectory (url-view-url t))))
+ (let ((file (read-file-name
+ "Filename to save as: "
+ (or mailcap-download-directory "~/")))
(require-final-newline nil))
- (set-buffer old-buff)
- (mule-write-region-no-coding-system (point-min) (point-max) file)
+ (write-region (point-min) (point-max) file)
(kill-buffer (current-buffer))))
(defun mailcap-maybe-eval ()
(defun mailcap-parse-mailcaps (&optional path force)
"Parse out all the mailcaps specified in a unix-style path string PATH.
If FORCE, re-parse even if already parsed."
+ (interactive)
(when (or (not mailcap-parsed-p)
force)
(cond
(setq viewer (buffer-substring save-pos (point))))
(setq save-pos (point))
(end-of-line)
- (setq info (nconc (list (cons "viewer" viewer)
- (cons "type" (concat major "/"
- (if (string= minor ".*")
- "*" minor))))
+ (setq info (nconc (list (cons 'viewer viewer)
+ (cons 'type (concat major "/"
+ (if (string= minor ".*")
+ "*" minor))))
(mailcap-parse-mailcap-extras save-pos (point))))
(mailcap-mailcap-entry-passes-test info)
(mailcap-add-mailcap-entry major minor info)))))
;; Return t iff a mailcap entry passes its test clause or no test
;; clause is present.
(let (status ; Call-process-regions return value
- (test (assoc "test" info)) ; The test clause
+ (test (assq 'test info)) ; The test clause
)
(setq status (and test (split-string (cdr test) " ")))
(if (and (assoc "needsx11" info) (not (getenv "DISPLAY")))
((null save-chr) nil)
((= save-chr ?t)
(delete-region save-pos (progn (forward-char 1) (point)))
- (insert (or (cdr (assoc "type" type-info)) "\"\"")))
+ (insert (or (cdr (assq 'type type-info)) "\"\"")))
((= save-chr ?M)
(delete-region save-pos (progn (forward-char 1) (point)))
(insert "\"\""))
(defun mailcap-viewer-passes-test (viewer-info type-info)
;; Return non-nil iff the viewer specified by VIEWER-INFO passes its
;; test clause (if any).
- (let* ((test-info (assoc "test" viewer-info))
+ (let* ((test-info (assq 'test viewer-info))
(test (cdr test-info))
(otest test)
- (viewer (cdr (assoc "viewer" viewer-info)))
+ (viewer (cdr (assoc 'viewer viewer-info)))
(default-directory (expand-file-name "~/"))
status parsed-test cache result)
(if (setq cache (assoc test mailcap-viewer-test-cache))
(let ((cur-minor (assoc minor old-major)))
(cond
((or (null cur-minor) ; New minor area, or
- (assoc "test" info)) ; Has a test, insert at beginning
+ (assq 'test info)) ; Has a test, insert at beginning
(setcdr old-major (cons (cons minor info) (cdr old-major))))
- ((and (not (assoc "test" info)) ; No test info, replace completely
- (not (assoc "test" cur-minor)))
+ ((and (not (assq 'test info)) ; No test info, replace completely
+ (not (assq 'test cur-minor)))
(setcdr cur-minor info))
(t
(setcdr old-major (cons (cons minor info) (cdr old-major)))))))))
(defun mailcap-viewer-lessp (x y)
;; Return t iff viewer X is more desirable than viewer Y
- (let ((x-wild (string-match "[*?]" (or (cdr-safe (assoc "type" x)) "")))
- (y-wild (string-match "[*?]" (or (cdr-safe (assoc "type" y)) "")))
- (x-lisp (not (stringp (or (cdr-safe (assoc "viewer" x)) ""))))
- (y-lisp (not (stringp (or (cdr-safe (assoc "viewer" y)) "")))))
+ (let ((x-wild (string-match "[*?]" (or (cdr-safe (assq 'type x)) "")))
+ (y-wild (string-match "[*?]" (or (cdr-safe (assq 'type y)) "")))
+ (x-lisp (not (stringp (or (cdr-safe (assq 'viewer x)) ""))))
+ (y-lisp (not (stringp (or (cdr-safe (assq 'viewer y)) "")))))
(cond
((and x-lisp (not y-lisp))
t)
viewer ; The one and only viewer
ctl)
(save-excursion
- (setq ctl (drums-parse-content-type (or string "text/plain")))
+ (setq ctl (mail-header-parse-content-type (or string "text/plain")))
(setq major (split-string (car ctl) "/"))
(setq minor (cadr major)
major (car major))
(setq viewers (cdr viewers)))
(setq passed (sort (nreverse passed) 'mailcap-viewer-lessp))
(setq viewer (car passed))))
- (when (and (stringp (cdr (assoc "viewer" viewer)))
+ (when (and (stringp (cdr (assq 'viewer viewer)))
passed)
(setq viewer (car passed)))
(cond
- ((and (null viewer) (not (equal major "default")))
+ ((and (null viewer) (not (equal major "default")) request)
(mailcap-mime-info "default" request))
((or (null request) (equal request ""))
- (mailcap-unescape-mime-test (cdr (assoc "viewer" viewer)) info))
+ (mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info))
((stringp request)
- (if (or (string= request "test") (string= request "viewer"))
+ (if (or (eq request 'test) (eq request 'viewer))
(mailcap-unescape-mime-test
(cdr-safe (assoc request viewer)) info)))
((eq request 'all)
(t
;; MUST make a copy *sigh*, else we modify mailcap-mime-data
(setq viewer (copy-tree viewer))
- (let ((view (assoc "viewer" viewer))
- (test (assoc "test" viewer)))
+ (let ((view (assq 'viewer viewer))
+ (test (assq 'test viewer)))
(if view (setcdr view (mailcap-unescape-mime-test (cdr view) info)))
(if test (setcdr test (mailcap-unescape-mime-test (cdr test) info))))
viewer)))))
(if (string-match "XEmacs\\|Lucid" emacs-version)
(require 'mail-abbrevs)
(require 'mailabbrev))
-(require 'rfc2047)
+(require 'mail-parse)
(require 'mm-bodies)
+(require 'mm-encode)
(defgroup message '((user-mail-address custom-variable)
(user-full-name custom-variable))
(point-max)))
(goto-char (point-min)))
+(defun message-narrow-to-headers-or-head ()
+ "Narrow the buffer to the head of the message."
+ (widen)
+ (narrow-to-region
+ (goto-char (point-min))
+ (cond
+ ((re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
+ (match-beginning 0))
+ ((search-forward "\n\n" nil t)
+ (1- (point)))
+ (t
+ (point-max))))
+ (goto-char (point-min)))
+
(defun message-news-p ()
"Say whether the current buffer contains a news message."
(and (not message-this-is-mail)
(let ((message-deletable-headers
(if news nil message-deletable-headers)))
(message-generate-headers message-required-mail-headers))
- (rfc2047-encode-message-header)
+ (mail-encode-encoded-word-buffer)
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
(message-encode-message-body)
(message-narrow-to-headers)
;; Insert some headers.
(message-generate-headers message-required-news-headers)
- (rfc2047-encode-message-header)
+ (mail-encode-encoded-word-buffer)
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
- (message-encode-message-body)
(message-cleanup-headers)
(if (not (message-check-news-syntax))
nil
+ (message-encode-message-body)
(unwind-protect
(save-excursion
(set-buffer tembuf)
list file)
(save-excursion
(set-buffer (get-buffer-create " *message temp*"))
- (buffer-disable-undo (current-buffer))
(erase-buffer)
(insert-buffer-substring buf)
(save-restriction
(let* ((now (or now (current-time)))
(zone (nth 8 (decode-time now)))
(sign "+"))
+ (when (< zone 0)
+ (setq sign ""))
;; We do all of this because XEmacs doesn't have the %z spec.
(concat (format-time-string "%d %b %Y %H:%M:%S " (or now (current-time)))
(format "%s%02d%02d"
(error "This article is not yours"))
;; Make control message.
(setq buf (set-buffer (get-buffer-create " *message cancel*")))
- (buffer-disable-undo (current-buffer))
(erase-buffer)
(insert "Newsgroups: " newsgroups "\n"
"From: " (message-make-from) "\n"
beg)
;; We first set up a normal mail buffer.
(set-buffer (get-buffer-create " *message resend*"))
- (buffer-disable-undo (current-buffer))
(erase-buffer)
(message-setup `((To . ,address)))
;; Insert our usual headers.
(when (featurep 'mule)
(save-excursion
(save-restriction
- (message-narrow-to-headers)
+ (message-narrow-to-headers-or-head)
(message-remove-header
"^Content-Transfer-Encoding:\\|^Content-Type:\\|^Mime-Version:" t)
(goto-char (point-max))
(when (consp charset)
(error "Can't encode messages with multiple charsets (yet)"))
(widen)
- (message-narrow-to-headers)
+ (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.
(if (not (fboundp 'base64-encode-string))
(require 'base64)))
(require 'mm-util)
+(require 'rfc2047)
(require 'qp)
(defun mm-encode-body ()
;;; Code:
-(require 'drums)
+(require 'mail-parse)
(require 'mailcap)
(require 'mm-bodies)
("text/.*" . inline)))
(defvar mm-user-automatic-display
- '("text/plain" "image/gif"))
+ '("text/plain" "text/html" "image/gif"))
+
+(defvar mm-alternative-precedence '("text/plain" "text/html")
+ "List that describes the precedence of alternative parts.")
(defvar mm-tmp-directory "/tmp/"
"Where mm will store its temporary files.")
(defvar mm-dissection-list nil)
(defvar mm-last-shell-command "")
+(defvar mm-content-id-alist nil)
+
+;;; Convenience macros.
+
+(defmacro mm-handle-buffer (handle)
+ `(nth 0 ,handle))
+(defmacro mm-handle-type (handle)
+ `(nth 1 ,handle))
+(defmacro mm-handle-encoding (handle)
+ `(nth 2 ,handle))
+(defmacro mm-handle-undisplayer (handle)
+ `(nth 3 ,handle))
+(defmacro mm-handle-set-undisplayer (handle function)
+ `(setcar (nthcdr 3 ,handle) ,function))
+(defmacro mm-handle-disposition (handle)
+ `(nth 4 ,handle))
+(defmacro mm-handle-description (handle)
+ `(nth 5 ,handle))
+
+;;; The functions.
(defun mm-dissect-buffer (&optional no-strict-mime)
"Dissect the current buffer and return a list of MIME handles."
(save-excursion
- (let (ct ctl type subtype cte)
+ (let (ct ctl type subtype cte cd description id result)
(save-restriction
- (drums-narrow-to-header)
+ (mail-narrow-to-head)
(when (and (or no-strict-mime
(mail-fetch-field "mime-version"))
(setq ct (mail-fetch-field "content-type")))
- (setq ctl (drums-parse-content-type ct))
- (setq cte (mail-fetch-field "content-transfer-encoding"))))
+ (setq ctl (mail-header-parse-content-type ct)
+ cte (mail-fetch-field "content-transfer-encoding")
+ cd (mail-fetch-field "content-disposition")
+ description (mail-fetch-field "content-description")
+ id (mail-fetch-field "content-id"))))
(when ctl
(setq type (split-string (car ctl) "/"))
(setq subtype (cadr type)
type (pop type))
- (cond
- ((equal type "multipart")
- (mm-dissect-multipart ctl))
- (t
- (mm-dissect-singlepart ctl (and cte (intern cte))
- no-strict-mime)))))))
-
-(defun mm-dissect-singlepart (ctl cte &optional force)
+ (setq
+ result
+ (cond
+ ((equal type "multipart")
+ (mm-dissect-multipart ctl))
+ (t
+ (mm-dissect-singlepart
+ ctl
+ (and cte (intern (downcase (mail-header-remove-whitespace
+ (mail-header-remove-comments
+ cte)))))
+ no-strict-mime
+ (and cd (mail-header-parse-content-disposition cd))))))
+ (when id
+ (push (cons id result) mm-content-id-alist))
+ result))))
+
+(defun mm-dissect-singlepart (ctl cte &optional force cdl description)
(when (or force
(not (equal "text/plain" (car ctl))))
- (let ((res (list (list (mm-copy-to-buffer) ctl cte nil))))
+ (let ((res (list (list (mm-copy-to-buffer) ctl cte nil cdl description))))
(push (car res) mm-dissection-list)
res)))
(defun mm-dissect-multipart (ctl)
(goto-char (point-min))
- (let ((boundary (concat "\n--" (drums-content-type-get ctl 'boundary)))
+ (let ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary)))
start parts end)
(while (search-forward boundary nil t)
(forward-line -1)
"Display the MIME part represented by HANDLE."
(save-excursion
(mailcap-parse-mailcaps)
- (if (nth 3 handle)
+ (if (mm-handle-undisplayer handle)
(mm-remove-part handle)
- (let* ((type (caadr handle))
+ (let* ((type (car (mm-handle-type handle)))
(method (mailcap-mime-info type))
(user-method (mm-user-method type)))
(if (eq user-method 'inline)
(progn
(forward-line 1)
(mm-display-inline handle))
- (mm-display-external handle (or user-method method)))))))
+ (mm-display-external
+ handle (or user-method method 'mailcap-save-binary-file)))))))
(defun mm-display-external (handle method)
"Display HANDLE using METHOD."
(mm-with-unibyte-buffer
- (insert-buffer-substring (car handle))
- (mm-decode-content-transfer-encoding (nth 2 handle))
+ (insert-buffer-substring (mm-handle-buffer handle))
+ (mm-decode-content-transfer-encoding (mm-handle-encoding handle))
(if (functionp method)
(let ((cur (current-buffer)))
(switch-to-buffer (generate-new-buffer "*mm*"))
(insert-buffer-substring cur)
(funcall method)
- (setcar (nthcdr 3 handle) (current-buffer)))
+ (mm-handle-set-undisplayer handle (current-buffer)))
(let* ((file (make-temp-name (expand-file-name "emm." mm-tmp-directory)))
process)
(write-region (point-min) (point-max)
(setq process
(start-process "*display*" nil shell-file-name
"-c" (format method file)))
- (setcar (nthcdr 3 handle) (cons file process))
+ (mm-handle-set-undisplayer handle (cons file process))
(message "Displaying %s..." (format method file))))))
(defun mm-remove-part (handle)
"Remove the displayed MIME part represented by HANDLE."
- (let ((object (nth 3 handle)))
- (cond
- ;; Internally displayed part.
- ((mm-annotationp object)
- (delete-annotation object))
- ((or (functionp object)
- (and (listp object)
- (eq (car object) 'lambda)))
- (funcall object))
- ;; Externally displayed part.
- ((consp object)
- (condition-case ()
- (delete-file (car object))
- (error nil))
- (condition-case ()
- (kill-process (cdr object))
- (error nil)))
- ((bufferp object)
- (when (buffer-live-p object)
- (kill-buffer object))))
- (setcar (nthcdr 3 handle) nil)))
+ (let ((object (mm-handle-undisplayer handle)))
+ (condition-case ()
+ (cond
+ ;; Internally displayed part.
+ ((mm-annotationp object)
+ (delete-annotation object))
+ ((or (functionp object)
+ (and (listp object)
+ (eq (car object) 'lambda)))
+ (funcall object))
+ ;; Externally displayed part.
+ ((consp object)
+ (condition-case ()
+ (delete-file (car object))
+ (error nil))
+ (condition-case ()
+ (kill-process (cdr object))
+ (error nil)))
+ ((bufferp object)
+ (when (buffer-live-p object)
+ (kill-buffer object))))
+ (error nil))
+ (mm-handle-set-undisplayer handle nil)))
(defun mm-display-inline (handle)
- (let* ((type (caadr handle))
+ (let* ((type (car (mm-handle-type handle)))
(function (cadr (assoc type mm-inline-media-tests))))
(funcall function handle)))
(defun mm-destroy-part (handle)
"Destroy the data structures connected to HANDLE."
(mm-remove-part handle)
- (when (buffer-live-p (car handle))
- (kill-buffer (car handle))))
+ (when (buffer-live-p (mm-handle-buffer handle))
+ (kill-buffer (mm-handle-buffer handle))))
(defun mm-quote-arg (arg)
"Return a version of ARG that is safe to evaluate in a shell."
(apply 'concat (nconc (nreverse accum) (list (substring arg pos)))))))
;;;
-;;; Functions for displaying various formats inline
-;;;
-
-(defun mm-inline-image (handle)
- (let ((type (cadr (split-string (caadr handle) "/")))
- image)
- (mm-with-unibyte-buffer
- (insert-buffer-substring (car handle))
- (mm-decode-content-transfer-encoding (nth 2 handle))
- (setq image (make-image-specifier
- (vector (intern type) :data (buffer-string)))))
- (let ((annot (make-annotation image nil 'text)))
- (set-extent-property annot 'mm t)
- (set-extent-property annot 'duplicable t)
- (setcar (nthcdr 3 handle) annot))))
-
-(defun mm-inline-text (handle)
- (let ((type (cadr (split-string (caadr handle) "/")))
- text buffer-read-only)
- (mm-with-unibyte-buffer
- (insert-buffer-substring (car handle))
- (mm-decode-content-transfer-encoding (nth 2 handle))
- (setq text (buffer-string)))
- (cond
- ((equal type "plain")
- (let ((b (point)))
- (insert text)
- (save-restriction
- (narrow-to-region b (point))
- (let ((charset (drums-content-type-get (nth 1 handle) 'charset)))
- (when charset
- (mm-decode-body charset nil)))
- (setcar
- (nthcdr 3 handle)
- `(lambda ()
- (let (buffer-read-only)
- (delete-region ,(set-marker (make-marker) (point-min))
- ,(set-marker (make-marker) (point-max)))))))))
- )))
-
-(defun mm-inline-audio (handle)
- (message "Not implemented"))
-
-;;;
;;; Functions for outputting parts
;;;
+(defun mm-get-part (handle)
+ "Return the contents of HANDLE as a string."
+ (mm-with-unibyte-buffer
+ (insert-buffer-substring (mm-handle-buffer handle))
+ (mm-decode-content-transfer-encoding (mm-handle-encoding handle))
+ (buffer-string)))
+
(defun mm-save-part (handle)
"Write HANDLE to a file."
- (let* ((name (drums-content-type-get (cadr handle) 'name))
- (file (read-file-name "Save MIME part to: "
- (expand-file-name
- (or name "") default-directory))))
+ (let* ((name (mail-content-type-get (mm-handle-type handle) 'name))
+ (filename (mail-content-type-get
+ (mm-handle-disposition handle) 'filename))
+ file)
+ (when filename
+ (setq filename (file-name-nondirectory filename)))
+ (setq file
+ (read-file-name "Save MIME part to: "
+ (expand-file-name
+ (or filename name "") default-directory)))
(mm-with-unibyte-buffer
- (insert-buffer-substring (car handle))
- (mm-decode-content-transfer-encoding (nth 2 handle))
+ (insert-buffer-substring (mm-handle-buffer handle))
+ (mm-decode-content-transfer-encoding (mm-handle-encoding handle))
(when (or (not (file-exists-p file))
- (yes-or-no-p (format "File %s already exists; overwrite? ")))
+ (yes-or-no-p (format "File %s already exists; overwrite? "
+ file)))
(write-region (point-min) (point-max) file)))))
(defun mm-pipe-part (handle)
"Pipe HANDLE to a process."
- (let* ((name (drums-content-type-get (cadr handle) 'name))
+ (let* ((name (mail-content-type-get (car (mm-handle-type handle)) 'name))
(command
(read-string "Shell command on MIME part: " mm-last-shell-command)))
(mm-with-unibyte-buffer
- (insert-buffer-substring (car handle))
- (mm-decode-content-transfer-encoding (nth 2 handle))
+ (insert-buffer-substring (mm-handle-buffer handle))
+ (mm-decode-content-transfer-encoding (mm-handle-encoding handle))
(shell-command-on-region (point-min) (point-max) command nil))))
(defun mm-interactively-view-part (handle)
"Display HANDLE using METHOD."
- (let* ((type (caadr handle))
+ (let* ((type (car (mm-handle-type handle)))
(methods
(mapcar (lambda (i) (list (cdr (assoc "viewer" i))))
(mailcap-mime-info type 'all)))
(method (completing-read "Viewer: " methods)))
(mm-display-external (copy-sequence handle) method)))
+(defun mm-preferred-alternative (handles &optional preferred)
+ "Say which of HANDLES are preferred."
+ (let ((prec (if preferred (list preferred) mm-alternative-precedence))
+ p h result type)
+ (while (setq p (pop prec))
+ (setq h handles)
+ (while h
+ (setq type (car (mm-handle-type (car h))))
+ (when (and (equal p type)
+ (mm-automatic-display-p type)
+ (or (not (mm-handle-disposition (car h)))
+ (equal (car (mm-handle-disposition (car h)))
+ "inline")))
+ (setq result (car h)
+ h nil
+ prec nil))
+ (pop h)))
+ result))
+
+(defun mm-get-content-id (id)
+ "Return the handle(s) referred to by ID."
+ (cdr (assoc id mm-content-id-alist)))
+
(provide 'mm-decode)
;; mm-decode.el ends here
;;; Code:
+(require 'mail-parse)
+
+(defun mm-insert-rfc822-headers (charset encoding)
+ "Insert text/plain headers with CHARSET and ENCODING."
+ (insert "MIME-Version: 1.0\n")
+ (insert "Content-Type: text/plain; charset="
+ (mail-quote-string (downcase (symbol-name charset))) "\n")
+ (insert "Content-Transfer-Encoding: "
+ (downcase (symbol-name encoding)) "\n"))
+
(provide 'mm-encode)
;;; mm-encode.el ends here
;;; Code:
+(defvar mm-default-coding-system nil
+ "The default coding system to use.")
+
(defvar mm-known-charsets '(iso-8859-1)
"List of known charsets.")
(when (fboundp 'set-buffer-multibyte)
(set-buffer-multibyte t)))
-(defun mm-insert-rfc822-headers (charset encoding)
- "Insert text/plain headers with CHARSET and ENCODING."
- (insert "MIME-Version: 1.0\n")
- (insert "Content-Type: text/plain; charset=\""
- (downcase (symbol-name charset)) "\"\n")
- (insert "Content-Transfer-Encoding: "
- (downcase (symbol-name encoding)) "\n"))
-
(defun mm-mime-charset (charset b e)
(if (fboundp 'coding-system-get)
(or
+ (and
+ mm-default-coding-system
+ (let ((safe (coding-system-get mm-default-coding-system
+ 'safe-charsets)))
+ (or (eq safe t) (memq charset safe)))
+ (coding-system-get mm-default-coding-system 'mime-charset))
(coding-system-get
(get-charset-property charset 'prefered-coding-system)
'mime-charset)
--- /dev/null
+;;; mm-view.el --- Functions for viewing MIME objects
+;; 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:
+
+;;; Code:
+
+(require 'mail-parse)
+(require 'mailcap)
+(require 'mm-bodies)
+
+;;;
+;;; Functions for displaying various formats inline
+;;;
+
+(defun mm-inline-image (handle)
+ (let ((type (cadr (split-string (car (mm-handle-type handle)) "/")))
+ buffer-read-only image)
+ (mm-with-unibyte-buffer
+ (insert-buffer-substring (mm-handle-buffer handle))
+ (mm-decode-content-transfer-encoding (mm-handle-encoding handle))
+ (setq image (make-image-specifier
+ (vector (intern type) :data (buffer-string)))))
+ (let ((annot (make-annotation image nil 'text)))
+ (set-extent-property annot 'mm t)
+ (set-extent-property annot 'duplicable t)
+ (mm-handle-set-undisplayer handle annot))
+ (insert " ")))
+
+(defun mm-inline-text (handle)
+ (let ((type (cadr (split-string (car (mm-handle-type handle)) "/")))
+ text buffer-read-only)
+ (cond
+ ((equal type "plain")
+ (with-temp-buffer
+ (insert-buffer-substring (mm-handle-buffer handle))
+ (mm-decode-content-transfer-encoding (mm-handle-encoding handle))
+ (setq text (buffer-string)))
+ (let ((b (point)))
+ (insert text)
+ (save-restriction
+ (narrow-to-region b (point))
+ (let ((charset (mail-content-type-get
+ (mm-handle-type handle) 'charset)))
+ (when charset
+ (mm-decode-body charset nil)))
+ (mm-handle-set-undisplayer
+ handle
+ `(lambda ()
+ (let (buffer-read-only)
+ (delete-region
+ ,(set-marker (make-marker) (point-min))
+ ,(set-marker (make-marker) (point-max)))))))))
+ ((equal type "html")
+ (save-excursion
+ (w3-do-setup)
+ (mm-with-unibyte-buffer
+ (insert-buffer-substring (mm-handle-buffer handle))
+ (mm-decode-content-transfer-encoding (mm-handle-encoding handle))
+ (require 'url)
+ (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)))))))))
+ )))
+
+(defun mm-inline-audio (handle)
+ (message "Not implemented"))
+
+(defun mm-view-sound-file ()
+ (message "Not implemented"))
+
+(defun mm-w3-prepare-buffer ()
+ (require 'w3)
+ (w3-prepare-buffer))
+
+(provide 'mm-view)
+
+;; mm-view.el ends here
(setq nndoc-dissection-alist nil)
(save-excursion
(set-buffer nndoc-current-buffer)
- (buffer-disable-undo (current-buffer))
(erase-buffer)
(if (stringp nndoc-address)
(nnheader-insert-file-contents nndoc-address)
(let* ((buf (get-buffer-create " *draft headers*"))
article)
(set-buffer buf)
- (buffer-disable-undo (current-buffer))
(erase-buffer)
;; We don't support fetching by Message-ID.
(if (stringp (car articles))
(nnfolder-request-article article group server)
(save-excursion
(set-buffer buf)
- (buffer-disable-undo (current-buffer))
(erase-buffer)
(insert-buffer-substring nntp-server-buffer)
(goto-char (point-min))
`(let ((new (generate-new-buffer " *nnheader replace*"))
(cur (current-buffer))
(start (point-min)))
- (set-buffer new)
- (buffer-disable-undo (current-buffer))
(set-buffer cur)
(goto-char (point-min))
(while (,(if regexp 're-search-forward 'search-forward)
(save-excursion
;; Insert the incoming file.
(set-buffer (get-buffer-create " *nnmail incoming*"))
- (buffer-disable-undo (current-buffer))
(erase-buffer)
(nnheader-insert-file-contents incoming)
(unless (zerop (buffer-size))
(set-buffer
(setq nnmail-cache-buffer
(get-buffer-create " *nnmail message-id cache*")))
- (buffer-disable-undo (current-buffer))
(when (file-exists-p nnmail-message-id-cache-file)
(nnheader-insert-file-contents nnmail-message-id-cache-file))
(set-buffer-modified-p nil)
(nnmbox-request-article article group server)
(save-excursion
(set-buffer buf)
- (buffer-disable-undo (current-buffer))
(erase-buffer)
(insert-buffer-substring nntp-server-buffer)
(goto-char (point-min))
(defun nnml-find-group-number (id)
(save-excursion
(set-buffer (get-buffer-create " *nnml id*"))
- (buffer-disable-undo (current-buffer))
(let ((alist nnml-group-alist)
number)
;; We want to look through all .overview files, but we want to
(string-to-int (match-string 1 f2)))))))
active group lines ident elem min)
(set-buffer (get-buffer-create " *nnsoup work*"))
- (buffer-disable-undo (current-buffer))
(while files
(nnheader-message 5 "Doing %s..." (car files))
(erase-buffer)
(defun nnspool-find-id (id)
(save-excursion
(set-buffer (get-buffer-create " *nnspool work*"))
- (buffer-disable-undo (current-buffer))
(erase-buffer)
(ignore-errors
(call-process "grep" nil t nil (regexp-quote id) nnspool-history-file))
-;;; qp.el --- Quoted-printable functions
+;;; qp.el --- Quoted-Printable functions
;; Copyright (C) 1998 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(require 'base64))))
(require 'qp)
(require 'mm-util)
+(require 'drums)
(defvar rfc2047-default-charset 'iso-8859-1
"Default MIME charset -- does not need encoding.")
(point-max))))
(goto-char (point-min)))
-;;;###autoload
(defun rfc2047-encode-message-header ()
"Encode the message header according to `rfc2047-header-encoding-alist'.
Should be called narrowed to the head of the message."
(interactive "*")
(when (featurep 'mule)
(save-excursion
+ (goto-char (point-min))
(let ((alist rfc2047-header-encoding-alist)
elem method)
(while (not (eobp))
(save-restriction
(narrow-to-region b e)
(goto-char (point-min))
- (while (re-search-forward "[^ \t\n]+" nil t)
+ (while (re-search-forward (concat "[^" drums-tspecials " \t\n]+") nil t)
(push
(list (match-beginning 0) (match-end 0)
(car
'B))
(start (concat
"=?" (downcase (symbol-name mime-charset)) "?"
- (downcase (symbol-name encoding)) "?")))
+ (downcase (symbol-name encoding)) "?"))
+ (first t))
(save-restriction
(narrow-to-region b e)
(mm-encode-coding-region b e mime-charset)
(funcall (cdr (assq encoding rfc2047-encoding-function-alist))
(point-min) (point-max))
(goto-char (point-min))
- (insert start)
- (goto-char (point-max))
- (insert "?=")
- ;; Encoded words can't be more than 75 chars long, so we have to
- ;; split the long ones up.
- (end-of-line)
- (while (> (current-column) 74)
- (beginning-of-line)
- (forward-char 73)
- (insert "?=\n " start)
- (end-of-line)))))
+ (while (not (eobp))
+ (unless first
+ (insert " "))
+ (setq first nil)
+ (insert start)
+ (end-of-line)
+ (insert "?=")
+ (forward-line 1)))))
(defun rfc2047-b-encode-region (b e)
"Encode the header contained in REGION with the B encoding."
- (base64-encode-region b e t))
+ (base64-encode-region b e t)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (goto-char (min (point-max) (+ 64 (point))))
+ (unless (eobp)
+ (insert "\n"))))
(defun rfc2047-q-encode-region (b e)
"Encode the header contained in REGION with the Q encoding."
(while alist
(when (looking-at (caar alist))
(quoted-printable-encode-region b e nil (cdar alist))
- (subst-char-in-region (point-min) (point-max) ? ?_))
- (pop alist))))))
+ (subst-char-in-region (point-min) (point-max) ? ?_)
+ (setq alist nil))
+ (pop alist))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (forward-char 64)
+ (search-backward "=" nil (- (point) 2))
+ (unless (eobp)
+ (insert "\n")))))))
;;;
;;; Functions for decoding RFC2047 messages
;;;
(defvar rfc2047-encoded-word-regexp
- "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ ]+\\)\\?=")
+ "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ +]+\\)\\?=")
-;;;###autoload
(defun rfc2047-decode-region (start end)
"Decode MIME-encoded words in region between START and END."
(interactive "r")
(when (mm-multibyte-p)
(mm-decode-coding-region b (point-max) rfc2047-default-charset))))))
-;;;###autoload
(defun rfc2047-decode-string (string)
"Decode the quoted-printable-encoded STRING and return the results."
(let ((m (mm-multibyte-p)))
--- /dev/null
+;;; rfc2231.el --- Functions for decoding rfc2231 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:
+
+;;; Code:
+
+(require 'drums)
+
+(defun rfc2231-get-value (ct attribute)
+ "Return the value of ATTRIBUTE from CT."
+ (cdr (assq attribute (cdr ct))))
+
+(defun rfc2231-parse-string (string)
+ "Parse STRING and return a list.
+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"))
+ (prev-value "")
+ display-name mailbox c display-string parameters
+ attribute value type subtype number encoded
+ prev-attribute)
+ (drums-init (mail-header-remove-whitespace
+ (mail-header-remove-comments string)))
+ (let ((table (copy-syntax-table drums-syntax-table)))
+ (modify-syntax-entry ?\' "w" table)
+ (set-syntax-table table))
+ (setq c (following-char))
+ (when (and (memq c ttoken)
+ (not (memq c stoken)))
+ (setq type (downcase (buffer-substring
+ (point) (progn (forward-sexp 1) (point)))))
+ ;; Do the params
+ (while (not (eobp))
+ (setq c (following-char))
+ (unless (eq c ?\;)
+ (error "Invalid header: %s" string))
+ (forward-char 1)
+ (setq c (following-char))
+ (if (and (memq c ttoken)
+ (not (memq c stoken)))
+ (setq attribute
+ (intern
+ (downcase
+ (buffer-substring
+ (point) (progn (forward-sexp 1) (point))))))
+ (error "Invalid header: %s" string))
+ (setq c (following-char))
+ (setq encoded nil)
+ (when (eq c ?*)
+ (forward-char 1)
+ (setq c (following-char))
+ (when (memq c ntoken)
+ (setq number
+ (string-to-number
+ (buffer-substring
+ (point) (progn (forward-sexp 1) (point)))))
+ (setq c (following-char))
+ (when (eq c ?*)
+ (setq encoded t)
+ (forward-char 1)
+ (setq c (following-char)))))
+ ;; See if we have any previous continuations.
+ (when (and prev-attribute
+ (not (eq prev-attribute attribute)))
+ (push (cons prev-attribute prev-value) parameters)
+ (setq prev-attribute nil
+ prev-value ""))
+ (unless (eq c ?=)
+ (error "Invalid header: %s" string))
+ (forward-char 1)
+ (setq c (following-char))
+ (cond
+ ((eq c ?\")
+ (setq value
+ (buffer-substring (1+ (point))
+ (progn (forward-sexp 1) (1- (point))))))
+ ((and (memq c ttoken)
+ (not (memq c stoken)))
+ (setq value (buffer-substring
+ (point) (progn (forward-sexp 1) (point)))))
+ (t
+ (error "Invalid header: %s" string)))
+ (when encoded
+ (setq value (rfc2231-decode-encoded-string value)))
+ (if number
+ (setq prev-attribute attribute
+ prev-value (concat prev-value value))
+ (push (cons attribute value) parameters)))
+
+ ;; Take care of any final continuations.
+ (when prev-attribute
+ (push (cons prev-attribute prev-value) parameters))
+
+ `(,type ,@(nreverse parameters))))))
+
+(defun rfc2231-decode-encoded-string (string)
+ "Decode an RFC2231-encoded string.
+These look like \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\"."
+ (with-temp-buffer
+ (let ((elems (split-string string "'")))
+ ;; The encoded string may contain zero to two single-quote
+ ;; marks. This should give us the encoded word stripped
+ ;; of any preceding values.
+ (insert (car (last elems)))
+ (goto-char (point-min))
+ (while (search-forward "%" nil t)
+ (insert
+ (prog1
+ (string-to-number (buffer-substring (point) (+ (point) 2)) 16)
+ (delete-region (1- (point)) (+ (point) 2)))))
+ ;; Encode using the charset, if any.
+ (when (and (< (length elems) 1)
+ (not (equal (intern (car elems)) 'us-ascii)))
+ (mm-decode-coding-region (point-min) (point-max)
+ (intern (car elems))))
+ (buffer-string))))
+
+(provide 'rfc2231)
+
+;;; rfc2231.el ends here
(defun gnus-score-edit-insert-date ()
"Insert date in numerical format."
(interactive)
- (princ (time-to-day (current-time)) (current-buffer)))
+ (princ (time-to-days (current-time)) (current-buffer)))
(defun gnus-score-pretty-print ()
"Format the current score file."
(defun date-to-day (date)
"Return the number of days between year 1 and DATE."
- (time-to-day (date-to-time date)))
+ (time-to-days (date-to-time date)))
(defun days-between (date1 date2)
"Return the number of days between DATE1 and DATE2."
(setq day-of-year (1+ day-of-year))))
day-of-year))
-(defun time-to-day (time)
+(defun time-to-days (time)
"The number of days between the Gregorian date 0001-12-31bce and TIME.
The Gregorian date Sunday, December 31, 1bce is imaginary."
(let* ((tim (decode-time time))
+1998-09-13 08:58:56 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * dir (File): Updated.
+
+1998-09-12 08:53:05 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * emacs-mime.texi: New file.
+
+ * gnus.texi (Misc Article): Addition.
+
1998-09-11 08:52:50 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus.texi (Group Score Commands): Fix.
(Saving Articles): Fix.
(Agent Expiry): Fix.
+ (Using MIME): Change.
1998-09-10 03:19:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
SHELL = /bin/sh
PAPERTYPE=a4
-all: gnus message
+all: gnus message emacs-mime
most: texi2latex.elc latex latexps
makeinfo -o $* $<; \
fi
-dvi: gnus.dvi message.dvi refcard.dvi
+dvi: gnus.dvi message.dvi refcard.dvi emacs-mime.dvi
.texi.dvi :
$(PERL) -n -e 'print unless (/\@iflatex/ .. /\@end iflatex/)' $< > gnustmp.texi
install:
$(SHELL) $(top_srcdir)/mkinstalldirs $(infodir)
- @for file in gnus message; do \
+ @for file in gnus message emacs-info; do \
for ifile in `echo $$file $$file-[0-9] $$file-[0-9][0-9]`; do \
if test -f $$ifile; then \
echo " $(INSTALL_DATA) $$ifile $(infodir)/$$ifile"; \
* Menu:
-* Gnus: (gnus). The news reader Gnus.
-* Message: (message). The Message sending thingamabob.
+* Gnus: (gnus). The news reader Gnus.
+* Message: (message). The Message sending thingamabob.
+* Emacs MIME: (emacs-mime). Libraries for handling MIME.
--- /dev/null
+\input texinfo @c -*-texinfo-*-
+
+@setfilename message
+@settitle Emacs MIME Manual
+@synindex fn cp
+@synindex vr cp
+@synindex pg cp
+@c @direntry
+@c * Emacs MIME: (emacs-mime). The MIME de/composition library.
+@c @end direntry
+@iftex
+@finalout
+@end iftex
+@setchapternewpage odd
+
+@ifinfo
+
+This file documents the Emacs MIME interface functionality.
+
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+@ignore
+Permission is granted to process this file through Tex and print the
+results, provided the printed document carries copying permission
+notice identical to this one except for the removal of this paragraph
+(this paragraph not being relevant to the printed manual).
+
+@end ignore
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided also that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions.
+@end ifinfo
+
+@tex
+
+@titlepage
+@title Emacs MIME Manual
+
+@author by Lars Magne Ingebrigtsen
+@page
+
+@vskip 0pt plus 1filll
+Copyright @copyright{} 1998 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions.
+
+@end titlepage
+@page
+
+@end tex
+
+@node Top
+@top Emacs MIME
+
+This manual documents the libraries used to compose and display
+@sc{mime} messages.
+
+This is not a manual meant for users; it's a manual directed at people
+who want to write functions and commands that manipulate @sc{mime}
+elements.
+
+@sc{mime} is short for @dfn{Multipurpose Internet Mail Extensions}.
+This standard is documented in a number of RFCs; mainly RFC2045 (Format
+of Internet Message Bodies), RFC2046 (Media Types), RFC2047 (Message
+Header Extensions for Non-ASCII Text), RFC2048 (Registration
+Procedures), RFC2049 (Conformance Criteria and Examples). It is highly
+recommended that anyone who intends writing @sc{mime}-compliant software
+read at least RFC2045 and RFC2047.
+
+@menu
+* Basic Functions:: Utility and basic parsing functions.
+* Decoding and Viewing:: A framework for decoding and viewing.
+* Index:: Function and variable index.
+@end menu
+
+
+@node Basic Functions
+@chapter Basic Functions
+
+This chapter describes the basic, ground-level functions for parsing and
+handling. Covered here is parsing @code{From} lines, removing comments
+from header lines, decoding encoded words, parsing date headers and so
+on. High-level functionality is dealt with in the next chapter
+(@pxref{Decoding and Viewing}).
+
+@menu
+* mail-parse:: The generalized @sc{mime} and mail interface.
+* rfc2231:: Parsing @code{Content-Type} headers.
+* drums:: Handling mail headers defined by RFC822bis.
+* rfc2047:: En/decoding encoded words in headers.
+* time-date:: Functions for parsing dates and manipulating time.
+* qp:: Quoted-Printable en/decoding.
+* base64:: Base64 en/decoding.
+* mailcap:: How parts are displayed is specified by the @file{.mailcap} file
+@end menu
+
+
+@node mail-parse
+@section mail-parse
+
+It is perhaps misleading to place the @code{mail-parse} library in this
+chapter. It is not a basic low-level library---rather, it is an
+abstraction over the actual low-level libraries that are described in the
+subsequent sections.
+
+Standards change, and so programs have to change to fit in the new
+mold. For instance, RFC2045 describes a syntax for the
+@code{Content-Type} header that only allows ASCII characters in the
+parameter list. RFC2231 expands on RFC2045 syntax to provide a scheme
+for continuation headers and non-ASCII characters.
+
+The traditional way to deal with this is just to update the library
+functions to parse the new syntax. However, this is sometimes the wrong
+thing to do. In some instances it may be vital to be able to understand
+both the old syntax as well as the new syntax, and if there is only one
+library, one must choose between the old version of the library and the
+new version of the library.
+
+The Emacs MIME library takes a different tack. It defines a series of
+low-level libraries (@file{rfc2047.el}, @file{rfc2231.el} and so on)
+that parses strictly according to the corresponding standard. However,
+normal programs would not use the functions provided by these libraries
+directly, but instead use the functions provided by the
+@code{mail-parse} library. The functions in this library are just
+aliases to the corresponding functions in the latest low-level
+libraries. Using this scheme, programs get a consistent interface they
+can use, and library developers are free to create write code that
+handles new standards.
+
+The following functions are defined by this library:
+
+@table @code
+@item mail-header-parse-content-type
+@findex mail-header-parse-content-type
+Parse a @code{Content-Type} header and return a list on the following
+format:
+
+@lisp
+("type/subtype"
+ (attribute1 . value1)
+ (attribute2 . value2)
+ ...)
+@end lisp
+
+Here's an example:
+
+@example
+(mail-header-parse-content-type
+ "image/gif; name=\"b980912.gif\"")
+=> ("image/gif" (name . "b980912.gif"))
+@end example
+
+@item mail-header-parse-content-disposition
+@findex mail-header-parse-content-disposition
+Parse a @code{Content-Disposition} header and return a list on the same
+format as the function above.
+
+@item mail-content-type-get
+@findex mail-content-type-get
+Takes two parameters---a list on the format above, and an attribute.
+Returns the value of the attribute.
+
+@example
+(mail-content-type-get
+ '("image/gif" (name . "b980912.gif")) 'name)
+=> "b980912.gif"
+@end example
+
+@item mail-header-remove-comments
+@findex mail-header-remove-comments
+Return a comment-free version of a header.
+
+@example
+(mail-header-remove-comments
+ "Gnus/5.070027 (Pterodactyl Gnus v0.27) (Finnish Landrace)")
+=> "Gnus/5.070027 "
+@end example
+
+@item mail-header-remove-whitespace
+@findex mail-header-remove-whitespace
+Remove linear white space from a header. Space inside quoted strings
+and comments is preserved.
+
+@example
+(mail-header-remove-whitespace
+ "image/gif; name=\"Name with spaces\"")
+=> "image/gif;name=\"Name with spaces\""
+@end example
+
+@item mail-header-get-comment
+@findex mail-header-get-comment
+Return the last comment in a header.
+
+@example
+(mail-header-get-comment
+ "Gnus/5.070027 (Pterodactyl Gnus v0.27) (Finnish Landrace)")
+=> "Finnish Landrace"
+@end example
+
+@item mail-header-parse-address
+@findex mail-header-parse-address
+Parse an address and return a list containing the mailbox and the
+plaintext name.
+
+@example
+(mail-header-parse-address
+ "Hrvoje Niksic <hniksic@@srce.hr>")
+=> ("hniksic@@srce.hr" . "Hrvoje Niksic")
+@end example
+
+@item mail-header-parse-addresses
+@findex mail-header-parse-addresses
+Parse a string with list of addresses and return a list of elements like
+the one described above.
+
+@example
+(mail-header-parse-addresses
+ "Hrvoje Niksic <hniksic@@srce.hr>, Steinar Bang <sb@@metis.no>")
+=> (("hniksic@@srce.hr" . "Hrvoje Niksic")
+ ("sb@@metis.no" . "Steinar Bang"))
+@end example
+
+@item mail-header-parse-date
+@findex mail-header-parse-date
+Parse a date string and return an Emacs time structure.
+
+@item mail-narrow-to-head
+@findex mail-narrow-to-head
+Narrow the buffer to the header section of the buffer. Point is placed
+at the beginning of the narrowed buffer.
+
+@item mail-header-narrow-to-field
+@findex mail-header-narrow-to-field
+Narrow the buffer to the header under point.
+
+@item mail-encode-encoded-word-region
+@findex mail-encode-encoded-word-region
+Encode the non-ASCII words in the region. For instance,
+@samp{Naïve} is encoded as @samp{=?iso-8859-1?q?Na=EFve?=}.
+
+@item mail-encode-encoded-word-buffer
+@findex mail-encode-encoded-word-buffer
+Encode the non-ASCII words in the current buffer. This function is
+meant to be called narrowed to the headers of a message.
+
+@item mail-encode-encoded-word-string
+@findex mail-encode-encoded-word-string
+Encode the words that need encoding in a string, and return the result.
+
+@example
+(mail-encode-encoded-word-string
+ "This is naïve, baby")
+=> "This is =?iso-8859-1?q?na=EFve,?= baby"
+@end example
+
+@item mail-decode-encoded-word-region
+@findex mail-decode-encoded-word-region
+Decode the encoded words in the region.
+
+@item mail-decode-encoded-word-string
+@findex mail-decode-encoded-word-string
+Decode the encoded words in the string and return the result.
+
+@example
+(mail-decode-encoded-word-string
+ "This is =?iso-8859-1?q?na=EFve,?= baby")
+=> "This is naïve, baby"
+@end example
+
+@end table
+
+Currently, @code{mail-parse} is an abstraction over @code{drums},
+@code{rfc2047} and @code{rfc2231}. These are documented in the
+subsequent sections.
+
+
+@node rfc2231
+@section rfc2231
+
+RFC2231 defines a syntax for the @code{Content-Type} and
+@code{Content-Disposition} headers. Its snappy name is @dfn{MIME
+Parameter Value and Encoded Word Extensions: Character Sets, Languages,
+and Continuations}.
+
+In short, these headers look something like this:
+
+@example
+Content-Type: application/x-stuff;
+ title*0*=us-ascii'en'This%20is%20even%20more%20;
+ title*1*=%2A%2A%2Afun%2A%2A%2A%20;
+ title*2="isn't it!"
+@end example
+
+They usually aren't this bad, though.
+
+The following functions are defined by this library:
+
+@table @code
+@item rfc2231-parse-string
+@findex rfc2231-parse-string
+Parse a @code{Content-Type} header and return a list describing its
+elements.
+
+@example
+(rfc2231-parse-string
+ "application/x-stuff;
+ title*0*=us-ascii'en'This%20is%20even%20more%20;
+ title*1*=%2A%2A%2Afun%2A%2A%2A%20;
+ title*2=\"isn't it!\"")
+=> ("application/x-stuff"
+ (title . "This is even more ***fun*** isn't it!"))
+@end example
+
+@item rfc2231-get-value
+@findex rfc2231-get-value
+Takes one of the lists on the format above and return
+the value of the specified attribute.
+
+@end table
+
+
+@node drums
+@section drums
+
+@dfn{drums} is an IETF working group that is working on the replacement
+for RFC822.
+
+The functions provided by this library include:
+
+@table @code
+@item drums-remove-comments
+@findex drums-remove-comments
+Remove the comments from the argument and return the results.
+
+@item drums-remove-whitespace
+@findex drums-remove-whitespace
+Remove linear white space from the string and return the results.
+Spaces inside quoted strings and comments are left untouched.
+
+@item drums-get-comment
+@findex drums-get-comment
+Return the last most comment from the string.
+
+@item drums-parse-address
+@findex drums-parse-address
+Parse an address string and return a list that contains the mailbox and
+the plain text name.
+
+@item drums-parse-addresses
+@findex drums-parse-addresses
+Parse a string that contains any number of comma-separated addresses and
+return a list that contains mailbox/plain text pairs.
+
+@item drums-parse-date
+@findex drums-parse-date
+Parse a date string and return an Emacs time structure.
+
+@item drums-narrow-to-header
+@findex drums-narrow-to-header
+Narrow the buffer to the header section of the current buffer.
+
+@end table
+
+
+@node rfc2047
+@section rfc2047
+
+RFC2047 (Message Header Extensions for Non-ASCII Text) specifies how
+non-ASCII text in headers are to be encoded. This is actually rather
+complicated, so a number of variables are necessary to tweak what this
+library does.
+
+The following variables are tweakable:
+
+@table @code
+@item rfc2047-default-charset
+@vindex rfc2047-default-charset
+Characters in this charset should not be decoded by this library.
+This defaults to @code{iso-8859-1}.
+
+@item rfc2047-header-encoding-list
+@vindex rfc2047-header-encoding-list
+This is an alist of header / encoding-type pairs. Its main purpose is
+to prevent encoding of certain headers.
+
+The keys can either be header regexps, or @code{t}.
+
+The values can be either @code{nil}, in which case the header(s) in
+question won't be encoded, or @code{mime}, which means that they will be
+encoded.
+
+@item rfc2047-charset-encoding-alist
+@vindex rfc2047-charset-encoding-alist
+RFC2047 specifies two forms of encoding---@code{Q} (a
+Quoted-Printable-like encoding) and @code{B} (base64). This alist
+specifies which charset should use which encoding.
+
+@item rfc2047-encoding-function-alist
+@vindex rfc2047-encoding-function-alist
+This is an alist of encoding / function pairs. The encodings are
+@code{Q}, @code{B} and @code{nil}.
+
+@item rfc2047-q-encoding-alist
+@vindex rfc2047-q-encoding-alist
+The @code{Q} encoding isn't quite the same for all headers. Some
+headers allow a narrower range of characters, and that is what this
+variable is for. It's an alist of header regexps / allowable character
+ranges.
+
+@item rfc2047-encoded-word-regexp
+@vindex rfc2047-encoded-word-regexp
+When decoding words, this library looks for matches to this regexp.
+
+@end table
+
+Those were the variables, and these are this functions:
+
+@table @code
+@item rfc2047-narrow-to-field
+@findex rfc2047-narrow-to-field
+Narrow the buffer to the header on the current line.
+
+@item rfc2047-encode-message-header
+@findex rfc2047-encode-message-header
+Should be called narrowed to the header of a message. Encodes according
+to @code{rfc2047-header-encoding-alist}.
+
+@item rfc2047-encode-region
+@findex rfc2047-encode-region
+Encodes all encodable words in the region specified.
+
+@item rfc2047-encode-string
+@findex rfc2047-encode-string
+Encode a string and return the results.
+
+@item rfc2047-decode-region
+@findex rfc2047-decode-region
+Decode the encoded words in the region.
+
+@item rfc2047-decode-string
+@findex rfc2047-decode-string
+Decode a string and return the results.
+
+@end table
+
+
+@node time-date
+@section time-date
+
+While not really a part of the @sc{mime} library, it is convenient to
+document this library here. It deals with parsing @code{Date} headers
+and manipulating time. (Not by using tesseracts, though, I'm sorry to
+say.)
+
+These functions converts between five formats: A date string, an Emacs
+time structure, a decoded time list, a second number, and a day number.
+
+The functions have quite self-explanatory names, so the following just
+gives an overview of which functions are available.
+
+@example
+(parse-time-string "Sat Sep 12 12:21:54 1998 +0200")
+=> (54 21 12 12 9 1998 6 nil 7200)
+
+(date-to-time "Sat Sep 12 12:21:54 1998 +0200")
+=> (13818 19266)
+
+(time-to-seconds '(13818 19266))
+=> 905595714.0
+
+(seconds-to-time 905595714.0)
+=> (13818 19266 0)
+
+(time-to-day '(13818 19266))
+=> 729644
+
+(days-to-time 729644)
+=> (961933 65536)
+
+(time-since '(13818 19266))
+=> (0 430)
+
+(time-less-p '(13818 19266) '(13818 19145))
+=> nil
+
+(subtract-time '(13818 19266) '(13818 19145))
+=> (0 121)
+
+(days-between "Sat Sep 12 12:21:54 1998 +0200"
+ "Sat Sep 07 12:21:54 1998 +0200")
+=> 5
+
+(date-leap-year-p 2000)
+=> t
+
+(time-to-day-in-year '(13818 19266))
+=> 255
+
+@end example
+
+And finally, we have @code{safe-date-to-time}, which does the same as
+@code{date-to-time}, but returns a zero time if the date is
+syntactically malformed.
+
+
+
+@node qp
+@section qp
+
+This library deals with decoding and encoding Quoted-Printable text.
+
+Very briefly explained, qp encoding means translating all 8-bit
+characters (and lots of control characters) into things that look like
+@samp{=EF}; that is, an equal sign followed by the byte encoded as a hex
+string.
+
+The following functions are defined by the library:
+
+@table @code
+@item quoted-printable-decode-region
+@findex quoted-printable-decode-region
+QP-decode all the encoded text in the specified region.
+
+@item quoted-printable-decode-string
+@findex quoted-printable-decode-string
+Decode the QP-encoded text in a string and return the results.
+
+@item quoted-printable-encode-region
+@findex quoted-printable-encode-region
+QP-encode all the encodable characters in the specified region. The third
+optional parameter @var{fold} specifies whether to fold long lines.
+(Long here means 72.)
+
+@item quoted-printable-encode-string
+@findex quoted-printable-encode-string
+QP-encode all the encodable characters in a string and return the
+results.
+
+@end table
+
+
+@node base64
+@section base64
+
+Base64 is an encoding that encodes three bytes into four characters,
+thereby increasing the size by about 33%. The alphabet used for
+encoding is very resistant to mangling during transit.
+
+The following functions are defined by this library:
+
+@table @code
+@item base64-encode-region
+@findex base64-encode-region
+base64 encode the selected region. Return the length of the encoded
+text. Optional third argument @var{no-line-break} means do not break
+long lines into shorter lines.
+
+@item base64-encode-string
+@findex base64-encode-string
+base64 encode a string and return the result.
+
+@item base64-decode-region
+@findex base64-decode-region
+base64 decode the selected region. Return the length of the decoded
+text. If the region can't be decoded, return @code{nil} and don't
+modify the buffer.
+
+@item base64-decode-string
+@findex base64-decode-string
+base64 decode a string and return the result. If the string can't be
+decoded, @code{nil} is returned.
+
+@end table
+
+
+@node mailcap
+@section mailcap
+
+The @file{~/.mailcap} file is parsed by most @sc{mime}-aware message
+handlers and describes how elements are supposed to be displayed.
+Here's an example file:
+
+@example
+image/*; xv -8 %s
+audio/x-pn-realaudio; rvplayer %s
+@end example
+
+This says that all image files should be displayed with @samp{xv}, and
+that realaudio files should be played by @samp{rvplayer}.
+
+The @code{mailcap} library parses this file, and provides functions for
+matching types.
+
+@table @code
+@item mailcap-mime-data
+@vindex mailcap-mime-data
+This variable is an alist of alists containing backup viewing rules.
+
+@end table
+
+Interface functions:
+
+@table @code
+@item mailcap-parse-mailcaps
+@findex mailcap-parse-mailcaps
+Parse the @code{~/.mailcap} file.
+
+@item mailcap-mime-info
+Takes a @sc{mime} type as its argument and returns the matching viewer.
+
+@end table
+
+
+
+
+@node Decoding and Viewing
+@chapter Decoding and Viewing
+
+This chapter deals with decoding and viewing @sc{mime} messages on a
+higher level.
+
+The main idea is to first analyze a @sc{mime} article, and then allow
+other programs to do things based on the list of @dfn{handles} that are
+returned as a result of this analyzation.
+
+@menu
+* Dissection:: Analyzing a @sc{mime} message.
+* Handles:: Handle manipulations.
+* Display:: Displaying handles.
+@end menu
+
+
+@node Dissection
+@section Dissection
+
+The @code{mm-dissect-buffer} is the function responsible for dissecting
+a @sc{mime} article. If given a multipart message, it will recursively
+descend the message, following the structure, and return a tree of
+@sc{mime} handles that describes the structure of the message.
+
+
+@node Handles
+@section Handles
+
+A @sc{mime} handle is a list that fully describes a @sc{mime}
+component.
+
+The following macros can be used to access elements in a handle:
+
+@table @code
+@item mm-handle-buffer
+@findex mm-handle-buffer
+Return the buffer that holds the contents of the undecoded @sc{mime}
+part.
+
+@item mm-handle-type
+@findex mm-handle-type
+Return the parsed @code{Content-Type} of the part.
+
+@item mm-handle-encoding
+@findex mm-handle-encoding
+Return the @code{Content-Transfer-Encoding} of the part.
+
+@item mm-handle-undisplayer
+@findex mm-handle-undisplayer
+Return the object that can be used to remove the displayed part (if it
+has been displayed).
+
+@item mm-handle-set-undisplayer
+@findex mm-handle-set-undisplayer
+Set the undisplayer object.
+
+@item mm-handle-disposition
+@findex mm-handle-disposition
+Return the parsed @code{Content-Disposition} of the part.
+
+@item mm-handle-disposition
+@findex mm-handle-disposition
+Return the description of the part.
+
+@item mm-get-content-id
+Returns the handle(s) referred to by @code{Content-ID}.
+
+@end table
+
+
+@node Display
+@section Display
+
+Functions for displaying, removing and saving.
+
+@table @code
+@item mm-display-part
+@findex mm-display-part
+Display the part.
+
+@item mm-remove-part
+@findex mm-remove-part
+Remove the part (if it has been displayed).
+
+@item mm-inlinable-p
+@findex mm-inlinable-p
+Say whether a @sc{mime} type can be displayed inline.
+
+@item mm-automatic-display-p
+@findex mm-automatic-display-p
+Say whether a @sc{mime} type should be displayed automatically.
+
+@item mm-destroy-part
+@findex mm-destroy-part
+Free all resources occupied by a part.
+
+@item mm-save-part
+@findex mm-save-part
+Offer to save the part in a file.
+
+@item mm-pipe-part
+@findex mm-pipe-part
+Offer to pipe the part to some process.
+
+@item mm-interactively-view-part
+@findex mm-interactively-view-part
+Prompt for a mailcap method to use to view the part.
+
+@end table
+
+
+
+@node Index
+@chapter Index
+@printindex cp
+
+@summarycontents
+@contents
+@bye
+
+@c End:
\input texinfo @c -*-texinfo-*-
@setfilename gnus
-@settitle Pterodactyl Gnus 0.26 Manual
+@settitle Pterodactyl Gnus 0.30 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
\thispagestyle{empty}
-Copyright \copyright{} 1995,96,97 Free Software Foundation, Inc.
+Copyright \copyright{} 1995,96,97,98 Free Software Foundation, Inc.
Permission is granted to make and distribute verbatim copies of
this manual provided the copyright notice and this permission notice
@tex
@titlepage
-@title Pterodactyl Gnus 0.26 Manual
+@title Pterodactyl Gnus 0.30 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.26.
+This manual corresponds to Pterodactyl Gnus 0.30.
@end ifinfo
of the characters, and it also makes it possible to embed pictures and
other naughty stuff in innocent-looking articles.
-@vindex gnus-show-mime
-@vindex gnus-show-mime-method
-@vindex gnus-strict-mime
-@findex metamail-buffer
-Gnus handles @sc{mime} by pushing the articles through
-@code{gnus-show-mime-method}, which is @code{metamail-buffer} by
-default. This function calls the external @code{metamail} program to
-actually do the work. One common problem with this program is that is
-thinks that it can't display 8-bit things in the Emacs buffer. To tell
-it the truth, put something like the following in your
-@file{.bash_profile} file. (You do use @code{bash}, don't you?)
+@vindex gnus-display-mime-function
+@findex gnus-display-mime
+Gnus pushes @sc{mime} articles through @code{gnus-display-mime-function}
+to display the @sc{mime} parts. This is @code{gnus-display-mime} by
+default, which creates a bundle of clickable buttons that can be used to
+display, save and manipulate the @sc{mime} objects.
-@example
-export MM_CHARSET="iso-8859-1"
-@end example
+The following commands are available when you have placed point over a
+@sc{mime} button:
-For more information on @code{metamail}, see its manual page.
+@table @kbd
+@findex gnus-article-press-button
+@item RET (Article)
+@itemx BUTTON-2 (Article)
+Toggle displaying of the @sc{mime} object
+(@code{gnus-article-press-button}).
+
+@findex gnus-mime-view-part
+@item M-RET (Article)
+@itemx v (Article)
+Prompt for a method, and then view the @sc{mime} object using this
+method (@code{gnus-mime-view-part}).
+
+@findex gnus-mime-save-part
+@item o (Article)
+Prompt for a file name, and then save the @sc{mime} object
+(@code{gnus-mime-save-part}).
+
+@findex gnus-mime-copy-part
+@item c (Article)
+Copy the @sc{mime} object to a fresh buffer and display this buffer
+(@code{gnus-mime-copy-part}).
+
+@findex gnus-mime-pipe-part
+@item | (Article)
+Output the @sc{mime} object to a process (@code{gnus-mime-pipe-part}).
+@end table
-Set @code{gnus-show-mime} to @code{t} if you want to use
-@sc{mime} all the time. However, if @code{gnus-strict-mime} is
-non-@code{nil}, the @sc{mime} method will only be used if there are
-@sc{mime} headers in the article. If you have @code{gnus-show-mime}
-set, then you'll see some unfortunate display glitches in the article
-buffer. These can't be avoided.
+Gnus will display some @sc{mime} objects automatically. The way Gnus
+determines which parts to do this with is described in the Emacs MIME
+manual.
-It might be best to just use the toggling functions from the summary
-buffer to avoid getting nasty surprises. (For instance, you enter the
+It might be best to just use the toggling functions from the article
+buffer to avoid getting nasty surprises. (For instance, you enter the
group @samp{alt.sing-a-long} and, before you know it, @sc{mime} has
decoded the sound file in the article and some horrible sing-a-long song
-comes screaming out your speakers, and you can't find the volume
-button, because there isn't one, and people are starting to look at you,
-and you try to stop the program, but you can't, and you can't find the
-program to control the volume, and everybody else in the room suddenly
-decides to look at you disdainfully, and you'll feel rather stupid.)
+comes screaming out your speakers, and you can't find the volume button,
+because there isn't one, and people are starting to look at you, and you
+try to stop the program, but you can't, and you can't find the program
+to control the volume, and everybody else in the room suddenly decides
+to look at you disdainfully, and you'll feel rather stupid.)
Any similarity to real events and people is purely coincidental. Ahem.
(This is the default.) If @code{nil}, each group will have its own
article buffer.
+@vindex gnus-article-decode-hook
+@item gnus-article-decode-hook
+@cindex MIME
+Hook used to decode @sc{mime} articles. The default value is
+@code{(article-decode-charset article-decode-encoded-words)}
+
@vindex gnus-article-prepare-hook
@item gnus-article-prepare-hook
This hook is called right after the article has been inserted into the
@vindex nnmail-split-hook
@item nnmail-split-hook
-@findex article-decode-rfc1522
+@findex article-decode-encoded-words
@findex RFC1522 decoding
+@findex RFC2047 decoding
Hook run in the buffer where the mail headers of each message is kept
just before the splitting based on these headers is done. The hook is
free to modify the buffer contents in any way it sees fit---the buffer
is discarded after the splitting has been done, and no changes performed
-in the buffer will show up in any files. @code{gnus-article-decode-rfc1522}
-is one likely function to add to this hook.
+in the buffer will show up in any files.
+@code{gnus-article-decode-encoded-words} is one likely function to add
+to this hook.
@vindex nnmail-pre-get-new-mail-hook
@vindex nnmail-post-get-new-mail-hook
\input texinfo @c -*-texinfo-*-
@setfilename message
-@settitle Pterodactyl Message 0.26 Manual
+@settitle Pterodactyl Message 0.30 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
This file documents Message, the Emacs message composition mode.
-Copyright (C) 1996 Free Software Foundation, Inc.
+Copyright (C) 1996,97,98 Free Software Foundation, Inc.
Permission is granted to make and distribute verbatim copies of
this manual provided the copyright notice and this permission notice
@tex
@titlepage
-@title Pterodactyl Message 0.26 Manual
+@title Pterodactyl Message 0.30 Manual
@author by Lars Magne Ingebrigtsen
@page
* Key Index:: List of Message mode keys.
@end menu
-This manual corresponds to Pterodactyl Message 0.26. Message is
+This manual corresponds to Pterodactyl Message 0.30. Message is
distributed with the Gnus distribution bearing the same version number
as this manual.
projects / elisp / gnus.git- / commitdiff