+++ /dev/null
-;;; base64.el,v --- Base64 encoding functions
-;; Author: Kyle E. Jones
-;; Created: 1997/03/12 14:37:09
-;; Version: 1.6
-;; Keywords: extensions
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Copyright (C) 1997 Kyle E. Jones
-;;;
-;;; This file is not part of GNU Emacs, but the same permissions apply.
-;;;
-;;; GNU Emacs is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2, or (at your option)
-;;; any later version.
-;;;
-;;; GNU Emacs is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Emacs; see the file COPYING. If not, write to the
-;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;;; Boston, MA 02111-1307, USA.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; For non-MULE
-(if (not (fboundp 'char-int))
- (fset 'char-int 'identity))
-
-(defvar base64-alphabet
- "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
-
-(defvar base64-decoder-program nil
- "*Non-nil value should be a string that names a MIME base64 decoder.
-The program should expect to read base64 data on its standard
-input and write the converted data to its standard output.")
-
-(defvar base64-decoder-switches nil
- "*List of command line flags passed to the command named by
-base64-decoder-program.")
-
-(defvar base64-encoder-program nil
- "*Non-nil value should be a string that names a MIME base64 encoder.
-The program should expect arbitrary data on its standard
-input and write base64 data to its standard output.")
-
-(defvar base64-encoder-switches nil
- "*List of command line flags passed to the command named by
-base64-encoder-program.")
-
-(defconst base64-alphabet-decoding-alist
- '(
- ( ?A . 00) ( ?B . 01) ( ?C . 02) ( ?D . 03) ( ?E . 04) ( ?F . 05)
- ( ?G . 06) ( ?H . 07) ( ?I . 08) ( ?J . 09) ( ?K . 10) ( ?L . 11)
- ( ?M . 12) ( ?N . 13) ( ?O . 14) ( ?P . 15) ( ?Q . 16) ( ?R . 17)
- ( ?S . 18) ( ?T . 19) ( ?U . 20) ( ?V . 21) ( ?W . 22) ( ?X . 23)
- ( ?Y . 24) ( ?Z . 25) ( ?a . 26) ( ?b . 27) ( ?c . 28) ( ?d . 29)
- ( ?e . 30) ( ?f . 31) ( ?g . 32) ( ?h . 33) ( ?i . 34) ( ?j . 35)
- ( ?k . 36) ( ?l . 37) ( ?m . 38) ( ?n . 39) ( ?o . 40) ( ?p . 41)
- ( ?q . 42) ( ?r . 43) ( ?s . 44) ( ?t . 45) ( ?u . 46) ( ?v . 47)
- ( ?w . 48) ( ?x . 49) ( ?y . 50) ( ?z . 51) ( ?0 . 52) ( ?1 . 53)
- ( ?2 . 54) ( ?3 . 55) ( ?4 . 56) ( ?5 . 57) ( ?6 . 58) ( ?7 . 59)
- ( ?8 . 60) ( ?9 . 61) ( ?+ . 62) ( ?/ . 63)
- ))
-
-(defvar base64-alphabet-decoding-vector
- (let ((v (make-vector 123 nil))
- (p base64-alphabet-decoding-alist))
- (while p
- (aset v (car (car p)) (cdr (car p)))
- (setq p (cdr p)))
- v))
-
-(defun base64-run-command-on-region (start end output-buffer command
- &rest arg-list)
- (let ((tempfile nil) status errstring default-process-coding-system)
- (unwind-protect
- (progn
- (setq tempfile (make-temp-name "base64"))
- (setq status
- (apply 'call-process-region
- start end command nil
- (list output-buffer tempfile)
- nil arg-list))
- (cond ((equal status 0) t)
- ((zerop (save-excursion
- (set-buffer (find-file-noselect tempfile))
- (buffer-size)))
- t)
- (t (save-excursion
- (set-buffer (find-file-noselect tempfile))
- (setq errstring (buffer-string))
- (kill-buffer nil)
- (cons status errstring)))))
- (condition-case ()
- (delete-file tempfile)
- (error nil)))))
-
-(defun base64-insert-char (char &optional count ignored buffer)
- (condition-case nil
- (progn
- (insert-char char count ignored buffer)
- (fset 'base64-insert-char 'insert-char))
- (wrong-number-of-arguments
- (fset 'base64-insert-char 'base64-xemacs-insert-char)
- (base64-insert-char char count ignored buffer))))
-
-(defun base64-xemacs-insert-char (char &optional count ignored buffer)
- (if (or (null buffer) (eq buffer (current-buffer)))
- (insert-char char count)
- (save-excursion
- (set-buffer buffer)
- (insert-char char count))))
-
-(defun base64-decode-region (start end)
- (interactive "r")
- ;;(message "Decoding base64...")
- (let ((work-buffer nil)
- (done nil)
- (counter 0)
- (bits 0)
- (lim 0) inputpos
- (non-data-chars (concat "^=" base64-alphabet)))
- (unwind-protect
- (save-excursion
- (setq work-buffer (generate-new-buffer " *base64-work*"))
- (buffer-disable-undo work-buffer)
- (if base64-decoder-program
- (let* ((binary-process-output t) ; any text already has CRLFs
- (status (apply 'base64-run-command-on-region
- start end work-buffer
- base64-decoder-program
- base64-decoder-switches)))
- (if (not (eq status t))
- (error "%s" (cdr status))))
- (goto-char start)
- (skip-chars-forward non-data-chars end)
- (while (not done)
- (setq inputpos (point))
- (cond
- ((> (skip-chars-forward base64-alphabet end) 0)
- (setq lim (point))
- (while (< inputpos lim)
- (setq bits (+ bits
- (aref base64-alphabet-decoding-vector
- (char-int (char-after inputpos)))))
- (setq counter (1+ counter)
- inputpos (1+ inputpos))
- (cond ((= counter 4)
- (base64-insert-char (lsh bits -16) 1 nil work-buffer)
- (base64-insert-char (logand (lsh bits -8) 255) 1 nil
- work-buffer)
- (base64-insert-char (logand bits 255) 1 nil
- work-buffer)
- (setq bits 0 counter 0))
- (t (setq bits (lsh bits 6)))))))
- (cond
- ((= (point) end)
- (if (not (zerop counter))
- (error "at least %d bits missing at end of base64 encoding"
- (* (- 4 counter) 6)))
- (setq done t))
- ((eq (char-after (point)) ?=)
- (setq done t)
- (cond ((= counter 1)
- (error "at least 2 bits missing at end of base64 encoding"))
- ((= counter 2)
- (base64-insert-char (lsh bits -10) 1 nil work-buffer))
- ((= counter 3)
- (base64-insert-char (lsh bits -16) 1 nil work-buffer)
- (base64-insert-char (logand (lsh bits -8) 255)
- 1 nil work-buffer))
- ((= counter 0) t)))
- (t (skip-chars-forward non-data-chars end)))))
- (or (markerp end) (setq end (set-marker (make-marker) end)))
- (goto-char start)
- (insert-buffer-substring work-buffer)
- (delete-region (point) end))
- (and work-buffer (kill-buffer work-buffer))))
- ;;(message "Decoding base64... done")
- )
-
-(defun base64-encode-region (start end &optional no-line-break)
- (interactive "r")
- (message "Encoding base64...")
- (let ((work-buffer nil)
- (counter 0)
- (cols 0)
- (bits 0)
- (alphabet base64-alphabet)
- inputpos)
- (unwind-protect
- (save-excursion
- (setq work-buffer (generate-new-buffer " *base64-work*"))
- (buffer-disable-undo work-buffer)
- (if base64-encoder-program
- (let ((status (apply 'base64-run-command-on-region
- start end work-buffer
- base64-encoder-program
- base64-encoder-switches)))
- (if (not (eq status t))
- (error "%s" (cdr status))))
- (setq inputpos start)
- (while (< inputpos end)
- (setq bits (+ bits (char-int (char-after inputpos))))
- (setq counter (1+ counter))
- (cond ((= counter 3)
- (base64-insert-char (aref alphabet (lsh bits -18)) 1 nil
- work-buffer)
- (base64-insert-char
- (aref alphabet (logand (lsh bits -12) 63))
- 1 nil work-buffer)
- (base64-insert-char
- (aref alphabet (logand (lsh bits -6) 63))
- 1 nil work-buffer)
- (base64-insert-char
- (aref alphabet (logand bits 63))
- 1 nil work-buffer)
- (setq cols (+ cols 4))
- (cond ((and (= cols 72)
- (not no-line-break))
- (base64-insert-char ?\n 1 nil work-buffer)
- (setq cols 0)))
- (setq bits 0 counter 0))
- (t (setq bits (lsh bits 8))))
- (setq inputpos (1+ inputpos)))
- ;; write out any remaining bits with appropriate padding
- (if (= counter 0)
- nil
- (setq bits (lsh bits (- 16 (* 8 counter))))
- (base64-insert-char (aref alphabet (lsh bits -18)) 1 nil
- work-buffer)
- (base64-insert-char (aref alphabet (logand (lsh bits -12) 63))
- 1 nil work-buffer)
- (if (= counter 1)
- (base64-insert-char ?= 2 nil work-buffer)
- (base64-insert-char (aref alphabet (logand (lsh bits -6) 63))
- 1 nil work-buffer)
- (base64-insert-char ?= 1 nil work-buffer)))
- (if (and (> cols 0)
- (not no-line-break))
- (base64-insert-char ?\n 1 nil work-buffer)))
- (or (markerp end) (setq end (set-marker (make-marker) end)))
- (goto-char start)
- (insert-buffer-substring work-buffer)
- (delete-region (point) end))
- (and work-buffer (kill-buffer work-buffer))))
- (message "Encoding base64... done"))
-
-(defun base64-encode (string)
- (save-excursion
- (set-buffer (get-buffer-create " *base64-encode*"))
- (erase-buffer)
- (insert string)
- (base64-encode-region (point-min) (point-max))
- (skip-chars-backward " \t\r\n")
- (delete-region (point-max) (point))
- (prog1
- (buffer-string)
- (kill-buffer (current-buffer)))))
-
-(defun base64-decode (string)
- (save-excursion
- (set-buffer (get-buffer-create " *base64-decode*"))
- (erase-buffer)
- (insert string)
- (base64-decode-region (point-min) (point-max))
- (goto-char (point-max))
- (skip-chars-backward " \t\r\n")
- (delete-region (point-max) (point))
- (prog1
- (buffer-string)
- (kill-buffer (current-buffer)))))
-
-(fset 'base64-decode-string 'base64-decode)
-
-(provide 'base64)
+++ /dev/null
-;;; date.el --- Date and time handling functions
-;; Copyright (C) 1998 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu Umeda <umerin@mse.kyutech.ac.jp>
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'timezone)
-
-(defun parse-time-string (date)
- "Convert DATE into time."
- (decode-time
- (condition-case ()
- (let* ((d1 (timezone-parse-date date))
- (t1 (timezone-parse-time (aref d1 3))))
- (apply 'encode-time
- (mapcar (lambda (el)
- (and el (string-to-number el)))
- (list
- (aref t1 2) (aref t1 1) (aref t1 0)
- (aref d1 2) (aref d1 1) (aref d1 0)
- (number-to-string
- (* 60 (timezone-zone-to-minute (aref d1 4))))))))
- ;; If we get an error, then we just return a 0 time.
- (error (list 0 0)))))
-
-(defun date-to-time (date)
- "Convert DATE into time."
- (apply 'encode-time (parse-time-string date)))
-
-(defun time-less-p (t1 t2)
- "Say whether time T1 is less than time T2."
- (or (< (car t1) (car t2))
- (and (= (car t1) (car t2))
- (< (nth 1 t1) (nth 1 t2)))))
-
-(defun days-to-time (days)
- "Convert DAYS into time."
- (let* ((seconds (* 1.0 days 60 60 24))
- (rest (expt 2 16))
- (ms (condition-case nil (floor (/ seconds rest))
- (range-error (expt 2 16)))))
- (list ms (condition-case nil (round (- seconds (* ms rest)))
- (range-error (expt 2 16))))))
-
-(defun time-since (time)
- "Return the time since TIME, which is either an internal time or a date."
- (when (stringp time)
- ;; Convert date strings to internal time.
- (setq time (date-to-time time)))
- (let* ((current (current-time))
- (rest (when (< (nth 1 current) (nth 1 time))
- (expt 2 16))))
- (list (- (+ (car current) (if rest -1 0)) (car time))
- (- (+ (or rest 0) (nth 1 current)) (nth 1 time)))))
-
-(defun subtract-time (t1 t2)
- "Subtract two internal times."
- (let ((borrow (< (cadr t1) (cadr t2))))
- (list (- (car t1) (car t2) (if borrow 1 0))
- (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
-
-(defun date-to-day (date)
- "Return the number of days between year 1 and DATE."
- (time-to-day (date-to-time date)))
-
-(defun days-between (date1 date2)
- "Return the number of days between DATE1 and DATE2."
- (- (date-to-day date1) (date-to-day date2)))
-
-(defun date-leap-year-p (year)
- "Return t if YEAR is a leap year."
- (or (and (zerop (% year 4))
- (not (zerop (% year 100))))
- (zerop (% year 400))))
-
-(defun time-to-day-in-year (time)
- "Return the day number within the year of the date month/day/year."
- (let* ((tim (decode-time time))
- (month (nth 4 tim))
- (day (nth 3 tim))
- (year (nth 5 tim))
- (day-of-year (+ day (* 31 (1- month)))))
- (when (> month 2)
- (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
- (when (date-leap-year-p year)
- (setq day-of-year (1+ day-of-year))))
- day-of-year))
-
-(defun time-to-day (time)
- "The number of days between the Gregorian date 0001-12-31bce and TIME.
-The Gregorian date Sunday, December 31, 1bce is imaginary."
- (let* ((tim (decode-time time))
- (month (nth 4 tim))
- (day (nth 3 tim))
- (year (nth 5 tim)))
- (+ (time-to-day-in-year time) ; Days this year
- (* 365 (1- year)) ; + Days in prior years
- (/ (1- year) 4) ; + Julian leap years
- (- (/ (1- year) 100)) ; - century years
- (/ (1- year) 400)))) ; + Gregorian leap years
-
-(provide 'date)
-
-;;; date.el ends here
+++ /dev/null
-;;; drums.el --- Functions for parsing RFC822bis headers
-;; Copyright (C) 1998 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; DRUMS is an IETF Working Group that works (or worked) on the
-;; successor to RFC822, "Standard For The Format Of Arpa Internet Text
-;; Messages". This library is based on
-;; draft-ietf-drums-msg-fmt-05.txt, released on 1998-08-05.
-
-;;; Code:
-
-(require 'time-date)
-(require 'mm-util)
-
-(defvar drums-no-ws-ctl-token "\001-\010\013\014\016-\037\177"
- "US-ASCII control characters excluding CR, LF and white space.")
-(defvar drums-text-token "\001-\011\013\014\016-\177"
- "US-ASCII characters exlcuding CR and LF.")
-(defvar drums-specials-token "()<>[]:;@\\,.\""
- "Special characters.")
-(defvar drums-quote-token "\\"
- "Quote character.")
-(defvar drums-wsp-token " \t"
- "White space.")
-(defvar drums-fws-regexp
- (concat "[" drums-wsp-token "]*\n[" drums-wsp-token "]+")
- "Folding white space.")
-(defvar drums-atext-token "-^a-zA-Z0-9!#$%&'*+/=?_`{|}~"
- "Textual token.")
-(defvar drums-dot-atext-token "-^a-zA-Z0-9!#$%&'*+/=?_`{|}~."
- "Textual token including full stop.")
-(defvar drums-qtext-token
- (concat drums-no-ws-ctl-token "\041\043-\133\135-\177")
- "Non-white-space control characaters, plus the rest of ASCII excluding backslash and doublequote.")
-(defvar drums-tspecials "][()<>@,;:\\\"/?="
- "Tspecials.")
-
-(defvar drums-syntax-table
- (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
- (modify-syntax-entry ?\\ "/" table)
- (modify-syntax-entry ?< "(" table)
- (modify-syntax-entry ?> ")" table)
- (modify-syntax-entry ?@ "w" table)
- (modify-syntax-entry ?/ "w" table)
- (modify-syntax-entry ?= " " table)
- (modify-syntax-entry ?* " " table)
- (modify-syntax-entry ?\; " " table)
- (modify-syntax-entry ?\' " " table)
- table))
-
-(defun drums-token-to-list (token)
- "Translate TOKEN into a list of characters."
- (let ((i 0)
- b e c out range)
- (while (< i (length token))
- (setq c (mm-char-int (aref token i)))
- (incf i)
- (cond
- ((eq c (mm-char-int ?-))
- (if b
- (setq range t)
- (push c out)))
- (range
- (while (<= b c)
- (push (mm-make-char 'ascii b) out)
- (incf b))
- (setq range nil))
- ((= i (length token))
- (push (mm-make-char 'ascii c) out))
- (t
- (setq b c))))
- (nreverse out)))
-
-(defsubst drums-init (string)
- (set-syntax-table drums-syntax-table)
- (insert string)
- (drums-unfold-fws)
- (goto-char (point-min)))
-
-(defun drums-remove-comments (string)
- "Remove comments from STRING."
- (with-temp-buffer
- (let (c)
- (drums-init string)
- (while (not (eobp))
- (setq c (following-char))
- (cond
- ((eq c ?\")
- (forward-sexp 1))
- ((eq c ?\()
- (delete-region (point) (progn (forward-sexp 1) (point))))
- (t
- (forward-char 1))))
- (buffer-string))))
-
-(defun drums-remove-whitespace (string)
- "Remove comments from STRING."
- (with-temp-buffer
- (drums-init string)
- (let (c)
- (while (not (eobp))
- (setq c (following-char))
- (cond
- ((eq c ?\")
- (forward-sexp 1))
- ((eq c ?\()
- (forward-sexp 1))
- ((memq c '(? ?\t ?\n))
- (delete-char 1))
- (t
- (forward-char 1))))
- (buffer-string))))
-
-(defun drums-get-comment (string)
- "Return the first comment in STRING."
- (with-temp-buffer
- (drums-init string)
- (let (result c)
- (while (not (eobp))
- (setq c (following-char))
- (cond
- ((eq c ?\")
- (forward-sexp 1))
- ((eq c ?\()
- (setq result
- (buffer-substring
- (1+ (point))
- (progn (forward-sexp 1) (1- (point))))))
- (t
- (forward-char 1))))
- result)))
-
-(defun drums-parse-address (string)
- "Parse STRING and return a MAILBOX / DISPLAY-NAME pair."
- (with-temp-buffer
- (let (display-name mailbox c display-string)
- (drums-init string)
- (while (not (eobp))
- (setq c (following-char))
- (cond
- ((or (eq c ? )
- (eq c ?\t))
- (forward-char 1))
- ((eq c ?\()
- (forward-sexp 1))
- ((eq c ?\")
- (push (buffer-substring
- (1+ (point)) (progn (forward-sexp 1) (1- (point))))
- display-name))
- ((looking-at (concat "[" drums-atext-token "@" "]"))
- (push (buffer-substring (point) (progn (forward-sexp 1) (point)))
- display-name))
- ((eq c ?<)
- (setq mailbox
- (drums-remove-whitespace
- (drums-remove-comments
- (buffer-substring
- (1+ (point))
- (progn (forward-sexp 1) (1- (point))))))))
- (t (error "Unknown symbol: %c" c))))
- ;; If we found no display-name, then we look for comments.
- (if display-name
- (setq display-string
- (mapconcat 'identity (reverse display-name) " "))
- (setq display-string (drums-get-comment string)))
- (if (not mailbox)
- (when (string-match "@" display-string)
- (cons
- (mapconcat 'identity (nreverse display-name) "")
- (drums-get-comment string)))
- (cons mailbox display-string)))))
-
-(defun drums-parse-addresses (string)
- "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs."
- (with-temp-buffer
- (drums-init string)
- (let ((beg (point))
- pairs c)
- (while (not (eobp))
- (setq c (following-char))
- (cond
- ((memq c '(?\" ?< ?\())
- (forward-sexp 1))
- ((eq c ?,)
- (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 ()
- "Unfold folding white space in the current buffer."
- (goto-char (point-min))
- (while (re-search-forward drums-fws-regexp nil t)
- (replace-match " " t t))
- (goto-char (point-min)))
-
-(defun drums-parse-date (string)
- "Return an Emacs time spec from STRING."
- (apply 'encode-time (parse-time-string string)))
-
-(defun drums-narrow-to-header ()
- "Narrow to the header section in the current buffer."
- (narrow-to-region
- (goto-char (point-min))
- (if (search-forward "\n\n" nil 1)
- (1- (point))
- (point-max)))
- (goto-char (point-min)))
-
-(defun 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
+++ /dev/null
-;;; ietf-drums.el --- Functions for parsing RFC822bis headers
-;; Copyright (C) 1998 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; DRUMS is an IETF Working Group that works (or worked) on the
-;; successor to RFC822, "Standard For The Format Of Arpa Internet Text
-;; Messages". This library is based on
-;; draft-ietf-drums-msg-fmt-05.txt, released on 1998-08-05.
-
-;;; Code:
-
-(require 'time-date)
-(require 'mm-util)
-
-(defvar ietf-drums-no-ws-ctl-token "\001-\010\013\014\016-\037\177"
- "US-ASCII control characters excluding CR, LF and white space.")
-(defvar ietf-drums-text-token "\001-\011\013\014\016-\177"
- "US-ASCII characters exlcuding CR and LF.")
-(defvar ietf-drums-specials-token "()<>[]:;@\\,.\""
- "Special characters.")
-(defvar ietf-drums-quote-token "\\"
- "Quote character.")
-(defvar ietf-drums-wsp-token " \t"
- "White space.")
-(defvar ietf-drums-fws-regexp
- (concat "[" ietf-drums-wsp-token "]*\n[" ietf-drums-wsp-token "]+")
- "Folding white space.")
-(defvar ietf-drums-atext-token "-^a-zA-Z0-9!#$%&'*+/=?_`{|}~"
- "Textual token.")
-(defvar ietf-drums-dot-atext-token "-^a-zA-Z0-9!#$%&'*+/=?_`{|}~."
- "Textual token including full stop.")
-(defvar ietf-drums-qtext-token
- (concat ietf-drums-no-ws-ctl-token "\041\043-\133\135-\177")
- "Non-white-space control characaters, plus the rest of ASCII excluding backslash and doublequote.")
-(defvar ietf-drums-tspecials "][()<>@,;:\\\"/?="
- "Tspecials.")
-
-(defvar ietf-drums-syntax-table
- (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
- (modify-syntax-entry ?\\ "/" table)
- (modify-syntax-entry ?< "(" table)
- (modify-syntax-entry ?> ")" table)
- (modify-syntax-entry ?@ "w" table)
- (modify-syntax-entry ?/ "w" table)
- (modify-syntax-entry ?= " " table)
- (modify-syntax-entry ?* " " table)
- (modify-syntax-entry ?\; " " table)
- (modify-syntax-entry ?\' " " table)
- table))
-
-(defun ietf-drums-token-to-list (token)
- "Translate TOKEN into a list of characters."
- (let ((i 0)
- b e c out range)
- (while (< i (length token))
- (setq c (mm-char-int (aref token i)))
- (incf i)
- (cond
- ((eq c (mm-char-int ?-))
- (if b
- (setq range t)
- (push c out)))
- (range
- (while (<= b c)
- (push (mm-make-char 'ascii b) out)
- (incf b))
- (setq range nil))
- ((= i (length token))
- (push (mm-make-char 'ascii c) out))
- (t
- (setq b c))))
- (nreverse out)))
-
-(defsubst ietf-drums-init (string)
- (set-syntax-table ietf-drums-syntax-table)
- (insert string)
- (ietf-drums-unfold-fws)
- (goto-char (point-min)))
-
-(defun ietf-drums-remove-comments (string)
- "Remove comments from STRING."
- (with-temp-buffer
- (let (c)
- (ietf-drums-init string)
- (while (not (eobp))
- (setq c (char-after))
- (cond
- ((eq c ?\")
- (forward-sexp 1))
- ((eq c ?\()
- (delete-region (point) (progn (forward-sexp 1) (point))))
- (t
- (forward-char 1))))
- (buffer-string))))
-
-(defun ietf-drums-remove-whitespace (string)
- "Remove comments from STRING."
- (with-temp-buffer
- (ietf-drums-init string)
- (let (c)
- (while (not (eobp))
- (setq c (char-after))
- (cond
- ((eq c ?\")
- (forward-sexp 1))
- ((eq c ?\()
- (forward-sexp 1))
- ((memq c '(? ?\t ?\n))
- (delete-char 1))
- (t
- (forward-char 1))))
- (buffer-string))))
-
-(defun ietf-drums-get-comment (string)
- "Return the first comment in STRING."
- (with-temp-buffer
- (ietf-drums-init string)
- (let (result c)
- (while (not (eobp))
- (setq c (char-after))
- (cond
- ((eq c ?\")
- (forward-sexp 1))
- ((eq c ?\()
- (setq result
- (buffer-substring
- (1+ (point))
- (progn (forward-sexp 1) (1- (point))))))
- (t
- (forward-char 1))))
- result)))
-
-(defun ietf-drums-parse-address (string)
- "Parse STRING and return a MAILBOX / DISPLAY-NAME pair."
- (with-temp-buffer
- (let (display-name mailbox c display-string)
- (ietf-drums-init string)
- (while (not (eobp))
- (setq c (char-after))
- (cond
- ((or (eq c ? )
- (eq c ?\t))
- (forward-char 1))
- ((eq c ?\()
- (forward-sexp 1))
- ((eq c ?\")
- (push (buffer-substring
- (1+ (point)) (progn (forward-sexp 1) (1- (point))))
- display-name))
- ((looking-at (concat "[" ietf-drums-atext-token "@" "]"))
- (push (buffer-substring (point) (progn (forward-sexp 1) (point)))
- display-name))
- ((eq c ?<)
- (setq mailbox
- (ietf-drums-remove-whitespace
- (ietf-drums-remove-comments
- (buffer-substring
- (1+ (point))
- (progn (forward-sexp 1) (1- (point))))))))
- (t (error "Unknown symbol: %c" c))))
- ;; If we found no display-name, then we look for comments.
- (if display-name
- (setq display-string
- (mapconcat 'identity (reverse display-name) " "))
- (setq display-string (ietf-drums-get-comment string)))
- (if (not mailbox)
- (when (string-match "@" display-string)
- (cons
- (mapconcat 'identity (nreverse display-name) "")
- (ietf-drums-get-comment string)))
- (cons mailbox display-string)))))
-
-(defun ietf-drums-parse-addresses (string)
- "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs."
- (with-temp-buffer
- (ietf-drums-init string)
- (let ((beg (point))
- pairs c)
- (while (not (eobp))
- (setq c (char-after))
- (cond
- ((memq c '(?\" ?< ?\())
- (forward-sexp 1))
- ((eq c ?,)
- (push (ietf-drums-parse-address (buffer-substring beg (point)))
- pairs)
- (forward-char 1)
- (setq beg (point)))
- (t
- (forward-char 1))))
- (push (ietf-drums-parse-address (buffer-substring beg (point)))
- pairs)
- (nreverse pairs))))
-
-(defun ietf-drums-unfold-fws ()
- "Unfold folding white space in the current buffer."
- (goto-char (point-min))
- (while (re-search-forward ietf-drums-fws-regexp nil t)
- (replace-match " " t t))
- (goto-char (point-min)))
-
-(defun ietf-drums-parse-date (string)
- "Return an Emacs time spec from STRING."
- (apply 'encode-time (parse-time-string string)))
-
-(defun ietf-drums-narrow-to-header ()
- "Narrow to the header section in the current buffer."
- (narrow-to-region
- (goto-char (point-min))
- (if (re-search-forward "^\n" nil 1)
- (1- (point))
- (point-max)))
- (goto-char (point-min)))
-
-(defun ietf-drums-quote-string (string)
- "Quote string if it needs quoting to be displayed in a header."
- (if (string-match (concat "[^" ietf-drums-atext-token "]") string)
- (concat "\"" string "\"")
- string))
-
-(provide 'ietf-drums)
-
-;;; ietf-drums.el ends here
+++ /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 'ietf-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 'ietf-drums-remove-comments)
-(defalias 'mail-header-remove-whitespace 'ietf-drums-remove-whitespace)
-(defalias 'mail-header-get-comment 'ietf-drums-get-comment)
-(defalias 'mail-header-parse-address 'ietf-drums-parse-address)
-(defalias 'mail-header-parse-addresses 'ietf-drums-parse-addresses)
-(defalias 'mail-header-parse-date 'ietf-drums-parse-date)
-(defalias 'mail-narrow-to-head 'ietf-drums-narrow-to-header)
-(defalias 'mail-quote-string 'ietf-drums-quote-string)
-
-(defalias 'mail-header-narrow-to-field 'rfc2047-narrow-to-field)
-(defalias 'mail-encode-encoded-word-region 'rfc2047-encode-region)
-(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
+++ /dev/null
-;;; mailcap.el --- Functions for displaying MIME parts
-;; Copyright (C) 1998 Free Software Foundation, Inc.
-
-;; Author: William M. Perry <wmperry@aventail.com>
-;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news, mail
-
-;; 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:
-
-(eval-and-compile
- (require 'cl))
-(require 'mail-parse)
-
-(defvar mailcap-parse-args-syntax-table
- (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
- (modify-syntax-entry ?' "\"" table)
- (modify-syntax-entry ?` "\"" table)
- (modify-syntax-entry ?{ "(" table)
- (modify-syntax-entry ?} ")" table)
- table)
- "A syntax table for parsing sgml attributes.")
-
-(defvar mailcap-mime-data
- '(("application"
- ("x-x509-ca-cert"
- (viewer . ssl-view-site-cert)
- (test . (fboundp 'ssl-view-site-cert))
- (type . "application/x-x509-ca-cert"))
- ("x-x509-user-cert"
- (viewer . ssl-view-user-cert)
- (test . (fboundp 'ssl-view-user-cert))
- (type . "application/x-x509-user-cert"))
- ("octet-stream"
- (viewer . mailcap-save-binary-file)
- (type ."application/octet-stream"))
- ("dvi"
- (viewer . "open %s")
- (type . "application/dvi")
- (test . (eq (mm-device-type) 'ns)))
- ("dvi"
- (viewer . "xdvi %s")
- (test . (eq (mm-device-type) 'x))
- ("needsx11")
- (type . "application/dvi"))
- ("dvi"
- (viewer . "dvitty %s")
- (test . (not (getenv "DISPLAY")))
- (type . "application/dvi"))
- ("emacs-lisp"
- (viewer . mailcap-maybe-eval)
- (type . "application/emacs-lisp"))
- ("x-tar"
- (viewer . mailcap-save-binary-file)
- (type . "application/x-tar"))
- ("x-latex"
- (viewer . tex-mode)
- (test . (fboundp 'tex-mode))
- (type . "application/x-latex"))
- ("x-tex"
- (viewer . tex-mode)
- (test . (fboundp 'tex-mode))
- (type . "application/x-tex"))
- ("latex"
- (viewer . tex-mode)
- (test . (fboundp 'tex-mode))
- (type . "application/latex"))
- ("tex"
- (viewer . tex-mode)
- (test . (fboundp 'tex-mode))
- (type . "application/tex"))
- ("texinfo"
- (viewer . texinfo-mode)
- (test . (fboundp 'texinfo-mode))
- (type . "application/tex"))
- ("zip"
- (viewer . mailcap-save-binary-file)
- (type . "application/zip")
- ("copiousoutput"))
- ("pdf"
- (viewer . "acroread %s")
- (type . "application/pdf"))
- ("postscript"
- (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))
- ("needsx11"))
- ("postscript"
- (viewer . "ps2ascii %s")
- (type . "application/postscript")
- (test . (not (getenv "DISPLAY")))
- ("copiousoutput")))
- ("audio"
- ("x-mpeg"
- (viewer . "maplay %s")
- (type . "audio/x-mpeg"))
- (".*"
- (viewer . mailcap-save-binary-file)
- (test . (or (featurep 'nas-sound)
- (featurep 'native-sound)))
- (type . "audio/*"))
- (".*"
- (viewer . "showaudio")
- (type . "audio/*")))
- ("message"
- ("rfc-*822"
- (viewer . gnus-article-prepare-display)
- (test . (and (featurep 'gnus)
- (gnus-alive-p)))
- (type . "message/rfc-822"))
- ("rfc-*822"
- (viewer . vm-mode)
- (test . (fboundp 'vm-mode))
- (type . "message/rfc-822"))
- ("rfc-*822"
- (viewer . w3-mode)
- (test . (fboundp 'w3-mode))
- (type . "message/rfc-822"))
- ("rfc-*822"
- (viewer . view-mode)
- (test . (fboundp 'view-mode))
- (type . "message/rfc-822"))
- ("rfc-*822"
- (viewer . fundamental-mode)
- (type . "message/rfc-822")))
- ("image"
- ("x-xwd"
- (viewer . "xwud -in %s")
- (type . "image/x-xwd")
- ("compose" . "xwd -frame > %s")
- (test . (eq (mm-device-type) 'x))
- ("needsx11"))
- ("x11-dump"
- (viewer . "xwud -in %s")
- (type . "image/x-xwd")
- ("compose" . "xwd -frame > %s")
- (test . (eq (mm-device-type) 'x))
- ("needsx11"))
- ("windowdump"
- (viewer . "xwud -in %s")
- (type . "image/x-xwd")
- ("compose" . "xwd -frame > %s")
- (test . (eq (mm-device-type) 'x))
- ("needsx11"))
- (".*"
- (viewer . "aopen %s")
- (type . "image/*")
- (test . (eq (mm-device-type) 'ns)))
- (".*"
- (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"))
- ("plain"
- (viewer . view-mode)
- (test . (fboundp 'view-mode))
- (type . "text/plain"))
- ("plain"
- (viewer . fundamental-mode)
- (type . "text/plain"))
- ("enriched"
- (viewer . enriched-decode-region)
- (test . (fboundp 'enriched-decode))
- (type . "text/enriched"))
- ("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))
- ("needsx11")))
- ("x-world"
- ("x-vrml"
- (viewer . "webspace -remote %s -URL %u")
- (type . "x-world/x-vrml")
- ("description"
- "VRML document")))
- ("archive"
- ("tar"
- (viewer . tar-mode)
- (type . "archive/tar")
- (test . (fboundp 'tar-mode)))))
- "*The mailcap structure is an assoc list of assoc lists.
-1st assoc list is keyed on the major content-type
-2nd assoc list is keyed on the minor content-type (which can be a regexp)
-
-Which looks like:
------------------
- ((\"application\"
- (\"postscript\" . <info>))
- (\"text\"
- (\"plain\" . <info>)))
-
-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\"))
-
-Where viewerinfo specifies how the content-type is viewed. Can be
-a string, in which case it is run through a shell, with
-appropriate parameters, or a symbol, in which case the symbol is
-funcall'd, with the buffer as an argument.
-
-testinfo is a list of strings, or nil. If nil, it means the
-viewer specified is always valid. If it is a list of strings,
-these are used to determine whether a viewer passes the 'test' or
-not.")
-
-(defvar mailcap-download-directory nil
- "*Where downloaded files should go by default.")
-
-(defvar mailcap-temporary-directory (or (getenv "TMPDIR") "/tmp")
- "*Where temporary files go.")
-
-;;;
-;;; Utility functions
-;;;
-
-(defun mailcap-generate-unique-filename (&optional fmt)
- "Generate a unique filename in mailcap-temporary-directory"
- (if (not fmt)
- (let ((base (format "mailcap-tmp.%d" (user-real-uid)))
- (fname "")
- (x 0))
- (setq fname (format "%s%d" base x))
- (while (file-exists-p
- (expand-file-name fname mailcap-temporary-directory))
- (setq x (1+ x)
- fname (concat base (int-to-string x))))
- (expand-file-name fname mailcap-temporary-directory))
- (let ((base (concat "mm" (int-to-string (user-real-uid))))
- (fname "")
- (x 0))
- (setq fname (format fmt (concat base (int-to-string x))))
- (while (file-exists-p
- (expand-file-name fname mailcap-temporary-directory))
- (setq x (1+ x)
- fname (format fmt (concat base (int-to-string x)))))
- (expand-file-name fname mailcap-temporary-directory))))
-
-(defun mailcap-save-binary-file ()
- (goto-char (point-min))
- (unwind-protect
- (let ((file (read-file-name
- "Filename to save as: "
- (or mailcap-download-directory "~/")))
- (require-final-newline nil))
- (write-region (point-min) (point-max) file))
- (kill-buffer (current-buffer))))
-
-(defun mailcap-maybe-eval ()
- "Maybe evaluate a buffer of emacs lisp code"
- (if (yes-or-no-p "This is emacs-lisp code, evaluate it? ")
- (eval-buffer (current-buffer))
- (emacs-lisp-mode)))
-
-;;;
-;;; The mailcap parser
-;;;
-
-(defun mailcap-replace-regexp (regexp to-string)
- ;; Quiet replace-regexp.
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (replace-match to-string t nil)))
-
-(defvar mailcap-parsed-p nil)
-
-(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 (list nil t))
- (when (or (not mailcap-parsed-p)
- force)
- (cond
- (path nil)
- ((getenv "MAILCAPS") (setq path (getenv "MAILCAPS")))
- ((memq system-type '(ms-dos ms-windows windows-nt))
- (setq path (mapconcat 'expand-file-name '("~/mail.cap" "~/etc/mail.cap")
- ";")))
- (t (setq path (mapconcat 'expand-file-name
- '("~/.mailcap"
- "/etc/mailcap:/usr/etc/mailcap"
- "/usr/local/etc/mailcap") ":"))))
- (let ((fnames (reverse
- (split-string
- path (if (memq system-type
- '(ms-dos ms-windows windows-nt))
- ";"
- ":"))))
- fname)
- (while fnames
- (setq fname (car fnames))
- (if (and (file-exists-p fname) (file-readable-p fname)
- (file-regular-p fname))
- (mailcap-parse-mailcap (car fnames)))
- (setq fnames (cdr fnames))))
- (setq mailcap-parsed-p t)))
-
-(defun mailcap-parse-mailcap (fname)
- ;; Parse out the mailcap file specified by FNAME
- (let (major ; The major mime type (image/audio/etc)
- minor ; The minor mime type (gif, basic, etc)
- save-pos ; Misc saved positions used in parsing
- viewer ; How to view this mime type
- info ; Misc info about this mime type
- )
- (with-temp-buffer
- (insert-file-contents fname)
- (set-syntax-table mailcap-parse-args-syntax-table)
- (mailcap-replace-regexp "#.*" "") ; Remove all comments
- (mailcap-replace-regexp "\n+" "\n") ; And blank lines
- (mailcap-replace-regexp "\\\\[ \t\n]+" " ") ; And collapse spaces
- (mailcap-replace-regexp (concat (regexp-quote "\\") "[ \t]*\n") "")
- (goto-char (point-max))
- (skip-chars-backward " \t\n")
- (delete-region (point) (point-max))
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward " \t\n")
- (setq save-pos (point)
- info nil)
- (skip-chars-forward "^/;")
- (downcase-region save-pos (point))
- (setq major (buffer-substring save-pos (point)))
- (skip-chars-forward "/ \t\n")
- (setq save-pos (point))
- (skip-chars-forward "^;")
- (downcase-region save-pos (point))
- (setq minor
- (cond
- ((eq ?* (or (char-after save-pos) 0)) ".*")
- ((= (point) save-pos) ".*")
- (t (buffer-substring save-pos (point)))))
- (skip-chars-forward "; \t\n")
- ;;; Got the major/minor chunks, now for the viewers/etc
- ;;; The first item _must_ be a viewer, according to the
- ;;; RFC for mailcap files (#1343)
- (skip-chars-forward "; \t\n")
- (setq save-pos (point))
- (skip-chars-forward "^;\n")
- (if (eq (or (char-after save-pos) 0) ?')
- (setq viewer (progn
- (narrow-to-region (1+ save-pos) (point))
- (goto-char (point-min))
- (prog1
- (read (current-buffer))
- (goto-char (point-max))
- (widen))))
- (setq viewer (buffer-substring save-pos (point))))
- (setq save-pos (point))
- (end-of-line)
- (setq info (nconc (list (cons 'viewer viewer)
- (cons 'type (concat major "/"
- (if (string= minor ".*")
- "*" minor))))
- (mailcap-parse-mailcap-extras save-pos (point))))
- (mailcap-mailcap-entry-passes-test info)
- (mailcap-add-mailcap-entry major minor info)))))
-
-(defun mailcap-parse-mailcap-extras (st nd)
- ;; Grab all the extra stuff from a mailcap entry
- (let (
- name ; From name=
- value ; its value
- results ; Assoc list of results
- name-pos ; Start of XXXX= position
- val-pos ; Start of value position
- done ; Found end of \'d ;s?
- )
- (save-restriction
- (narrow-to-region st nd)
- (goto-char (point-min))
- (skip-chars-forward " \n\t;")
- (while (not (eobp))
- (setq done nil)
- (skip-chars-forward " \";\n\t")
- (setq name-pos (point))
- (skip-chars-forward "^ \n\t=")
- (downcase-region name-pos (point))
- (setq name (buffer-substring name-pos (point)))
- (skip-chars-forward " \t\n")
- (if (not (eq (or (char-after (point)) 0) ?=)) ; There is no value
- (setq value nil)
- (skip-chars-forward " \t\n=")
- (setq val-pos (point))
- (if (memq (char-after val-pos) '(?\" ?'))
- (progn
- (setq val-pos (1+ val-pos))
- (condition-case nil
- (progn
- (forward-sexp 1)
- (backward-char 1))
- (error (goto-char (point-max)))))
- (while (not done)
- (skip-chars-forward "^;")
- (if (eq (or (char-after (1- (point))) 0) ?\\ )
- (progn
- (subst-char-in-region (1- (point)) (point) ?\\ ? )
- (skip-chars-forward ";"))
- (setq done t))))
- (setq value (buffer-substring val-pos (point))))
- (setq results (cons (cons name value) results)))
- results)))
-
-(defun mailcap-mailcap-entry-passes-test (info)
- ;; Return t iff a mailcap entry passes its test clause or no test
- ;; clause is present.
- (let (status ; Call-process-regions return value
- (test (assq 'test info)) ; The test clause
- )
- (setq status (and test (split-string (cdr test) " ")))
- (if (and (or (assoc "needsterm" info)
- (assoc "needsx11" info))
- (not (getenv "DISPLAY")))
- (setq status nil)
- (cond
- ((and (equal (nth 0 status) "test")
- (equal (nth 1 status) "-n")
- (or (equal (nth 2 status) "$DISPLAY")
- (equal (nth 2 status) "\"$DISPLAY\"")))
- (setq status (if (getenv "DISPLAY") t nil)))
- ((and (equal (nth 0 status) "test")
- (equal (nth 1 status) "-z")
- (or (equal (nth 2 status) "$DISPLAY")
- (equal (nth 2 status) "\"$DISPLAY\"")))
- (setq status (if (getenv "DISPLAY") nil t)))
- (test nil)
- (t nil)))
- (and test (listp test) (setcdr test status))))
-
-;;;
-;;; The action routines.
-;;;
-
-(defun mailcap-possible-viewers (major minor)
- ;; Return a list of possible viewers from MAJOR for minor type MINOR
- (let ((exact '())
- (wildcard '()))
- (while major
- (cond
- ((equal (car (car major)) minor)
- (setq exact (cons (cdr (car major)) exact)))
- ((and minor (string-match (car (car major)) minor))
- (setq wildcard (cons (cdr (car major)) wildcard))))
- (setq major (cdr major)))
- (nconc (nreverse exact) (nreverse wildcard))))
-
-(defun mailcap-unescape-mime-test (test type-info)
- (let (save-pos save-chr subst)
- (cond
- ((symbolp test) test)
- ((and (listp test) (symbolp (car test))) test)
- ((or (stringp test)
- (and (listp test) (stringp (car test))
- (setq test (mapconcat 'identity test " "))))
- (with-temp-buffer
- (insert test)
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward "^%")
- (if (/= (- (point)
- (progn (skip-chars-backward "\\\\")
- (point)))
- 0) ; It is an escaped %
- (progn
- (delete-char 1)
- (skip-chars-forward "%."))
- (setq save-pos (point))
- (skip-chars-forward "%")
- (setq save-chr (char-after (point)))
- (cond
- ((null save-chr) nil)
- ((= save-chr ?t)
- (delete-region save-pos (progn (forward-char 1) (point)))
- (insert (or (cdr (assq 'type type-info)) "\"\"")))
- ((= save-chr ?M)
- (delete-region save-pos (progn (forward-char 1) (point)))
- (insert "\"\""))
- ((= save-chr ?n)
- (delete-region save-pos (progn (forward-char 1) (point)))
- (insert "\"\""))
- ((= save-chr ?F)
- (delete-region save-pos (progn (forward-char 1) (point)))
- (insert "\"\""))
- ((= save-chr ?{)
- (forward-char 1)
- (skip-chars-forward "^}")
- (downcase-region (+ 2 save-pos) (point))
- (setq subst (buffer-substring (+ 2 save-pos) (point)))
- (delete-region save-pos (1+ (point)))
- (insert (or (cdr (assoc subst type-info)) "\"\"")))
- (t nil))))
- (buffer-string)))
- (t (error "Bad value to mailcap-unescape-mime-test. %s" test)))))
-
-(defvar mailcap-viewer-test-cache nil)
-
-(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 (assq 'test viewer-info))
- (test (cdr test-info))
- (otest test)
- (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))
- (cadr cache)
- (setq
- result
- (cond
- ((not test-info) t) ; No test clause
- ((not test) nil) ; Already failed test
- ((eq test t) t) ; Already passed test
- ((and (symbolp test) ; Lisp function as test
- (fboundp test))
- (funcall test type-info))
- ((and (symbolp test) ; Lisp variable as test
- (boundp test))
- (symbol-value test))
- ((and (listp test) ; List to be eval'd
- (symbolp (car test)))
- (eval test))
- (t
- (setq test (mailcap-unescape-mime-test test type-info)
- test (list shell-file-name nil nil nil
- shell-command-switch test)
- status (apply 'call-process test))
- (= 0 status))))
- (push (list otest result) mailcap-viewer-test-cache)
- result)))
-
-(defun mailcap-add-mailcap-entry (major minor info)
- (let ((old-major (assoc major mailcap-mime-data)))
- (if (null old-major) ; New major area
- (setq mailcap-mime-data
- (cons (cons major (list (cons minor info)))
- mailcap-mime-data))
- (let ((cur-minor (assoc minor old-major)))
- (cond
- ((or (null cur-minor) ; New minor area, or
- (assq 'test info)) ; Has a test, insert at beginning
- (setcdr old-major (cons (cons minor info) (cdr old-major))))
- ((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)))))))))
-
-;;;
-;;; The main whabbo
-;;;
-
-(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 (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)
- ((and (not y-lisp) x-wild (not y-wild))
- t)
- ((and (not x-wild) y-wild)
- t)
- (t nil))))
-
-(defun mailcap-mime-info (string &optional request)
- "Get the MIME viewer command for STRING, return nil if none found.
-Expects a complete content-type header line as its argument.
-
-Second argument REQUEST specifies what information to return. If it is
-nil or the empty string, the viewer (second field of the mailcap
-entry) will be returned. If it is a string, then the mailcap field
-corresponding to that string will be returned (print, description,
-whatever). If a number, then all the information for this specific
-viewer is returned. If `all', then all possible viewers for
-this type is returned."
- (let (
- major ; Major encoding (text, etc)
- minor ; Minor encoding (html, etc)
- info ; Other info
- save-pos ; Misc. position during parse
- major-info ; (assoc major mailcap-mime-data)
- minor-info ; (assoc minor major-info)
- test ; current test proc.
- viewers ; Possible viewers
- passed ; Viewers that passed the test
- viewer ; The one and only viewer
- ctl)
- (save-excursion
- (setq ctl (mail-header-parse-content-type (or string "text/plain")))
- (setq major (split-string (car ctl) "/"))
- (setq minor (cadr major)
- major (car major))
- (when (setq major-info (cdr (assoc major mailcap-mime-data)))
- (when (setq viewers (mailcap-possible-viewers major-info minor))
- (setq info (mapcar (lambda (a) (cons (symbol-name (car a))
- (cdr a)))
- (cdr ctl)))
- (while viewers
- (if (mailcap-viewer-passes-test (car viewers) info)
- (setq passed (cons (car viewers) passed)))
- (setq viewers (cdr viewers)))
- (setq passed (sort (nreverse passed) 'mailcap-viewer-lessp))
- (setq viewer (car passed))))
- (when (and (stringp (cdr (assq 'viewer viewer)))
- passed)
- (setq viewer (car passed)))
- (cond
- ((and (null viewer) (not (equal major "default")) request)
- (mailcap-mime-info "default" request))
- ((or (null request) (equal request ""))
- (mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info))
- ((stringp request)
- (if (or (eq request 'test) (eq request 'viewer))
- (mailcap-unescape-mime-test
- (cdr-safe (assoc request viewer)) info)))
- ((eq request 'all)
- passed)
- (t
- ;; MUST make a copy *sigh*, else we modify mailcap-mime-data
- (setq viewer (copy-tree 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)))))
-
-;;;
-;;; Experimental MIME-types parsing
-;;;
-
-(defvar mailcap-mime-extensions
- '(("" . "text/plain")
- (".abs" . "audio/x-mpeg")
- (".aif" . "audio/aiff")
- (".aifc" . "audio/aiff")
- (".aiff" . "audio/aiff")
- (".ano" . "application/x-annotator")
- (".au" . "audio/ulaw")
- (".avi" . "video/x-msvideo")
- (".bcpio" . "application/x-bcpio")
- (".bin" . "application/octet-stream")
- (".cdf" . "application/x-netcdr")
- (".cpio" . "application/x-cpio")
- (".csh" . "application/x-csh")
- (".dvi" . "application/x-dvi")
- (".el" . "application/emacs-lisp")
- (".eps" . "application/postscript")
- (".etx" . "text/x-setext")
- (".exe" . "application/octet-stream")
- (".fax" . "image/x-fax")
- (".gif" . "image/gif")
- (".hdf" . "application/x-hdf")
- (".hqx" . "application/mac-binhex40")
- (".htm" . "text/html")
- (".html" . "text/html")
- (".icon" . "image/x-icon")
- (".ief" . "image/ief")
- (".jpg" . "image/jpeg")
- (".macp" . "image/x-macpaint")
- (".man" . "application/x-troff-man")
- (".me" . "application/x-troff-me")
- (".mif" . "application/mif")
- (".mov" . "video/quicktime")
- (".movie" . "video/x-sgi-movie")
- (".mp2" . "audio/x-mpeg")
- (".mp3" . "audio/x-mpeg")
- (".mp2a" . "audio/x-mpeg2")
- (".mpa" . "audio/x-mpeg")
- (".mpa2" . "audio/x-mpeg2")
- (".mpe" . "video/mpeg")
- (".mpeg" . "video/mpeg")
- (".mpega" . "audio/x-mpeg")
- (".mpegv" . "video/mpeg")
- (".mpg" . "video/mpeg")
- (".mpv" . "video/mpeg")
- (".ms" . "application/x-troff-ms")
- (".nc" . "application/x-netcdf")
- (".nc" . "application/x-netcdf")
- (".oda" . "application/oda")
- (".pbm" . "image/x-portable-bitmap")
- (".pdf" . "application/pdf")
- (".pgm" . "image/portable-graymap")
- (".pict" . "image/pict")
- (".png" . "image/png")
- (".pnm" . "image/x-portable-anymap")
- (".ppm" . "image/portable-pixmap")
- (".ps" . "application/postscript")
- (".qt" . "video/quicktime")
- (".ras" . "image/x-raster")
- (".rgb" . "image/x-rgb")
- (".rtf" . "application/rtf")
- (".rtx" . "text/richtext")
- (".sh" . "application/x-sh")
- (".sit" . "application/x-stuffit")
- (".snd" . "audio/basic")
- (".src" . "application/x-wais-source")
- (".tar" . "archive/tar")
- (".tcl" . "application/x-tcl")
- (".tcl" . "application/x-tcl")
- (".tex" . "application/x-tex")
- (".texi" . "application/texinfo")
- (".tga" . "image/x-targa")
- (".tif" . "image/tiff")
- (".tiff" . "image/tiff")
- (".tr" . "application/x-troff")
- (".troff" . "application/x-troff")
- (".tsv" . "text/tab-separated-values")
- (".txt" . "text/plain")
- (".vbs" . "video/mpeg")
- (".vox" . "audio/basic")
- (".vrml" . "x-world/x-vrml")
- (".wav" . "audio/x-wav")
- (".wrl" . "x-world/x-vrml")
- (".xbm" . "image/xbm")
- (".xpm" . "image/x-pixmap")
- (".xwd" . "image/windowdump")
- (".zip" . "application/zip")
- (".ai" . "application/postscript")
- (".jpe" . "image/jpeg")
- (".jpeg" . "image/jpeg"))
- "*An assoc list of file extensions and the MIME content-types they
-correspond to.")
-
-(defun mailcap-parse-mimetypes (&optional path)
- ;; Parse out all the mimetypes specified in a unix-style path string PATH
- (cond
- (path nil)
- ((getenv "MIMETYPES") (setq path (getenv "MIMETYPES")))
- ((memq system-type '(ms-dos ms-windows windows-nt))
- (setq path (mapconcat 'expand-file-name
- '("~/mime.typ" "~/etc/mime.typ") ";")))
- (t (setq path (mapconcat 'expand-file-name
- '("~/.mime-types"
- "/etc/mime-types:/usr/etc/mime-types"
- "/usr/local/etc/mime-types"
- "/usr/local/www/conf/mime-types") ":"))))
- (let ((fnames (reverse
- (split-string path
- (if (memq system-type
- '(ms-dos ms-windows windows-nt))
- ";" ":"))))
- fname)
- (while fnames
- (setq fname (car fnames))
- (if (and (file-exists-p fname) (file-readable-p fname))
- (mailcap-parse-mimetype-file (car fnames)))
- (setq fnames (cdr fnames)))))
-
-(defun mailcap-parse-mimetype-file (fname)
- ;; Parse out a mime-types file
- (let (type ; The MIME type for this line
- extns ; The extensions for this line
- save-pos ; Misc. saved buffer positions
- )
- (with-temp-buffer
- (insert-file-contents fname)
- (mailcap-replace-regexp "#.*" "")
- (mailcap-replace-regexp "\n+" "\n")
- (mailcap-replace-regexp "[ \t]+$" "")
- (goto-char (point-max))
- (skip-chars-backward " \t\n")
- (delete-region (point) (point-max))
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward " \t\n")
- (setq save-pos (point))
- (skip-chars-forward "^ \t")
- (downcase-region save-pos (point))
- (setq type (buffer-substring save-pos (point)))
- (while (not (eolp))
- (skip-chars-forward " \t")
- (setq save-pos (point))
- (skip-chars-forward "^ \t\n")
- (setq extns (cons (buffer-substring save-pos (point)) extns)))
- (while extns
- (setq mailcap-mime-extensions
- (cons
- (cons (if (= (string-to-char (car extns)) ?.)
- (car extns)
- (concat "." (car extns))) type)
- mailcap-mime-extensions)
- extns (cdr extns)))))))
-
-(defun mailcap-extension-to-mime (extn)
- "Return the MIME content type of the file extensions EXTN."
- (if (and (stringp extn)
- (not (eq (string-to-char extn) ?.)))
- (setq extn (concat "." extn)))
- (cdr (assoc (downcase extn) mailcap-mime-extensions)))
-
-(defvar mailcap-binary-suffixes
- (if (memq system-type '(ms-dos windows-nt))
- '(".exe" ".com" ".bat" ".cmd" ".btm" "")
- '("")))
-
-(defun mailcap-command-p (command)
- "Say whether COMMAND is in the exec path.
-The path of COMMAND will be returned iff COMMAND is a command."
- (let ((path (if (file-name-absolute-p command) '(nil) exec-path))
- file dir)
- (catch 'found
- (while (setq dir (pop path))
- (let ((suffixes mailcap-binary-suffixes))
- (while suffixes
- (when (and (file-executable-p
- (setq file (expand-file-name
- (concat command (pop suffixes))
- dir)))
- (not (file-directory-p file)))
- (throw 'found file))))))))
-
-(provide 'mailcap)
-
-;;; mailcap.el ends here
+++ /dev/null
-;;; mm-decode.el --- Functions for decoding MIME things
-;; Copyright (C) 1998 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; 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)
-
-;;; 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))
-
-(defvar mm-inline-media-tests
- '(("image/jpeg" mm-inline-image
- (and window-system (featurep 'jpeg) (mm-image-fit-p handle)))
- ("image/png" mm-inline-image
- (and window-system (featurep 'png) (mm-image-fit-p handle)))
- ("image/gif" mm-inline-image
- (and window-system (featurep 'gif) (mm-image-fit-p handle)))
- ("image/tiff" mm-inline-image
- (and window-system (featurep 'tiff) (mm-image-fit-p handle)))
- ("image/xbm" mm-inline-image
- (and window-system (fboundp 'device-type)
- (eq (device-type) 'x)))
- ("image/xpm" mm-inline-image
- (and window-system (featurep 'xpm)))
- ("image/bmp" mm-inline-image
- (and window-system (featurep 'bmp)))
- ("text/plain" mm-inline-text t)
- ("text/enriched" mm-inline-text t)
- ("text/richtext" mm-inline-text t)
- ("text/html" mm-inline-text (locate-library "w3"))
- ("message/delivery-status" mm-inline-text t)
- ("audio/wav" mm-inline-audio
- (and (or (featurep 'nas-sound) (featurep 'native-sound))
- (device-sound-enabled-p)))
- ("audio/au" mm-inline-audio
- (and (or (featurep 'nas-sound) (featurep 'native-sound))
- (device-sound-enabled-p))))
- "Alist of media types/test that say whether the media types can be displayed inline.")
-
-(defvar mm-user-display-methods
- '(("image/.*" . inline)
- ("text/.*" . inline)
- ("message/delivery-status" . inline)))
-
-(defvar mm-user-automatic-display
- '("text/plain" "text/enriched" "text/richtext" "text/html"
- "image/.*" "message/delivery-status" "multipart/.*"))
-
-(defvar mm-alternative-precedence
- '("image/jpeg" "image/gif" "text/html" "text/enriched"
- "text/richtext" "text/plain")
- "List that describes the precedence of alternative parts.")
-
-(defvar mm-tmp-directory "/tmp/"
- "Where mm will store its temporary files.")
-
-;;; Internal variables.
-
-(defvar mm-dissection-list nil)
-(defvar mm-last-shell-command "")
-(defvar mm-content-id-alist nil)
-
-;;; 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 cd description id result)
- (save-restriction
- (mail-narrow-to-head)
- (when (and (or no-strict-mime
- (mail-fetch-field "mime-version"))
- (setq ct (mail-fetch-field "content-type")))
- (setq ctl (condition-case () (mail-header-parse-content-type ct)
- (error nil))
- cte (mail-fetch-field "content-transfer-encoding")
- cd (mail-fetch-field "content-disposition")
- description (mail-fetch-field "content-description")
- id (mail-fetch-field "content-id"))))
- (if (not ctl)
- (mm-dissect-singlepart
- '("text/plain") nil no-strict-mime nil description)
- (setq type (split-string (car ctl) "/"))
- (setq subtype (cadr type)
- type (pop type))
- (setq
- result
- (cond
- ((equal type "multipart")
- (cons (car ctl) (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 (condition-case ()
- (mail-header-parse-content-disposition cd)
- (error nil)))
- description))))
- (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 (mm-copy-to-buffer) ctl cte nil cdl description)))
- (push (car res) mm-dissection-list)
- res)))
-
-(defun mm-remove-all-parts ()
- "Remove all MIME handles."
- (interactive)
- (mapcar 'mm-remove-part mm-dissection-list)
- (setq mm-dissection-list nil))
-
-(defun mm-dissect-multipart (ctl)
- (goto-char (point-min))
- (let* ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary)))
- (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$"))
- start parts
- (end (save-excursion
- (goto-char (point-max))
- (if (re-search-backward close-delimiter nil t)
- (match-beginning 0)
- (point-max)))))
- (while (search-forward boundary end t)
- (goto-char (match-beginning 0))
- (when start
- (save-excursion
- (save-restriction
- (narrow-to-region start (point))
- (setq parts (nconc (list (mm-dissect-buffer t)) parts)))))
- (forward-line 2)
- (setq start (point)))
- (when start
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (setq parts (nconc (list (mm-dissect-buffer t)) parts)))))
- (nreverse parts)))
-
-(defun mm-copy-to-buffer ()
- "Copy the contents of the current buffer to a fresh buffer."
- (save-excursion
- (let ((obuf (current-buffer))
- beg)
- (goto-char (point-min))
- (search-forward-regexp "^\n" nil t)
- (setq beg (point))
- (set-buffer (generate-new-buffer " *mm*"))
- (insert-buffer-substring obuf beg)
- (current-buffer))))
-
-(defun mm-inlinable-part-p (type)
- "Say whether TYPE can be displayed inline."
- (eq (mm-user-method type) 'inline))
-
-(defun mm-display-part (handle &optional no-default)
- "Display the MIME part represented by HANDLE.
-Returns nil if the part is removed; inline if displayed inline;
-external if displayed external."
- (save-excursion
- (mailcap-parse-mailcaps)
- (if (mm-handle-displayed-p handle)
- (mm-remove-part 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))
- (when (or user-method
- method
- (not no-default))
- (if (and (not user-method)
- (not method)
- (equal "text" (car (split-string type))))
- (progn
- (mm-insert-inline handle (mm-get-part handle))
- 'inline)
- (mm-display-external
- handle (or user-method method
- 'mailcap-save-binary-file))
- 'external)))))))
-
-(defun mm-display-external (handle method)
- "Display HANDLE using METHOD."
- (mm-with-unibyte-buffer
- (insert-buffer-substring (mm-handle-buffer handle))
- (mm-decode-content-transfer-encoding
- (mm-handle-encoding handle) (car (mm-handle-type handle)))
- (if (functionp method)
- (let ((cur (current-buffer)))
- (if (eq method 'mailcap-save-binary-file)
- (progn
- (set-buffer (generate-new-buffer "*mm*"))
- (setq method nil))
- (let ((win (get-buffer-window cur t)))
- (when win
- (select-window win)))
- (switch-to-buffer (generate-new-buffer "*mm*")))
- (buffer-disable-undo)
- (mm-set-buffer-file-coding-system 'binary)
- (insert-buffer-substring cur)
- (message "Viewing with %s" method)
- (let ((mm (current-buffer)))
- (unwind-protect
- (if method
- (funcall method)
- (mm-save-part handle))
- (mm-handle-set-undisplayer handle mm))))
- (let* ((dir (make-temp-name (expand-file-name "emm." mm-tmp-directory)))
- (filename (mail-content-type-get
- (mm-handle-disposition handle) 'filename))
- (needsterm (assoc "needsterm"
- (mailcap-mime-info
- (car (mm-handle-type handle)) t)))
- process file)
- ;; We create a private sub-directory where we store our files.
- (make-directory dir)
- (set-file-modes dir 448)
- (if filename
- (setq file (expand-file-name (file-name-nondirectory filename)
- dir))
- (setq file (make-temp-name (expand-file-name "mm." dir))))
- (write-region (point-min) (point-max)
- file nil 'nomesg nil 'binary)
- (message "Viewing with %s" method)
- (unwind-protect
- (setq process
- (if needsterm
- (start-process "*display*" nil
- "xterm"
- "-e" shell-file-name "-c"
- (format method
- (mm-quote-arg file)))
- (start-process "*display*" (generate-new-buffer "*mm*")
- shell-file-name
- "-c" (format method
- (mm-quote-arg file)))))
- (mm-handle-set-undisplayer handle (cons file process)))
- (message "Displaying %s..." (format method file))))))
-
-(defun mm-remove-parts (handles)
- "Remove the displayed MIME parts represented by HANDLE."
- (if (and (listp handles)
- (bufferp (car handles)))
- (mm-remove-part handles)
- (let (handle)
- (while (setq handle (pop handles))
- (cond
- ((stringp handle)
- )
- ((and (listp handle)
- (stringp (car handle)))
- (mm-remove-parts (cdr handle)))
- (t
- (mm-remove-part handle)))))))
-
-(defun mm-destroy-parts (handles)
- "Remove the displayed MIME parts represented by HANDLE."
- (if (and (listp handles)
- (bufferp (car handles)))
- (mm-destroy-part handles)
- (let (handle)
- (while (setq handle (pop handles))
- (cond
- ((stringp handle)
- )
- ((and (listp handle)
- (stringp (car handle)))
- (mm-destroy-parts (cdr handle)))
- (t
- (mm-destroy-part handle)))))))
-
-(defun mm-remove-part (handle)
- "Remove the displayed MIME part represented by HANDLE."
- (when (listp handle)
- (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 ()
- (delete-directory (file-name-directory (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 (car (mm-handle-type handle)))
- (function (cadr (assoc type mm-inline-media-tests))))
- (funcall function handle)
- (goto-char (point-min))))
-
-(defun mm-inlinable-p (type)
- "Say whether TYPE can be displayed inline."
- (let ((alist mm-inline-media-tests)
- test)
- (while alist
- (when (equal type (caar alist))
- (setq test (caddar alist)
- alist nil)
- (setq test (eval test)))
- (pop alist))
- test))
-
-(defun mm-user-method (type)
- "Return the user-defined method for TYPE."
- (let ((methods mm-user-display-methods)
- method result)
- (while (setq method (pop methods))
- (when (string-match (car method) type)
- (when (or (not (eq (cdr method) 'inline))
- (mm-inlinable-p type))
- (setq result (cdr method)
- methods nil))))
- result))
-
-(defun mm-automatic-display-p (type)
- "Return the user-defined method for TYPE."
- (let ((methods mm-user-automatic-display)
- method result)
- (while (setq method (pop methods))
- (when (and (string-match method type)
- (mm-inlinable-p type))
- (setq result t
- methods nil)))
- result))
-
-(defun add-mime-display-method (type method)
- "Make parts of TYPE be displayed with METHOD.
-This overrides entries in the mailcap file."
- (push (cons type method) mm-user-display-methods))
-
-(defun mm-destroy-part (handle)
- "Destroy the data structures connected to HANDLE."
- (when (listp handle)
- (mm-remove-part handle)
- (when (buffer-live-p (mm-handle-buffer handle))
- (kill-buffer (mm-handle-buffer handle)))))
-
-(defun mm-handle-displayed-p (handle)
- "Say whether HANDLE is displayed or not."
- (mm-handle-undisplayer handle))
-
-(defun mm-quote-arg (arg)
- "Return a version of ARG that is safe to evaluate in a shell."
- (let ((pos 0) new-pos accum)
- ;; *** bug: we don't handle newline characters properly
- (while (setq new-pos (string-match "[;!`\"$\\& \t{} ]" arg pos))
- (push (substring arg pos new-pos) accum)
- (push "\\" accum)
- (push (list (aref arg new-pos)) accum)
- (setq pos (1+ new-pos)))
- (if (= pos 0)
- arg
- (apply 'concat (nconc (nreverse accum) (list (substring arg pos)))))))
-
-;;;
-;;; 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)
- (car (mm-handle-type handle)))
- (buffer-string)))
-
-(defvar mm-default-directory nil)
-
-(defun mm-save-part (handle)
- "Write HANDLE to a file."
- (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 "")
- (or mm-default-directory default-directory))))
- (setq mm-default-directory (file-name-directory file))
- (mm-with-unibyte-buffer
- (insert-buffer-substring (mm-handle-buffer handle))
- (mm-decode-content-transfer-encoding
- (mm-handle-encoding handle)
- (car (mm-handle-type handle)))
- (when (or (not (file-exists-p file))
- (yes-or-no-p (format "File %s already exists; overwrite? "
- file)))
- (let ((coding-system-for-write
- (if (equal "text" (car (split-string
- (car (mm-handle-type handle)) "/")))
- buffer-file-coding-system
- 'binary)))
- (write-region (point-min) (point-max) file))))))
-
-(defun mm-pipe-part (handle)
- "Pipe HANDLE to a process."
- (let* ((name (mail-content-type-get (mm-handle-type handle) 'name))
- (command
- (read-string "Shell command on MIME part: " mm-last-shell-command)))
- (mm-with-unibyte-buffer
- (insert-buffer-substring (mm-handle-buffer handle))
- (mm-decode-content-transfer-encoding
- (mm-handle-encoding handle)
- (car (mm-handle-type handle)))
- (shell-command-on-region (point-min) (point-max) command nil))))
-
-(defun mm-interactively-view-part (handle)
- "Display HANDLE using METHOD."
- (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 handle)
- (while (setq p (pop prec))
- (setq h handles)
- (while h
- (setq type
- (if (stringp (caar h))
- (caar h)
- (car (mm-handle-type (car h)))))
- (setq handle (car h))
- (when (and (equal p type)
- (mm-automatic-display-p type)
- (or (stringp (caar h))
- (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)))
-
-(defun mm-get-image (handle)
- "Return an image instance based on HANDLE."
- (let ((type (cadr (split-string (car (mm-handle-type handle)) "/"))))
- (mm-with-unibyte-buffer
- (insert-buffer-substring (mm-handle-buffer handle))
- (mm-decode-content-transfer-encoding
- (mm-handle-encoding handle)
- (car (mm-handle-type handle)))
- (make-image-specifier
- (vector (intern type) :data (buffer-string))))))
-
-(defun mm-image-fit-p (handle)
- "Say whether the image in HANDLE will fit the current window."
- (let ((image (make-annotation (mm-get-image handle))))
- (and (< (glyph-width (annotation-glyph image))
- (window-pixel-width))
- (< (glyph-height (annotation-glyph image))
- (window-pixel-height)))))
-
-(provide 'mm-decode)
-
-;; mm-decode.el ends here
+++ /dev/null
-;;; mm-encode.el --- Functions for encoding MIME things
-;; Copyright (C) 1998 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; 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)
-
-(defvar mm-content-transfer-encoding-defaults
- '(("text/.*" quoted-printable)
- (".*" base64))
- "Alist of regexps that match MIME types and their encodings.")
-
-(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"))
-
-(defun mm-insert-multipart-headers ()
- "Insert multipart/mixed headers."
- (let ((boundary "=-=-="))
- (insert "MIME-Version: 1.0\n")
- (insert (format "Content-Type: multipart/mixed; boundary=\"%s\"\n"
- boundary))
- boundary))
-
-(defun mm-default-file-encoding (file)
- "Return a default encoding for FILE."
- (if (not (string-match "\\.[^.]+$" file))
- "application/octet-stream"
- (mailcap-extension-to-mime (match-string 0 file))))
-
-(defun mm-encode-content-transfer-encoding (encoding &optional type)
- (cond
- ((eq encoding 'quoted-printable)
- (quoted-printable-encode-region (point-min) (point-max)))
- ((eq encoding 'base64)
- (when (equal type "text/plain")
- (goto-char (point-min))
- (while (search-forward "\n" nil t)
- (replace-match "\r\n" t t)))
- (condition-case ()
- (base64-encode-region (point-min) (point-max))
- (error nil)))
- ((memq encoding '(7bit 8bit binary))
- )
- ((null encoding)
- )
- ;;((eq encoding 'x-uuencode)
- ;; (condition-case ()
- ;; (uudecode-encode-region (point-min) (point-max))
- ;; (error nil)))
- ((functionp encoding)
- (condition-case ()
- (funcall encoding (point-min) (point-max))
- (error nil)))
- (t
- (message "Unknown encoding %s; defaulting to 8bit" encoding))))
-
-(defun mm-encode-buffer (type)
- "Encode the buffer which contains data of TYPE.
-The encoding used is returned."
- (let* ((mime-type (if (stringp type) type (car type)))
- (encoding
- (or (and (listp type)
- (cadr (assq 'encoding type)))
- (mm-content-transfer-encoding mime-type))))
- (mm-encode-content-transfer-encoding encoding mime-type)
- encoding))
-
-(defun mm-insert-headers (type encoding &optional file)
- "Insert headers for TYPE."
- (insert "Content-Type: " type)
- (when file
- (insert ";\n\tname=\"" (file-name-nondirectory file) "\""))
- (insert "\n")
- (insert (format "Content-Transfer-Encoding: %s\n" encoding))
- (insert "Content-Disposition: inline")
- (when file
- (insert ";\n\tfilename=\"" (file-name-nondirectory file) "\""))
- (insert "\n")
- (insert "\n"))
-
-(defun mm-content-transfer-encoding (type)
- "Return a CTE suitable for TYPE."
- (let ((rules mm-content-transfer-encoding-defaults))
- (catch 'found
- (while rules
- (when (string-match (caar rules) type)
- (throw 'found (cadar rules)))
- (pop rules)))))
-
-(provide 'mm-encode)
-
-;;; mm-encode.el ends here
+++ /dev/null
-;;; mm-util.el --- Utility functions for MIME things
-;; Copyright (C) 1998 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; 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:
-
-(defvar mm-default-coding-system nil
- "The default coding system to use.")
-
-(defvar mm-known-charsets '(iso-8859-1)
- "List of known charsets.")
-
-(defvar mm-mime-mule-charset-alist
- '((us-ascii ascii)
- (iso-8859-1 latin-iso8859-1)
- (iso-8859-2 latin-iso8859-2)
- (iso-8859-3 latin-iso8859-3)
- (iso-8859-4 latin-iso8859-4)
- (iso-8859-5 cyrillic-iso8859-5)
- (koi8-r cyrillic-iso8859-5)
- (iso-8859-6 arabic-iso8859-6)
- (iso-8859-7 greek-iso8859-7)
- (iso-8859-8 hebrew-iso8859-8)
- (iso-8859-9 latin-iso8859-9)
- (iso-2022-jp latin-jisx0201
- japanese-jisx0208-1978 japanese-jisx0208)
- (euc-kr korean-ksc5601)
- (cn-gb-2312 chinese-gb2312)
- (cn-big5 chinese-big5-1 chinese-big5-2)
- (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212)
- (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212
- chinese-cns11643-1 chinese-cns11643-2)
- (iso-2022-int-1 latin-iso8859-1 latin-iso8859-2
- cyrillic-iso8859-5 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212
- chinese-cns11643-1 chinese-cns11643-2
- chinese-cns11643-3 chinese-cns11643-4
- chinese-cns11643-5 chinese-cns11643-6
- chinese-cns11643-7))
- "Alist of MIME-charset/MULE-charsets.")
-
-
-(eval-and-compile
- (mapcar
- (lambda (elem)
- (let ((nfunc (intern (format "mm-%s" (car elem)))))
- (if (fboundp (car elem))
- (fset nfunc (car elem))
- (fset nfunc (cdr elem)))))
- '((decode-coding-string . (lambda (s a) s))
- (encode-coding-string . (lambda (s a) s))
- (encode-coding-region . ignore)
- (coding-system-list . ignore)
- (decode-coding-region . ignore)
- (char-int . identity)
- (device-type . ignore)
- (coding-system-equal . equal)
- (annotationp . ignore)
- (set-buffer-file-coding-system . ignore)
- (make-char
- . (lambda (charset int)
- (int-to-char int)))
- (read-coding-system
- . (lambda (prompt)
- "Prompt the user for a coding system."
- (completing-read
- prompt (mapcar (lambda (s) (list (symbol-name (car s))))
- mm-mime-mule-charset-alist)))))))
-
-(defvar mm-coding-system-list nil)
-(defun mm-get-coding-system-list ()
- "Get the coding system list."
- (or mm-coding-system-list
- (setq mm-coding-system-list (mm-coding-system-list))))
-
-(defvar mm-charset-coding-system-alist
- (let ((rest
- '((gb2312 . cn-gb-2312)
- (iso-2022-jp-2 . iso-2022-7bit-ss2)
- (x-ctext . ctext)))
- (systems (mm-get-coding-system-list))
- dest)
- (while rest
- (let ((pair (car rest)))
- (unless (memq (car pair) systems)
- (setq dest (cons pair dest))))
- (setq rest (cdr rest)))
- dest)
- "Charset/coding system alist.")
-
-;;;Internal variable
-(defvar mm-charset-iso-8859-1-forced nil)
-
-(defun mm-mule-charset-to-mime-charset (charset)
- "Return the MIME charset corresponding to MULE CHARSET."
- (let ((alist mm-mime-mule-charset-alist)
- out)
- (while alist
- (when (memq charset (cdar alist))
- (setq out (caar alist)
- alist nil))
- (pop alist))
- out))
-
-(defun mm-charset-to-coding-system (charset &optional lbt)
- "Return coding-system corresponding to CHARSET.
-CHARSET is a symbol naming a MIME charset.
-If optional argument LBT (`unix', `dos' or `mac') is specified, it is
-used as the line break code type of the coding system."
- (when (stringp charset)
- (setq charset (intern (downcase charset))))
- (if (and mm-charset-iso-8859-1-forced
- (eq charset 'iso-8859-1))
- (setq charset mm-charset-iso-8859-1-forced))
- (setq charset
- (or (cdr (assq charset mm-charset-coding-system-alist))
- charset))
- (when lbt
- (setq charset (intern (format "%s-%s" charset lbt))))
- (cond
- ;; Running in a non-MULE environment.
- ((and (null (mm-get-coding-system-list))
- (memq charset mm-known-charsets))
- charset)
- ;; ascii
- ((eq charset 'us-ascii)
- 'ascii)
- ;; Check to see whether we can handle this charset.
- ((memq charset (mm-get-coding-system-list))
- charset)
- ;; Nope.
- (t
- nil)))
-
-(defun mm-replace-chars-in-string (string from to)
- "Replace characters in STRING from FROM to TO."
- (let ((string (substring string 0)) ;Copy string.
- (len (length string))
- (idx 0))
- ;; Replace all occurrences of FROM with TO.
- (while (< idx len)
- (when (= (aref string idx) from)
- (aset string idx to))
- (setq idx (1+ idx)))
- string))
-
-(defsubst mm-enable-multibyte ()
- "Enable multibyte in the current buffer."
- (when (and (fboundp 'set-buffer-multibyte)
- (default-value 'enable-multibyte-characters))
- (set-buffer-multibyte t)))
-
-(defsubst mm-disable-multibyte ()
- "Disable multibyte in the current buffer."
- (when (fboundp 'set-buffer-multibyte)
- (set-buffer-multibyte nil)))
-
-(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)
- (car (memq charset (find-coding-systems-region
- (point-min) (point-max)))))
- (mm-mule-charset-to-mime-charset charset)))
-
-(defsubst mm-multibyte-p ()
- "Say whether multibyte is enabled."
- (and (boundp 'enable-multibyte-characters)
- enable-multibyte-characters))
-
-(defmacro mm-with-unibyte-buffer (&rest forms)
- "Create a temporary buffer, and evaluate FORMS there like `progn'.
-See also `with-temp-file' and `with-output-to-string'."
- (let ((temp-buffer (make-symbol "temp-buffer"))
- (multibyte (make-symbol "multibyte")))
- `(if (not (boundp 'enable-multibyte-characters))
- (with-temp-buffer ,@forms)
- (let ((,multibyte (default-value 'enable-multibyte-characters))
- ,temp-buffer)
- (unwind-protect
- (progn
- (setq-default enable-multibyte-characters nil)
- (setq ,temp-buffer
- (get-buffer-create (generate-new-buffer-name " *temp*")))
- (unwind-protect
- (with-current-buffer ,temp-buffer
- (let ((buffer-file-coding-system 'binary))
- ,@forms))
- (and (buffer-name ,temp-buffer)
- (kill-buffer ,temp-buffer))))
- (setq-default enable-multibyte-characters ,multibyte))))))
-(put 'mm-with-unibyte-buffer 'lisp-indent-function 0)
-(put 'mm-with-unibyte-buffer 'edebug-form-spec '(body))
-
-(defun mm-find-charset-region (b e)
- "Return a list of charsets in the region."
- (cond
- ((and (boundp 'enable-multibyte-characters)
- enable-multibyte-characters)
- (find-charset-region b e))
- ((not (boundp 'current-language-environment))
- (save-excursion
- (save-restriction
- (narrow-to-region b e)
- (goto-char (point-min))
- (skip-chars-forward "\0-\177")
- (if (eobp)
- '(ascii)
- ;;;!!!bogus
- (list 'ascii 'latin-iso8859-1)))))
- (t
- ;; We are in a unibyte buffer, so we futz around a bit.
- (save-excursion
- (save-restriction
- (narrow-to-region b e)
- (goto-char (point-min))
- (let ((entry (assoc (capitalize current-language-environment)
- language-info-alist)))
- (skip-chars-forward "\0-\177")
- (if (eobp)
- '(ascii)
- (list 'ascii (car (last (assq 'charset entry)))))))))))
-
-(provide 'mm-util)
-
-;;; mm-util.el ends here
+++ /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)
-(require 'mm-decode)
-
-;;;
-;;; Functions for displaying various formats inline
-;;;
-
-(defun mm-inline-image (handle)
- (let ((annot (make-annotation (mm-get-image handle) nil 'text))
- buffer-read-only)
- (mm-insert-inline handle ".\n")
- (set-extent-property annot 'mm t)
- (set-extent-property annot 'duplicable t)))
-
-(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)
- (car (mm-handle-type 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)))
- (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")
- (let ((width (window-width)))
- (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)
- (car (mm-handle-type handle)))
- (require 'url)
- (save-window-excursion
- (require 'w3-vars)
- (let ((w3-strict-width width))
- (w3-region (point-min) (point-max)))
- (setq text (buffer-string))))))
- (mm-insert-inline handle text))
- ((or (equal type "enriched")
- (equal type "richtext"))
- (save-excursion
- (mm-with-unibyte-buffer
- (insert-buffer-substring (mm-handle-buffer handle))
- (mm-decode-content-transfer-encoding
- (mm-handle-encoding handle)
- (car (mm-handle-type handle)))
- (save-window-excursion
- (enriched-decode (point-min) (point-max))
- (setq text (buffer-string)))))
- (mm-insert-inline handle text))
- (t
- (save-excursion
- (mm-with-unibyte-buffer
- (insert-buffer-substring (mm-handle-buffer handle))
- (mm-decode-content-transfer-encoding
- (mm-handle-encoding handle)
- (car (mm-handle-type handle)))
- (setq text (buffer-string))))
- (mm-insert-inline handle text)))))
-
-(defun mm-insert-inline (handle text)
- "Insert TEXT inline from HANDLE."
- (let ((b (point)))
- (insert text)
- (mm-handle-set-undisplayer
- handle
- `(lambda ()
- (let (buffer-read-only)
- (delete-region ,(set-marker (make-marker) b)
- ,(set-marker (make-marker) (point))))))))
-
-(defun mm-inline-audio (handle)
- (message "Not implemented"))
-
-(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
+++ /dev/null
-;;; mm.el,v --- Mailcap parsing routines, and MIME handling
-;; Author: wmperry
-;; Created: 1996/05/28 02:46:51
-;; Version: 1.96
-;; Keywords: mail, news, hypermedia
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Copyright (c) 1994, 1995, 1996 by William M. Perry <wmperry@cs.indiana.edu>
-;;; Copyright (c) 1996 - 1998 Free Software Foundation, Inc.
-;;;
-;;; This file is not part of GNU Emacs, but the same permissions apply.
-;;;
-;;; GNU Emacs is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2, or (at your option)
-;;; any later version.
-;;;
-;;; GNU Emacs is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Emacs; see the file COPYING. If not, write to the
-;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;;; Boston, MA 02111-1307, USA.
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Generalized mailcap parsing and access routines
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; Data structures
-;;; ---------------
-;;; The mailcap structure is an assoc list of assoc lists.
-;;; 1st assoc list is keyed on the major content-type
-;;; 2nd assoc list is keyed on the minor content-type (which can be a regexp)
-;;;
-;;; Which looks like:
-;;; -----------------
-;;; (
-;;; ("application"
-;;; ("postscript" . <info>)
-;;; )
-;;; ("text"
-;;; ("plain" . <info>)
-;;; )
-;;; )
-;;;
-;;; 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")
-;;; )
-;;;
-;;; Where viewerinfo specifies how the content-type is viewed. Can be
-;;; a string, in which case it is run through a shell, with
-;;; appropriate parameters, or a symbol, in which case the symbol is
-;;; funcall'd, with the buffer as an argument.
-;;;
-;;; testinfo is a list of strings, or nil. If nil, it means the
-;;; viewer specified is always valid. If it is a list of strings,
-;;; these are used to determine whether a viewer passes the 'test' or
-;;; not.
-;;;
-;;; The main interface to this code is:
-;;;
-;;; To set everything up:
-;;;
-;;; (mm-parse-mailcaps [path])
-;;;
-;;; Where PATH is a unix-style path specification (: separated list
-;;; of strings). If PATH is nil, the environment variable MAILCAPS
-;;; will be consulted. If there is no environment variable, then a
-;;; default list of paths is used.
-;;;
-;;; To retrieve the information:
-;;; (mm-mime-info st [nd] [request])
-;;;
-;;; Where st and nd are positions in a buffer that contain the
-;;; content-type header information of a mail/news/whatever message.
-;;; st can optionally be a string that contains the content-type
-;;; information.
-;;;
-;;; Third argument REQUEST specifies what information to return. If
-;;; it is nil or the empty string, the viewer (second field of the
-;;; mailcap entry) will be returned. If it is a string, then the
-;;; mailcap field corresponding to that string will be returned
-;;; (print, description, whatever). If a number, then all the
-;;; information for this specific viewer is returned.
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Variables, etc
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(eval-and-compile
- (require 'cl)
-;LMI was here
- ;;(require 'devices)
- )
-
-(defconst mm-version (let ((x "1.96"))
- (if (string-match "Revision: \\([^ \t\n]+\\)" x)
- (substring x (match-beginning 1) (match-end 1))
- x))
- "Version # of MM package")
-
-(defvar mm-parse-args-syntax-table
- (copy-syntax-table emacs-lisp-mode-syntax-table)
- "A syntax table for parsing sgml attributes.")
-
-(modify-syntax-entry ?' "\"" mm-parse-args-syntax-table)
-(modify-syntax-entry ?` "\"" mm-parse-args-syntax-table)
-(modify-syntax-entry ?{ "(" mm-parse-args-syntax-table)
-(modify-syntax-entry ?} ")" mm-parse-args-syntax-table)
-
-(defvar mm-mime-data
- '(
- ("multipart" . (
- ("alternative". (("viewer" . mm-multipart-viewer)
- ("type" . "multipart/alternative")))
- ("mixed" . (("viewer" . mm-multipart-viewer)
- ("type" . "multipart/mixed")))
- (".*" . (("viewer" . mm-save-binary-file)
- ("type" . "multipart/*")))
- )
- )
- ("application" . (
- ("x-x509-ca-cert" . (("viewer" . ssl-view-site-cert)
- ("test" . (fboundp 'ssl-view-site-cert))
- ("type" . "application/x-x509-ca-cert")))
- ("x-x509-user-cert" . (("viewer" . ssl-view-user-cert)
- ("test" . (fboundp 'ssl-view-user-cert))
- ("type" . "application/x-x509-user-cert")))
- ("octet-stream" . (("viewer" . mm-save-binary-file)
- ("type" ."application/octet-stream")))
- ("dvi" . (("viewer" . "open %s")
- ("type" . "application/dvi")
- ("test" . (eq (device-type) 'ns))))
- ("dvi" . (("viewer" . "xdvi %s")
- ("test" . (eq (device-type) 'x))
- ("needsx11")
- ("type" . "application/dvi")))
- ("dvi" . (("viewer" . "dvitty %s")
- ("test" . (not (getenv "DISPLAY")))
- ("type" . "application/dvi")))
- ("emacs-lisp" . (("viewer" . mm-maybe-eval)
- ("type" . "application/emacs-lisp")))
-; ("x-tar" . (("viewer" . tar-mode)
-; ("test" . (fboundp 'tar-mode))
-; ("type" . "application/x-tar")))
- ("x-tar" . (("viewer" . mm-save-binary-file)
- ("type" . "application/x-tar")))
- ("x-latex" . (("viewer" . tex-mode)
- ("test" . (fboundp 'tex-mode))
- ("type" . "application/x-latex")))
- ("x-tex" . (("viewer" . tex-mode)
- ("test" . (fboundp 'tex-mode))
- ("type" . "application/x-tex")))
- ("latex" . (("viewer" . tex-mode)
- ("test" . (fboundp 'tex-mode))
- ("type" . "application/latex")))
- ("tex" . (("viewer" . tex-mode)
- ("test" . (fboundp 'tex-mode))
- ("type" . "application/tex")))
- ("texinfo" . (("viewer" . texinfo-mode)
- ("test" . (fboundp 'texinfo-mode))
- ("type" . "application/tex")))
- ("zip" . (("viewer" . mm-save-binary-file)
- ("type" . "application/zip")
- ("copiousoutput")))
- ("pdf" . (("viewer" . "acroread %s")
- ("type" . "application/pdf")))
- ("postscript" . (("viewer" . "open %s")
- ("type" . "application/postscript")
- ("test" . (eq (device-type) 'ns))))
- ("postscript" . (("viewer" . "ghostview %s")
- ("type" . "application/postscript")
- ("test" . (eq (device-type) 'x))
- ("needsx11")))
- ("postscript" . (("viewer" . "ps2ascii %s")
- ("type" . "application/postscript")
- ("test" . (not (getenv "DISPLAY")))
- ("copiousoutput")))
- ))
- ("audio" . (
- ("x-mpeg" . (("viewer" . "maplay %s")
- ("type" . "audio/x-mpeg")))
- (".*" . (("viewer" . mm-play-sound-file)
- ("test" . (or (featurep 'nas-sound)
- (featurep 'native-sound)))
- ("type" . "audio/*")))
- (".*" . (("viewer" . "showaudio")
- ("type" . "audio/*")))
- ))
- ("message" . (
- ("rfc-*822" . (("viewer" . vm-mode)
- ("test" . (fboundp 'vm-mode))
- ("type" . "message/rfc-822")))
- ("rfc-*822" . (("viewer" . w3-mode)
- ("test" . (fboundp 'w3-mode))
- ("type" . "message/rfc-822")))
- ("rfc-*822" . (("viewer" . view-mode)
- ("test" . (fboundp 'view-mode))
- ("type" . "message/rfc-822")))
- ("rfc-*822" . (("viewer" . fundamental-mode)
- ("type" . "message/rfc-822")))
- ))
- ("image" . (
- ("x-xwd" . (("viewer" . "xwud -in %s")
- ("type" . "image/x-xwd")
- ("compose" . "xwd -frame > %s")
- ("test" . (eq (device-type) 'x))
- ("needsx11")))
- ("x11-dump" . (("viewer" . "xwud -in %s")
- ("type" . "image/x-xwd")
- ("compose" . "xwd -frame > %s")
- ("test" . (eq (device-type) 'x))
- ("needsx11")))
- ("windowdump" . (("viewer" . "xwud -in %s")
- ("type" . "image/x-xwd")
- ("compose" . "xwd -frame > %s")
- ("test" . (eq (device-type) 'x))
- ("needsx11")))
- (".*" . (("viewer" . "open %s")
- ("type" . "image/*")
- ("test" . (eq (device-type) 'ns))))
- (".*" . (("viewer" . "xv -perfect %s")
- ("type" . "image/*")
- ("test" . (eq (device-type) 'x))
- ("needsx11")))
- ))
- ("text" . (
- ("plain" . (("viewer" . w3-mode)
- ("test" . (fboundp 'w3-mode))
- ("type" . "text/plain")))
- ("plain" . (("viewer" . view-mode)
- ("test" . (fboundp 'view-mode))
- ("type" . "text/plain")))
- ("plain" . (("viewer" . fundamental-mode)
- ("type" . "text/plain")))
- ("enriched" . (("viewer" . enriched-decode-region)
- ("test" . (fboundp
- 'enriched-decode-region))
- ("type" . "text/enriched")))
- ("html" . (("viewer" . w3-prepare-buffer)
- ("test" . (fboundp 'w3-prepare-buffer))
- ("type" . "text/html")))
- ))
- ("video" . (
- ("mpeg" . (("viewer" . "mpeg_play %s")
- ("type" . "video/mpeg")
- ("test" . (eq (device-type) 'x))
- ("needsx11")))
- ))
- ("x-world" . (
- ("x-vrml" . (("viewer" . "webspace -remote %s -URL %u")
- ("type" . "x-world/x-vrml")
- ("description"
- "VRML document")))))
- ("archive" . (
- ("tar" . (("viewer" . tar-mode)
- ("type" . "archive/tar")
- ("test" . (fboundp 'tar-mode))))
- ))
- )
- "*The mailcap structure is an assoc list of assoc lists.
-1st assoc list is keyed on the major content-type
-2nd assoc list is keyed on the minor content-type (which can be a regexp)
-
-Which looks like:
------------------
-(
- (\"application\"
- (\"postscript\" . <info>)
- )
- (\"text\"
- (\"plain\" . <info>)
- )
-)
-
-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\")
-)
-
-Where viewerinfo specifies how the content-type is viewed. Can be
-a string, in which case it is run through a shell, with
-appropriate parameters, or a symbol, in which case the symbol is
-funcall'd, with the buffer as an argument.
-
-testinfo is a list of strings, or nil. If nil, it means the
-viewer specified is always valid. If it is a list of strings,
-these are used to determine whether a viewer passes the 'test' or
-not.")
-
-(defvar mm-content-transfer-encodings
- '(("base64" . base64-decode-region)
- ("7bit" . ignore)
- ("8bit" . ignore)
- ("binary" . ignore)
- ("x-compress" . ("uncompress" "-c"))
- ("x-gzip" . ("gzip" "-dc"))
- ("compress" . ("uncompress" "-c"))
- ("gzip" . ("gzip" "-dc"))
- ("x-hqx" . ("mcvert" "-P" "-s" "-S"))
- ("quoted-printable" . mm-decode-quoted-printable)
- )
- "*An assoc list of content-transfer-encodings and how to decode them.")
-
-(defvar mm-download-directory nil
- "*Where downloaded files should go by default.")
-
-(defvar mm-temporary-directory (or (getenv "TMPDIR") "/tmp")
- "*Where temporary files go.")
-
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; A few things from w3 and url, just in case this is used without them
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun mm-generate-unique-filename (&optional fmt)
- "Generate a unique filename in mm-temporary-directory"
- (if (not fmt)
- (let ((base (format "mm-tmp.%d" (user-real-uid)))
- (fname "")
- (x 0))
- (setq fname (format "%s%d" base x))
- (while (file-exists-p
- (expand-file-name fname mm-temporary-directory))
- (setq x (1+ x)
- fname (concat base (int-to-string x))))
- (expand-file-name fname mm-temporary-directory))
- (let ((base (concat "mm" (int-to-string (user-real-uid))))
- (fname "")
- (x 0))
- (setq fname (format fmt (concat base (int-to-string x))))
- (while (file-exists-p
- (expand-file-name fname mm-temporary-directory))
- (setq x (1+ x)
- fname (format fmt (concat base (int-to-string x)))))
- (expand-file-name fname mm-temporary-directory))))
-
-(if (and (fboundp 'copy-tree)
- (subrp (symbol-function 'copy-tree)))
- (fset 'mm-copy-tree 'copy-tree)
- (defun mm-copy-tree (tree)
- (if (consp tree)
- (cons (mm-copy-tree (car tree))
- (mm-copy-tree (cdr tree)))
- (if (vectorp tree)
- (let* ((new (copy-sequence tree))
- (i (1- (length new))))
- (while (>= i 0)
- (aset new i (mm-copy-tree (aref new i)))
- (setq i (1- i)))
- new)
- tree))))
-
-;LMI was here
-;(require 'mule-sysdp)
-
-(if (not (fboundp 'w3-save-binary-file))
- (defun mm-save-binary-file ()
- ;; Ok, this is truly fucked. In XEmacs, if you use the mouse to select
- ;; a URL that gets saved via this function, read-file-name will pop up a
- ;; dialog box for file selection. For some reason which buffer we are in
- ;; gets royally screwed (even with save-excursions and the whole nine
- ;; yards). SO, we just keep the old buffer name around and away we go.
- (let ((old-buff (current-buffer))
- (file (read-file-name "Filename to save as: "
- (or mm-download-directory "~/")
- (file-name-nondirectory (url-view-url t))
- nil
- (file-name-nondirectory (url-view-url t))))
- (require-final-newline nil))
- (set-buffer old-buff)
- (mule-write-region-no-coding-system (point-min) (point-max) file)
- (kill-buffer (current-buffer))))
- (fset 'mm-save-binary-file 'w3-save-binary-file))
-
-(defun mm-maybe-eval ()
- "Maybe evaluate a buffer of emacs lisp code"
- (if (yes-or-no-p "This is emacs-lisp code, evaluate it? ")
- (eval-buffer (current-buffer))
- (emacs-lisp-mode)))
-
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; The mailcap parser
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun mm-viewer-unescape (format &optional filename url)
- (save-excursion
- (set-buffer (get-buffer-create " *mm-parse*"))
- (erase-buffer)
- (insert format)
- (goto-char (point-min))
- (while (re-search-forward "%\\(.\\)" nil t)
- (let ((escape (aref (match-string 1) 0)))
- (replace-match "" t t)
- (case escape
- (?% (insert "%"))
- (?s (insert (or filename "\"\"")))
- (?u (insert (or url "\"\""))))))
- (buffer-string)))
-
-(defun mm-in-assoc (elt list)
- ;; Check to see if ELT matches any of the regexps in the car elements of LIST
- (let (rslt)
- (while (and list (not rslt))
- (and (car (car list))
- (string-match (car (car list)) elt)
- (setq rslt (car list)))
- (setq list (cdr list)))
- rslt))
-
-(defun mm-replace-regexp (regexp to-string)
- ;; Quiet replace-regexp.
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (replace-match to-string t nil)))
-
-(defun mm-parse-mailcaps (&optional path)
- ;; Parse out all the mailcaps specified in a unix-style path string PATH
- (cond
- (path nil)
- ((getenv "MAILCAPS") (setq path (getenv "MAILCAPS")))
- ((memq system-type '(ms-dos ms-windows windows-nt))
- (setq path (mapconcat 'expand-file-name '("~/mail.cap" "~/etc/mail.cap")
- ";")))
- (t (setq path (mapconcat 'expand-file-name
- '("~/.mailcap"
- "/etc/mailcap:/usr/etc/mailcap"
- "/usr/local/etc/mailcap") ":"))))
- (let ((fnames (reverse
- (mm-string-to-tokens path
- (if (memq system-type
- '(ms-dos ms-windows windows-nt))
- ?;
- ?:))))
- fname)
- (while fnames
- (setq fname (car fnames))
- (if (and (file-exists-p fname) (file-readable-p fname))
- (mm-parse-mailcap (car fnames)))
- (setq fnames (cdr fnames)))))
-
-(defun mm-parse-mailcap (fname)
- ;; Parse out the mailcap file specified by FNAME
- (let (major ; The major mime type (image/audio/etc)
- minor ; The minor mime type (gif, basic, etc)
- save-pos ; Misc saved positions used in parsing
- viewer ; How to view this mime type
- info ; Misc info about this mime type
- )
- (save-excursion
- (set-buffer (get-buffer-create " *mailcap*"))
- (erase-buffer)
- (insert-file-contents fname)
- (set-syntax-table mm-parse-args-syntax-table)
- (mm-replace-regexp "#.*" "") ; Remove all comments
- (mm-replace-regexp "\n+" "\n") ; And blank lines
- (mm-replace-regexp "\\\\[ \t\n]+" " ") ; And collapse spaces
- (mm-replace-regexp (concat (regexp-quote "\\") "[ \t]*\n") "")
- (goto-char (point-max))
- (skip-chars-backward " \t\n")
- (delete-region (point) (point-max))
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward " \t\n")
- (setq save-pos (point)
- info nil)
- (skip-chars-forward "^/;")
- (downcase-region save-pos (point))
- (setq major (buffer-substring save-pos (point)))
- (skip-chars-forward "/ \t\n")
- (setq save-pos (point))
- (skip-chars-forward "^;")
- (downcase-region save-pos (point))
- (setq minor
- (cond
- ((= ?* (or (char-after save-pos) 0)) ".*")
- ((= (point) save-pos) ".*")
- (t (buffer-substring save-pos (point)))))
- (skip-chars-forward "; \t\n")
- ;;; Got the major/minor chunks, now for the viewers/etc
- ;;; The first item _must_ be a viewer, according to the
- ;;; RFC for mailcap files (#1343)
- (skip-chars-forward "; \t\n")
- (setq save-pos (point))
- (skip-chars-forward "^;\n")
- (if (= (or (char-after save-pos) 0) ?')
- (setq viewer (progn
- (narrow-to-region (1+ save-pos) (point))
- (goto-char (point-min))
- (prog1
- (read (current-buffer))
- (goto-char (point-max))
- (widen))))
- (setq viewer (buffer-substring save-pos (point))))
- (setq save-pos (point))
- (end-of-line)
- (setq info (nconc (list (cons "viewer" viewer)
- (cons "type" (concat major "/"
- (if (string= minor ".*")
- "*" minor))))
- (mm-parse-mailcap-extras save-pos (point))))
- (mm-mailcap-entry-passes-test info)
- (mm-add-mailcap-entry major minor info)))))
-
-(defun mm-parse-mailcap-extras (st nd)
- ;; Grab all the extra stuff from a mailcap entry
- (let (
- name ; From name=
- value ; its value
- results ; Assoc list of results
- name-pos ; Start of XXXX= position
- val-pos ; Start of value position
- done ; Found end of \'d ;s?
- )
- (save-restriction
- (narrow-to-region st nd)
- (goto-char (point-min))
- (skip-chars-forward " \n\t;")
- (while (not (eobp))
- (setq done nil)
- (skip-chars-forward " \";\n\t")
- (setq name-pos (point))
- (skip-chars-forward "^ \n\t=")
- (downcase-region name-pos (point))
- (setq name (buffer-substring name-pos (point)))
- (skip-chars-forward " \t\n")
- (if (/= (or (char-after (point)) 0) ?=) ; There is no value
- (setq value nil)
- (skip-chars-forward " \t\n=")
- (setq val-pos (point))
- (if (memq (char-after val-pos) '(?\" ?'))
- (progn
- (setq val-pos (1+ val-pos))
- (condition-case nil
- (progn
- (forward-sexp 1)
- (backward-char 1))
- (error (goto-char (point-max)))))
- (while (not done)
- (skip-chars-forward "^;")
- (if (= (or (char-after (1- (point))) 0) ?\\ )
- (progn
- (subst-char-in-region (1- (point)) (point) ?\\ ? )
- (skip-chars-forward ";"))
- (setq done t))))
- (setq value (buffer-substring val-pos (point))))
- (setq results (cons (cons name value) results)))
- results)))
-
-(defun mm-string-to-tokens (str &optional delim)
- "Return a list of words from the string STR"
- (setq delim (or delim ? ))
- (let (results y)
- (mapcar
- (function
- (lambda (x)
- (cond
- ((and (= x delim) y) (setq results (cons y results) y nil))
- ((/= x delim) (setq y (concat y (char-to-string x))))
- (t nil)))) str)
- (nreverse (cons y results))))
-
-(defun mm-mailcap-entry-passes-test (info)
- ;; Return t iff a mailcap entry passes its test clause or no test
- ;; clause is present.
- (let (status ; Call-process-regions return value
- (test (assoc "test" info)); The test clause
- )
- (setq status (and test (mm-string-to-tokens (cdr test))))
- (if (and (assoc "needsx11" info) (not (getenv "DISPLAY")))
- (setq status nil)
- (cond
- ((and (equal (nth 0 status) "test")
- (equal (nth 1 status) "-n")
- (or (equal (nth 2 status) "$DISPLAY")
- (equal (nth 2 status) "\"$DISPLAY\"")))
- (setq status (if (getenv "DISPLAY") t nil)))
- ((and (equal (nth 0 status) "test")
- (equal (nth 1 status) "-z")
- (or (equal (nth 2 status) "$DISPLAY")
- (equal (nth 2 status) "\"$DISPLAY\"")))
- (setq status (if (getenv "DISPLAY") nil t)))
- (test nil)
- (t nil)))
- (and test (listp test) (setcdr test status))))
-
-(defun mm-parse-args (st &optional nd nodowncase)
- ;; Return an assoc list of attribute/value pairs from an RFC822-type string
- (let (
- name ; From name=
- value ; its value
- results ; Assoc list of results
- name-pos ; Start of XXXX= position
- val-pos ; Start of value position
- )
- (save-excursion
- (if (stringp st)
- (progn
- (set-buffer (get-buffer-create " *mm-temp*"))
- (set-syntax-table mm-parse-args-syntax-table)
- (erase-buffer)
- (insert st)
- (setq st (point-min)
- nd (point-max)))
- (set-syntax-table mm-parse-args-syntax-table))
- (save-restriction
- (narrow-to-region st nd)
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward "; \n\t")
- (setq name-pos (point))
- (skip-chars-forward "^ \n\t=;")
- (if (not nodowncase)
- (downcase-region name-pos (point)))
- (setq name (buffer-substring name-pos (point)))
- (skip-chars-forward " \t\n")
- (if (/= (or (char-after (point)) 0) ?=) ; There is no value
- (setq value nil)
- (skip-chars-forward " \t\n=")
- (setq val-pos (point)
- value
- (cond
- ((or (= (or (char-after val-pos) 0) ?\")
- (= (or (char-after val-pos) 0) ?'))
- (buffer-substring (1+ val-pos)
- (condition-case ()
- (prog2
- (forward-sexp 1)
- (1- (point))
- (skip-chars-forward "\""))
- (error
- (skip-chars-forward "^ \t\n")
- (point)))))
- (t
- (buffer-substring val-pos
- (progn
- (skip-chars-forward "^;")
- (skip-chars-backward " \t")
- (point)))))))
- (setq results (cons (cons name value) results))
- (skip-chars-forward "; \n\t"))
- results))))
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; The action routines.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun mm-possible-viewers (major minor)
- ;; Return a list of possible viewers from MAJOR for minor type MINOR
- (let ((exact '())
- (wildcard '()))
- (while major
- (cond
- ((equal (car (car major)) minor)
- (setq exact (cons (cdr (car major)) exact)))
- ((string-match (car (car major)) minor)
- (setq wildcard (cons (cdr (car major)) wildcard))))
- (setq major (cdr major)))
- (nconc (nreverse exact) (nreverse wildcard))))
-
-(defun mm-unescape-mime-test (test type-info)
- (let ((buff (get-buffer-create " *unescape*"))
- save-pos save-chr subst)
- (cond
- ((symbolp test) test)
- ((and (listp test) (symbolp (car test))) test)
- ((or (stringp test)
- (and (listp test) (stringp (car test))
- (setq test (mapconcat 'identity test " "))))
- (save-excursion
- (set-buffer buff)
- (erase-buffer)
- (insert test)
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward "^%")
- (if (/= (- (point)
- (progn (skip-chars-backward "\\\\")
- (point)))
- 0) ; It is an escaped %
- (progn
- (delete-char 1)
- (skip-chars-forward "%."))
- (setq save-pos (point))
- (skip-chars-forward "%")
- (setq save-chr (char-after (point)))
- (cond
- ((null save-chr) nil)
- ((= save-chr ?t)
- (delete-region save-pos (progn (forward-char 1) (point)))
- (insert (or (cdr (assoc "type" type-info)) "\"\"")))
- ((= save-chr ?M)
- (delete-region save-pos (progn (forward-char 1) (point)))
- (insert "\"\""))
- ((= save-chr ?n)
- (delete-region save-pos (progn (forward-char 1) (point)))
- (insert "\"\""))
- ((= save-chr ?F)
- (delete-region save-pos (progn (forward-char 1) (point)))
- (insert "\"\""))
- ((= save-chr ?{)
- (forward-char 1)
- (skip-chars-forward "^}")
- (downcase-region (+ 2 save-pos) (point))
- (setq subst (buffer-substring (+ 2 save-pos) (point)))
- (delete-region save-pos (1+ (point)))
- (insert (or (cdr (assoc subst type-info)) "\"\"")))
- (t nil))))
- (buffer-string)))
- (t (error "Bad value to mm-unescape-mime-test. %s" test)))))
-
-(defun mm-viewer-passes-test (viewer-info type-info)
- ;; Return non-nil iff the viewer specified by VIEWER-INFO passes its
- ;; test clause (if any).
- (let* ((test-info (assoc "test" viewer-info))
- (test (cdr test-info))
- (viewer (cdr (assoc "viewer" viewer-info)))
- (default-directory (expand-file-name "~/"))
- status
- parsed-test
- )
- (cond
- ((not test-info) t) ; No test clause
- ((not test) nil) ; Already failed test
- ((eq test t) t) ; Already passed test
- ((and (symbolp test) ; Lisp function as test
- (fboundp test))
- (funcall test type-info))
- ((and (symbolp test) ; Lisp variable as test
- (boundp test))
- (symbol-value test))
- ((and (listp test) ; List to be eval'd
- (symbolp (car test)))
- (eval test))
- (t
- (setq test (mm-unescape-mime-test test type-info)
- test (list shell-file-name nil nil nil shell-command-switch test)
- status (apply 'call-process test))
- (= 0 status)))))
-
-(defun mm-add-mailcap-entry (major minor info)
- (let ((old-major (assoc major mm-mime-data)))
- (if (null old-major) ; New major area
- (setq mm-mime-data
- (cons (cons major (list (cons minor info)))
- mm-mime-data))
- (let ((cur-minor (assoc minor old-major)))
- (cond
- ((or (null cur-minor) ; New minor area, or
- (assoc "test" info)) ; Has a test, insert at beginning
- (setcdr old-major (cons (cons minor info) (cdr old-major))))
- ((and (not (assoc "test" info)); No test info, replace completely
- (not (assoc "test" cur-minor)))
- (setcdr cur-minor info))
- (t
- (setcdr old-major (cons (cons minor info) (cdr old-major)))))))))
-
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; The main whabbo
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun mm-viewer-lessp (x y)
- ;; Return t iff viewer X is more desirable than viewer Y
- (let ((x-wild (string-match "[*?]" (or (cdr-safe (assoc "type" x)) "")))
- (y-wild (string-match "[*?]" (or (cdr-safe (assoc "type" y)) "")))
- (x-lisp (not (stringp (or (cdr-safe (assoc "viewer" x)) ""))))
- (y-lisp (not (stringp (or (cdr-safe (assoc "viewer" y)) "")))))
- (cond
- ((and x-lisp (not y-lisp))
- t)
- ((and (not y-lisp) x-wild (not y-wild))
- t)
- ((and (not x-wild) y-wild)
- t)
- (t nil))))
-
-(defun mm-mime-info (st &optional nd request)
- "Get the mime viewer command for HEADERLINE, return nil if none found.
-Expects a complete content-type header line as its argument. This can
-be simple like text/html, or complex like text/plain; charset=blah; foo=bar
-
-Third argument REQUEST specifies what information to return. If it is
-nil or the empty string, the viewer (second field of the mailcap
-entry) will be returned. If it is a string, then the mailcap field
-corresponding to that string will be returned (print, description,
-whatever). If a number, then all the information for this specific
-viewer is returned."
- (let (
- major ; Major encoding (text, etc)
- minor ; Minor encoding (html, etc)
- info ; Other info
- save-pos ; Misc. position during parse
- major-info ; (assoc major mm-mime-data)
- minor-info ; (assoc minor major-info)
- test ; current test proc.
- viewers ; Possible viewers
- passed ; Viewers that passed the test
- viewer ; The one and only viewer
- )
- (save-excursion
- (cond
- ((null st)
- (set-buffer (get-buffer-create " *mimeparse*"))
- (erase-buffer)
- (insert "text/plain")
- (setq st (point-min)))
- ((stringp st)
- (set-buffer (get-buffer-create " *mimeparse*"))
- (erase-buffer)
- (insert st)
- (setq st (point-min)))
- ((null nd)
- (narrow-to-region st (progn (goto-char st) (end-of-line) (point))))
- (t (narrow-to-region st nd)))
- (goto-char st)
- (skip-chars-forward ": \t\n")
- (buffer-enable-undo)
- (setq viewer
- (catch 'mm-exit
- (setq save-pos (point))
- (skip-chars-forward "^/")
- (downcase-region save-pos (point))
- (setq major (buffer-substring save-pos (point)))
- (if (not (setq major-info (cdr (assoc major mm-mime-data))))
- (throw 'mm-exit nil))
- (skip-chars-forward "/ \t\n")
- (setq save-pos (point))
- (skip-chars-forward "^ \t\n;")
- (downcase-region save-pos (point))
- (setq minor (buffer-substring save-pos (point)))
- (if (not
- (setq viewers (mm-possible-viewers major-info minor)))
- (throw 'mm-exit nil))
- (skip-chars-forward "; \t")
- (if (eolp)
- nil ; No qualifiers
- (setq save-pos (point))
- (end-of-line)
- (setq info (mm-parse-args save-pos (point)))
- )
- (while viewers
- (if (mm-viewer-passes-test (car viewers) info)
- (setq passed (cons (car viewers) passed)))
- (setq viewers (cdr viewers)))
- (setq passed (sort (nreverse passed) 'mm-viewer-lessp))
- (car passed)))
- (if (and (stringp (cdr (assoc "viewer" viewer)))
- passed)
- (setq viewer (car passed)))
- (widen)
- (cond
- ((and (null viewer) (not (equal major "default")))
- (mm-mime-info "default" nil request))
- ((or (null request) (equal request ""))
- (mm-unescape-mime-test (cdr (assoc "viewer" viewer)) info))
- ((stringp request)
- (if (or (string= request "test") (string= request "viewer"))
- (mm-unescape-mime-test (cdr-safe (assoc request viewer)) info)))
- (t
- ;; MUST make a copy *sigh*, else we modify mm-mime-data
- (setq viewer (mm-copy-tree viewer))
- (let ((view (assoc "viewer" viewer))
- (test (assoc "test" viewer)))
- (if view (setcdr view (mm-unescape-mime-test (cdr view) info)))
- (if test (setcdr test (mm-unescape-mime-test (cdr test) info))))
- viewer)))))
-
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Experimental MIME-types parsing
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar mm-mime-extensions
- '(
- ("" . "text/plain")
- (".abs" . "audio/x-mpeg")
- (".aif" . "audio/aiff")
- (".aifc" . "audio/aiff")
- (".aiff" . "audio/aiff")
- (".ano" . "application/x-annotator")
- (".au" . "audio/ulaw")
- (".avi" . "video/x-msvideo")
- (".bcpio" . "application/x-bcpio")
- (".bin" . "application/octet-stream")
- (".cdf" . "application/x-netcdr")
- (".cpio" . "application/x-cpio")
- (".csh" . "application/x-csh")
- (".dvi" . "application/x-dvi")
- (".el" . "application/emacs-lisp")
- (".eps" . "application/postscript")
- (".etx" . "text/x-setext")
- (".exe" . "application/octet-stream")
- (".fax" . "image/x-fax")
- (".gif" . "image/gif")
- (".hdf" . "application/x-hdf")
- (".hqx" . "application/mac-binhex40")
- (".htm" . "text/html")
- (".html" . "text/html")
- (".icon" . "image/x-icon")
- (".ief" . "image/ief")
- (".jpg" . "image/jpeg")
- (".macp" . "image/x-macpaint")
- (".man" . "application/x-troff-man")
- (".me" . "application/x-troff-me")
- (".mif" . "application/mif")
- (".mov" . "video/quicktime")
- (".movie" . "video/x-sgi-movie")
- (".mp2" . "audio/x-mpeg")
- (".mp2a" . "audio/x-mpeg2")
- (".mpa" . "audio/x-mpeg")
- (".mpa2" . "audio/x-mpeg2")
- (".mpe" . "video/mpeg")
- (".mpeg" . "video/mpeg")
- (".mpega" . "audio/x-mpeg")
- (".mpegv" . "video/mpeg")
- (".mpg" . "video/mpeg")
- (".mpv" . "video/mpeg")
- (".ms" . "application/x-troff-ms")
- (".nc" . "application/x-netcdf")
- (".nc" . "application/x-netcdf")
- (".oda" . "application/oda")
- (".pbm" . "image/x-portable-bitmap")
- (".pdf" . "application/pdf")
- (".pgm" . "image/portable-graymap")
- (".pict" . "image/pict")
- (".png" . "image/png")
- (".pnm" . "image/x-portable-anymap")
- (".ppm" . "image/portable-pixmap")
- (".ps" . "application/postscript")
- (".qt" . "video/quicktime")
- (".ras" . "image/x-raster")
- (".rgb" . "image/x-rgb")
- (".rtf" . "application/rtf")
- (".rtx" . "text/richtext")
- (".sh" . "application/x-sh")
- (".sit" . "application/x-stuffit")
- (".snd" . "audio/basic")
- (".src" . "application/x-wais-source")
- (".tar" . "archive/tar")
- (".tcl" . "application/x-tcl")
- (".tcl" . "application/x-tcl")
- (".tex" . "application/x-tex")
- (".texi" . "application/texinfo")
- (".tga" . "image/x-targa")
- (".tif" . "image/tiff")
- (".tiff" . "image/tiff")
- (".tr" . "application/x-troff")
- (".troff" . "application/x-troff")
- (".tsv" . "text/tab-separated-values")
- (".txt" . "text/plain")
- (".vbs" . "video/mpeg")
- (".vox" . "audio/basic")
- (".vrml" . "x-world/x-vrml")
- (".wav" . "audio/x-wav")
- (".wrl" . "x-world/x-vrml")
- (".xbm" . "image/xbm")
- (".xpm" . "image/x-pixmap")
- (".xwd" . "image/windowdump")
- (".zip" . "application/zip")
- (".ai" . "application/postscript")
- (".jpe" . "image/jpeg")
- (".jpeg" . "image/jpeg")
- )
- "*An assoc list of file extensions and the MIME content-types they
-correspond to.")
-
-(defun mm-parse-mimetypes (&optional path)
- ;; Parse out all the mimetypes specified in a unix-style path string PATH
- (cond
- (path nil)
- ((getenv "MIMETYPES") (setq path (getenv "MIMETYPES")))
- ((memq system-type '(ms-dos ms-windows windows-nt))
- (setq path (mapconcat 'expand-file-name
- '("~/mime.typ" "~/etc/mime.typ") ";")))
- (t (setq path (mapconcat 'expand-file-name
- '("~/.mime-types"
- "/etc/mime-types:/usr/etc/mime-types"
- "/usr/local/etc/mime-types"
- "/usr/local/www/conf/mime-types") ":"))))
- (let ((fnames (reverse
- (mm-string-to-tokens path
- (if (memq system-type
- '(ms-dos ms-windows windows-nt))
- ?;
- ?:))))
- fname)
- (while fnames
- (setq fname (car fnames))
- (if (and (file-exists-p fname) (file-readable-p fname))
- (mm-parse-mimetype-file (car fnames)))
- (setq fnames (cdr fnames)))))
-
-(defun mm-parse-mimetype-file (fname)
- ;; Parse out a mime-types file
- (let (type ; The MIME type for this line
- extns ; The extensions for this line
- save-pos ; Misc. saved buffer positions
- )
- (save-excursion
- (set-buffer (get-buffer-create " *mime-types*"))
- (erase-buffer)
- (insert-file-contents fname)
- (mm-replace-regexp "#.*" "")
- (mm-replace-regexp "\n+" "\n")
- (mm-replace-regexp "[ \t]+$" "")
- (goto-char (point-max))
- (skip-chars-backward " \t\n")
- (delete-region (point) (point-max))
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward " \t\n")
- (setq save-pos (point))
- (skip-chars-forward "^ \t")
- (downcase-region save-pos (point))
- (setq type (buffer-substring save-pos (point)))
- (while (not (eolp))
- (skip-chars-forward " \t")
- (setq save-pos (point))
- (skip-chars-forward "^ \t\n")
- (setq extns (cons (buffer-substring save-pos (point)) extns)))
- (while extns
- (setq mm-mime-extensions
- (cons
- (cons (if (= (string-to-char (car extns)) ?.)
- (car extns)
- (concat "." (car extns))) type) mm-mime-extensions)
- extns (cdr extns)))))))
-
-(defun mm-extension-to-mime (extn)
- "Return the MIME content type of the file extensions EXTN"
- (if (and (stringp extn)
- (not (eq (string-to-char extn) ?.)))
- (setq extn (concat "." extn)))
- (cdr (assoc (downcase extn) mm-mime-extensions)))
-
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Editing/Composition of body parts
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun mm-compose-type (type)
- ;; Compose a body section of MIME-type TYPE.
- (let* ((info (mm-mime-info type nil 5))
- (fnam (mm-generate-unique-filename))
- (comp (or (cdr (assoc "compose" info))))
- (ctyp (cdr (assoc "composetyped" info)))
- (buff (get-buffer-create " *mimecompose*"))
- (typeit (not ctyp))
- (retval "")
- (usef nil))
- (setq comp (mm-unescape-mime-test (or comp ctyp) info))
- (while (string-match "\\([^\\\\]\\)%s" comp)
- (setq comp (concat (substring comp 0 (match-end 1)) fnam
- (substring comp (match-end 0) nil))
- usef t))
- (call-process shell-file-name nil
- (if usef nil buff)
- nil shell-command-switch comp)
- (setq retval
- (concat
- (if typeit (concat "Content-type: " type "\r\n\r\n") "")
- (if usef
- (save-excursion
- (set-buffer buff)
- (erase-buffer)
- (insert-file-contents fnam)
- (buffer-string))
- (save-excursion
- (set-buffer buff)
- (buffer-string)))
- "\r\n"))
- retval))
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Misc.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun mm-type-to-file (type)
- "Return the file extension for content-type TYPE"
- (rassoc type mm-mime-extensions))
-
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Miscellaneous MIME viewers written in elisp
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun mm-play-sound-file (&optional buff)
- "Play a sound file in buffer BUFF (defaults to current buffer)"
- (setq buff (or buff (current-buffer)))
- (let ((fname (mm-generate-unique-filename "%s.au"))
- (synchronous-sounds t)) ; Play synchronously
- (mule-write-region-no-coding-system (point-min) (point-max) fname)
- (kill-buffer (current-buffer))
- (play-sound-file fname)
- (condition-case ()
- (delete-file fname)
- (error nil))))
-
-(defun mm-parse-mime-headers (&optional no-delete)
- "Return a list of the MIME headers at the top of this buffer. If
-optional argument NO-DELETE is non-nil, don't delete the headers."
- (let* ((st (point-min))
- (nd (progn
- (goto-char (point-min))
- (skip-chars-forward " \t\n")
- (if (re-search-forward "^\r*$" nil t)
- (1+ (point))
- (point-max))))
- save-pos
- status
- hname
- hvalu
- result
- search
- )
- (narrow-to-region st (min nd (point-max)))
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward " \t\n\r")
- (setq save-pos (point))
- (skip-chars-forward "^:\n\r")
- (downcase-region save-pos (point))
- (setq hname (buffer-substring save-pos (point)))
- (skip-chars-forward ": \t ")
- (setq save-pos (point))
- (skip-chars-forward "^\n\r")
- (setq search t)
- (while search
- (skip-chars-forward "^\n\r")
- (save-excursion
- (skip-chars-forward "\n\r")
-
- (setq search
- (string-match "[ \t]"
- (char-to-string
- (or (char-after (point)) ?a)))))
- (if search
- (skip-chars-forward "\n\r")))
- (setq hvalu (buffer-substring save-pos (point))
- result (cons (cons hname hvalu) result)))
- (or no-delete (delete-region st nd))
- result))
-
-(defun mm-find-available-multiparts (separator &optional buf)
- "Return a list of mime-headers for the various body parts of a
-multipart message in buffer BUF with separator SEPARATOR.
-The different multipart specs are put in `mm-temporary-directory'."
- (let ((sep (concat "^--" separator "\r*$"))
- headers
- fname
- results)
- (save-excursion
- (and buf (set-buffer buf))
- (goto-char (point-min))
- (while (re-search-forward sep nil t)
- (let ((st (set-marker (make-marker)
- (progn
- (forward-line 1)
- (beginning-of-line)
- (point))))
- (nd (set-marker (make-marker)
- (if (re-search-forward sep nil t)
- (1- (match-beginning 0))
- (point-max)))))
- (narrow-to-region st nd)
- (goto-char st)
- (if (looking-at "^\r*$")
- (insert "Content-type: text/plain\n"
- "Content-length: " (int-to-string (- nd st)) "\n"))
- (setq headers (mm-parse-mime-headers)
- fname (mm-generate-unique-filename))
- (let ((x (or (cdr (assoc "content-type" headers)) "text/plain")))
- (if (string-match "name=\"*\\([^ \"]+\\)\"*" x)
- (setq fname (expand-file-name
- (substring x (match-beginning 1)
- (match-end 1))
- mm-temporary-directory))))
- (widen)
- (if (assoc "content-transfer-encoding" headers)
- (let ((coding (cdr
- (assoc "content-transfer-encoding" headers)))
- (cmd nil))
- (setq coding (and coding (downcase coding))
- cmd (or (cdr (assoc coding
- mm-content-transfer-encodings))
- (read-string
- (concat "How shall I decode " coding "? ")
- "cat")))
- (if (string= cmd "") (setq cmd "cat"))
- (if (stringp cmd)
- (shell-command-on-region st nd cmd t)
- (funcall cmd st nd))
- (or (eq cmd 'ignore) (set-marker nd (point)))))
- (write-region st nd fname nil 5)
- (delete-region st nd)
- (setq results (cons
- (cons
- (cons "mm-filename" fname) headers) results)))))
- results))
-
-(defun mm-format-multipart-as-html (&optional buf type)
- (if buf (set-buffer buf))
- (let* ((boundary (if (string-match
- "boundary[ \t]*=[ \t\"]*\\([^ \"\t\n]+\\)"
- type)
- (regexp-quote
- (substring type (match-beginning 1) (match-end 1)))))
- (parts (mm-find-available-multiparts boundary)))
- (erase-buffer)
- (insert "<html>\n"
- " <head>\n"
- " <title>Multipart Message</title>\n"
- " </head>\n"
- " <body>\n"
- " <h1> Multipart message encountered </h1>\n"
- " <p> I have encountered a multipart MIME message.\n"
- " The following parts have been detected. Please\n"
- " select which one you want to view.\n"
- " </p>\n"
- " <ul>\n"
- (mapconcat
- (function (lambda (x)
- (concat " <li> <a href=\"file:"
- (cdr (assoc "mm-filename" x))
- "\">"
- (or (cdr (assoc "content-description" x)) "")
- "--"
- (or (cdr (assoc "content-type" x))
- "unknown type")
- "</a> </li>")))
- parts "\n")
- " </ul>\n"
- " </body>\n"
- "</html>\n"
- "<!-- Automatically generated by MM v" mm-version "-->\n")))
-
-(defun mm-multipart-viewer ()
- (mm-format-multipart-as-html
- (current-buffer)
- (cdr (assoc "content-type" url-current-mime-headers)))
- (let ((w3-working-buffer (current-buffer)))
- (w3-prepare-buffer)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Transfer encodings we can decrypt automatically
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun mm-decode-quoted-printable (&optional st nd)
- (interactive)
- (setq st (or st (point-min))
- nd (or nd (point-max)))
- (save-restriction
- (narrow-to-region st nd)
- (save-excursion
- (let ((buffer-read-only nil))
- (goto-char (point-min))
- (while (re-search-forward "=[0-9A-F][0-9A-F]" nil t)
- (replace-match
- (char-to-string
- (+
- (* 16 (mm-hex-char-to-integer
- (char-after (1+ (match-beginning 0)))))
- (mm-hex-char-to-integer
- (char-after (1- (match-end 0))))))))))
- (goto-char (point-max))))
-
-;; Taken from hexl.el.
-(defun mm-hex-char-to-integer (character)
- "Take a char and return its value as if it was a hex digit."
- (if (and (>= character ?0) (<= character ?9))
- (- character ?0)
- (let ((ch (logior character 32)))
- (if (and (>= ch ?a) (<= ch ?f))
- (- ch (- ?a 10))
- (error (format "Invalid hex digit `%c'." ch))))))
-
-
-\f
-(require 'base64)
-(provide 'mm)
+++ /dev/null
-;;; qp.el --- Quoted-Printable functions
-;; 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:
-
-(defvar quoted-printable-encoding-characters
- (mapcar 'identity "0123456789ABCDEF"))
-
-(defun quoted-printable-decode-region (from to)
- "Decode quoted-printable in the region between FROM and TO."
- (interactive "r")
- (save-excursion
- (goto-char from)
- (while (search-forward "=" to t)
- (cond ((eq (char-after) ?\n)
- (delete-char -1)
- (delete-char 1))
- ((and
- (memq (char-after) quoted-printable-encoding-characters)
- (memq (char-after (1+ (point)))
- quoted-printable-encoding-characters))
- (subst-char-in-region
- (1- (point)) (point) ?=
- (string-to-number
- (buffer-substring (point) (+ 2 (point)))
- 16))
- (delete-char 2))
- ((looking-at "=")
- (delete-char 1))
- ((message "Malformed MIME quoted-printable message"))))))
-
-(defun quoted-printable-decode-string (string)
- "Decode the quoted-printable-encoded STRING and return the results."
- (with-temp-buffer
- (insert string)
- (quoted-printable-decode-region (point-min) (point-max))
- (buffer-string)))
-
-(defun quoted-printable-encode-region (from to &optional fold class)
- "QP-encode the region between FROM and TO.
-If FOLD, fold long lines. If CLASS, translate the characters
-matched by that regexp."
- (interactive "r")
- (save-excursion
- (save-restriction
- (narrow-to-region from to)
- (mm-encode-body)
- (goto-char (point-min))
- (while (and (skip-chars-forward
- (or class "^\000-\007\013\015-\037\200-\377="))
- (not (eobp)))
- (insert
- (prog1
- (upcase (format "=%x" (char-after)))
- (delete-char 1))))
- (when fold
- ;; Fold long lines.
- (goto-char (point-min))
- (end-of-line)
- (while (> (current-column) 72)
- (beginning-of-line)
- (forward-char 72)
- (search-backward "=" (- (point) 2) t)
- (insert "=\n")
- (end-of-line))))))
-
-(defun quoted-printable-encode-string (string)
- "QP-encode STRING and return the results."
- (mm-with-unibyte-buffer
- (insert string)
- (quoted-printable-encode-region (point-min) (point-max))
- (buffer-string)))
-
-(provide 'qp)
-
-;; qp.el ends here
+++ /dev/null
-;;; rfc1522.el --- Functions for encoding and decoding rfc1522 messages
-;; Copyright (C) 1998 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; 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 'base64)
-(require 'qp)
-(require 'mm-util)
-
-(defvar rfc1522-header-encoding-alist
- '(("Newsgroups" . nil)
- ("Message-ID" . nil)
- (t . mime))
- "*Header/encoding method alist.
-The list is traversed sequentially. The keys can either be
-header regexps or `t'.
-
-The values can be:
-
-1) nil, in which case no encoding is done;
-2) `mime', in which case the header will be encoded according to RFC1522;
-3) a charset, in which case it will be encoded as that charse;
-4) `default', in which case the field will be encoded as the rest
- of the article.")
-
-(defvar rfc1522-charset-encoding-alist
- '((us-ascii . nil)
- (iso-8859-1 . Q)
- (iso-8859-2 . Q)
- (iso-8859-3 . Q)
- (iso-8859-4 . Q)
- (iso-8859-5 . Q)
- (koi8-r . Q)
- (iso-8859-7 . Q)
- (iso-8859-8 . Q)
- (iso-8859-9 . Q)
- (iso-2022-jp . B)
- (iso-2022-kr . B)
- (gb2312 . B)
- (cn-gb . B)
- (cn-gb-2312 . B)
- (euc-kr . B)
- (iso-2022-jp-2 . B)
- (iso-2022-int-1 . B))
- "Alist of MIME charsets to RFC1522 encodings.
-Valid encodings are nil, `Q' and `B'.")
-
-(defvar rfc1522-encoding-function-alist
- '((Q . rfc1522-q-encode-region)
- (B . base64-encode-region)
- (nil . ignore))
- "Alist of RFC1522 encodings to encoding functions.")
-
-(defvar rfc1522-q-encoding-alist
- '(("\\(From\\|Cc\\|To\\|Bcc\||Reply-To\\):" . "[^-A-Za-z0-9!*+/=_]")
- ("." . "[\000-\007\013\015-\037\200-\377=_?]"))
- "Alist of header regexps and valid Q characters.")
-
-;;;
-;;; Functions for encoding RFC1522 messages
-;;;
-
-(defun rfc1522-narrow-to-field ()
- "Narrow the buffer to the header on the current line."
- (beginning-of-line)
- (narrow-to-region
- (point)
- (progn
- (forward-line 1)
- (if (re-search-forward "^[^ \n\t]" nil t)
- (progn
- (beginning-of-line)
- (point))
- (point-max))))
- (goto-char (point-min)))
-
-;;;###autoload
-(defun rfc1522-encode-message-header ()
- "Encode the message header according to `rfc1522-header-encoding-alist'.
-Should be called narrowed to the head of the message."
- (interactive "*")
- (when (featurep 'mule)
- (save-excursion
- (let ((alist rfc1522-header-encoding-alist)
- elem method)
- (while (not (eobp))
- (save-restriction
- (rfc1522-narrow-to-field)
- (when (find-non-ascii-charset-region (point-min) (point-max))
- ;; We found something that may perhaps be encoded.
- (while (setq elem (pop alist))
- (when (or (and (stringp (car elem))
- (looking-at (car elem)))
- (eq (car elem) t))
- (setq alist nil
- method (cdr elem))))
- (when method
- (cond
- ((eq method 'mime)
- (rfc1522-encode-region (point-min) (point-max)))
- ;; Hm.
- (t))))
- (goto-char (point-max))))))))
-
-(defun rfc1522-encode-region (b e)
- "Encode all encodable words in REGION."
- (let (prev c start qstart qprev qend)
- (save-excursion
- (goto-char b)
- (while (re-search-forward "[^ \t\n]+" nil t)
- (save-restriction
- (narrow-to-region (match-beginning 0) (match-end 0))
- (goto-char (setq start (point-min)))
- (setq prev nil)
- (while (not (eobp))
- (unless (eq (setq c (char-charset (following-char))) 'ascii)
- (cond
- ((eq c prev)
- )
- ((null prev)
- (setq qstart (or qstart start)
- qend (point-max)
- qprev c)
- (setq prev c))
- (t
- ;(rfc1522-encode start (setq start (point)) prev)
- (setq prev c))))
- (forward-char 1)))
- (when (and (not prev) qstart)
- (rfc1522-encode qstart qend qprev)
- (setq qstart nil)))
- (when qstart
- (rfc1522-encode qstart qend qprev)
- (setq qstart nil)))))
-
-(defun rfc1522-encode-string (string)
- "Encode words in STRING."
- (with-temp-buffer
- (insert string)
- (rfc1522-encode-region (point-min) (point-max))
- (buffer-string)))
-
-(defun rfc1522-encode (b e charset)
- "Encode the word in the region with CHARSET."
- (let* ((mime-charset (mm-mule-charset-to-mime-charset charset))
- (encoding (cdr (assq mime-charset
- rfc1522-charset-encoding-alist)))
- (start (concat
- "=?" (downcase (symbol-name mime-charset)) "?"
- (downcase (symbol-name encoding)) "?")))
- (save-restriction
- (narrow-to-region b e)
- (insert
- (prog1
- (mm-encode-coding-string (buffer-string) mime-charset)
- (delete-region (point-min) (point-max))))
- (funcall (cdr (assq encoding rfc1522-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)))))
-
-(defun rfc1522-q-encode-region (b e)
- "Encode the header contained in REGION with the Q encoding."
- (save-excursion
- (save-restriction
- (narrow-to-region (goto-char b) e)
- (let ((alist rfc1522-q-encoding-alist))
- (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))))))
-
-;;;
-;;; Functions for decoding RFC1522 messages
-;;;
-
-(defvar rfc1522-encoded-word-regexp
- "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~]+\\)\\?=")
-
-;;;###autoload
-(defun rfc1522-decode-region (start end)
- "Decode MIME-encoded words in region between START and END."
- (interactive "r")
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (goto-char (point-min))
- ;; Remove whitespace between encoded words.
- (while (re-search-forward
- (concat "\\(" rfc1522-encoded-word-regexp "\\)"
- "\\(\n?[ \t]\\)+"
- "\\(" rfc1522-encoded-word-regexp "\\)")
- nil t)
- (delete-region (goto-char (match-end 1)) (match-beginning 6)))
- ;; Decode the encoded words.
- (goto-char (point-min))
- (while (re-search-forward rfc1522-encoded-word-regexp nil t)
- (insert (rfc1522-parse-and-decode
- (prog1
- (match-string 0)
- (delete-region (match-beginning 0) (match-end 0)))))))))
-
-;;;###autoload
-(defun rfc1522-decode-string (string)
- "Decode the quoted-printable-encoded STRING and return the results."
- (with-temp-buffer
- (insert string)
- (inline
- (rfc1522-decode-region (point-min) (point-max)))
- (buffer-string)))
-
-(defun rfc1522-parse-and-decode (word)
- "Decode WORD and return it if it is an encoded word.
-Return WORD if not."
- (if (not (string-match rfc1522-encoded-word-regexp word))
- word
- (or
- (condition-case nil
- (rfc1522-decode
- (match-string 1 word)
- (upcase (match-string 2 word))
- (match-string 3 word))
- (error word))
- word)))
-
-(defun rfc1522-decode (charset encoding string)
- "Decode STRING as an encoded text.
-Valid ENCODINGs are \"B\" and \"Q\".
-If your Emacs implementation can't decode CHARSET, it returns nil."
- (let ((cs (mm-charset-to-coding-system charset)))
- (when cs
- (mm-decode-coding-string
- (cond
- ((equal "B" encoding)
- (base64-decode string))
- ((equal "Q" encoding)
- (quoted-printable-decode-string
- (mm-replace-chars-in-string string ?_ ? )))
- (t (error "Invalid encoding: %s" encoding)))
- cs))))
-
-(provide 'rfc1522)
-
-;;; rfc1522.el ends here
+++ /dev/null
-;;; rfc2047.el --- Functions for encoding and decoding rfc2047 messages
-;; Copyright (C) 1998 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; 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:
-
-(eval-and-compile
- (eval
- '(unless (fboundp 'base64-decode-string)
- (require 'base64))))
-
-(require 'qp)
-(require 'mm-util)
-(require 'ietf-drums)
-
-(defvar rfc2047-default-charset 'iso-8859-1
- "Default MIME charset -- does not need encoding.")
-
-(defvar rfc2047-header-encoding-alist
- '(("Newsgroups" . nil)
- ("Message-ID" . nil)
- (t . mime))
- "*Header/encoding method alist.
-The list is traversed sequentially. The keys can either be
-header regexps or `t'.
-
-The values can be:
-
-1) nil, in which case no encoding is done;
-2) `mime', in which case the header will be encoded according to RFC2047;
-3) a charset, in which case it will be encoded as that charse;
-4) `default', in which case the field will be encoded as the rest
- of the article.")
-
-(defvar rfc2047-charset-encoding-alist
- '((us-ascii . nil)
- (iso-8859-1 . Q)
- (iso-8859-2 . Q)
- (iso-8859-3 . Q)
- (iso-8859-4 . Q)
- (iso-8859-5 . B)
- (koi8-r . B)
- (iso-8859-7 . Q)
- (iso-8859-8 . Q)
- (iso-8859-9 . Q)
- (iso-2022-jp . B)
- (iso-2022-kr . B)
- (gb2312 . B)
- (cn-gb . B)
- (cn-gb-2312 . B)
- (euc-kr . B)
- (iso-2022-jp-2 . B)
- (iso-2022-int-1 . B))
- "Alist of MIME charsets to RFC2047 encodings.
-Valid encodings are nil, `Q' and `B'.")
-
-(defvar rfc2047-encoding-function-alist
- '((Q . rfc2047-q-encode-region)
- (B . rfc2047-b-encode-region)
- (nil . ignore))
- "Alist of RFC2047 encodings to encoding functions.")
-
-(defvar rfc2047-q-encoding-alist
- '(("\\(From\\|Cc\\|To\\|Bcc\||Reply-To\\):" . "-A-Za-z0-9!*+/=_")
- ("." . "^\000-\007\013\015-\037\200-\377=_?"))
- "Alist of header regexps and valid Q characters.")
-
-;;;
-;;; Functions for encoding RFC2047 messages
-;;;
-
-(defun rfc2047-narrow-to-field ()
- "Narrow the buffer to the header on the current line."
- (beginning-of-line)
- (narrow-to-region
- (point)
- (progn
- (forward-line 1)
- (if (re-search-forward "^[^ \n\t]" nil t)
- (progn
- (beginning-of-line)
- (point))
- (point-max))))
- (goto-char (point-min)))
-
-(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
- (rfc2047-narrow-to-field)
- (when (rfc2047-encodable-p)
- ;; We found something that may perhaps be encoded.
- (while (setq elem (pop alist))
- (when (or (and (stringp (car elem))
- (looking-at (car elem)))
- (eq (car elem) t))
- (setq alist nil
- method (cdr elem))))
- (when method
- (cond
- ((eq method 'mime)
- (rfc2047-encode-region (point-min) (point-max)))
- ;; Hm.
- (t))))
- (goto-char (point-max)))))
- (when rfc2047-default-charset
- (encode-coding-region (point-min) (point-max)
- rfc2047-default-charset)))))
-
-(defun rfc2047-encodable-p ()
- "Say whether the current (narrowed) buffer contains characters that need encoding."
- (let ((charsets (mapcar
- 'mm-mule-charset-to-mime-charset
- (find-charset-region (point-min) (point-max))))
- (cs (list 'us-ascii rfc2047-default-charset))
- found)
- (while charsets
- (unless (memq (pop charsets) cs)
- (setq found t)))
- found))
-
-(defun rfc2047-dissect-region (b e)
- "Dissect the region between B and E."
- (let (words)
- (save-restriction
- (narrow-to-region b e)
- (goto-char (point-min))
- (while (re-search-forward
- (concat "[^" ietf-drums-tspecials " \t\n]+") nil t)
- (push
- (list (match-beginning 0) (match-end 0)
- (car
- (delq 'ascii
- (find-charset-region (match-beginning 0)
- (match-end 0)))))
- words))
- words)))
-
-(defun rfc2047-encode-region (b e)
- "Encode all encodable words in REGION."
- (let ((words (rfc2047-dissect-region b e))
- beg end current word)
- (while (setq word (pop words))
- (if (equal (nth 2 word) current)
- (setq beg (nth 0 word))
- (when current
- (rfc2047-encode beg end current))
- (setq current (nth 2 word)
- beg (nth 0 word)
- end (nth 1 word))))
- (when current
- (rfc2047-encode beg end current))))
-
-(defun rfc2047-encode-string (string)
- "Encode words in STRING."
- (with-temp-buffer
- (insert string)
- (rfc2047-encode-region (point-min) (point-max))
- (buffer-string)))
-
-(defun rfc2047-encode (b e charset)
- "Encode the word in the region with CHARSET."
- (let* ((mime-charset
- (mm-mime-charset charset b e))
- (encoding (or (cdr (assq mime-charset
- rfc2047-charset-encoding-alist))
- 'B))
- (start (concat
- "=?" (downcase (symbol-name mime-charset)) "?"
- (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))
- (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)
- (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."
- (save-excursion
- (save-restriction
- (narrow-to-region (goto-char b) e)
- (let ((alist rfc2047-q-encoding-alist))
- (while alist
- (when (looking-at (caar alist))
- (quoted-printable-encode-region b e nil (cdar alist))
- (subst-char-in-region (point-min) (point-max) ? ?_)
- (setq alist nil))
- (pop alist))
- (goto-char (point-min))
- (while (not (eobp))
- (goto-char (min (point-max) (+ 64 (point))))
- (search-backward "=" (- (point) 2) t)
- (unless (eobp)
- (insert "\n")))))))
-
-;;;
-;;; Functions for decoding RFC2047 messages
-;;;
-
-(defvar rfc2047-encoded-word-regexp
- "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ +]+\\)\\?=")
-
-(defun rfc2047-decode-region (start end)
- "Decode MIME-encoded words in region between START and END."
- (interactive "r")
- (let ((case-fold-search t)
- b e)
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (goto-char (point-min))
- ;; Remove whitespace between encoded words.
- (while (re-search-forward
- (concat "\\(" rfc2047-encoded-word-regexp "\\)"
- "\\(\n?[ \t]\\)+"
- "\\(" rfc2047-encoded-word-regexp "\\)")
- nil t)
- (delete-region (goto-char (match-end 1)) (match-beginning 6)))
- ;; Decode the encoded words.
- (setq b (goto-char (point-min)))
- (while (re-search-forward rfc2047-encoded-word-regexp nil t)
- (setq e (match-beginning 0))
- (insert (rfc2047-parse-and-decode
- (prog1
- (match-string 0)
- (delete-region (match-beginning 0) (match-end 0)))))
- (when (and (mm-multibyte-p) rfc2047-default-charset)
- (mm-decode-coding-region b e rfc2047-default-charset))
- (setq b (point)))
- (when (and (mm-multibyte-p) rfc2047-default-charset)
- (mm-decode-coding-region b (point-max) rfc2047-default-charset))))))
-
-(defun rfc2047-decode-string (string)
- "Decode the quoted-printable-encoded STRING and return the results."
- (let ((m (mm-multibyte-p)))
- (with-temp-buffer
- (when m
- (mm-enable-multibyte))
- (insert string)
- (inline
- (rfc2047-decode-region (point-min) (point-max)))
- (buffer-string))))
-
-(defun rfc2047-parse-and-decode (word)
- "Decode WORD and return it if it is an encoded word.
-Return WORD if not."
- (if (not (string-match rfc2047-encoded-word-regexp word))
- word
- (or
- (condition-case nil
- (rfc2047-decode
- (match-string 1 word)
- (upcase (match-string 2 word))
- (match-string 3 word))
- (error word))
- word)))
-
-(defun rfc2047-decode (charset encoding string)
- "Decode STRING that uses CHARSET with ENCODING.
-Valid ENCODINGs are \"B\" and \"Q\".
-If your Emacs implementation can't decode CHARSET, it returns nil."
- (let ((cs (mm-charset-to-coding-system charset)))
- (when cs
- (when (eq cs 'ascii)
- (setq cs rfc2047-default-charset))
- (mm-decode-coding-string
- (cond
- ((equal "B" encoding)
- (base64-decode-string string))
- ((equal "Q" encoding)
- (quoted-printable-decode-string
- (mm-replace-chars-in-string string ?_ ? )))
- (t (error "Invalid encoding: %s" encoding)))
- cs))))
-
-(provide 'rfc2047)
-
-;;; rfc2047.el ends here
+++ /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 'ietf-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 (ietf-drums-token-to-list ietf-drums-text-token))
- (stoken (ietf-drums-token-to-list ietf-drums-tspecials))
- (ntoken (ietf-drums-token-to-list "0-9"))
- (prev-value "")
- display-name mailbox c display-string parameters
- attribute value type subtype number encoded
- prev-attribute)
- (ietf-drums-init (mail-header-remove-whitespace
- (mail-header-remove-comments string)))
- (let ((table (copy-syntax-table ietf-drums-syntax-table)))
- (modify-syntax-entry ?\' "w" table)
- (set-syntax-table table))
- (setq c (char-after))
- (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 (char-after))
- (unless (eq c ?\;)
- (error "Invalid header: %s" string))
- (forward-char 1)
- (setq c (char-after))
- (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 (char-after))
- (setq encoded nil)
- (when (eq c ?*)
- (forward-char 1)
- (setq c (char-after))
- (when (memq c ntoken)
- (setq number
- (string-to-number
- (buffer-substring
- (point) (progn (forward-sexp 1) (point)))))
- (setq c (char-after))
- (when (eq c ?*)
- (setq encoded t)
- (forward-char 1)
- (setq c (char-after)))))
- ;; 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 (char-after))
- (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
+++ /dev/null
-;;; time-date.el --- Date and time handling functions
-;; Copyright (C) 1998 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu Umeda <umerin@mse.kyutech.ac.jp>
-;; 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 'parse-time)
-
-(defun date-to-time (date)
- "Convert DATE into time."
- (condition-case ()
- (apply 'encode-time (parse-time-string date))
- (error (error "Invalid date: %s" date))))
-
-(defun time-to-seconds (time)
- "Convert TIME to a floating point number."
- (+ (* (car time) 65536.0)
- (cadr time)
- (/ (or (caddr time) 0) 1000000.0)))
-
-(defun seconds-to-time (seconds)
- "Convert SECONDS (a floating point number) to an Emacs time structure."
- (list (floor seconds 65536)
- (floor (mod seconds 65536))
- (floor (* (- seconds (ffloor seconds)) 1000000))))
-
-(defun time-less-p (t1 t2)
- "Say whether time T1 is less than time T2."
- (or (< (car t1) (car t2))
- (and (= (car t1) (car t2))
- (< (nth 1 t1) (nth 1 t2)))))
-
-(defun days-to-time (days)
- "Convert DAYS into time."
- (let* ((seconds (* 1.0 days 60 60 24))
- (rest (expt 2 16))
- (ms (condition-case nil (floor (/ seconds rest))
- (range-error (expt 2 16)))))
- (list ms (condition-case nil (round (- seconds (* ms rest)))
- (range-error (expt 2 16))))))
-
-(defun time-since (time)
- "Return the time since TIME, which is either an internal time or a date."
- (when (stringp time)
- ;; Convert date strings to internal time.
- (setq time (date-to-time time)))
- (let* ((current (current-time))
- (rest (when (< (nth 1 current) (nth 1 time))
- (expt 2 16))))
- (list (- (+ (car current) (if rest -1 0)) (car time))
- (- (+ (or rest 0) (nth 1 current)) (nth 1 time)))))
-
-(defun subtract-time (t1 t2)
- "Subtract two internal times."
- (let ((borrow (< (cadr t1) (cadr t2))))
- (list (- (car t1) (car t2) (if borrow 1 0))
- (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
-
-(defun date-to-day (date)
- "Return the number of days between year 1 and DATE."
- (time-to-days (date-to-time date)))
-
-(defun days-between (date1 date2)
- "Return the number of days between DATE1 and DATE2."
- (- (date-to-day date1) (date-to-day date2)))
-
-(defun date-leap-year-p (year)
- "Return t if YEAR is a leap year."
- (or (and (zerop (% year 4))
- (not (zerop (% year 100))))
- (zerop (% year 400))))
-
-(defun time-to-day-in-year (time)
- "Return the day number within the year of the date month/day/year."
- (let* ((tim (decode-time time))
- (month (nth 4 tim))
- (day (nth 3 tim))
- (year (nth 5 tim))
- (day-of-year (+ day (* 31 (1- month)))))
- (when (> month 2)
- (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
- (when (date-leap-year-p year)
- (setq day-of-year (1+ day-of-year))))
- day-of-year))
-
-(defun time-to-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))
- (month (nth 4 tim))
- (day (nth 3 tim))
- (year (nth 5 tim)))
- (+ (time-to-day-in-year time) ; Days this year
- (* 365 (1- year)) ; + Days in prior years
- (/ (1- year) 4) ; + Julian leap years
- (- (/ (1- year) 100)) ; - century years
- (/ (1- year) 400)))) ; + Gregorian leap years
-
-(defun safe-date-to-time (date)
- "Parse DATE and return a time structure.
-If DATE is malformed, a zero time will be returned."
- (condition-case ()
- (date-to-time date)
- (error '(0 0))))
-
-(provide 'time-date)
-
-;;; time-date.el ends here
+++ /dev/null
-;;; uudecode.el -- elisp native uudecode
-;; Copyright (c) 1998 by Shenghuo Zhu <zsh@cs.rochester.edu>
-
-;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; $Revision: 5.2 $
-;; Keywords: uudecode
-
-;; This file is not part of GNU Emacs, but the same permissions
-;; apply.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Lots of codes are stolen from mm-decode.el, gnus-uu.el and
-;; base64.el
-
-;;; Code:
-
-(if (not (fboundp 'char-int))
- (fset 'char-int 'identity))
-
-(defvar uudecode-decoder-program "uudecode"
- "*Non-nil value should be a string that names a uu decoder.
-The program should expect to read uu data on its standard
-input and write the converted data to its standard output.")
-
-(defvar uudecode-decoder-switches nil
- "*List of command line flags passed to the command named by uudecode-decoder-program.")
-
-(defconst uudecode-alphabet "\040-\140")
-
-(defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
-(defconst uudecode-end-line "^end[ \t]*$")
-
-(defconst uudecode-body-line
- (let ((i 61) (str "^M"))
- (while (> (setq i (1- i)) 0)
- (setq str (concat str "[^a-z]")))
- (concat str ".?$")))
-
-(defvar uudecode-temporary-file-directory "/tmp/")
-
-;;;###autoload
-(defun uudecode-decode-region-external (start end &optional file-name)
- "uudecode region between START and END with external decoder.
-
-If FILE-NAME is non-nil, save the result to FILE-NAME."
- (interactive "r\nP")
- (let ((cbuf (current-buffer)) tempfile firstline work-buffer status)
- (save-excursion
- (goto-char start)
- (when (re-search-forward uudecode-begin-line nil t)
- (forward-line 1)
- (setq firstline (point))
- (cond ((null file-name))
- ((stringp file-name))
- (t
- (setq file-name (read-file-name "File to Name:"
- nil nil nil
- (match-string 1)))))
- (setq tempfile (expand-file-name
- (or file-name (concat uudecode-temporary-file-directory
- (make-temp-name "uu")))))
- (let ((cdir default-directory) default-process-coding-system)
- (unwind-protect
- (progn
- (set-buffer (setq work-buffer
- (generate-new-buffer " *uudecode-work*")))
- (buffer-disable-undo work-buffer)
- (insert "begin 600 " (file-name-nondirectory tempfile) "\n")
- (insert-buffer-substring cbuf firstline end)
- (cd (file-name-directory tempfile))
- (apply 'call-process-region
- (point-min)
- (point-max)
- uudecode-decoder-program
- nil
- nil
- nil
- uudecode-decoder-switches))
- (cd cdir) (set-buffer cbuf)))
- (if (file-exists-p tempfile)
- (unless file-name
- (goto-char start)
- (delete-region start end)
- (let (format-alist)
- (insert-file-contents-literally tempfile)))
- (message "Can not uudecode")))
- (and work-buffer (kill-buffer work-buffer))
- (condition-case ()
- (or file-name (delete-file tempfile))
- (error))
- )))
-
-(defun uudecode-insert-char (char &optional count ignored buffer)
- (condition-case nil
- (progn
- (insert-char char count ignored buffer)
- (fset 'uudecode-insert-char 'insert-char))
- (wrong-number-of-arguments
- (fset 'uudecode-insert-char 'uudecode-xemacs-insert-char)
- (uudecode-insert-char char count ignored buffer))))
-
-(defun uudecode-xemacs-insert-char (char &optional count ignored buffer)
- (if (or (null buffer) (eq buffer (current-buffer)))
- (insert-char char count)
- (save-excursion
- (set-buffer buffer)
- (insert-char char count))))
-
-;;;###autoload
-
-(defun uudecode-decode-region (start end &optional file-name)
- "uudecode region between START and END.
-If FILE-NAME is non-nil, save the result to FILE-NAME."
- (interactive "r\nP")
- (let ((work-buffer nil)
- (done nil)
- (counter 0)
- (remain 0)
- (bits 0)
- (lim 0) inputpos
- (non-data-chars (concat "^" uudecode-alphabet)))
- (unwind-protect
- (save-excursion
- (goto-char start)
- (when (re-search-forward uudecode-begin-line nil t)
- (cond ((null file-name))
- ((stringp file-name))
- (t
- (setq file-name (expand-file-name
- (read-file-name "File to Name:"
- nil nil nil
- (match-string 1))))))
- (setq work-buffer (generate-new-buffer " *uudecode-work*"))
- (buffer-disable-undo work-buffer)
- (forward-line 1)
- (skip-chars-forward non-data-chars end)
- (while (not done)
- (setq inputpos (point))
- (setq remain 0 bits 0 counter 0)
- (cond
- ((> (skip-chars-forward uudecode-alphabet end) 0)
- (setq lim (point))
- (setq remain
- (logand (- (char-int (char-after inputpos)) 32) 63))
- (setq inputpos (1+ inputpos))
- (if (= remain 0) (setq done t))
- (while (and (< inputpos lim) (> remain 0))
- (setq bits (+ bits
- (logand
- (-
- (char-int (char-after inputpos)) 32) 63)))
- (if (/= counter 0) (setq remain (1- remain)))
- (setq counter (1+ counter)
- inputpos (1+ inputpos))
- (cond ((= counter 4)
- (uudecode-insert-char
- (lsh bits -16) 1 nil work-buffer)
- (uudecode-insert-char
- (logand (lsh bits -8) 255) 1 nil work-buffer)
- (uudecode-insert-char (logand bits 255) 1 nil
- work-buffer)
- (setq bits 0 counter 0))
- (t (setq bits (lsh bits 6)))))))
- (cond
- (done)
- ((> 0 remain)
- (error "uucode line ends unexpectly")
- (setq done t))
- ((and (= (point) end) (not done))
- ;(error "uucode ends unexpectly")
- (setq done t))
- ((= counter 3)
- (uudecode-insert-char (logand (lsh bits -16) 255) 1 nil
- work-buffer)
- (uudecode-insert-char (logand (lsh bits -8) 255) 1 nil
- work-buffer))
- ((= counter 2)
- (uudecode-insert-char (logand (lsh bits -10) 255) 1 nil
- work-buffer)))
- (skip-chars-forward non-data-chars end))
- (if file-name
- (save-excursion
- (set-buffer work-buffer)
- (write-file file-name))
- (or (markerp end) (setq end (set-marker (make-marker) end)))
- (goto-char start)
- (insert-buffer-substring work-buffer)
- (delete-region (point) end))))
- (and work-buffer (kill-buffer work-buffer)))))
-
-(provide 'uudecode)
-
-;;; uudecode.el ends here
+++ /dev/null
-\input texinfo @c -*-texinfo-*-
-
-@setfilename emacs-mime
-@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
-* Interface Functions:: An abstraction over the basic functions.
-* Basic Functions:: Utility and basic parsing functions.
-* Decoding and Viewing:: A framework for decoding and viewing.
-* Standards:: A summary of RFCs and working documents used.
-* Index:: Function and variable index.
-@end menu
-
-
-@node Interface Functions
-@chapter Interface Functions
-@cindex interface functions
-@cindex mail-parse
-
-The @code{mail-parse} library is an abstraction over the actual
-low-level libraries that are described in the next chapter.
-
-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\"")
-@result{} ("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)
-@result{} "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)")
-@result{} "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\"")
-@result{} "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)")
-@result{} "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>")
-@result{} ("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>")
-@result{} (("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")
-@result{} "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")
-@result{} "This is naïve, baby"
-@end example
-
-@end table
-
-Currently, @code{mail-parse} is an abstraction over @code{ietf-drums},
-@code{rfc2047} and @code{rfc2231}. These are documented in the
-subsequent sections.
-
-
-
-@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
-* rfc2231:: Parsing @code{Content-Type} headers.
-* ietf-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.
-* binhex:: Binhex decoding.
-* uudecode:: Uuencode decoding.
-* rfc1843:: Decoding HZ-encoded text.
-* mailcap:: How parts are displayed is specified by the @file{.mailcap} file
-@end menu
-
-
-@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!\"")
-@result{} ("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 ietf-drums
-@section ietf-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 ietf-drums-remove-comments
-@findex ietf-drums-remove-comments
-Remove the comments from the argument and return the results.
-
-@item ietf-drums-remove-whitespace
-@findex ietf-drums-remove-whitespace
-Remove linear white space from the string and return the results.
-Spaces inside quoted strings and comments are left untouched.
-
-@item ietf-drums-get-comment
-@findex ietf-drums-get-comment
-Return the last most comment from the string.
-
-@item ietf-drums-parse-address
-@findex ietf-drums-parse-address
-Parse an address string and return a list that contains the mailbox and
-the plain text name.
-
-@item ietf-drums-parse-addresses
-@findex ietf-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 ietf-drums-parse-date
-@findex ietf-drums-parse-date
-Parse a date string and return an Emacs time structure.
-
-@item ietf-drums-narrow-to-header
-@findex ietf-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 convert 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")
-@result{} (54 21 12 12 9 1998 6 nil 7200)
-
-(date-to-time "Sat Sep 12 12:21:54 1998 +0200")
-@result{} (13818 19266)
-
-(time-to-seconds '(13818 19266))
-@result{} 905595714.0
-
-(seconds-to-time 905595714.0)
-@result{} (13818 19266 0)
-
-(time-to-day '(13818 19266))
-@result{} 729644
-
-(days-to-time 729644)
-@result{} (961933 65536)
-
-(time-since '(13818 19266))
-@result{} (0 430)
-
-(time-less-p '(13818 19266) '(13818 19145))
-@result{} nil
-
-(subtract-time '(13818 19266) '(13818 19145))
-@result{} (0 121)
-
-(days-between "Sat Sep 12 12:21:54 1998 +0200"
- "Sat Sep 07 12:21:54 1998 +0200")
-@result{} 5
-
-(date-leap-year-p 2000)
-@result{} t
-
-(time-to-day-in-year '(13818 19266))
-@result{} 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
-@cindex 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 binhex
-@section binhex
-@cindex binhex
-@cindex Apple
-@cindex Macintosh
-
-@code{binhex} is an encoding that originated in Macintosh environments.
-The following function is supplied to deal with these:
-
-@table @code
-@item binhex-decode-region
-@findex binhex-decode-region
-Decode the encoded text in the region. If given a third parameter, only
-decode the @code{binhex} header and return the filename.
-
-@end table
-
-
-@node uudecode
-@section uudecode
-@cindex uuencode
-@cindex uudecode
-
-@code{uuencode} is probably still the most popular encoding of binaries
-used on Usenet, although @code{base64} rules the mail world.
-
-The following function is supplied by this package:
-
-@table @code
-@item uudecode-decode-region
-@findex uudecode-decode-region
-Decode the text in the region.
-@end table
-
-
-@node rfc1843
-@section rfc1843
-@cindex rfc1843
-@cindex HZ
-@cindex Chinese
-
-RFC1843 deals with mixing Chinese and ASCII characters in messages. In
-essence, RFC1843 switches between ASCII and Chinese by doing this:
-
-@example
-This sentence is in ASCII.
-The next sentence is in GB.~@{<:Ky2;S@{#,NpJ)l6HK!#~@}Bye.
-@end example
-
-Simple enough, and widely used in China.
-
-The following functions are available to handle this encoding:
-
-@table @code
-@item rfc1843-decode-region
-Decode HZ-encoded text in the region.
-
-@item rfc1843-decode-string
-Decode a HZ-encoded string and return the result.
-
-@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/*; gimp -8 %s
-audio/wav; wavplayer %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 analysis.
-
-@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 Standards
-@chapter Standards
-
-The Emacs @sc{mime} library implements handling of various elements
-according to a (somewhat) large number of RFCs, drafts and standards
-documents. This chapter lists the relevant ones. They can all be
-fetched from @samp{http://www.stud.ifi.uio.no/~larsi/notes/}.
-
-@table @dfn
-@item RFC822
-@itemx STD11
-Standard for the Format of ARPA Internet Text Messages.
-
-@item RFC1036
-Standard for Interchange of USENET Messages
-
-@item RFC2045
-Format of Internet Message Bodies
-
-@item RFC2046
-Media Types
-
-@item RFC2047
-Message Header Extensions for Non-ASCII Text
-
-@item RFC2048
-Registration Procedures
-
-@item RFC2049
-Conformance Criteria and Examples
-
-@item RFC2231
-MIME Parameter Value and Encoded Word Extensions: Character Sets,
-Languages, and Continuations
-
-@item RFC1843
-HZ - A Data Format for Exchanging Files of Arbitrarily Mixed Chinese and
-ASCII characters
-
-@item draft-ietf-drums-msg-fmt-05.txt
-Draft for the successor of RFC822
-
-@item RFC1892
-The Multipart/Report Content Type for the Reporting of Mail System
-Administrative Messages
-
-@end table
-
-
-@node Index
-@chapter Index
-@printindex cp
-
-@summarycontents
-@contents
-@bye
-
-@c End:
projects / elisp / gnus.git- / commitdiff