From b779954646f821fadd7d7771849df59b73cda196 Mon Sep 17 00:00:00 2001 From: tomo Date: Fri, 26 Jun 1998 07:53:56 +0000 Subject: [PATCH] This commit was manufactured by cvs2svn to create branch 'unlabeled-1.311.2'. --- Makefile | 71 -- NEWS | 412 -------- README.en | 207 ---- SEMI-CFG | 166 ---- SEMI-ELS | 40 - SEMI-MK | 54 -- SEMI-naming.ol | 41 - TODO | 105 -- VERSION | 172 ---- ftp.in | 17 - mail-mime-setup.el | 65 -- mime-bbdb.el | 303 ------ mime-edit.el | 2685 ---------------------------------------------------- mime-image.el | 177 ---- mime-mc.el | 164 ---- mime-partial.el | 99 -- mime-pgp.el | 265 ------ mime-play.el | 642 ------------- mime-setup.el | 47 - mime-text.el | 94 -- mime-view-ja.sgml | 278 ------ mime-view-ja.texi | 311 ------ mime-view.el | 1274 ------------------------- mime-w3.el | 64 -- semi-def.el | 250 ----- semi-setup.el | 195 ---- signature.el | 159 ---- 27 files changed, 8357 deletions(-) delete mode 100644 Makefile delete mode 100644 NEWS delete mode 100644 README.en delete mode 100644 SEMI-CFG delete mode 100644 SEMI-ELS delete mode 100644 SEMI-MK delete mode 100644 SEMI-naming.ol delete mode 100644 TODO delete mode 100644 VERSION delete mode 100644 ftp.in delete mode 100644 mail-mime-setup.el delete mode 100644 mime-bbdb.el delete mode 100644 mime-edit.el delete mode 100644 mime-image.el delete mode 100644 mime-mc.el delete mode 100644 mime-partial.el delete mode 100644 mime-pgp.el delete mode 100644 mime-play.el delete mode 100644 mime-setup.el delete mode 100644 mime-text.el delete mode 100644 mime-view-ja.sgml delete mode 100644 mime-view-ja.texi delete mode 100644 mime-view.el delete mode 100644 mime-w3.el delete mode 100644 semi-def.el delete mode 100644 semi-setup.el delete mode 100644 signature.el diff --git a/Makefile b/Makefile deleted file mode 100644 index eb229ce..0000000 --- a/Makefile +++ /dev/null @@ -1,71 +0,0 @@ -# -# Makefile for SEMI kernel. -# - -PACKAGE = semi -VERSION = 1.8.0 - -SHELL = /bin/sh -MAKE = make -CC = gcc -CFLAGS = -O2 -TAR = tar -RM = /bin/rm -f -CP = /bin/cp -p -EMACS = emacs - -GOMI = *.elc -FLAGS = -batch -q -no-site-file - -PREFIX = NONE -EXEC_PREFIX = NONE -LISPDIR = NONE - -elc: - $(EMACS) $(FLAGS) -l SEMI-MK -f compile-semi \ - $(PREFIX) $(EXEC_PREFIX) $(LISPDIR) - -install-elc: elc - $(EMACS) $(FLAGS) -l SEMI-MK -f install-semi \ - $(PREFIX) $(EXEC_PREFIX) $(LISPDIR) - - -all: $(UTILS) $(DVI) elc - -tex: ol2 - cd doc; $(MAKE) tex - -dvi: ol2 - cd doc; $(MAKE) dvi - -ps: ol2 - cd doc; $(MAKE) ps - - -install: install-elc - -update-xemacs: - $(EMACS) $(FLAGS) -l SEMI-MK -f update-xemacs-source - - -clean: - -$(RM) $(GOMI) - -cd doc && $(MAKE) clean - -cd gnus && $(MAKE) clean - -cd mh-e && $(MAKE) clean - cd ../mel && $(MAKE) clean - - -tar: - cvs commit - sh -c 'cvs tag -RF $(PACKAGE)-`echo $(VERSION) \ - | sed s/\\\\./_/ | sed s/\\\\./_/`; \ - cd /tmp; \ - cvs -d :pserver:anonymous@chamonix.jaist.ac.jp:/hare/cvs/root \ - export -d $(PACKAGE)-$(VERSION) \ - -r $(PACKAGE)-`echo $(VERSION) \ - | sed s/\\\\./_/ | sed s/\\\\./_/` semi' - $(RM) /tmp/$(PACKAGE)-$(VERSION)/ftp.in - cd /tmp; $(TAR) cvzf $(PACKAGE)-$(VERSION).tar.gz $(PACKAGE)-$(VERSION) - cd /tmp; $(RM) -r $(PACKAGE)-$(VERSION) - sed "s/VERSION/$(VERSION)/" < ftp.in > ftp diff --git a/NEWS b/NEWS deleted file mode 100644 index ab7b381..0000000 --- a/NEWS +++ /dev/null @@ -1,412 +0,0 @@ -SEMI NEWS --- history of major-changes. -Copyright (C) 1998 Free Software Foundation, Inc. - -* Changes in SEMI 1.8 - -** Abolish external X-Face viewer - - -** Abolish obsolete utility for *-field-list and *-field-regexp - - Abolish function `tm:set-fields', `tm:add-fields' and -`tm:delete-fields'. - - -** Change MUA interface of automatic message/partial combining - - Abolish variable `mime-view-partial-message-method-alist'. - - Instead of it, `request-partial-message-method' in acting-situation -is available to specify MUA depended implementation. - - Each element of `mime-view-partial-message-method-alist' were -required to display message at current summary line, and its return -value were ignored. On the other hand, -`request-partial-message-method' is required to return structure of -message at current summary line. Format of it is mime-entity. - - -* Changes in SEMI 1.7 - -** Header-presentation-method - - Now MIME-View uses header-presentation-method instead of -header-filter. - - - abolish variable `mime-view-content-header-filter-alist' - - - abolish function `mime-view-cut-header' - - - Rename `mime-view-content-header-filter-hook' to - `mime-display-header-hook' - - -** Abolish `mime-view-ignored-field-regexp' - - Now mime-view uses `mime-view-ignored-field-list' directly in -default header-presentation-method. - - -** Abolish body filter support - - Please use body-presentation-method. - - -** Methods for MUAs - - - Rename `mime-view-following-method-alist' to - `mime-preview-following-method-alist' - - - Rename `mime-method-to-combine-message/partial-pieces' to - `mime-combine-message/partial-pieces-automatically' - - -* Changes in SEMI 1.6 - -** Abolish tm-compatible external method support - - Abolish tm-compatible external method support. Please use mailcap -method instead of it. - - -** Abolish `mime-edit-signing-type' and `mime-edit-encrypting-type' - - C-c C-m C-s encloses as "pgp-signed" which means PGP/MIME signature. - - C-c C-m C-e encloses as "pgp-encrypted" which means PGP/MIME -encryption. - - -** New method to detect content of entity - - Now MIME-View can detect content of entity for -application/octet-stream in default setting. - - It uses "file" command to detect. User can customize -`mime-file-content-type-alist' to specify media-type for output of -"file" command. It is an alist of "file" output patterns -vs. corresponding media-types. Each element looks like (REGEXP TYPE -SUBTYPE). REGEXP is pattern for "file" command output. TYPE is -symbol to indicate primary type of media-type. SUBTYPE is symbol to -indicate subtype of media-type. - - -** New interface to display message - -- Function `mime-view-buffer' -- Function `mime-view-display-message' - - -** Change interface of internal playback method - - Interface of internal playback method was changed to - - (entity situation) - -It is as same as interface of body-presentation-method. - - -** Change interface of `mime-view-entity-button-visible-p' - -** Change interface of `mime-view-insert-entity-button' - - -** `mime-preview-original-major-mode' - - Abolish variable `mime-preview-original-major-mode'. - - Please use function `mime-preview-original-major-mode' instead of -it. - - -** mime-preview-over-to-{previous|next}-method-alist - - `mime-preview-over-to-{previous|next}-method-alist' were renamed -from `mime-view-over-to-{previous|next}-method-alist'. - - -* Changes in SEMI 1.5 - -** mime-w3 - - Add inline text/html preview feature using w3. If -`mime-setup-enable-inline-html' is not nil, semi-setup.el sets up it. - - -** `pgp-elkins' -> `pgp-mime' - - Rename `pgp-elkins' -> `pgp-mime'. Variable -`mime-edit-signing-type' and `mime-edit-encrypting-type' does not -allow `pgp-elkins'. - - -** type-subtype-score - - Now MIME-View chooses one entity to display body in -multipart/alternative. In this mechanism, -`mime-view-type-subtype-score-alist' is used to specify priority of -each entity. - - Variable `mime-view-type-subtype-score-alist' is alist of -TYPE-SUBTYPE vs. SCORE. TYPE-SUBTYPE is cons pair (TYPE . SUBTYPE), -symbol TYPE or t. TYPE and SUBTYPE are symbol. `t' means default. -SCORE is integer. Larger number is larger priority. - - -** text presentation - - Change text presentation mechanism. In anything older than SEMI -1.4, text presentation mechanism is based on filter model. However it -has design problem about conversion between byte representation and -text presentation. So SEMI was changed to use -body-presentation-method to display text entity. In this purpose, old -text decoding features were abolished and introduces news features -(cf. next section). - - -** mime-raw-representation-type and mime-raw-representation-type-alist - - Abolish `mime-text-decoder' and `mime-text-decoder-alist' because of -text presentation mechanism change (cf. previous section). Instead of -it, SEMI introduces variable about representation-type of -mime-raw-buffer. If it is `binary', mime-raw-buffer is as same as -network representation. If it is `cooked', mime-raw-buffer is -code-converted. - - `mime-raw-representation-type-alist' is an alist of major-mode -vs. representation-type. Each element looks like - - (SYMBOL . REPRESENTATION-TYPE). - -SYMBOL is major-mode or t. t means default. - - `mime-raw-representation-type' is a buffer local variable of -mime-raw-buffer. If it is non-nil, it overrides -`mime-raw-representation-type-alist'. - - In addition, `mime-raw-buffer-coding-system-alist' was abolished. -Because representation-type has enough information. - - -* Changes in SEMI 1.4 - -** mailcap - - mailcap was supported to set up 'mime-acting-condition. - - tm-external-method scripts written by born shell were abolished. - - -** mime-add-condition - - New function to set up 'mime-preview-condition and/or -'mime-acting-condition. - - -** signature setting in semi-setup.el - - Abolish MUA depended signature setting. - - Setting for mail-mode were moved to mail-mime-setup.el. - - -* Changes in SEMI 1.3 - -** mime-acting-condition - - Format of variable 'mime-acting-condition was changed from `atype' -to `condition tree'. Its format is as same as -'mime-preview-condition. - - If there are two or more conditions are found when matching, menu -pops up to select method to run. Selected situation will be added to -example database. (cf. mime-acting-situation-examples-file) - -** New variables - -*** mime-view-find-every-acting-situation - - Find every available acting-situation if non-nil. - -*** mime-acting-situation-examples-file - - File name of example about acting-situation demonstrated by - user. - - -* Changes in SEMI 1.2 - -** User setting - -*** hooks - - 'mime-view-plain-text-preview-hook was renamed to -'mime-preview-text/plain-hook. - -*** Variable - - Variable 'mime-view-childrens-header-showing-Content-Type-list was -abolished. Please use 'mime-preview-condition instead. - -*** API about visible-predicates were abolished - - Following functions were abolished: - - mime-view-header-visible-p (entity message-info) - - mime-view-body-visible-p (entity message-info) - - mime-view-entity-separator-visible-p (entity message-info) - -Please use 'mime-preview-condition instead. - - Function 'mime-view-entity-button-visible-p is not abolished, but it -is obsoleted. - -*** mime-preview-condition - - Following are added as pre-defined keys: - - 'childrens-situation default preview-situation for children - 'message-button to specify to display message-button - nil: default (invisible) - 'visible: visible - 'invisible: invisible - 'entity-button to specify to display entity-button - nil: default (visible) - 'visible: visible - 'invisible: invisible - 'header to specify to display header - nil: default (invisible) - 'visible: visible - 'invisible: invisible - -** API - -*** Interface for body-filter - - 'mime-view-filter-for-* was renamed to 'mime-preview-filter-for-*. - - -*** mime-text-decode-body - - Function 'mime-decode-text-body was renamed to -'mime-text-decode-body and changed interface. New interface is -following: - - mime-text-decode-body (SITUATION) - -SITUATION is preview-situation. Content-Transfer-Encoding and -MIME-charset are specified in field of it. - - -* Changes in SEMI 1.1 - -** User setting - -*** Setting variable about visible body - - 'mime-view-visible-media-type-list and -'mime-view-content-filter-alist were abolished. Please use -'mime-preview-condition instead. - - Notice that 'mime-preview-condition is not list of -media-type/subtype string nor association-list. It uses new -data-structure `ctree' (condition-tree; it is introduced to replace -`atype'). Function 'ctree-set-calist-strictly and -'ctree-set-calist-with-default may be useful to modify it (`calist' -(condition-alist) is as same as `atype'). - - -*** API about visible-predicates - - Interface of visible-predicates for entity elements were changed. -New interfaces are following: - - mime-view-entity-button-visible-p (entity message-info) - - mime-view-header-visible-p (entity message-info) - - mime-view-body-visible-p (entity message-info) - - mime-view-entity-separator-visible-p (entity message-info) - - -** API - -*** entity representation - - Structure 'mime-entity-info was renamed to 'mime-entity. So various -functions were renamed too. - - -*** Interface for entity-button generators - - Interface of entity-button generators was changed. New interfaces -is following: - - mime-view-insert-entity-button (entity message-info subject) - - -*** mime-preview-condition and preview-situation - - Conditions about preview generation are unified to -'mime-preview-condition. Namely other variables, such as -'mime-view-visible-media-type-list, 'mime-view-content-filter-alist, -'mime-view-image-converter-alist were abolished. - - Preview-situation is generated from entity information, running -environment and 'mime-preview-condition. These elements are checked -to match with each other. (it is similar to acting-situation) - - Format of preview-situation is association-list. Following key is -pre-defined: - - 'type media-type - 'subtype media-subtype - 'encoding content-transfer-encoding - 'major-mode major-mode of MUA - attribute of Content-Type field. - 'body-presentation-method body-presentation-method - -If 'body-presentation-method is 'with-filter, 'body-filter is used to -specify body-filter function. If 'body-presentation-method is -function, it is called to generate presentation of entity body. - -Body-filter function 'mime-view-filter-for-image refers 'image-format. - -Setting for message/partial button is specified by -'mime-preview-condition instead of hard-coding. - - -*** Interface for body-filter - - Interface of body-filter was changed. New interfaces is following: - - (situation) - -Current pre-defined filters are following: - - mime-view-filter-for-text/plain (situation) - mime-view-filter-for-text/richtext (situation) - mime-view-filter-for-text/enriched (situation) - mime-view-filter-for-image (situation) ; if available - -'mime-view-filter-for-application/postscript was abolished. - - -*** Format of mime-acting-condition (acting-situation) - - Format of `mime-acting-condition' were changed. `type' and -`subtype' are separated and changed to symbol. - - -*** Renaming - -- mime-view-buffer -> mime-preview-buffer - - -Local variables: -mode: outline -paragraph-separate: "[ ]*$" -end: diff --git a/README.en b/README.en deleted file mode 100644 index 38e14c2..0000000 --- a/README.en +++ /dev/null @@ -1,207 +0,0 @@ -[README for SEMI kernel package (English Version)] - -What's SEMI? -============ - - SEMI is a library to provide MIME feature for GNU Emacs. MIME is a - proposed internet standard for including content and headers other - than (ASCII) plain text in messages. - - RFC 2045 : Internet Message Bodies - RFC 2046 : Media Types - RFC 2047 : Message Header Extensions - RFC 2048 : MIME Registration Procedures - RFC 2049 : MIME Conformance - - SEMI has the following features: - - - MIME message viewer (mime-view-mode) (RFC 2045 .. 2049) - - MIME message composer (mime-edit-mode) (RFC 2045 .. 2049) - - MIME message viewer and composer also support following features: - - - filename handling by Content-Disposition field (RFC 1806) - - PGP/MIME security Multiparts (RFC 2015) - - application/pgp (draft-kazu-pgp-mime-00.txt; obsolete) - - text/richtext (RFC 1521; obsolete; preview only) - - text/enriched (RFC 1896) - - External method configuration by mailcap (RFC 1524) - - Notice that this package does not contain MIME extender for any - MUAs. They are released as separated packages. - - -Required environment -==================== - - SEMI supports XEmacs 20.2 or later with mule, and Emacs 20. - - SEMI does not support anything older than Emacs 19.28 or XEmacs - 19.14. SEMI also does not support Emacs 19.29 to 19.34, XEmacs - 19.15 or XEmacs 20.2 without mule, but SEMI may work with them. - - SEMI requires APEL (8.7 or later) and FLIM (1.7.0 or later) package. - Please install them before installing it. APEL package is available - at: - - ftp://ftp.jaist.ac.jp/pub/GNU/elisp/apel/ - - and FLIM package is available at: - - ftp://ftp.jaist.ac.jp/pub/GNU/elisp/flim/ - - PGP/MIME and application/pgp require mailcrypt or tiny-pgp package. - - The package enriched.el is required to compose text/enriched, so if - you use Emacs anything 19.28 or older (including official version of - MULE 2.3), WYSIWYG composing for text/enriched is not available. - - -Installation -============ - - % make install - - You can specify the emacs command name, for example - - % make install EMACS=xemacs - - If `EMACS=...' is omitted, EMACS=emacs is used. - - You can specify the prefix of the directory tree for Emacs Lisp - programs and shell scripts, for example: - - % make install PREFIX=~/ - - If `PREFIX=...' is omitted, the prefix of the directory tree of the - specified emacs command is used (perhaps /usr/local). - - For example, if PREFIX=/usr/local and EMACS 19.34 is specified, it - will create the following directory tree: - - /usr/local/share/emacs/19.34/site-lisp/ --- emu - /usr/local/share/emacs/site-lisp/apel/ --- APEL - /usr/local/share/emacs/site-lisp/flim/ --- FLIM - /usr/local/share/emacs/site-lisp/semi/ --- SEMI - - You can specify site-lisp directory, for example - - % make install LISPDIR=~/share/emacs/lisp - - If `LISPDIR=...' is omitted, site-lisp directory of the specified - emacs command is used (perhaps /usr/local/share/emacs/site-lisp or - /usr/local/lib/xemacs/site-lisp). - - You can specify other optional settings by editing the file - ${archive}/SEMI-CFG. Please read ${archive}/README.en and comments - in ${archive}/SEMI-CFG. - - -Initialization -============== - -(a) load-path - - If you are using Emacs or Mule, please add directory of emu, apel, - flim and semi to load-path. If you install by default setting, you - can write subdirs.el for example: - - -------------------------------------------------------------------- - (normal-top-level-add-to-load-path - '("apel" "flim" "semi")) - -------------------------------------------------------------------- - - If you are using XEmacs, there are no need of setting about - load-path. - -(b) mime-setup - - Please insert the following into your ~/.emacs: - - (load "mime-setup") - - -Documentation -============= - - To get started, please read ${archive}/README.en. - - RFC's 822, 1524, 1806, 1847, 1896, 2015, 2045, 2046, 2047, 2048 and - 2049 are available via anonymous ftp: - - ftp://ftp.merit.edu/internet/documents/rfc/ - - -Mailing lists -============= - - If you write bug-reports and/or suggestions for improvement, please - send them to the tm Mailing List: - - bug-tm-en@chamonix.jaist.ac.jp (English) - bug-tm-ja@chamonix.jaist.ac.jp (Japanese) - - Via the tm ML, you can report SEMI bugs, obtain the latest release - of SEMI, and discuss future enhancements to SEMI. To join the tm - ML, send an empty e-mail to - - tm-en-help@chamonix.jaist.ac.jp (English) - tm-ja-help@chamonix.jaist.ac.jp (Japanese) - - Notice that you should not send mail to author(s), such as - morioka@jaist.ac.jp, directly. Because your problem may occur in - other environments (if not, it might be your problem, not bug of - SEMI). We should discuss in the tm mailing lists. Anyway - direct-mail for authors might be ignored. Please send mail to the - tm mailing lists. - - -CVS based development -===================== - - If you would like to join CVS based development, please send mail to - - cvs@chamonix.jaist.ac.jp - - with your account name and UNIX style crypted password. We hope you - will join the open development. - - -Authors -======= - -Original authors - - MORIOKA Tomohiko - (the author of mime-view and various parts of SEMI) - UMEDA Masanobu - (the author of mime.el of emacs-mime-tools. mime.el is the - origin of mime-edit.el of SEMI) - -Other authors - - Shuhei KOBAYASHI - (a major author of signature.el and a lot of codes) - MASUTANI Yasuhiro - (anonymous ftp codes of mime-play.el) - OKABE Yasuo - (a major author of mime-partial.el and signature.el) - - Steinar Bang - Steven L. Baur - Kevin Broadey - Alastair Burt - Eric Ding - Thierry Emery - Simon Josefsson - Jens Lautenbacher - Carsten Leonhardt - Pekka Marjola - Hisashi Miyashita - Kazuhiro Ohta - Alexandre Oliva - François Pinard - Artur Pioro - Dan Rich - (contribute to evolve mime-image.el with XEmacs) - Katsumi Yamaoka diff --git a/SEMI-CFG b/SEMI-CFG deleted file mode 100644 index d56c948..0000000 --- a/SEMI-CFG +++ /dev/null @@ -1,166 +0,0 @@ -;;; -*-Emacs-Lisp-*- - -;; SEMI-CFG: installation setting about SEMI. - -;;; Code: - -(require 'cl) - -(defvar default-load-path load-path) - -(add-to-list 'load-path - (expand-file-name "../../site-lisp/apel" data-directory)) -(add-to-list 'load-path - (expand-file-name "." data-directory)) - -(when (boundp 'LISPDIR) - (add-to-list 'default-load-path LISPDIR) - (add-to-list 'load-path LISPDIR) - (add-to-list 'load-path (expand-file-name "apel" LISPDIR)) - ) - -(condition-case nil - (require 'install) - (error (error "Please install APEL 8.7 or later."))) - -(add-path "bitmap-mule") -(add-path "flim") - -(add-to-list 'load-path (expand-file-name ".")) - -(or (module-installed-p 'calist) - (error "Please install APEL 8.7 or later.")) -(or (module-installed-p 'mime) - (error "Please install FLIM 1.6.0 or later.")) -(if (module-installed-p 'tm-view) - (message "Please remove tm from load-path.")) - - -;;; @ Please specify optional package directory if you use them. -;;; - -;; It is only necessary to use `add-path' if these packages are not -;; already on the standard load-path of Emacs. - -;; Function `get-latest-path' detect latest version of such package -;; under load-path directories. If you want to use a version of a -;; package instead of latest version, please specify by argument of -;; function `add-path'. - -;; Function `add-path' finds path under load-path directories. If a -;; package does not exist in load-path, please specify by absolutely -;; (`~/' is available), for example -;; (add-path "~/lib/elisp/mailcrypt-3.4") -;; or -;; (add-path "/opt/share/xmule/site-lisp/mailcrypt-3.4") - - -;;; @@ Please specify Mailcrypt path. -;;; - -;; Use latest version installed in load-path. - -(let ((path (get-latest-path "mailcrypt" 'all-paths))) - (if path - (add-path path) - )) - -;; Or please specify path. -;; (add-path "mailcrypt-3.4" 'all-paths) - - -;;; @@ Please specify BBDB path. -;;; - -(let ((path (get-latest-path "bbdb" 'all-paths))) - (when path - (add-path path) - (add-path (expand-file-name "lisp" path)) ; run-in-place installation - )) - -;; Or please specify path. -;; (add-path "bbdb-1.50" 'all-paths) - - -;;; -;;; @@ Please specify Emacs/W3 path. -;;; - -(let ((path (get-latest-path "w3" 'all-paths))) - (when path - (add-path path) - (add-path (expand-file-name "lisp" path)) ; run-in-place installation - )) - -;; Or please specify path. -;; (add-path "w3-4.0pre.20" 'all-paths) - - -;;; @ shell -;;; - -;; Please specify shell command path. -(setq SHELL - (find-if (function file-exists-p) - '("/bin/sh" "/usr/bin/sh") - )) - -;; Please specify shell command option. -(setq SHELLOPTION "-c") - - -;;; @ Please specify prefix of install directory. -;;; - -;; Please specify install path prefix. -;; If it is omitted, shared directory (maybe /usr/local is used). -(defvar PREFIX install-prefix) -;;(setq PREFIX "~/") - -;; Please specify install path prefix for binaries. -(defvar EXEC_PREFIX - (if (or running-emacs-18 running-xemacs) - (expand-file-name "../../.." exec-directory) - (expand-file-name "../../../.." exec-directory) - )) - -;; Please specify emu prefix [optional] -(setq EMU_PREFIX - (if (string-match "XEmacs" emacs-version) - "emu" - "")) - -;; Please specify SEMI prefix [optional] -(setq SEMI_PREFIX "semi") - - -;;; @ executables -;;; - -;; Please specify binary path. -(defvar BIN_DIR (expand-file-name "bin" EXEC_PREFIX)) - -;; Please specify binary path. (for external method scripts) -(setq METHOD_DIR (expand-file-name "share/semi" PREFIX)) - - - - -;;; @ optional settings -;;; - -;; It is generated by automatically. Please set variable `PREFIX'. -;; If you don't like default directory tree, please set it. -(defvar LISPDIR (install-detect-elisp-directory PREFIX)) -;; (setq install-default-elisp-directory "~/lib/emacs/lisp") - -(setq SEMI_KERNEL_DIR (expand-file-name SEMI_PREFIX LISPDIR)) -(setq SETUP_FILE_DIR SEMI_KERNEL_DIR) - -(setq METHOD_SRC_DIR "methods") -(setq METHODS - '("tm-au" "tm-file" "tm-html" "tm-image" "tm-mpeg" - "tm-plain" "tm-ps" - "tmdecode")) - -;;; SEMI-CFG ends here diff --git a/SEMI-ELS b/SEMI-ELS deleted file mode 100644 index ff195ea..0000000 --- a/SEMI-ELS +++ /dev/null @@ -1,40 +0,0 @@ -;;; -*-Emacs-Lisp-*- - -;; SEMI-ELS: list of SEMI modules to install - -;;; Code: - -(setq semi-modules-to-compile - '(signature - semi-def mime-view mime-text mime-play mime-partial mime-edit - semi-setup mail-mime-setup)) - -(setq semi-modules-not-to-compile nil) - -(mapcar (function - (lambda (cell) - (let ((c-module (car cell)) - (i-modules (cdr cell)) - ) - (if (module-installed-p c-module) - (setq semi-modules-to-compile - (nconc semi-modules-to-compile i-modules)) - (setq semi-modules-not-to-compile - (nconc semi-modules-not-to-compile i-modules)) - ) - ))) - '((mailcrypt mime-pgp mime-mc) - (bbdb mime-bbdb) - (w3 mime-w3) - )) - -(if (or (string-match "XEmacs" emacs-version) - (featurep 'mule)) - (setq semi-modules-to-compile - (nconc semi-modules-to-compile '(mime-image))) - ) - -(setq semi-modules (append semi-modules-to-compile - semi-modules-not-to-compile)) - -;;; SEMI-ELS ends here diff --git a/SEMI-MK b/SEMI-MK deleted file mode 100644 index 5abe824..0000000 --- a/SEMI-MK +++ /dev/null @@ -1,54 +0,0 @@ -;;; -*-Emacs-Lisp-*- -;;; -;;; $Id: SEMI-MK,v 1.2 1998-03-13 12:55:52 morioka Exp $ -;;; -;;; Code: - -(defun config-semi () - (let (prefix exec-prefix lisp-dir) - (and (setq prefix (car command-line-args-left)) - (or (string-equal "NONE" prefix) - (defvar PREFIX prefix) - )) - (setq command-line-args-left (cdr command-line-args-left)) - (and (setq exec-prefix (car command-line-args-left)) - (or (string-equal "NONE" exec-prefix) - (defvar EXEC_PREFIX exec-prefix) - )) - (setq command-line-args-left (cdr command-line-args-left)) - (and (setq lisp-dir (car command-line-args-left)) - (or (string-equal "NONE" lisp-dir) - (defvar LISPDIR lisp-dir) - )) - (setq command-line-args-left (cdr command-line-args-left)) - ) - (load-file "SEMI-CFG") - (load-file "SEMI-ELS") - (princ (format "PREFIX=%s\tEXEC_PREFIX=%s -LISPDIR=%s\n" PREFIX EXEC_PREFIX LISPDIR)) - ) - -(defun directory= (dir1 dir2) - (string= (file-name-as-directory dir1)(file-name-as-directory dir2)) - ) - -(defun compile-semi () - (config-semi) - (print load-path) - (compile-elisp-modules semi-modules-to-compile ".") - (compile-elisp-module 'mime-setup ".") - ) - -(defun install-semi () - (config-semi) - (princ (format "%s\n" emacs-version)) - (install-elisp-modules semi-modules "." SEMI_KERNEL_DIR) - (install-elisp-modules '(mime-setup) "." SETUP_FILE_DIR) - ) - -(defun install-execs () - (config-semi) - (install-files METHODS METHOD_SRC_DIR METHOD_DIR nil t) - ) - -;;; SEMI-MK ends here diff --git a/SEMI-naming.ol b/SEMI-naming.ol deleted file mode 100644 index 746e1f4..0000000 --- a/SEMI-naming.ol +++ /dev/null @@ -1,41 +0,0 @@ -* MIME-View - -** mime-entity-* - - mime-entity related functions. - - -** mime-raw-* - - mime-raw-buffer related features. - - - buffer local variables in mime-raw-buffer - - - functions expected running in mime-raw-buffer - - -** mime-preview-* - - mime-preview-buffer related features. - - - buffer local variables in mime-preview-buffer - - - functions expected running in mime-preview-buffer - - -** mime-display-* - - - functions to make presentation in mime-preview-buffer from - element(s) of mime-raw-buffer - - -** mime-view-* - - MIME-View related general features. - - - variables or functions related with both mime-raw-buffer and - mime-preview-buffer - - - customizable variables - - - view something and enter another mode in another buffer diff --git a/TODO b/TODO deleted file mode 100644 index 4a051ff..0000000 --- a/TODO +++ /dev/null @@ -1,105 +0,0 @@ -[TODO] -====== - -* MIME-View - -** dynamic configuration for 'mime-preview-condition - -** multipart/related support - -** Don't use filter-model - - tomo (major developer of SEMI) and akr (major developer of -FLIM-FLAM) discussed about Emacs 20.3 problem related with SEMI and -FLIM. They found essential problem with Emacs 20.3 are: - - - Emacs 20.3 separates string-type to unibyte-string and - multibyte-string. Emacs 20.3 has enough APIs to treat them. - - - Buffer has mode about interpretation of contents. Each mode is - designed to save semantics as characters. Namely buffer contains - unibyte-characters or multibyte-characters. One buffer can not - contain both representations. - - - {decode|encode}-coding-{region|string} run in byte world. So it - is not harmonized with other API. - - - It seems easy to write code in one mode or one world - (unibyte-string or multibyte-string). However it seems not easy - to write inter-mode program, such as SEMI. - - - Byte <-> byte conversion, such as base64, quoted-printable, must - be run only with unibyte-mode. - - - Byte <-> character conversion, such as - {decode|encode}-coding-region, should not be defined in single - buffer. Instead of them, decoder should read from unibyte buffer - and output to multibyte buffer. Similarly, encoder should read - from multibyte buffer and output to unibyte buffer. - `insert-buffer-substring' like API may be suitable. Anyway Emacs - introduces multiple representations, so it should be redesigned - based on multiple representation world model. - - Anyway FLIM should introduce new APIs based on inter-representation -world model. Conventional APIs should be implemented based on new -APIs. - - SEMI should abolish filter model and introduce new methods to -display inline data. These methods should use new FLIM APIs based on -inter-representation world model. - - -* MIME-Edit - -** WYSIWYG editing support - -** Use MIME-Preview like tag and display - -** Redesign to use two buffers for one message - - MIME-View is based on "Multiple Representation Space (layer) Model". -In this model, network representation and its presentation are -distinguished. Thus MIME-View uses two buffers for one message, -'mime-raw-buffer (for network representation) and -'mime-preview-buffer. MIME-View manages them based on information of -entities. According to experience of MIME-View, this model is good to -treat complex structured data, such as MIME. - - MIME-Edit was designed to use one buffer for one message. So it is -hard to edit like WYSIWYG style. Format of tag is limited by -translation. Content of forwarded message is unreadable. It is -better to introduce "Multiple Representation Space Model" to resolve -these problems. - -** Check available MIME-charset - - MIME-charset $B0J30$,@8@.$5$l$k>l9g$N=hM}$r;XDj$G$-$k$h$&$K$9$k!#(B - - For example: - - (a) translate problematic characters to similar representation - (b) display warning message - (e.g. "`x-ctext' is generated. Do you send it? (yes/no)") - (c) stop sending - -** Don't use buffer-local variables - - Don't use buffer-local variables to control behavior about -translating to network representation, such as 'mime-transfer-level, -'mime-transfer-level-string, -'mime-edit-charset-default-encoding-alist, 'mime-edit-pgp-processing. -Because they have problem with Semi-gnus. - - -* Etc. - -** Write manual - - - -[Known Bugs] -============ - -* MIME-Edit - -** Content-ID is mandatory for message/external-body diff --git a/VERSION b/VERSION deleted file mode 100644 index 10f7c90..0000000 --- a/VERSION +++ /dev/null @@ -1,172 +0,0 @@ -[SEMI Version names] - -0.72 -------- -------- -0.75 -------- -------- -0.83 -------- -------- -0.87 -------- -------- -0.88 -------- -------- -0.91 -------- -------- -0.92 -------- -------- - -;;------------------------------------------------------------------------- -;; Hokuriku Railway $(BKLN&E4F;(B -;; Ishikawa Line $(B@P@n@~(B -;;------------------------------------------------------------------------- -0.96 Kaga-Ichinomiya $(B2C2l0l$N5\(B ; $(B!JGr;3Hf$(D5/$(B?@ $(B$8$c$$%P%9(B -0.115 Hinomiko $(BF|8f;R(B -0.115.1 Oyanagi $(B>.Lx(B -0.115.2 Inokuchi $(B0f8}(B -0.116 D-Dòhòji-A $(BF;K!;{(B -0.118 Sodani $(BA>C+(B -0.118.1 Shijima $(B;M==K|(B -0.118.2 Otomaru $(B254](B -1.0.0 Nukaj-Dþtaku-mae-A $(B3[=;BpA0(B -1.0.1 Magae $(BGOBX(B -1.0.2 Nonoichi-K-Dòdaimae-A $(BLn!9;T9)BgA0(B -1.1.0 Nonoichi $(BLn!9;T(B -1.1.1 Oshino $(B2!Ln(B -1.1.2 Shin-Nishikanazawa $(B?7@>6bBt(B ; <=> JR $(B@>6bBt(B -1.2.0 Nishiizumi $(B@>@t(B -1.2.1 Nomachi $(BLnD.(B - -;;------------------------------------------------------------------------- -;; West Japan Railway $(B@>F|K\N95RE4F;(B http://www.westjr.co.jp/ -;; Hokuriku Line $(BKLN&K\@~(B -;;------------------------------------------------------------------------- -1.2.2 Naoetsu $(BD>9>DE(B ; = JR $(B?.1[K\@~(B -1.2.3 Tanihama $(BC+IM(B -1.2.4 Arimagawa $(BM-4V@n(B -1.3.0 Nadachi $(BL>N)(B -1.3.1 Tsutsuishi $(BE{@P(B -1.3.2 N-Dò-A $(BG=@8(B -1.3.3 Uramoto $(B1:K\(B -1.3.4 Kajiyashiki $(B3a20I_(B -1.4.0 Itoigawa $(B;e5{@n(B ; = JR $(BBg;e@~(B -1.4.1 -DÒmi-A $(B@D3$(B -1.4.2 Oyashirazu $(B?FITCN(B -1.4.3 Ichiburi $(B;T?6(B -1.4.4 Ecch-Dþ-Miyazaki-A $(B1[Cf5\:j(B -1.4.5 Tomari $(BGq(B -1.4.6 Ny-Dþzen-A $(BF~A1(B -1.5.0 Nishi-Ny-Dþzen-A $(B@>F~A1(B -1.5.1 Ikuji $(B@8CO(B -1.5.2 Kurobe $(B9uIt(B -1.5.3 Uozu $(B5{DE(B ; <=> $(BIY;3COJ}E4F;(B -1.5.4 Higashi-Namerikawa $(BEl3j@n(B -1.6.0 Namerikawa $(B3j@n(B ; <=> $(BIY;3COJ}E4F;(B -1.7.0 Mizuhashi $(B?e66(B -1.7.1 Higashi-Toyama $(BElIY;3(B -1.8.0 Toyama $(BIY;3(B ; = JR $(B9b;3K\@~!"IY;39A@~(B -: : : -------- Takaoka $(B9b2,(B ; = JR $(BI98+@~!">kC<@~(B -: : : -------- Higashi-Kanazawa $(BEl6bBt(B -------- Kanazawa $(B6bBt(B ; <=> $(BKLN&E4F;(B $(BKLE46bBt(B -------- Nishi-Kanazawa $(B@>6bBt(B ; <=> $(BKLN&E4F;(B $(B?7@>6bBt(B -------- (JR) Nonoichi $(BLn!9;T(B -: : : -------- Tsuruga $(BFX2l(B ; = JR $(B>.IM@~(B -------- Shin-Hikida $(B?7I%ED(B -------- -DÒmi-Shiotsu-A $(B6a9>1vDE(B ; = JR $(B8P@>@~(B -------- Yogo $(BM>8b(B -------- Kinomoto $(BLZ%NK\(B -------- Takatsuki $(B9b7n(B -------- Kawake $(B2OLS(B -------- Torahime $(B8WI1(B -------- Nagahama $(BD9IM(B -------- Tamura $(BEDB<(B -------- Sakata $(B:dED(B - (Maibara) ($(BJF86(B) ; = JR $(BEl3$F;K\@~(B - - -[WEMI version names] - -;;------------------------------------------------------------------------- -;; East Japan Railway $(BElF|K\N95RE4F;(B http://www.jreast.co.jp/ -;; T-Dòkaidò-A Line $(BEl3$F;K\@~(B -;;------------------------------------------------------------------------- -1.2.0 T-Dòkyò-A $(BEl5~(B -1.2.1 Shinbashi $(B?766(B ; = JR $(B;3 $(B>.ED5^EEE4(B $(B9>%NEg@~!"9>%NEgEEE4(B -1.4.1 Tsujid-Dò-A $(@DT$(BF2(B ; $(B!J!V$(@DT$(B!W(B= J90@B-4454:128b$(B!K(B -1.4.2 Chigasaki $(B3}%v:j(B ; = JR $(BAjLO@~(B -1.4.3 Hiratsuka $(BJ?DM(B -1.4.4 -DÒiso-A $(BBg0k(B -1.4.5 Ninomiya $(BFs5\(B -1.4.6 K-Dòzu-A $(B9qI\DE(B ; = JR $(B8fEB>l@~(B -1.5.0 Kamonomiya $(B3{5\(B -1.5.1 Odawara $(B>.ED86(B ; <=> $(B>.ED5^!"H":,EP;3E4F;!"0KF&H":,E4F;(B -1.5.2 Hayakawa $(BAa@n(B -1.5.3 Nebukawa $(B:,I\@n(B -1.5.4 Manazuru $(B??Da(B -1.6.0 Yugawara $(BEr2O86(B -1.7.0 Atami $(BG.3$(B ; = JR $(B0KEl@~(B -;;------------------------------------------------------------------------- -;; Central Japan Railway $(BEl3$N95RE4F;(B -;;------------------------------------------------------------------------- -1.7.1 Kan'nami $(BH!Fn(B ------ Mishima $(B;0Eg(B ; = $(B0KF&H":,E4F;(B ------ Numazu $(B>BDE(B ; = JR $(B8fEB>l@~(B ------ Katahama $(BJRIM(B ------ Hara $(B86(B ------ Higashi-Tagonoura $(BElED;R%N1:(B ------ Yoshiwara $(B5H86(B ; = $(B3YFnE4F;(B ------ Fuji $(BIY;N(B ; = JR $(B?H1d@~(B -: : : ------ Kanayama $(B6b;3(B ; =$(B!J(BJR $(BCf1{K\@~!K(B ------ Ot-Dòbashi-A $(BHxF,66(B ------ Nagoya $(BL>8E20(B ; = JR $(B4X@>K\@~!J!&Cf1{K\@~!K(B -: : : ------ Gifu $(B4tIl(B ; = JR $(B9b;3K\@~(B -: : : ------ Samegai $(B@C%v0f(B -;;------------------------------------------------------------------------- -;; West Japan Railway $(B@>F|K\N95RE4F;(B http://www.westjr.co.jp/ -;;------------------------------------------------------------------------- ------ Maibara $(BJF86(B ; = JR $(BKLN&K\@~(B -: : : ------ Kusatsu $(BApDE(B ; = JR $(BApDE@~(B -: : : ------ Yamashina $(B;32J(B ; = JR $(B8P@>@~(B ------ Ky-Dòto-A $(B5~ET(B ; = JR $(BF`NI@~!&;31"K\@~(B - ; <=> $(B6aE4(B $(B5~ET@~!"5~ET;T8rDL6I(B $(B1(4]@~(B -: : : ------ -DÒsaka-A $(BBg:e(B ; = JR $(BBg:e4D>u@~(B <=> JR $(BEl@>@~(B $(BKL?7CO(B - ; <=> $(BBg:e;T8rDL6I!":e?@!":e5^(B $(BG_ED(B -: : : ------ K-Dòbe-A $(B?@8M(B ; = JR $(B;3M[K\@~(B - - -[REMI version names] - -;;------------------------------------------------------------------------- -;; West Japan Railway $(B@>F|K\N95RE4F;(B http://www.westjr.co.jp/ -;; Himi Line $(BI98+@~(B -;;------------------------------------------------------------------------- -1.4.0 Himi $(BI98+(B -1.5.0 Shimao $(BEgHx(B -1.6.0 Amaharashi $(B1+@2(B -1.7.0 Ecch-Dþ-Kokubu-A $(B1[Cf9qJ,(B -------- Fushiki $(BIzLZ(B -------- Noumachi $(BG=D.(B -------- Ecch-Dþ-Nakagawa-A $(B1[CfCf@n(B - (Takaoka) ($(B9b2,(B) ; = JR $(BKLN&K\@~!">kC<@~(B - - -[etc.] - -;;------------------------------------------------------------------------- -;; West Japan Railway $(B@>F|K\N95RE4F;(B http://www.westjr.co.jp/ -;; Kosei Line $(B8P@>@~(B -;;------------------------------------------------------------------------- -------- (-DÒmi-Shiotsu)-A ($(B6a9>1vDE(B) ; = JR $(BKLN&K\@~(B -: : : -------- Nishi--DÒtsu-A $(B@>BgDE(B - (Yamashina) ($(B;32J(B) ; = JR $(BEl3$F;K\@~(B diff --git a/ftp.in b/ftp.in deleted file mode 100644 index 7cb4860..0000000 --- a/ftp.in +++ /dev/null @@ -1,17 +0,0 @@ ---<>-{ - - It is available from - - ftp://ftp.jaist.ac.jp/pub/GNU/elisp/semi/ - ---[[message/external-body; - access-type=anon-ftp; - site="ftp.jaist.ac.jp"; - directory="/pub/GNU/elisp/semi"; - name="semi-VERSION.tar.gz"; - mode=image]] -Content-Type: application/octet-stream; - name="semi-VERSION.tar.gz"; - type=tar; - conversions=gzip ---}-<> diff --git a/mail-mime-setup.el b/mail-mime-setup.el deleted file mode 100644 index 710d15b..0000000 --- a/mail-mime-setup.el +++ /dev/null @@ -1,65 +0,0 @@ -;;; mail-mime-setup.el --- setup file for mail-mode. - -;; Copyright (C) 1994,1995,1996,1997,1998 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; Keywords: mail-mode, MIME, multimedia, multilingual, encoded-word - -;; This file is part of SEMI (Setting for Emacs MIME Interfaces). - -;; This program 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. - -;; This program 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. - -;;; Code: - -(require 'semi-setup) -(require 'alist) - - -(autoload 'turn-on-mime-edit "mime-edit" - "Unconditionally turn on MIME-Edit minor mode." t) - -(autoload 'eword-decode-header "eword-decode" - "Decode MIME encoded-words in header fields." t) - - -;;; @ for mail-mode, RMAIL and VM -;;; - -(add-hook 'mail-setup-hook 'eword-decode-header) -(add-hook 'mail-setup-hook 'turn-on-mime-edit 'append) -(add-hook 'mail-send-hook 'mime-edit-maybe-translate) -(set-alist 'mime-edit-split-message-sender-alist - 'mail-mode (function - (lambda () - (interactive) - (funcall send-mail-function) - ))) - - -;;; @ for signature -;;; - -(if mime-setup-use-signature - (setq mail-signature nil) - ) - - -;;; @ end -;;; - -(provide 'mail-mime-setup) - -;;; mail-mime-setup.el ends here diff --git a/mime-bbdb.el b/mime-bbdb.el deleted file mode 100644 index 381655c..0000000 --- a/mime-bbdb.el +++ /dev/null @@ -1,303 +0,0 @@ -;;; mime-bbdb.el --- SEMI shared module for BBDB - -;; Copyright (C) 1995,1996,1997 Shuhei KOBAYASHI -;; Copyright (C) 1997,1998 MORIOKA Tomohiko - -;; Author: Shuhei KOBAYASHI -;; Maintainer: Shuhei KOBAYASHI -;; Keywords: BBDB, MIME, multimedia, multilingual, mail, news - -;; This file is part of SEMI (Suite of Emacs MIME Interfaces). - -;; This program 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. - -;; This program 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. - -;;; Code: - -(require 'path-util) -(require 'std11) -(require 'mime-view) - -(if (module-installed-p 'bbdb-com) - (require 'bbdb-com) - (eval-when-compile - ;; imported from bbdb-1.51 - (defmacro bbdb-pop-up-elided-display () - '(if (boundp 'bbdb-pop-up-elided-display) - bbdb-pop-up-elided-display - bbdb-elided-display)) - (defmacro bbdb-user-mail-names () - "Returns a regexp matching the address of the logged-in user" - '(or bbdb-user-mail-names - (setq bbdb-user-mail-names - (concat "\\b" (regexp-quote (user-login-name)) "\\b")))) - )) - - -;;; @ User Variables -;;; - -(defvar mime-bbdb/use-mail-extr t - "*If non-nil, `mail-extract-address-components' is used. -Otherwise `mime-bbdb/extract-address-components' overrides it.") - -(defvar mime-bbdb/auto-create-p nil - "*If t, create new BBDB records automatically. -If function, then it is called with no arguments to decide whether an -entry should be automatically creaded. - -mime-bbdb uses this variable instead of `bbdb/mail-auto-create-p' or -`bbdb/news-auto-create-p' unless other tm-MUA overrides it.") - -(defvar mime-bbdb/delete-empty-window nil - "*If non-nil, delete empty BBDB window. -All bbdb-MUAs but bbdb-gnus display BBDB window even if it is empty. -If you prefer behavior of bbdb-gnus, set this variable to t. - -For framepop users: If empty, `framepop-banish' is used instead.") - -;;; @ mail-extr -;;; - -(defun mime-bbdb/extract-address-components (str) - (let* ((ret (std11-extract-address-components str)) - (phrase (car ret)) - (address (car (cdr ret))) - (methods mime-bbdb/canonicalize-full-name-methods)) - (while (and phrase methods) - (setq phrase (funcall (car methods) phrase) - methods (cdr methods))) - (if (string= address "") (setq address nil)) - (if (string= phrase "") (setq phrase nil)) - (list phrase address) - )) - -(or mime-bbdb/use-mail-extr - (progn - (require 'mail-extr) ; for `what-domain' - (or (fboundp 'tm:mail-extract-address-components) - (fset 'tm:mail-extract-address-components - (symbol-function 'mail-extract-address-components))) - (fset 'mail-extract-address-components - (symbol-function 'mime-bbdb/extract-address-components)) - )) - - -;;; @ bbdb-extract-field-value -;;; - -(or (fboundp 'tm:bbdb-extract-field-value) - (progn - ;; (require 'bbdb-hooks) ; not provided. - ;; (or (fboundp 'bbdb-extract-field-value) ; defined as autoload - (or (fboundp 'bbdb-header-start) - (load "bbdb-hooks")) - (fset 'tm:bbdb-extract-field-value - (symbol-function 'bbdb-extract-field-value)) - (defun bbdb-extract-field-value (field) - (let ((value (tm:bbdb-extract-field-value field))) - (and value - (eword-decode-string value)))) - )) - - -;;; @ full-name canonicalization methods -;;; - -(defun mime-bbdb/canonicalize-spaces (str) - (let (dest) - (while (string-match "\\s +" str) - (setq dest (cons (substring str 0 (match-beginning 0)) dest)) - (setq str (substring str (match-end 0))) - ) - (or (string= str "") - (setq dest (cons str dest))) - (setq dest (nreverse dest)) - (mapconcat 'identity dest " ") - )) - -(defun mime-bbdb/canonicalize-dots (str) - (let (dest) - (while (string-match "\\." str) - (setq dest (cons (substring str 0 (match-end 0)) dest)) - (setq str (substring str (match-end 0))) - ) - (or (string= str "") - (setq dest (cons str dest))) - (setq dest (nreverse dest)) - (mapconcat 'identity dest " ") - )) - -(defvar mime-bbdb/canonicalize-full-name-methods - '(eword-decode-string - mime-bbdb/canonicalize-dots - mime-bbdb/canonicalize-spaces)) - - -;;; @ BBDB functions for mime-view-mode -;;; - -(defun mime-bbdb/update-record (&optional offer-to-create) - "Return the record corresponding to the current MIME previewing message. -Creating or modifying it as necessary. A record will be created if -mime-bbdb/auto-create-p is non-nil, or if OFFER-TO-CREATE is non-nil and -the user confirms the creation." - (save-excursion - (if (and mime-preview-buffer - (get-buffer mime-preview-buffer)) - (set-buffer mime-preview-buffer)) - (if bbdb-use-pop-up - (mime-bbdb/pop-up-bbdb-buffer offer-to-create) - (let* ((message (get-text-property (point-min) 'mime-view-entity)) - (from (mime-fetch-field 'From message)) - addr) - (if (or (null from) - (null (setq addr (car (mime-read-field 'From message)))) - (string-match (bbdb-user-mail-names) - (std11-address-string addr))) - (setq from (or (mime-fetch-field 'To message) - from)) - ) - (if from - (bbdb-annotate-message-sender - (eword-decode-structured-field-body from) t - (or (bbdb-invoke-hook-for-value mime-bbdb/auto-create-p) - offer-to-create) - offer-to-create)) - )))) - -(defun mime-bbdb/annotate-sender (string) - "Add a line to the end of the Notes field of the BBDB record -corresponding to the sender of this message." - (interactive - (list (if bbdb-readonly-p - (error "The Insidious Big Brother Database is read-only.") - (read-string "Comments: ")))) - (bbdb-annotate-notes (mime-bbdb/update-record t) string)) - -(defun mime-bbdb/edit-notes (&optional arg) - "Edit the notes field or (with a prefix arg) a user-defined field -of the BBDB record corresponding to the sender of this message." - (interactive "P") - (let ((record (or (mime-bbdb/update-record t) - (error "")))) - (bbdb-display-records (list record)) - (if arg - (bbdb-record-edit-property record nil t) - (bbdb-record-edit-notes record t)))) - -(defun mime-bbdb/show-sender () - "Display the contents of the BBDB for the sender of this message. -This buffer will be in bbdb-mode, with associated keybindings." - (interactive) - (let ((record (mime-bbdb/update-record t))) - (if record - (bbdb-display-records (list record)) - (error "unperson")))) - -(defun mime-bbdb/pop-up-bbdb-buffer (&optional offer-to-create) - "Make the *BBDB* buffer be displayed along with the MIME preview window(s), -displaying the record corresponding to the sender of the current message." - (let ((framepop (eq temp-buffer-show-function 'framepop-display-buffer))) - (or framepop - (bbdb-pop-up-bbdb-buffer - (function - (lambda (w) - (let ((b (current-buffer))) - (set-buffer (window-buffer w)) - (prog1 (eq major-mode 'mime-view-mode) - (set-buffer b))))))) - (let ((bbdb-gag-messages t) - (bbdb-use-pop-up nil) - (bbdb-electric-p nil)) - (let ((record (mime-bbdb/update-record offer-to-create)) - (bbdb-elided-display (bbdb-pop-up-elided-display)) - (b (current-buffer))) - (if framepop - (if record - (bbdb-display-records (list record)) - (framepop-banish)) - (bbdb-display-records (if record (list record) nil)) - (if (and (null record) - mime-bbdb/delete-empty-window) - (delete-windows-on (get-buffer "*BBDB*")))) - (set-buffer b) - record)))) - -(defun mime-bbdb/define-keys () - (let ((mime-view-mode-map (current-local-map))) - (define-key mime-view-mode-map ";" 'mime-bbdb/edit-notes) - (define-key mime-view-mode-map ":" 'mime-bbdb/show-sender) - )) - -(add-hook 'mime-view-define-keymap-hook 'mime-bbdb/define-keys) - - -;;; @ for signature.el -;;; - -(defun signature/get-bbdb-sigtype (addr) - "Extract sigtype information from BBDB." - (let ((record (bbdb-search-simple nil addr))) - (and record - (bbdb-record-getprop record 'sigtype)) - )) - -(defun signature/set-bbdb-sigtype (sigtype addr) - "Add sigtype information to BBDB." - (let* ((bbdb-notice-hook nil) - (record (bbdb-annotate-message-sender - addr t - (bbdb-invoke-hook-for-value - bbdb/mail-auto-create-p) - t))) - (if record - (progn - (bbdb-record-putprop record 'sigtype sigtype) - (bbdb-change-record record nil)) - ))) - -(defun signature/get-sigtype-from-bbdb (&optional verbose) - (let* ((to (std11-field-body "To")) - (addr (and to - (car (cdr (mail-extract-address-components to))))) - (sigtype (signature/get-bbdb-sigtype addr)) - return - ) - (if addr - (if verbose - (progn - (setq return (signature/get-sigtype-interactively sigtype)) - (if (and (not (string-equal return sigtype)) - (y-or-n-p - (format "Register \"%s\" for <%s>? " return addr)) - ) - (signature/set-bbdb-sigtype return addr) - ) - return) - (or sigtype - (signature/get-signature-file-name)) - )) - )) - - -;;; @ end -;;; - -(provide 'mime-bbdb) - -(run-hooks 'mime-bbdb-load-hook) - -;;; end of mime-bbdb.el diff --git a/mime-edit.el b/mime-edit.el deleted file mode 100644 index f911ce2..0000000 --- a/mime-edit.el +++ /dev/null @@ -1,2685 +0,0 @@ -;;; mime-edit.el --- Simple MIME Composer for GNU Emacs - -;; Copyright (C) 1993,1994,1995,1996,1997,1998 Free Software Foundation, Inc. - -;; Author: UMEDA Masanobu -;; MORIOKA Tomohiko -;; Maintainer: MORIOKA Tomohiko -;; Created: 1994/08/21 renamed from mime.el -;; Renamed: 1997/2/21 from tm-edit.el -;; Keywords: MIME, multimedia, multilingual, mail, news - -;; This file is part of SEMI (Sophisticated Emacs MIME Interfaces). - -;; This program 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. - -;; This program 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 is an Emacs minor mode for editing Internet multimedia -;; messages formatted in MIME (RFC 2045, 2046, 2047, 2048 and 2049). -;; All messages in this mode are composed in the tagged MIME format, -;; that are described in the following examples. The messages -;; composed in the tagged MIME format are automatically translated -;; into a MIME compliant message when exiting the mode. - -;; Mule (multilingual feature of Emacs 20 and multilingual extension -;; for XEmacs 20) has a capability of handling multilingual text in -;; limited ISO-2022 manner that is based on early experiences in -;; Japanese Internet community and resulted in RFC 1468 (ISO-2022-JP -;; charset for MIME). In order to enable multilingual capability in -;; single text message in MIME, charset of multilingual text written -;; in Mule is declared as either `ISO-2022-JP-2' [RFC 1554]. Mule is -;; required for reading the such messages. - -;; This MIME composer can work with Mail mode, mh-e letter Mode, and -;; News mode. First of all, you need the following autoload -;; definition to load mime-edit-mode automatically: -;; -;; (autoload 'turn-on-mime-edit "mime-edit" -;; "Minor mode for editing MIME message." t) -;; -;; In case of Mail mode (includes VM mode), you need the following -;; hook definition: -;; -;; (add-hook 'mail-mode-hook 'turn-on-mime-edit) -;; (add-hook 'mail-send-hook 'mime-edit-maybe-translate) -;; -;; In case of MH-E, you need the following hook definition: -;; -;; (add-hook 'mh-letter-mode-hook -;; (function -;; (lambda () -;; (turn-on-mime-edit) -;; (make-local-variable 'mail-header-separator) -;; (setq mail-header-separator "--------") -;; )))) -;; (add-hook 'mh-before-send-letter-hook 'mime-edit-maybe-translate) -;; -;; In case of News mode, you need the following hook definition: -;; -;; (add-hook 'news-reply-mode-hook 'turn-on-mime-edit) -;; (add-hook 'news-inews-hook 'mime-edit-maybe-translate) -;; -;; In case of Emacs 19, it is possible to emphasize the message tags -;; using font-lock mode as follows: -;; -;; (add-hook 'mime-edit-mode-hook -;; (function -;; (lambda () -;; (font-lock-mode 1) -;; (setq font-lock-keywords (list mime-edit-tag-regexp)) -;; )))) - -;; The message tag looks like: -;; -;; --[[TYPE/SUBTYPE;PARAMETERS][ENCODING]] -;; -;; The tagged MIME message examples: -;; -;; This is a conventional plain text. It should be translated into -;; text/plain. -;; -;;--[[text/plain]] -;; This is also a plain text. But, it is explicitly specified as is. -;;--[[text/plain; charset=ISO-8859-1]] -;; This is also a plain text. But charset is specified as iso-8859-1. -;; -;; ¡Hola! Buenos días. ¿Cómo está usted? -;;--[[text/enriched]] -;;
This is a richtext.
-;; -;;--[[image/gif][base64]]^M...image encoded in base64 comes here... -;; -;;--[[audio/basic][base64]]^M...audio encoded in base64 comes here... - -;;; Code: - -(require 'emu) -(require 'sendmail) -(require 'mail-utils) -(require 'mel) -(require 'mime-view) -(require 'signature) -(require 'alist) - - -;;; @ version -;;; - -(defconst mime-edit-version-string - `,(concat (car mime-user-interface-version) " " - (mapconcat #'number-to-string - (cddr mime-user-interface-version) ".") - " - \"" (cadr mime-user-interface-version) "\"")) - - -;;; @ variables -;;; - -(defgroup mime-edit nil - "MIME edit mode" - :group 'mime) - -(defcustom mime-ignore-preceding-spaces nil - "*Ignore preceding white spaces if non-nil." - :group 'mime-edit - :type 'boolean) - -(defcustom mime-ignore-trailing-spaces nil - "*Ignore trailing white spaces if non-nil." - :group 'mime-edit - :type 'boolean) - -(defcustom mime-ignore-same-text-tag t - "*Ignore preceding text content-type tag that is same with new one. -If non-nil, the text tag is not inserted unless something different." - :group 'mime-edit - :type 'boolean) - -(defcustom mime-auto-hide-body t - "*Hide non-textual body encoded in base64 after insertion if non-nil." - :group 'mime-edit - :type 'boolean) - -(defcustom mime-edit-voice-recorder - (function mime-edit-voice-recorder-for-sun) - "*Function to record a voice message and encode it." - :group 'mime-edit - :type 'function) - -(defcustom mime-edit-mode-hook nil - "*Hook called when enter MIME mode." - :group 'mime-edit - :type 'hook) - -(defcustom mime-edit-translate-hook nil - "*Hook called before translating into a MIME compliant message. -To insert a signature file automatically, call the function -`mime-edit-insert-signature' from this hook." - :group 'mime-edit - :type 'hook) - -(defcustom mime-edit-exit-hook nil - "*Hook called when exit MIME mode." - :group 'mime-edit - :type 'hook) - -(defvar mime-content-types - '(("text" - ;; Charset parameter need not to be specified, since it is - ;; defined automatically while translation. - ("plain" - ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") - ) - ("richtext" - ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") - ) - ("enriched" - ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") - ) - ("x-latex" - ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") - ) - ("html" - ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") - ) - ("x-rot13-47-48") - ) - ("message" - ("external-body" - ("access-type" - ("anon-ftp" - ("site" "ftp.jaist.ac.jp" "wnoc-fuk.wide.ad.jp" "nic.karrn.ad.jp") - ("directory" "/pub/GNU/elisp/mime") - ("name") - ("mode" "image" "ascii" "local8")) - ("ftp" - ("site") - ("directory") - ("name") - ("mode" "image" "ascii" "local8")) - ("tftp" ("site") ("name")) - ("afs" ("site") ("name")) - ("local-file" ("site") ("name")) - ("mail-server" - ("server" "ftpmail@nic.karrn.ad.jp") - ("subject")) - ("url" ("url")) - )) - ("rfc822") - ("news") - ) - ("application" - ("octet-stream" ("type" "" "tar" "shar")) - ("postscript") - ("x-kiss" ("x-cnf"))) - ("image" - ("gif") - ("jpeg") - ("png") - ("tiff") - ("x-pic") - ("x-mag") - ("x-xwd") - ("x-xbm") - ) - ("audio" ("basic")) - ("video" ("mpeg")) - ) - "*Alist of content-type, subtype, parameters and its values.") - -(defcustom mime-file-types - '(("\\.txt$" - "text" "plain" nil - nil - "inline" (("filename" . file)) - ) - ("\\.pln$" - "text" "plain" nil - nil - "inline" (("filename" . file)) - ) - ("\\.rtf$" - "text" "richtext" nil - nil - nil nil) - ("\\.html$" - "text" "html" nil - nil - nil nil) - ("\\.ps$" - "application" "postscript" nil - "quoted-printable" - "attachment" (("filename" . file)) - ) - ("\\.jpg$" - "image" "jpeg" nil - "base64" - "inline" (("filename" . file)) - ) - ("\\.gif$" - "image" "gif" nil - "base64" - "inline" (("filename" . file)) - ) - ("\\.png$" - "image" "png" nil - "base64" - "inline" (("filename" . file)) - ) - ("\\.tiff$" - "image" "tiff" nil - "base64" - "inline" (("filename" . file)) - ) - ("\\.pic$" - "image" "x-pic" nil - "base64" - "inline" (("filename" . file)) - ) - ("\\.mag$" - "image" "x-mag" nil - "base64" - "inline" (("filename" . file)) - ) - ("\\.xbm$" - "image" "x-xbm" nil - "base64" - "inline" (("filename" . file)) - ) - ("\\.xwd$" - "image" "x-xwd" nil - "base64" - "inline" (("filename" . file)) - ) - ("\\.au$" - "audio" "basic" nil - "base64" - "attachment" (("filename" . file)) - ) - ("\\.mpg$" - "video" "mpeg" nil - "base64" - "attachment" (("filename" . file)) - ) - ("\\.el$" - "application" "octet-stream" (("type" . "emacs-lisp")) - "7bit" - "attachment" (("filename" . file)) - ) - ("\\.lsp$" - "application" "octet-stream" (("type" . "common-lisp")) - "7bit" - "attachment" (("filename" . file)) - ) - ("\\.tar\\.gz$" - "application" "octet-stream" (("type" . "tar+gzip")) - "base64" - "attachment" (("filename" . file)) - ) - ("\\.tgz$" - "application" "octet-stream" (("type" . "tar+gzip")) - "base64" - "attachment" (("filename" . file)) - ) - ("\\.tar\\.Z$" - "application" "octet-stream" (("type" . "tar+compress")) - "base64" - "attachment" (("filename" . file)) - ) - ("\\.taz$" - "application" "octet-stream" (("type" . "tar+compress")) - "base64" - "attachment" (("filename" . file)) - ) - ("\\.gz$" - "application" "octet-stream" (("type" . "gzip")) - "base64" - "attachment" (("filename" . file)) - ) - ("\\.Z$" - "application" "octet-stream" (("type" . "compress")) - "base64" - "attachment" (("filename" . file)) - ) - ("\\.lzh$" - "application" "octet-stream" (("type" . "lha")) - "base64" - "attachment" (("filename" . file)) - ) - ("\\.zip$" - "application" "zip" nil - "base64" - "attachment" (("filename" . file)) - ) - ("\\.diff$" - "application" "octet-stream" (("type" . "patch")) - nil - "attachment" (("filename" . file)) - ) - ("\\.patch$" - "application" "octet-stream" (("type" . "patch")) - nil - "attachment" (("filename" . file)) - ) - ("\\.signature" - "text" "plain" nil nil nil nil) - (".*" - "application" "octet-stream" nil - nil - "attachment" (("filename" . file))) - ) - "*Alist of file name, types, parameters, and default encoding. -If encoding is nil, it is determined from its contents." - :type `(repeat - (list regexp - ;; primary-type - (choice :tag "Primary-Type" - ,@(nconc (mapcar (lambda (cell) - (list 'item (car cell)) - ) - mime-content-types) - '(string))) - ;; subtype - (choice :tag "Sub-Type" - ,@(nconc - (apply #'nconc - (mapcar (lambda (cell) - (mapcar (lambda (cell) - (list 'item (car cell)) - ) - (cdr cell))) - mime-content-types)) - '(string))) - ;; parameters - (repeat :tag "Parameters of Content-Type field" - (cons string (choice string symbol))) - ;; content-transfer-encoding - (choice :tag "Encoding" - ,@(cons - '(const nil) - (mapcar (lambda (cell) - (list 'item (car cell)) - ) - mime-file-encoding-method-alist))) - ;; disposition-type - (choice :tag "Disposition-Type" - (item nil) - (item "inline") - (item "attachment") - string) - ;; parameters - (repeat :tag "Parameters of Content-Disposition field" - (cons string (choice string symbol))) - )) - :group 'mime-edit) - - -;;; @@ about charset, encoding and transfer-level -;;; - -(defvar mime-charset-type-list - '((us-ascii 7 nil) - (iso-8859-1 8 "quoted-printable") - (iso-8859-2 8 "quoted-printable") - (iso-8859-3 8 "quoted-printable") - (iso-8859-4 8 "quoted-printable") - (iso-8859-5 8 "quoted-printable") - (koi8-r 8 "quoted-printable") - (iso-8859-7 8 "quoted-printable") - (iso-8859-8 8 "quoted-printable") - (iso-8859-9 8 "quoted-printable") - (iso-2022-jp 7 "base64") - (iso-2022-kr 7 "base64") - (euc-kr 8 "base64") - (cn-gb2312 8 "base64") - (gb2312 8 "base64") - (cn-big5 8 "base64") - (big5 8 "base64") - (shift_jis 8 "base64") - (iso-2022-jp-2 7 "base64") - (iso-2022-int-1 7 "base64") - )) - -(defvar mime-transfer-level 7 - "*A number of network transfer level. It should be bigger than 7.") -(make-variable-buffer-local 'mime-transfer-level) - -(defsubst mime-encoding-name (transfer-level &optional not-omit) - (cond ((> transfer-level 8) "binary") - ((= transfer-level 8) "8bit") - (not-omit "7bit") - )) - -(defvar mime-transfer-level-string - (mime-encoding-name mime-transfer-level 'not-omit) - "A string formatted version of mime-transfer-level") -(make-variable-buffer-local 'mime-transfer-level-string) - - -;;; @@ about message inserting -;;; - -(defvar mime-edit-yank-ignored-field-list - '("Received" "Approved" "Path" "Replied" "Status" - "Xref" "X-UIDL" "X-Filter" "X-Gnus-.*" "X-VM-.*") - "Delete these fields from original message when it is inserted -as message/rfc822 part. -Each elements are regexp of field-name.") - -(defvar mime-edit-yank-ignored-field-regexp - (concat "^" - (apply (function regexp-or) mime-edit-yank-ignored-field-list) - ":")) - -(defvar mime-edit-message-inserter-alist nil) -(defvar mime-edit-mail-inserter-alist nil) - - -;;; @@ about message splitting -;;; - -(defcustom mime-edit-split-message t - "*Split large message if it is non-nil." - :group 'mime-edit - :type 'boolean) - -(defcustom mime-edit-message-default-max-lines 1000 - "*Default maximum lines of a message." - :group 'mime-edit - :type 'integer) - -(defcustom mime-edit-message-max-lines-alist - '((news-reply-mode . 500)) - "Alist of major-mode vs maximum lines of a message. -If it is not specified for a major-mode, -`mime-edit-message-default-max-lines' is used." - :group 'mime-edit - :type 'list) - -(defconst mime-edit-split-ignored-field-regexp - "\\(^Content-\\|^Subject:\\|^Mime-Version:\\|Message-Id:\\)") - -(defvar mime-edit-split-blind-field-regexp - "\\(^[BDFbdf]cc:\\|^cc:[ \t]*$\\)") - -(defvar mime-edit-split-message-sender-alist nil) - -(defvar mime-edit-news-reply-mode-server-running nil) - - -;;; @@ about tag -;;; - -(defconst mime-edit-single-part-tag-regexp - "--[[][[]\\([^]]*\\)]\\([[]\\([^]]*\\)]\\|\\)]" - "*Regexp of MIME tag in the form of [[CONTENT-TYPE][ENCODING]].") - -(defconst mime-edit-quoted-single-part-tag-regexp - (concat "- " (substring mime-edit-single-part-tag-regexp 1))) - -(defconst mime-edit-multipart-beginning-regexp "--<<\\([^<>]+\\)>>-{\n") - -(defconst mime-edit-multipart-end-regexp "--}-<<\\([^<>]+\\)>>\n") - -(defconst mime-edit-beginning-tag-regexp - (regexp-or mime-edit-single-part-tag-regexp - mime-edit-multipart-beginning-regexp)) - -(defconst mime-edit-end-tag-regexp - (regexp-or mime-edit-single-part-tag-regexp - mime-edit-multipart-end-regexp)) - -(defconst mime-edit-tag-regexp - (regexp-or mime-edit-single-part-tag-regexp - mime-edit-multipart-beginning-regexp - mime-edit-multipart-end-regexp)) - -(defvar mime-tag-format "--[[%s]]" - "*Control-string making a MIME tag.") - -(defvar mime-tag-format-with-encoding "--[[%s][%s]]" - "*Control-string making a MIME tag with encoding.") - - -;;; @@ multipart boundary -;;; - -(defvar mime-multipart-boundary "Multipart" - "*Boundary of a multipart message.") - - -;;; @@ optional header fields -;;; - -(defvar mime-edit-insert-x-emacs-field t - "*If non-nil, insert X-Emacs header field.") - -(defvar mime-edit-x-emacs-value - (if (featurep 'xemacs) - (concat emacs-version (if (featurep 'mule) - " with mule" - " without mule")) - (let ((ver (if (string-match "\\.[0-9]+$" emacs-version) - (substring emacs-version 0 (match-beginning 0)) - emacs-version))) - (if (featurep 'mule) - (if (boundp 'enable-multibyte-characters) - (concat "Emacs " ver - (if enable-multibyte-characters - (concat ", MULE " mule-version) - " (with raw setting)") - (if (featurep 'meadow) - (concat ", " (Meadow-version)) - )) - (concat "MULE " mule-version " based on Emacs " ver)) - ver))) - "Body of X-Emacs field. -If variable `mime-edit-insert-x-emacs-field' is not nil, it is -inserted into message header.") - - -;;; @ constants -;;; - -(defconst mime-tspecials-regexp "[][()<>@,;:\\\"/?.= \t]" - "*Specify MIME tspecials. -Tspecials means any character that matches with it in header must be quoted.") - -(defconst mime-edit-mime-version-value - (concat "1.0 (generated by " mime-edit-version-string ")") - "MIME version number.") - -(defconst mime-edit-mime-version-field-for-message/partial - (concat "MIME-Version: 1.0 (split by " mime-edit-version-string ")\n") - "MIME version field for message/partial.") - - -;;; @ keymap and menu -;;; - -(defvar mime-edit-mode-flag nil) -(make-variable-buffer-local 'mime-edit-mode-flag) - -(defvar mime-edit-mode-entity-prefix "\C-c\C-x" - "Keymap prefix for MIME-Edit mode commands to insert entity or set status.") -(defvar mime-edit-mode-entity-map (make-sparse-keymap) - "Keymap for MIME-Edit mode commands to insert entity or set status.") - -(define-key mime-edit-mode-entity-map "\C-t" 'mime-edit-insert-text) -(define-key mime-edit-mode-entity-map "\C-i" 'mime-edit-insert-file) -(define-key mime-edit-mode-entity-map "\C-e" 'mime-edit-insert-external) -(define-key mime-edit-mode-entity-map "\C-v" 'mime-edit-insert-voice) -(define-key mime-edit-mode-entity-map "\C-y" 'mime-edit-insert-message) -(define-key mime-edit-mode-entity-map "\C-m" 'mime-edit-insert-mail) -(define-key mime-edit-mode-entity-map "\C-w" 'mime-edit-insert-signature) -(define-key mime-edit-mode-entity-map "\C-s" 'mime-edit-insert-signature) -(define-key mime-edit-mode-entity-map "\C-k" 'mime-edit-insert-key) -(define-key mime-edit-mode-entity-map "t" 'mime-edit-insert-tag) - -(define-key mime-edit-mode-entity-map "7" 'mime-edit-set-transfer-level-7bit) -(define-key mime-edit-mode-entity-map "8" 'mime-edit-set-transfer-level-8bit) -(define-key mime-edit-mode-entity-map "/" 'mime-edit-set-split) -(define-key mime-edit-mode-entity-map "s" 'mime-edit-set-sign) -(define-key mime-edit-mode-entity-map "v" 'mime-edit-set-sign) -(define-key mime-edit-mode-entity-map "e" 'mime-edit-set-encrypt) -(define-key mime-edit-mode-entity-map "h" 'mime-edit-set-encrypt) -(define-key mime-edit-mode-entity-map "p" 'mime-edit-preview-message) -(define-key mime-edit-mode-entity-map "\C-z" 'mime-edit-exit) -(define-key mime-edit-mode-entity-map "?" 'mime-edit-help) - -(defvar mime-edit-mode-enclosure-prefix "\C-c\C-m" - "Keymap prefix for MIME-Edit mode commands about enclosure.") -(defvar mime-edit-mode-enclosure-map (make-sparse-keymap) - "Keymap for MIME-Edit mode commands about enclosure.") - -(define-key mime-edit-mode-enclosure-map - "\C-a" 'mime-edit-enclose-alternative-region) -(define-key mime-edit-mode-enclosure-map - "\C-p" 'mime-edit-enclose-parallel-region) -(define-key mime-edit-mode-enclosure-map - "\C-m" 'mime-edit-enclose-mixed-region) -(define-key mime-edit-mode-enclosure-map - "\C-d" 'mime-edit-enclose-digest-region) -(define-key mime-edit-mode-enclosure-map - "\C-s" 'mime-edit-enclose-pgp-signed-region) -(define-key mime-edit-mode-enclosure-map - "\C-e" 'mime-edit-enclose-pgp-encrypted-region) -(define-key mime-edit-mode-enclosure-map - "\C-q" 'mime-edit-enclose-quote-region) - -(defvar mime-edit-mode-map (make-sparse-keymap) - "Keymap for MIME-Edit mode commands.") -(define-key mime-edit-mode-map - mime-edit-mode-entity-prefix mime-edit-mode-entity-map) -(define-key mime-edit-mode-map - mime-edit-mode-enclosure-prefix mime-edit-mode-enclosure-map) - -(defconst mime-edit-menu-title "MIME-Edit") - -(defconst mime-edit-menu-list - '((mime-help "Describe MIME editor mode" mime-edit-help) - (file "Insert File" mime-edit-insert-file) - (external "Insert External" mime-edit-insert-external) - (voice "Insert Voice" mime-edit-insert-voice) - (message "Insert Message" mime-edit-insert-message) - (mail "Insert Mail" mime-edit-insert-mail) - (signature "Insert Signature" mime-edit-insert-signature) - (text "Insert Text" mime-edit-insert-text) - (tag "Insert Tag" mime-edit-insert-tag) - (alternative "Enclose as alternative" - mime-edit-enclose-alternative-region) - (parallel "Enclose as parallel" mime-edit-enclose-parallel-region) - (mixed "Enclose as serial" mime-edit-enclose-mixed-region) - (digest "Enclose as digest" mime-edit-enclose-digest-region) - (signed "Enclose as signed" mime-edit-enclose-pgp-signed-region) - (encrypted "Enclose as encrypted" mime-edit-enclose-pgp-encrypted-region) - (quote "Verbatim region" mime-edit-enclose-quote-region) - (key "Insert Public Key" mime-edit-insert-key) - (split "About split" mime-edit-set-split) - (sign "About sign" mime-edit-set-sign) - (encrypt "About encryption" mime-edit-set-encrypt) - (preview "Preview Message" mime-edit-preview-message) - (level "Toggle transfer-level" mime-edit-toggle-transfer-level) - ) - "MIME-edit menubar entry.") - -(cond (running-xemacs - ;; modified by Pekka Marjola - ;; 1995/9/5 (c.f. [tm-en:69]) - (defun mime-edit-define-menu-for-xemacs () - "Define menu for XEmacs." - (cond ((featurep 'menubar) - (make-local-variable 'current-menubar) - (set-buffer-menubar current-menubar) - (add-submenu - nil - (cons mime-edit-menu-title - (mapcar (function - (lambda (item) - (vector (nth 1 item)(nth 2 item) - mime-edit-mode-flag) - )) - mime-edit-menu-list))) - ))) - - ;; modified by Steven L. Baur - ;; 1995/12/6 (c.f. [tm-en:209]) - (or (boundp 'mime-edit-popup-menu-for-xemacs) - (setq mime-edit-popup-menu-for-xemacs - (append '("MIME Commands" "---") - (mapcar (function (lambda (item) - (vector (nth 1 item) - (nth 2 item) - t))) - mime-edit-menu-list))) - ) - ) - ((>= emacs-major-version 19) - (define-key mime-edit-mode-map [menu-bar mime-edit] - (cons mime-edit-menu-title - (make-sparse-keymap mime-edit-menu-title))) - (mapcar (function - (lambda (item) - (define-key mime-edit-mode-map - (vector 'menu-bar 'mime-edit (car item)) - (cons (nth 1 item)(nth 2 item)) - ) - )) - (reverse mime-edit-menu-list) - ) - )) - - -;;; @ functions -;;; - -(defvar mime-edit-touched-flag nil) - -;;;###autoload -(defun mime-edit-mode () - "MIME minor mode for editing the tagged MIME message. - -In this mode, basically, the message is composed in the tagged MIME -format. The message tag looks like: - - --[[text/plain; charset=ISO-2022-JP][7bit]] - -The tag specifies the MIME content type, subtype, optional parameters -and transfer encoding of the message following the tag. Messages -without any tag are treated as `text/plain' by default. Charset and -transfer encoding are automatically defined unless explicitly -specified. Binary messages such as audio and image are usually -hidden. The messages in the tagged MIME format are automatically -translated into a MIME compliant message when exiting this mode. - -Available charsets depend on Emacs version being used. The following -lists the available charsets of each emacs. - -Without mule: US-ASCII and ISO-8859-1 (or other charset) are available. -With mule: US-ASCII, ISO-8859-* (except for ISO-8859-5), KOI8-R, - ISO-2022-JP, ISO-2022-JP-2, EUC-KR, CN-GB-2312, - CN-BIG5 and ISO-2022-INT-1 are available. - -ISO-2022-JP-2 and ISO-2022-INT-1 charsets used in mule is expected to -be used to represent multilingual text in intermixed manner. Any -languages that has no registered charset are represented as either -ISO-2022-JP-2 or ISO-2022-INT-1 in mule. - -If you want to use non-ISO-8859-1 charset in Emacs 19 or XEmacs -without mule, please set variable `default-mime-charset'. This -variable must be symbol of which name is a MIME charset. - -If you want to add more charsets in mule, please set variable -`charsets-mime-charset-alist'. This variable must be alist of which -key is list of charset and value is symbol of MIME charset. If name -of coding-system is different as MIME charset, please set variable -`mime-charset-coding-system-alist'. This variable must be alist of -which key is MIME charset and value is coding-system. - -Following commands are available in addition to major mode commands: - -\[make single part\] -\\[mime-edit-insert-text] insert a text message. -\\[mime-edit-insert-file] insert a (binary) file. -\\[mime-edit-insert-external] insert a reference to external body. -\\[mime-edit-insert-voice] insert a voice message. -\\[mime-edit-insert-message] insert a mail or news message. -\\[mime-edit-insert-mail] insert a mail message. -\\[mime-edit-insert-signature] insert a signature file at end. -\\[mime-edit-insert-key] insert PGP public key. -\\[mime-edit-insert-tag] insert a new MIME tag. - -\[make enclosure (maybe multipart)\] -\\[mime-edit-enclose-alternative-region] enclose as multipart/alternative. -\\[mime-edit-enclose-parallel-region] enclose as multipart/parallel. -\\[mime-edit-enclose-mixed-region] enclose as multipart/mixed. -\\[mime-edit-enclose-digest-region] enclose as multipart/digest. -\\[mime-edit-enclose-pgp-signed-region] enclose as PGP signed. -\\[mime-edit-enclose-pgp-encrypted-region] enclose as PGP encrypted. -\\[mime-edit-enclose-quote-region] enclose as verbose mode - (to avoid to expand tags) - -\[other commands\] -\\[mime-edit-set-transfer-level-7bit] set transfer-level as 7. -\\[mime-edit-set-transfer-level-8bit] set transfer-level as 8. -\\[mime-edit-set-split] set message splitting mode. -\\[mime-edit-set-sign] set PGP-sign mode. -\\[mime-edit-set-encrypt] set PGP-encryption mode. -\\[mime-edit-preview-message] preview editing MIME message. -\\[mime-edit-exit] exit and translate into a MIME - compliant message. -\\[mime-edit-help] show this help. -\\[mime-edit-maybe-translate] exit and translate if in MIME mode, - then split. - -Additional commands are available in some major modes: -C-c C-c exit, translate and run the original command. -C-c C-s exit, translate and run the original command. - -The following is a message example written in the tagged MIME format. -TABs at the beginning of the line are not a part of the message: - - This is a conventional plain text. It should be translated - into text/plain. - --[[text/plain]] - This is also a plain text. But, it is explicitly specified as - is. - --[[text/plain; charset=ISO-8859-1]] - This is also a plain text. But charset is specified as - iso-8859-1. - - ¡Hola! Buenos días. ¿Cómo está usted? - --[[text/enriched]] - This is a enriched text. - --[[image/gif][base64]]...image encoded in base64 here... - --[[audio/basic][base64]]...audio encoded in base64 here... - -User customizable variables (not documented all of them): - mime-edit-prefix - Specifies a key prefix for MIME minor mode commands. - - mime-ignore-preceding-spaces - Preceding white spaces in a message body are ignored if non-nil. - - mime-ignore-trailing-spaces - Trailing white spaces in a message body are ignored if non-nil. - - mime-auto-hide-body - Hide a non-textual body message encoded in base64 after insertion - if non-nil. - - mime-transfer-level - A number of network transfer level. It should be bigger than 7. - If you are in 8bit-through environment, please set 8. - - mime-edit-voice-recorder - Specifies a function to record a voice message and encode it. - The function `mime-edit-voice-recorder-for-sun' is for Sun - SparcStations. - - mime-edit-mode-hook - Turning on MIME mode calls the value of mime-edit-mode-hook, if - it is non-nil. - - mime-edit-translate-hook - The value of mime-edit-translate-hook is called just before translating - the tagged MIME format into a MIME compliant message if it is - non-nil. If the hook call the function mime-edit-insert-signature, - the signature file will be inserted automatically. - - mime-edit-exit-hook - Turning off MIME mode calls the value of mime-edit-exit-hook, if it is - non-nil." - (interactive) - (if mime-edit-mode-flag - (mime-edit-exit) - (if mime-edit-touched-flag - (mime-edit-again) - (make-local-variable 'mime-edit-touched-flag) - (setq mime-edit-touched-flag t) - (turn-on-mime-edit) - ))) - - -(cond (running-xemacs - (add-minor-mode 'mime-edit-mode-flag - '((" MIME-Edit " mime-transfer-level-string)) - mime-edit-mode-map - nil - 'mime-edit-mode) - ) - (t - (set-alist 'minor-mode-alist - 'mime-edit-mode-flag - '((" MIME-Edit " mime-transfer-level-string))) - (set-alist 'minor-mode-map-alist - 'mime-edit-mode-flag - mime-edit-mode-map) - )) - - -;;;###autoload -(defun turn-on-mime-edit () - "Unconditionally turn on MIME-Edit mode." - (interactive) - (if mime-edit-mode-flag - (error "You are already editing a MIME message.") - (setq mime-edit-mode-flag t) - - ;; Set transfer level into mode line - ;; - (setq mime-transfer-level-string - (mime-encoding-name mime-transfer-level 'not-omit)) - (force-mode-line-update) - - ;; Define menu for XEmacs. - (if running-xemacs - (mime-edit-define-menu-for-xemacs) - ) - - (enable-invisible) - - ;; I don't care about saving these. - (setq paragraph-start - (regexp-or mime-edit-single-part-tag-regexp - paragraph-start)) - (setq paragraph-separate - (regexp-or mime-edit-single-part-tag-regexp - paragraph-separate)) - (run-hooks 'mime-edit-mode-hook) - (message - (substitute-command-keys - "Type \\[mime-edit-exit] to exit MIME mode, and type \\[mime-edit-help] to get help.")) - )) - -;;;###autoload -(defalias 'edit-mime 'turn-on-mime-edit) ; for convenience - - -(defun mime-edit-exit (&optional nomime no-error) - "Translate the tagged MIME message into a MIME compliant message. -With no argument encode a message in the buffer into MIME, otherwise -just return to previous mode." - (interactive "P") - (if (not mime-edit-mode-flag) - (if (null no-error) - (error "You aren't editing a MIME message.") - ) - (if (not nomime) - (progn - (run-hooks 'mime-edit-translate-hook) - (mime-edit-translate-buffer))) - ;; Restore previous state. - (setq mime-edit-mode-flag nil) - (if (and running-xemacs - (featurep 'menubar)) - (delete-menu-item (list mime-edit-menu-title)) - ) - (end-of-invisible) - (set-buffer-modified-p (buffer-modified-p)) - (run-hooks 'mime-edit-exit-hook) - (message "Exit MIME editor mode.") - )) - -(defun mime-edit-maybe-translate () - (interactive) - (mime-edit-exit nil t) - (call-interactively 'mime-edit-maybe-split-and-send) - ) - -(defun mime-edit-help () - "Show help message about MIME mode." - (interactive) - (with-output-to-temp-buffer "*Help*" - (princ "MIME editor mode:\n") - (princ (documentation 'mime-edit-mode)) - (print-help-return-message))) - -(defun mime-edit-insert-text (&optional subtype) - "Insert a text message. -Charset is automatically obtained from the `charsets-mime-charset-alist'. -If optional argument SUBTYPE is not nil, text/SUBTYPE tag is inserted." - (interactive) - (let ((ret (mime-edit-insert-tag "text" subtype nil))) - (when ret - (if (looking-at mime-edit-single-part-tag-regexp) - (progn - ;; Make a space between the following message. - (insert "\n") - (forward-char -1) - )) - (if (and (member (cadr ret) '("enriched" "richtext")) - (fboundp 'enriched-mode) - ) - (enriched-mode t) - (if (boundp 'enriched-mode) - (enriched-mode -1) - )) - ))) - -(defun mime-edit-insert-file (file &optional verbose) - "Insert a message from a file." - (interactive "fInsert file as MIME message: \nP") - (let* ((guess (mime-find-file-type file)) - (type (nth 0 guess)) - (subtype (nth 1 guess)) - (parameters (nth 2 guess)) - (encoding (nth 3 guess)) - (disposition-type (nth 4 guess)) - (disposition-params (nth 5 guess)) - ) - (if verbose - (setq type (mime-prompt-for-type type) - subtype (mime-prompt-for-subtype type subtype) - )) - (if (or (interactive-p) verbose) - (setq encoding (mime-prompt-for-encoding encoding)) - ) - (if (or (consp parameters) (stringp disposition-type)) - (let ((rest parameters) cell attribute value) - (setq parameters "") - (while rest - (setq cell (car rest)) - (setq attribute (car cell)) - (setq value (cdr cell)) - (if (eq value 'file) - (setq value (std11-wrap-as-quoted-string - (file-name-nondirectory file))) - ) - (setq parameters (concat parameters "; " attribute "=" value)) - (setq rest (cdr rest)) - ) - (if disposition-type - (progn - (setq parameters - (concat parameters "\n" - "Content-Disposition: " disposition-type)) - (setq rest disposition-params) - (while rest - (setq cell (car rest)) - (setq attribute (car cell)) - (setq value (cdr cell)) - (if (eq value 'file) - (setq value (std11-wrap-as-quoted-string - (file-name-nondirectory file))) - ) - (setq parameters - (concat parameters "; " attribute "=" value)) - (setq rest (cdr rest)) - ) - )) - )) - (mime-edit-insert-tag type subtype parameters) - (mime-edit-insert-binary-file file encoding) - )) - -(defun mime-edit-insert-external () - "Insert a reference to external body." - (interactive) - (mime-edit-insert-tag "message" "external-body" nil ";\n\t") - ;;(forward-char -1) - ;;(insert "Content-Description: " (read-string "Content-Description: ") "\n") - ;;(forward-line 1) - (let* ((pritype (mime-prompt-for-type)) - (subtype (mime-prompt-for-subtype pritype)) - (parameters (mime-prompt-for-parameters pritype subtype ";\n\t"))) - (and pritype - subtype - (insert "Content-Type: " - pritype "/" subtype (or parameters "") "\n"))) - (if (and (not (eobp)) - (not (looking-at mime-edit-single-part-tag-regexp))) - (insert (mime-make-text-tag) "\n"))) - -(defun mime-edit-insert-voice () - "Insert a voice message." - (interactive) - (let ((encoding - (completing-read - "What transfer encoding: " - mime-file-encoding-method-alist nil t nil))) - (mime-edit-insert-tag "audio" "basic" nil) - (mime-edit-define-encoding encoding) - (save-restriction - (narrow-to-region (1- (point))(point)) - (unwind-protect - (funcall mime-edit-voice-recorder encoding) - (progn - (insert "\n") - (invisible-region (point-min)(point-max)) - (goto-char (point-max)) - ))))) - -(defun mime-edit-insert-signature (&optional arg) - "Insert a signature file." - (interactive "P") - (let ((signature-insert-hook - (function - (lambda () - (let ((items (mime-find-file-type signature-file-name))) - (apply (function mime-edit-insert-tag) - (car items) (cadr items) (list (caddr items)))) - ))) - ) - (insert-signature arg) - )) - - -;; Insert a new tag around a point. - -(defun mime-edit-insert-tag (&optional pritype subtype parameters delimiter) - "Insert new MIME tag and return a list of PRITYPE, SUBTYPE, and PARAMETERS. -If nothing is inserted, return nil." - (interactive) - (let ((p (point))) - (mime-edit-goto-tag) - (if (and (re-search-forward mime-edit-tag-regexp nil t) - (< (match-beginning 0) p) - (< p (match-end 0)) - ) - (goto-char (match-beginning 0)) - (goto-char p) - )) - (let ((oldtag nil) - (newtag nil) - (current (point)) - ) - (setq pritype - (or pritype - (mime-prompt-for-type))) - (setq subtype - (or subtype - (mime-prompt-for-subtype pritype))) - (setq parameters - (or parameters - (mime-prompt-for-parameters pritype subtype delimiter))) - ;; Make a new MIME tag. - (setq newtag (mime-make-tag pritype subtype parameters)) - ;; Find an current MIME tag. - (setq oldtag - (save-excursion - (if (mime-edit-goto-tag) - (buffer-substring (match-beginning 0) (match-end 0)) - ;; Assume content type is 'text/plan'. - (mime-make-tag "text" "plain") - ))) - ;; We are only interested in TEXT. - (if (and oldtag - (not (mime-test-content-type - (mime-edit-get-contype oldtag) "text"))) - (setq oldtag nil)) - ;; Make a new tag. - (if (or (not oldtag) ;Not text - (or mime-ignore-same-text-tag - (not (string-equal oldtag newtag)))) - (progn - ;; Mark the beginning of the tag for convenience. - (push-mark (point) 'nomsg) - (insert newtag "\n") - (list pritype subtype parameters) ;New tag is created. - ) - ;; Restore previous point. - (goto-char current) - nil ;Nothing is created. - ) - )) - -(defun mime-edit-insert-binary-file (file &optional encoding) - "Insert binary FILE at point. -Optional argument ENCODING specifies an encoding method such as base64." - (let* ((tagend (1- (point))) ;End of the tag - (hide-p (and mime-auto-hide-body - (stringp encoding) - (not - (let ((en (downcase encoding))) - (or (string-equal en "7bit") - (string-equal en "8bit") - (string-equal en "binary") - ))))) - ) - (save-restriction - (narrow-to-region tagend (point)) - (mime-insert-encoded-file file encoding) - (if hide-p - (progn - (invisible-region (point-min) (point-max)) - (goto-char (point-max)) - ) - (goto-char (point-max)) - )) - (or hide-p - (looking-at mime-edit-tag-regexp) - (= (point)(point-max)) - (mime-edit-insert-tag "text" "plain") - ) - ;; Define encoding even if it is 7bit. - (if (stringp encoding) - (save-excursion - (goto-char tagend) ; Make sure which line the tag is on. - (mime-edit-define-encoding encoding) - )) - )) - - -;; Commands work on a current message flagment. - -(defun mime-edit-goto-tag () - "Search for the beginning of the tagged MIME message." - (let ((current (point))) - (if (looking-at mime-edit-tag-regexp) - t - ;; At first, go to the end. - (cond ((re-search-forward mime-edit-beginning-tag-regexp nil t) - (goto-char (1- (match-beginning 0))) ;For multiline tag - ) - (t - (goto-char (point-max)) - )) - ;; Then search for the beginning. - (re-search-backward mime-edit-end-tag-regexp nil t) - (or (looking-at mime-edit-beginning-tag-regexp) - ;; Restore previous point. - (progn - (goto-char current) - nil - )) - ))) - -(defun mime-edit-content-beginning () - "Return the point of the beginning of content." - (save-excursion - (let ((beg (save-excursion - (beginning-of-line) (point)))) - (if (mime-edit-goto-tag) - (let ((top (point))) - (goto-char (match-end 0)) - (if (and (= beg top) - (= (following-char) ?\^M)) - (point) - (forward-line 1) - (point))) - ;; Default text/plain tag. - (goto-char (point-min)) - (re-search-forward - (concat "\n" (regexp-quote mail-header-separator) - (if mime-ignore-preceding-spaces - "[ \t\n]*\n" "\n")) nil 'move) - (point)) - ))) - -(defun mime-edit-content-end () - "Return the point of the end of content." - (save-excursion - (if (mime-edit-goto-tag) - (progn - (goto-char (match-end 0)) - (if (invisible-p (point)) - (next-visible-point (point)) - ;; Move to the end of this text. - (if (re-search-forward mime-edit-tag-regexp nil 'move) - ;; Don't forget a multiline tag. - (goto-char (match-beginning 0)) - ) - (point) - )) - ;; Assume the message begins with text/plain. - (goto-char (mime-edit-content-beginning)) - (if (re-search-forward mime-edit-tag-regexp nil 'move) - ;; Don't forget a multiline tag. - (goto-char (match-beginning 0))) - (point)) - )) - -(defun mime-edit-define-charset (charset) - "Set charset of current tag to CHARSET." - (save-excursion - (if (mime-edit-goto-tag) - (let ((tag (buffer-substring (match-beginning 0) (match-end 0)))) - (delete-region (match-beginning 0) (match-end 0)) - (insert - (mime-create-tag - (mime-edit-set-parameter - (mime-edit-get-contype tag) - "charset" (upcase (symbol-name charset))) - (mime-edit-get-encoding tag))) - )))) - -(defun mime-edit-define-encoding (encoding) - "Set encoding of current tag to ENCODING." - (save-excursion - (if (mime-edit-goto-tag) - (let ((tag (buffer-substring (match-beginning 0) (match-end 0)))) - (delete-region (match-beginning 0) (match-end 0)) - (insert (mime-create-tag (mime-edit-get-contype tag) encoding))) - ))) - -(defun mime-edit-choose-charset () - "Choose charset of a text following current point." - (detect-mime-charset-region (point) (mime-edit-content-end)) - ) - -(defun mime-make-text-tag (&optional subtype) - "Make a tag for a text after current point. -Subtype of text type can be specified by an optional argument SUBTYPE. -Otherwise, it is obtained from mime-content-types." - (let* ((pritype "text") - (subtype (or subtype - (car (car (cdr (assoc pritype mime-content-types))))))) - ;; Charset should be defined later. - (mime-make-tag pritype subtype))) - - -;; Tag handling functions - -(defun mime-make-tag (pritype subtype &optional parameters encoding) - "Make a tag of MIME message of PRITYPE, SUBTYPE and optional PARAMETERS." - (mime-create-tag (concat (or pritype "") "/" (or subtype "") - (or parameters "")) - encoding)) - -(defun mime-create-tag (contype &optional encoding) - "Make a tag with CONTENT-TYPE and optional ENCODING." - (format (if encoding mime-tag-format-with-encoding mime-tag-format) - contype encoding)) - -(defun mime-edit-get-contype (tag) - "Return Content-Type (including parameters) of TAG." - (and (stringp tag) - (or (string-match mime-edit-single-part-tag-regexp tag) - (string-match mime-edit-multipart-beginning-regexp tag) - (string-match mime-edit-multipart-end-regexp tag) - ) - (substring tag (match-beginning 1) (match-end 1)) - )) - -(defun mime-edit-get-encoding (tag) - "Return encoding of TAG." - (and (stringp tag) - (string-match mime-edit-single-part-tag-regexp tag) - (match-beginning 3) - (not (= (match-beginning 3) (match-end 3))) - (substring tag (match-beginning 3) (match-end 3)))) - -(defun mime-get-parameter (contype parameter) - "For given CONTYPE return value for PARAMETER. -Nil if no such parameter." - (if (string-match - (concat - ";[ \t\n]*" - (regexp-quote parameter) - "[ \t\n]*=[ \t\n]*\\([^\" \t\n;]*\\|\"[^\"]*\"\\)\\([ \t\n]*;\\|$\\)") - contype) - (substring contype (match-beginning 1) (match-end 1)) - nil ;No such parameter - )) - -(defun mime-edit-set-parameter (contype parameter value) - "For given CONTYPE set PARAMETER to VALUE." - (let (ctype opt-fields) - (if (string-match "\n[^ \t\n\r]+:" contype) - (setq ctype (substring contype 0 (match-beginning 0)) - opt-fields (substring contype (match-beginning 0))) - (setq ctype contype) - ) - (if (string-match - (concat - ";[ \t\n]*\\(" - (regexp-quote parameter) - "[ \t\n]*=[ \t\n]*\\([^\" \t\n;]*\\|\"[^\"]*\"\\)\\)[ \t\n]*\\(;\\|$\\)") - ctype) - ;; Change value - (concat (substring ctype 0 (match-beginning 1)) - parameter "=" value - (substring contype (match-end 1)) - opt-fields) - (concat ctype "; " parameter "=" value opt-fields) - ))) - -(defun mime-strip-parameters (contype) - "Return primary content-type and subtype without parameters for CONTYPE." - (if (string-match "^[ \t]*\\([^; \t\n]*\\)" contype) - (substring contype (match-beginning 1) (match-end 1)) nil)) - -(defun mime-test-content-type (contype type &optional subtype) - "Test if CONTYPE is a TYPE and an optional SUBTYPE." - (and (stringp contype) - (stringp type) - (string-match - (concat "^[ \t]*" (downcase type) "/" (downcase (or subtype ""))) - (downcase contype)))) - - -;; Basic functions - -(defun mime-find-file-type (file) - "Guess Content-Type, subtype, and parameters from FILE." - (let ((guess nil) - (guesses mime-file-types)) - (while (and (not guess) guesses) - (if (string-match (car (car guesses)) file) - (setq guess (cdr (car guesses)))) - (setq guesses (cdr guesses))) - guess - )) - -(defun mime-prompt-for-type (&optional default) - "Ask for Content-type." - (let ((type "")) - ;; Repeat until primary content type is specified. - (while (string-equal type "") - (setq type - (completing-read "What content type: " - mime-content-types - nil - 'require-match ;Type must be specified. - default - )) - (if (string-equal type "") - (progn - (message "Content type is required.") - (beep) - (sit-for 1) - )) - ) - type)) - -(defun mime-prompt-for-subtype (type &optional default) - "Ask for subtype of media-type TYPE." - (let ((subtypes (cdr (assoc type mime-content-types)))) - (or (and default - (assoc default subtypes)) - (setq default (car (car subtypes))) - )) - (let* ((answer - (completing-read - (if default - (concat - "What content subtype: (default " default ") ") - "What content subtype: ") - (cdr (assoc type mime-content-types)) - nil - 'require-match ;Subtype must be specified. - nil - ))) - (if (string-equal answer "") default answer))) - -(defun mime-prompt-for-parameters (pritype subtype &optional delimiter) - "Ask for Content-type parameters of Content-Type PRITYPE and SUBTYPE. -Optional DELIMITER specifies parameter delimiter (';' by default)." - (let* ((delimiter (or delimiter "; ")) - (parameters - (mapconcat - (function identity) - (delq nil - (mime-prompt-for-parameters-1 - (cdr (assoc subtype - (cdr (assoc pritype mime-content-types)))))) - delimiter - ))) - (if (and (stringp parameters) - (not (string-equal parameters ""))) - (concat delimiter parameters) - "" ;"" if no parameters - ))) - -(defun mime-prompt-for-parameters-1 (optlist) - (apply (function append) - (mapcar (function mime-prompt-for-parameter) optlist))) - -(defun mime-prompt-for-parameter (parameter) - "Ask for PARAMETER. -Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." - (let* ((prompt (car parameter)) - (choices (mapcar (function - (lambda (e) - (if (consp e) e (list e)))) - (cdr parameter))) - (default (car (car choices))) - (answer nil)) - (if choices - (progn - (setq answer - (completing-read - (concat "What " prompt - ": (default " - (if (string-equal default "") "\"\"" default) - ") ") - choices nil nil "")) - ;; If nothing is selected, use default. - (if (string-equal answer "") - (setq answer default))) - (setq answer - (read-string (concat "What " prompt ": ")))) - (cons (if (and answer - (not (string-equal answer ""))) - (concat prompt "=" - ;; Note: control characters ignored! - (if (string-match mime-tspecials-regexp answer) - (concat "\"" answer "\"") answer))) - (mime-prompt-for-parameters-1 (cdr (assoc answer (cdr parameter))))) - )) - -(defun mime-prompt-for-encoding (default) - "Ask for Content-Transfer-Encoding." - (let (encoding) - (while (string= - (setq encoding - (completing-read - "What transfer encoding: " - mime-file-encoding-method-alist nil t default) - ) - "")) - encoding)) - - -;;; @ Translate the tagged MIME messages into a MIME compliant message. -;;; - -(defvar mime-edit-translate-buffer-hook - '(mime-edit-pgp-enclose-buffer - mime-edit-translate-body - mime-edit-translate-header)) - -(defun mime-edit-translate-header () - "Encode the message header into network representation." - (eword-encode-header 'code-conversion) - (run-hooks 'mime-edit-translate-header-hook) - ) - -(defun mime-edit-translate-buffer () - "Encode the tagged MIME message in current buffer in MIME compliant message." - (interactive) - (if (catch 'mime-edit-error - (save-excursion - (run-hooks 'mime-edit-translate-buffer-hook) - )) - (progn - (undo) - (error "Translation error!") - ))) - -(defun mime-edit-find-inmost () - (goto-char (point-min)) - (if (re-search-forward mime-edit-multipart-beginning-regexp nil t) - (let ((bb (match-beginning 0)) - (be (match-end 0)) - (type (buffer-substring (match-beginning 1)(match-end 1))) - end-exp eb) - (setq end-exp (format "--}-<<%s>>\n" type)) - (widen) - (if (re-search-forward end-exp nil t) - (setq eb (match-beginning 0)) - (setq eb (point-max)) - ) - (narrow-to-region be eb) - (goto-char be) - (if (re-search-forward mime-edit-multipart-beginning-regexp nil t) - (progn - (narrow-to-region (match-beginning 0)(point-max)) - (mime-edit-find-inmost) - ) - (widen) - (list type bb be eb) - )))) - -(defun mime-edit-process-multipart-1 (boundary) - (let ((ret (mime-edit-find-inmost))) - (if ret - (let ((type (car ret)) - (bb (nth 1 ret))(be (nth 2 ret)) - (eb (nth 3 ret)) - ) - (narrow-to-region bb eb) - (delete-region bb be) - (setq bb (point-min)) - (setq eb (point-max)) - (widen) - (goto-char eb) - (if (looking-at mime-edit-multipart-end-regexp) - (let ((beg (match-beginning 0)) - (end (match-end 0)) - ) - (delete-region beg end) - (or (looking-at mime-edit-beginning-tag-regexp) - (eobp) - (insert (concat (mime-make-text-tag) "\n")) - ))) - (cond ((string-equal type "quote") - (mime-edit-enquote-region bb eb) - ) - ((string-equal type "pgp-signed") - (mime-edit-sign-pgp-mime bb eb boundary) - ) - ((string-equal type "pgp-encrypted") - (mime-edit-encrypt-pgp-mime bb eb boundary) - ) - ((string-equal type "kazu-signed") - (mime-edit-sign-pgp-kazu bb eb boundary) - ) - ((string-equal type "kazu-encrypted") - (mime-edit-encrypt-pgp-kazu bb eb boundary) - ) - (t - (setq boundary - (nth 2 (mime-edit-translate-region bb eb - boundary t))) - (goto-char bb) - (insert - (format "--[[multipart/%s; - boundary=\"%s\"][7bit]]\n" - type boundary)) - )) - boundary)))) - -(defun mime-edit-enquote-region (beg end) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char beg) - (while (re-search-forward mime-edit-single-part-tag-regexp nil t) - (let ((tag (buffer-substring (match-beginning 0)(match-end 0)))) - (replace-match (concat "- " (substring tag 1))) - ))))) - -(defun mime-edit-dequote-region (beg end) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char beg) - (while (re-search-forward - mime-edit-quoted-single-part-tag-regexp nil t) - (let ((tag (buffer-substring (match-beginning 0)(match-end 0)))) - (replace-match (concat "-" (substring tag 2))) - ))))) - -(defun mime-edit-sign-pgp-mime (beg end boundary) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (let* ((ret - (mime-edit-translate-region beg end boundary)) - (ctype (car ret)) - (encoding (nth 1 ret)) - (pgp-boundary (concat "pgp-sign-" boundary))) - (goto-char beg) - (insert (format "Content-Type: %s\n" ctype)) - (if encoding - (insert (format "Content-Transfer-Encoding: %s\n" encoding)) - ) - (insert "\n") - (or (as-binary-process - (funcall (pgp-function 'mime-sign) - (point-min)(point-max) nil nil pgp-boundary)) - (throw 'mime-edit-error 'pgp-error) - ) - )))) - -(defvar mime-edit-encrypt-recipient-fields-list '("To" "cc")) - -(defun mime-edit-make-encrypt-recipient-header () - (let* ((names mime-edit-encrypt-recipient-fields-list) - (values - (std11-field-bodies (cons "From" names) - nil mail-header-separator)) - (from (prog1 - (car values) - (setq values (cdr values)))) - (header (and (stringp from) - (if (string-equal from "") - "" - (format "From: %s\n" from) - ))) - recipients) - (while (and names values) - (let ((name (car names)) - (value (car values)) - ) - (and (stringp value) - (or (string-equal value "") - (progn - (setq header (concat header name ": " value "\n") - recipients (if recipients - (concat recipients " ," value) - value)) - )))) - (setq names (cdr names) - values (cdr values)) - ) - (vector from recipients header) - )) - -(defun mime-edit-encrypt-pgp-mime (beg end boundary) - (save-excursion - (save-restriction - (let (from recipients header) - (let ((ret (mime-edit-make-encrypt-recipient-header))) - (setq from (aref ret 0) - recipients (aref ret 1) - header (aref ret 2)) - ) - (narrow-to-region beg end) - (let* ((ret - (mime-edit-translate-region beg end boundary)) - (ctype (car ret)) - (encoding (nth 1 ret)) - (pgp-boundary (concat "pgp-" boundary))) - (goto-char beg) - (insert header) - (insert (format "Content-Type: %s\n" ctype)) - (if encoding - (insert (format "Content-Transfer-Encoding: %s\n" encoding)) - ) - (insert "\n") - (or (funcall (pgp-function 'encrypt) - recipients (point-min) (point-max) from) - (throw 'mime-edit-error 'pgp-error) - ) - (goto-char beg) - (insert (format "--[[multipart/encrypted; - boundary=\"%s\"; - protocol=\"application/pgp-encrypted\"][7bit]] ---%s -Content-Type: application/pgp-encrypted - ---%s -Content-Type: application/octet-stream -Content-Transfer-Encoding: 7bit - -" pgp-boundary pgp-boundary pgp-boundary)) - (goto-char (point-max)) - (insert (format "\n--%s--\n" pgp-boundary)) - ))))) - -(defun mime-edit-sign-pgp-kazu (beg end boundary) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (let* ((ret - (mime-edit-translate-region beg end boundary)) - (ctype (car ret)) - (encoding (nth 1 ret))) - (goto-char beg) - (insert (format "Content-Type: %s\n" ctype)) - (if encoding - (insert (format "Content-Transfer-Encoding: %s\n" encoding)) - ) - (insert "\n") - (or (as-binary-process - (funcall (pgp-function 'traditional-sign) - beg (point-max))) - (throw 'mime-edit-error 'pgp-error) - ) - (goto-char beg) - (insert - "--[[application/pgp; format=mime][7bit]]\n") - )) - )) - -(defun mime-edit-encrypt-pgp-kazu (beg end boundary) - (save-excursion - (let (recipients header) - (let ((ret (mime-edit-make-encrypt-recipient-header))) - (setq recipients (aref ret 1) - header (aref ret 2)) - ) - (save-restriction - (narrow-to-region beg end) - (let* ((ret - (mime-edit-translate-region beg end boundary)) - (ctype (car ret)) - (encoding (nth 1 ret))) - (goto-char beg) - (insert header) - (insert (format "Content-Type: %s\n" ctype)) - (if encoding - (insert (format "Content-Transfer-Encoding: %s\n" encoding)) - ) - (insert "\n") - (or (as-binary-process - (funcall (pgp-function 'encrypt) - recipients beg (point-max) nil 'maybe) - ) - (throw 'mime-edit-error 'pgp-error) - ) - (goto-char beg) - (insert - "--[[application/pgp; format=mime][7bit]]\n") - )) - ))) - -(defsubst replace-space-with-underline (str) - (mapconcat (function - (lambda (arg) - (char-to-string - (if (eq arg ?\ ) - ?_ - arg)))) str "") - ) - -(defun mime-edit-make-boundary () - (concat mime-multipart-boundary "_" - (replace-space-with-underline (current-time-string)) - )) - -(defun mime-edit-translate-body () - "Encode the tagged MIME body in current buffer in MIME compliant message." - (interactive) - (save-excursion - (let ((boundary (mime-edit-make-boundary)) - (i 1) - ret) - (while (mime-edit-process-multipart-1 - (format "%s-%d" boundary i)) - (setq i (1+ i)) - ) - (save-restriction - ;; We are interested in message body. - (let* ((beg - (progn - (goto-char (point-min)) - (re-search-forward - (concat "\n" (regexp-quote mail-header-separator) - (if mime-ignore-preceding-spaces - "[ \t\n]*\n" "\n")) nil 'move) - (point))) - (end - (progn - (goto-char (point-max)) - (and mime-ignore-trailing-spaces - (re-search-backward "[^ \t\n]\n" beg t) - (forward-char 1)) - (point)))) - (setq ret (mime-edit-translate-region - beg end - (format "%s-%d" boundary i))) - )) - (mime-edit-dequote-region (point-min)(point-max)) - (let ((contype (car ret)) ;Content-Type - (encoding (nth 1 ret)) ;Content-Transfer-Encoding - ) - ;; Insert X-Emacs field - (and mime-edit-insert-x-emacs-field - (or (mail-position-on-field "X-Emacs") - (insert mime-edit-x-emacs-value) - )) - ;; Make primary MIME headers. - (or (mail-position-on-field "MIME-Version") - (insert mime-edit-mime-version-value)) - ;; Remove old Content-Type and other fields. - (save-restriction - (goto-char (point-min)) - (search-forward (concat "\n" mail-header-separator "\n") nil t) - (narrow-to-region (point-min) (point)) - (goto-char (point-min)) - (mime-delete-field "Content-Type") - (mime-delete-field "Content-Transfer-Encoding")) - ;; Then, insert Content-Type and Content-Transfer-Encoding fields. - (mail-position-on-field "Content-Type") - (insert contype) - (if encoding - (progn - (mail-position-on-field "Content-Transfer-Encoding") - (insert encoding))) - )))) - -(defun mime-edit-translate-single-part-tag (boundary &optional prefix) - "Translate single-part-tag to MIME header." - (if (re-search-forward mime-edit-single-part-tag-regexp nil t) - (let* ((beg (match-beginning 0)) - (end (match-end 0)) - (tag (buffer-substring beg end))) - (delete-region beg end) - (let ((contype (mime-edit-get-contype tag)) - (encoding (mime-edit-get-encoding tag))) - (insert (concat prefix "--" boundary "\n")) - (save-restriction - (narrow-to-region (point)(point)) - (insert "Content-Type: " contype "\n") - (if encoding - (insert "Content-Transfer-Encoding: " encoding "\n")) - (eword-encode-header) - )) - t))) - -(defun mime-edit-translate-region (beg end &optional boundary multipart) - (or boundary - (setq boundary (mime-edit-make-boundary)) - ) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (let ((tag nil) ;MIME tag - (contype nil) ;Content-Type - (encoding nil) ;Content-Transfer-Encoding - (nparts 0)) ;Number of body parts - ;; Normalize the body part by inserting appropriate message - ;; tags for every message contents. - (mime-edit-normalize-body) - ;; Counting the number of Content-Type. - (goto-char (point-min)) - (while (re-search-forward mime-edit-single-part-tag-regexp nil t) - (setq nparts (1+ nparts))) - ;; Begin translation. - (cond - ((and (<= nparts 1)(not multipart)) - ;; It's a singular message. - (goto-char (point-min)) - (while (re-search-forward - mime-edit-single-part-tag-regexp nil t) - (setq tag - (buffer-substring (match-beginning 0) (match-end 0))) - (delete-region (match-beginning 0) (1+ (match-end 0))) - (setq contype (mime-edit-get-contype tag)) - (setq encoding (mime-edit-get-encoding tag)) - )) - (t - ;; It's a multipart message. - (goto-char (point-min)) - (and (mime-edit-translate-single-part-tag boundary) - (while (mime-edit-translate-single-part-tag boundary "\n"))) - ;; Define Content-Type as "multipart/mixed". - (setq contype - (concat "multipart/mixed;\n boundary=\"" boundary "\"")) - ;; Content-Transfer-Encoding must be "7bit". - ;; The following encoding can be `nil', but is - ;; specified as is since there is no way that a user - ;; specifies it. - (setq encoding "7bit") - ;; Insert the trailer. - (goto-char (point-max)) - (insert "\n--" boundary "--\n") - )) - (list contype encoding boundary nparts) - )))) - -(defun mime-edit-normalize-body () - "Normalize the body part by inserting appropriate message tags." - ;; Insert the first MIME tags if necessary. - (goto-char (point-min)) - (if (not (looking-at mime-edit-single-part-tag-regexp)) - (insert (mime-make-text-tag) "\n")) - ;; Check each tag, and add new tag or correct it if necessary. - (goto-char (point-min)) - (while (re-search-forward mime-edit-single-part-tag-regexp nil t) - (let* ((tag (buffer-substring (match-beginning 0) (match-end 0))) - (contype (mime-edit-get-contype tag)) - (charset (mime-get-parameter contype "charset")) - (encoding (mime-edit-get-encoding tag))) - ;; Remove extra whitespaces after the tag. - (if (looking-at "[ \t]+$") - (delete-region (match-beginning 0) (match-end 0))) - (let ((beg (point)) - (end (mime-edit-content-end)) - ) - (if (= end (point-max)) - nil - (goto-char end) - (or (looking-at mime-edit-beginning-tag-regexp) - (eobp) - (insert (mime-make-text-tag) "\n") - )) - (visible-region beg end) - (goto-char beg) - ) - (cond - ((mime-test-content-type contype "message") - ;; Content-type "message" should be sent as is. - (forward-line 1) - ) - ((mime-test-content-type contype "text") - ;; Define charset for text if necessary. - (setq charset (if charset - (intern (downcase charset)) - (mime-edit-choose-charset))) - (mime-edit-define-charset charset) - (cond ((string-equal contype "text/x-rot13-47-48") - (save-excursion - (forward-line) - (mule-caesar-region (point) (mime-edit-content-end)) - )) - ((string-equal contype "text/enriched") - (save-excursion - (let ((beg (progn - (forward-line) - (point))) - (end (mime-edit-content-end)) - ) - ;; Patch for hard newlines - ;; (save-excursion - ;; (goto-char beg) - ;; (while (search-forward "\n" end t) - ;; (put-text-property (match-beginning 0) - ;; (point) - ;; 'hard t))) - ;; End patch for hard newlines - (enriched-encode beg end) - (goto-char beg) - (if (search-forward "\n\n") - (delete-region beg (match-end 0)) - ) - )))) - ;; Point is now on current tag. - ;; Define encoding and encode text if necessary. - (or encoding ;Encoding is not specified. - (let* ((encoding - (let (bits conv) - (let ((ret (cdr (assq charset mime-charset-type-list)))) - (if ret - (setq bits (car ret) - conv (nth 1 ret)) - (setq bits 8 - conv "quoted-printable"))) - (if (<= bits mime-transfer-level) - (mime-encoding-name bits) - conv))) - (beg (mime-edit-content-beginning))) - (encode-mime-charset-region beg (mime-edit-content-end) - charset) - ;; Protect "From " in beginning of line - (save-restriction - (narrow-to-region beg (mime-edit-content-end)) - (goto-char beg) - (let (case-fold-search) - (if (re-search-forward "^From " nil t) - (unless encoding - (if (memq charset '(iso-2022-jp - iso-2022-jp-2 - iso-2022-int-1 - x-ctext)) - (while (progn - (replace-match "\e(BFrom ") - (re-search-forward "^From " nil t) - )) - (setq encoding "quoted-printable") - ))))) - ;; canonicalize line break code - (or (member encoding '(nil "7bit" "8bit" "quoted-printable")) - (save-restriction - (narrow-to-region beg (mime-edit-content-end)) - (goto-char beg) - (while (re-search-forward "\\([^\r]\\)\n" nil t) - (replace-match - (concat (buffer-substring (match-beginning 0) - (match-end 1)) "\r\n")) - ))) - (goto-char beg) - (mime-encode-region beg (mime-edit-content-end) encoding) - (mime-edit-define-encoding encoding) - )) - (goto-char (mime-edit-content-end)) - ) - ((null encoding) ;Encoding is not specified. - ;; Application, image, audio, video, and any other - ;; unknown content-type without encoding should be - ;; encoded. - (let* ((encoding "base64") ;Encode in BASE64 by default. - (beg (mime-edit-content-beginning)) - (end (mime-edit-content-end))) - (mime-encode-region beg end encoding) - (mime-edit-define-encoding encoding)) - (forward-line 1) - )) - ))) - -(defun mime-delete-field (field) - "Delete header FIELD." - (let ((regexp (format "^%s:[ \t]*" field))) - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (delete-region (match-beginning 0) - (progn (forward-line 1) (point))) - ))) - - -;;; -;;; Platform dependent functions -;;; - -;; Sun implementations - -(defun mime-edit-voice-recorder-for-sun (encoding) - "Record voice in a buffer using Sun audio device, -and insert data encoded as ENCODING." - (message "Start the recording on %s. Type C-g to finish the recording..." - (system-name)) - (mime-insert-encoded-file "/dev/audio" encoding) - ) - - -;;; @ Other useful commands. -;;; - -;; Message forwarding commands as content-type "message/rfc822". - -(defun mime-edit-insert-message (&optional message) - (interactive) - (let ((inserter (cdr (assq major-mode mime-edit-message-inserter-alist)))) - (if (and inserter (fboundp inserter)) - (progn - (mime-edit-insert-tag "message" "rfc822") - (funcall inserter message) - ) - (message "Sorry, I don't have message inserter for your MUA.") - ))) - -(defun mime-edit-insert-mail (&optional message) - (interactive) - (let ((inserter (cdr (assq major-mode mime-edit-mail-inserter-alist)))) - (if (and inserter (fboundp inserter)) - (progn - (mime-edit-insert-tag "message" "rfc822") - (funcall inserter message) - ) - (message "Sorry, I don't have mail inserter for your MUA.") - ))) - -(defun mime-edit-inserted-message-filter () - (save-excursion - (save-restriction - (let ((header-start (point)) - (case-fold-search t) - beg end) - ;; for Emacs 18 - ;; (if (re-search-forward "^$" (marker-position (mark-marker))) - (if (re-search-forward "^$" (mark t)) - (narrow-to-region header-start (match-beginning 0)) - ) - (goto-char header-start) - (while (and (re-search-forward - mime-edit-yank-ignored-field-regexp nil t) - (setq beg (match-beginning 0)) - (setq end (1+ (std11-field-end))) - ) - (delete-region beg end) - ) - )))) - - -;;; @ multipart enclosure -;;; - -(defun mime-edit-enclose-region-internal (type beg end) - (save-excursion - (goto-char beg) - (save-restriction - (narrow-to-region beg end) - (insert (format "--<<%s>>-{\n" type)) - (goto-char (point-max)) - (insert (format "--}-<<%s>>\n" type)) - (goto-char (point-max)) - ) - (or (looking-at mime-edit-beginning-tag-regexp) - (eobp) - (insert (mime-make-text-tag) "\n") - ) - )) - -(defun mime-edit-enclose-quote-region (beg end) - (interactive "*r") - (mime-edit-enclose-region-internal 'quote beg end) - ) - -(defun mime-edit-enclose-mixed-region (beg end) - (interactive "*r") - (mime-edit-enclose-region-internal 'mixed beg end) - ) - -(defun mime-edit-enclose-parallel-region (beg end) - (interactive "*r") - (mime-edit-enclose-region-internal 'parallel beg end) - ) - -(defun mime-edit-enclose-digest-region (beg end) - (interactive "*r") - (mime-edit-enclose-region-internal 'digest beg end) - ) - -(defun mime-edit-enclose-alternative-region (beg end) - (interactive "*r") - (mime-edit-enclose-region-internal 'alternative beg end) - ) - -(defun mime-edit-enclose-pgp-signed-region (beg end) - (interactive "*r") - (mime-edit-enclose-region-internal 'pgp-signed beg end) - ) - -(defun mime-edit-enclose-pgp-encrypted-region (beg end) - (interactive "*r") - (mime-edit-enclose-region-internal 'pgp-encrypted beg end) - ) - -(defun mime-edit-enclose-kazu-signed-region (beg end) - (interactive "*r") - (mime-edit-enclose-region-internal 'kazu-signed beg end) - ) - -(defun mime-edit-enclose-kazu-encrypted-region (beg end) - (interactive "*r") - (mime-edit-enclose-region-internal 'kazu-encrypted beg end) - ) - -(defun mime-edit-insert-key (&optional arg) - "Insert a pgp public key." - (interactive "P") - (mime-edit-insert-tag "application" "pgp-keys") - (mime-edit-define-encoding "7bit") - (funcall (pgp-function 'insert-key)) - ) - - -;;; @ flag setting -;;; - -(defun mime-edit-set-split (arg) - (interactive - (list - (y-or-n-p "Do you want to enable split? ") - )) - (setq mime-edit-split-message arg) - (if arg - (message "This message is enabled to split.") - (message "This message is not enabled to split.") - )) - -(defun mime-edit-toggle-transfer-level (&optional transfer-level) - "Toggle transfer-level is 7bit or 8bit through. - -Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." - (interactive) - (if (numberp transfer-level) - (setq mime-transfer-level transfer-level) - (if (< mime-transfer-level 8) - (setq mime-transfer-level 8) - (setq mime-transfer-level 7) - )) - (message (format "Current transfer-level is %d bit" - mime-transfer-level)) - (setq mime-transfer-level-string - (mime-encoding-name mime-transfer-level 'not-omit)) - (force-mode-line-update) - ) - -(defun mime-edit-set-transfer-level-7bit () - (interactive) - (mime-edit-toggle-transfer-level 7) - ) - -(defun mime-edit-set-transfer-level-8bit () - (interactive) - (mime-edit-toggle-transfer-level 8) - ) - - -;;; @ pgp -;;; - -(defvar mime-edit-pgp-processing nil) -(make-variable-buffer-local 'mime-edit-pgp-processing) - -(defun mime-edit-set-sign (arg) - (interactive - (list - (y-or-n-p "Do you want to sign? ") - )) - (if arg - (progn - (setq mime-edit-pgp-processing 'sign) - (message "This message will be signed.") - ) - (if (eq mime-edit-pgp-processing 'sign) - (setq mime-edit-pgp-processing nil) - ) - (message "This message will not be signed.") - )) - -(defun mime-edit-set-encrypt (arg) - (interactive - (list - (y-or-n-p "Do you want to encrypt? ") - )) - (if arg - (progn - (setq mime-edit-pgp-processing 'encrypt) - (message "This message will be encrypt.") - ) - (if (eq mime-edit-pgp-processing 'encrypt) - (setq mime-edit-pgp-processing nil) - ) - (message "This message will not be encrypt.") - )) - -(defun mime-edit-pgp-enclose-buffer () - (let ((beg (save-excursion - (goto-char (point-min)) - (if (search-forward (concat "\n" mail-header-separator "\n")) - (match-end 0) - ))) - (end (point-max)) - ) - (if beg - (cond ((eq mime-edit-pgp-processing 'sign) - (mime-edit-enclose-pgp-signed-region beg end) - ) - ((eq mime-edit-pgp-processing 'encrypt) - (mime-edit-enclose-pgp-encrypted-region beg end) - )) - ))) - - -;;; @ split -;;; - -(defun mime-edit-insert-partial-header (fields subject - id number total separator) - (insert fields) - (insert (format "Subject: %s (%d/%d)\n" subject number total)) - (insert mime-edit-mime-version-field-for-message/partial) - (insert (format "\ -Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" - id number total separator)) - ) - -(defun mime-edit-split-and-send - (&optional cmd lines mime-edit-message-max-length) - (interactive) - (or lines - (setq lines - (count-lines (point-min) (point-max))) - ) - (or mime-edit-message-max-length - (setq mime-edit-message-max-length - (or (cdr (assq major-mode mime-edit-message-max-lines-alist)) - mime-edit-message-default-max-lines)) - ) - (let* ((mime-edit-draft-file-name - (or (buffer-file-name) - (make-temp-name - (expand-file-name "mime-draft" mime-temp-directory)))) - (separator mail-header-separator) - (id (concat "\"" - (replace-space-with-underline (current-time-string)) - "@" (system-name) "\""))) - (run-hooks 'mime-edit-before-split-hook) - (let ((the-buf (current-buffer)) - (copy-buf (get-buffer-create " *Original Message*")) - (header (std11-header-string-except - mime-edit-split-ignored-field-regexp separator)) - (subject (mail-fetch-field "subject")) - (total (+ (/ lines mime-edit-message-max-length) - (if (> (mod lines mime-edit-message-max-length) 0) - 1))) - (command - (or cmd - (cdr - (assq major-mode - mime-edit-split-message-sender-alist)) - (function - (lambda () - (interactive) - (error "Split sender is not specified for `%s'." major-mode) - )) - )) - (mime-edit-partial-number 1) - data) - (save-excursion - (set-buffer copy-buf) - (erase-buffer) - (insert-buffer the-buf) - (save-restriction - (if (re-search-forward - (concat "^" (regexp-quote separator) "$") nil t) - (let ((he (match-beginning 0))) - (replace-match "") - (narrow-to-region (point-min) he) - )) - (goto-char (point-min)) - (while (re-search-forward mime-edit-split-blind-field-regexp nil t) - (delete-region (match-beginning 0) - (1+ (std11-field-end))) - ))) - (while (< mime-edit-partial-number total) - (erase-buffer) - (save-excursion - (set-buffer copy-buf) - (setq data (buffer-substring - (point-min) - (progn - (goto-line mime-edit-message-max-length) - (point)) - )) - (delete-region (point-min)(point)) - ) - (mime-edit-insert-partial-header - header subject id mime-edit-partial-number total separator) - (insert data) - (save-excursion - (message (format "Sending %d/%d..." - mime-edit-partial-number total)) - (call-interactively command) - (message (format "Sending %d/%d... done" - mime-edit-partial-number total)) - ) - (setq mime-edit-partial-number - (1+ mime-edit-partial-number)) - ) - (erase-buffer) - (save-excursion - (set-buffer copy-buf) - (setq data (buffer-string)) - (erase-buffer) - ) - (mime-edit-insert-partial-header - header subject id mime-edit-partial-number total separator) - (insert data) - (save-excursion - (message (format "Sending %d/%d..." - mime-edit-partial-number total)) - (message (format "Sending %d/%d... done" - mime-edit-partial-number total)) - ) - ))) - -(defun mime-edit-maybe-split-and-send (&optional cmd) - (interactive) - (run-hooks 'mime-edit-before-send-hook) - (let ((mime-edit-message-max-length - (or (cdr (assq major-mode mime-edit-message-max-lines-alist)) - mime-edit-message-default-max-lines)) - (lines (count-lines (point-min) (point-max))) - ) - (if (and (> lines mime-edit-message-max-length) - mime-edit-split-message) - (mime-edit-split-and-send cmd lines mime-edit-message-max-length) - ))) - - -;;; @ preview message -;;; - -(defvar mime-edit-buffer nil) ; buffer local variable - -(defun mime-edit-preview-message () - "preview editing MIME message." - (interactive) - (let* ((str (buffer-string)) - (separator mail-header-separator) - (the-buf (current-buffer)) - (buf-name (buffer-name)) - (temp-buf-name (concat "*temp-article:" buf-name "*")) - (buf (get-buffer temp-buf-name)) - ) - (if buf - (progn - (switch-to-buffer buf) - (erase-buffer) - ) - (setq buf (get-buffer-create temp-buf-name)) - (switch-to-buffer buf) - ) - (insert str) - (setq major-mode 'mime-temp-message-mode) - (make-local-variable 'mail-header-separator) - (setq mail-header-separator separator) - (make-local-variable 'mime-edit-buffer) - (setq mime-edit-buffer the-buf) - - (run-hooks 'mime-edit-translate-hook) - (mime-edit-translate-buffer) - (goto-char (point-min)) - (if (re-search-forward - (concat "^" (regexp-quote separator) "$")) - (replace-match "") - ) - (mime-view-mode) - )) - -(defun mime-edit-quitting-method () - "Quitting method for mime-view." - (let ((temp mime-raw-buffer) - buf) - (mime-preview-kill-buffer) - (set-buffer temp) - (setq buf mime-edit-buffer) - (kill-buffer temp) - (switch-to-buffer buf) - )) - -(set-alist 'mime-preview-quitting-method-alist - 'mime-temp-message-mode - #'mime-edit-quitting-method) - - -;;; @ edit again -;;; - -(defvar mime-edit-again-ignored-field-regexp - (concat "^\\(" "Content-.*\\|Mime-Version" - (if mime-edit-insert-x-emacs-field "\\|X-Emacs") - "\\):") - "Regexp for deleted header fields when `mime-edit-again' is called.") - -(defun mime-edit-decode-buffer (not-decode-text) - (save-excursion - (goto-char (point-min)) - (let ((ctl (mime-read-Content-Type))) - (if ctl - (let ((type (mime-content-type-primary-type ctl)) - (stype (mime-content-type-subtype ctl)) - (params (mime-content-type-parameters ctl))) - (cond - ((and (eq type 'application)(eq stype 'pgp-signature)) - (delete-region (point-min)(point-max)) - ) - ((eq type 'multipart) - (let* ((boundary (cdr (assoc "boundary" params))) - (boundary-pat - (concat "\n--" (regexp-quote boundary) "[ \t]*\n")) - ) - (re-search-forward boundary-pat nil t) - (let ((bb (match-beginning 0)) eb tag) - (setq tag (format "\n--<<%s>>-{\n" stype)) - (goto-char bb) - (insert tag) - (setq bb (+ bb (length tag))) - (re-search-forward - (concat "\n--" (regexp-quote boundary) "--[ \t]*\n") - nil t) - (setq eb (match-beginning 0)) - (replace-match (format "--}-<<%s>>\n" stype)) - (save-restriction - (narrow-to-region bb eb) - (goto-char (point-min)) - (while (re-search-forward boundary-pat nil t) - (let ((beg (match-beginning 0)) - end) - (delete-region beg (match-end 0)) - (save-excursion - (if (re-search-forward boundary-pat nil t) - (setq end (match-beginning 0)) - (setq end (point-max)) - ) - (save-restriction - (narrow-to-region beg end) - (mime-edit-decode-buffer not-decode-text) - (goto-char (point-max)) - )))) - )) - (goto-char (point-min)) - (or (= (point-min) 1) - (delete-region (point-min) - (if (search-forward "\n\n" nil t) - (match-end 0) - (point-min) - ))) - )) - (t - (let* ((ctype (format "%s/%s" type stype)) - charset - (pstr - (let ((bytes (+ 14 (length ctype)))) - (mapconcat (function - (lambda (attr) - (if (string= (car attr) "charset") - (progn - (setq charset (cdr attr)) - "") - (let* ((str - (concat (car attr) - "=" (cdr attr)) - ) - (bs (length str)) - ) - (setq bytes (+ bytes bs 2)) - (if (< bytes 76) - (concat "; " str) - (setq bytes (+ bs 1)) - (concat ";\n " str) - ) - )))) - params ""))) - encoding - encoded) - (save-excursion - (if (re-search-forward - "Content-Transfer-Encoding:" nil t) - (let ((beg (match-beginning 0)) - (hbeg (match-end 0)) - (end (std11-field-end))) - (setq encoding - (eliminate-top-spaces - (std11-unfold-string - (buffer-substring hbeg end)))) - (if (or charset (eq type 'text)) - (progn - (delete-region beg (1+ end)) - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (progn - (mime-decode-region - (match-end 0)(point-max) encoding) - (setq encoded t - encoding nil) - ))))))) - (if (or encoded (not not-decode-text)) - (decode-mime-charset-region - (point-min)(point-max) - (or charset default-mime-charset)) - ) - (let ((he - (if (re-search-forward "^$" nil t) - (match-end 0) - (point-min) - ))) - (if (= (point-min) 1) - (progn - (goto-char he) - (insert - (concat "\n" - (mime-create-tag - (format "%s/%s%s" type stype pstr) - encoding))) - ) - (delete-region (point-min) he) - (insert - (mime-create-tag - (format "%s/%s%s" type stype pstr) - encoding)) - )) - )))) - (or not-decode-text - (decode-mime-charset-region (point-min) (point-max) - default-mime-charset) - ) - )))) - -(defun mime-edit-again (&optional not-decode-text no-separator not-turn-on) - "Convert current buffer to MIME-Edit buffer and turn on MIME-Edit mode. -Content-Type and Content-Transfer-Encoding header fields will be -converted to MIME-Edit tags." - (interactive) - (goto-char (point-min)) - (if (search-forward - (concat "\n" (regexp-quote mail-header-separator) "\n") - nil t) - (replace-match "\n\n") - ) - (mime-edit-decode-buffer not-decode-text) - (goto-char (point-min)) - (save-restriction - (std11-narrow-to-header) - (goto-char (point-min)) - (while (re-search-forward mime-edit-again-ignored-field-regexp nil t) - (delete-region (match-beginning 0) (1+ (std11-field-end))) - )) - (or no-separator - (and (re-search-forward "^$") - (replace-match mail-header-separator) - )) - (or not-turn-on - (turn-on-mime-edit) - )) - - -;;; @ end -;;; - -(provide 'mime-edit) - -(run-hooks 'mime-edit-load-hook) - -;;; mime-edit.el ends here diff --git a/mime-image.el b/mime-image.el deleted file mode 100644 index 1e20ac0..0000000 --- a/mime-image.el +++ /dev/null @@ -1,177 +0,0 @@ -;;; mime-image.el --- mime-view filter to display images - -;; Copyright (C) 1995,1996,1997,1998 MORIOKA Tomohiko -;; Copyright (C) 1996 Dan Rich - -;; Author: MORIOKA Tomohiko -;; Dan Rich -;; Maintainer: MORIOKA Tomohiko -;; Created: 1995/12/15 -;; Renamed: 1997/2/21 from tm-image.el - -;; Keywords: image, picture, X-Face, MIME, multimedia, mail, news - -;; This file is part of SEMI (Showy Emacs MIME Interfaces). - -;; This program 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. - -;; This program 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 XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: -;; If you use this program with MULE, please install -;; etl8x16-bitmap.bdf font included in tl package. - -;;; Code: - -(require 'mime-view) -(require 'alist) - -(cond ((featurep 'xemacs) - (require 'images) - - (defun-maybe image-inline-p (format) - (or (memq format image-native-formats) - (find-if (function - (lambda (native) - (image-converter-chain format native) - )) - image-native-formats) - )) - - (image-register-netpbm-utilities) - (image-register-converter 'pic 'ppm "pictoppm") - (image-register-converter 'mag 'ppm "magtoppm") - - (defun bitmap-insert-xbm-file (file) - (let ((gl (make-glyph (list (cons 'x file)))) - (e (make-extent (point) (point))) - ) - (set-extent-end-glyph e gl) - )) - - ;; - ;; X-Face - ;; - (autoload 'highlight-headers "highlight-headers") - - (defun mime-preview-x-face-function-use-highlight-headers () - (highlight-headers (point-min) (re-search-forward "^$" nil t) t) - ) - - (add-hook 'mime-display-header-hook - 'mime-preview-x-face-function-use-highlight-headers) - - ) - ((featurep 'mule) - ;; for MULE 2.* or mule merged EMACS - (require 'x-face-mule) - - (defvar image-native-formats '(xbm)) - - (defun-maybe image-inline-p (format) - (memq format image-native-formats) - ) - - (defun-maybe image-normalize (format data) - (and (eq format 'xbm) - (vector 'xbm ':data data) - )) - - ;; - ;; X-Face - ;; - (if (exec-installed-p uncompface-program exec-path) - (add-hook 'mime-display-header-hook - 'x-face-decode-message-header) - ) - )) - -(or (fboundp 'image-invalid-glyph-p) - (defsubst image-invalid-glyph-p (glyph) - (or (null (aref glyph 0)) - (null (aref glyph 2)) - (equal (aref glyph 2) "") - )) - ) - -(mapcar (function - (lambda (rule) - (let ((type (car rule)) - (subtype (nth 1 rule)) - (format (nth 2 rule))) - (if (image-inline-p format) - (ctree-set-calist-strictly - 'mime-preview-condition - (list (cons 'type type)(cons 'subtype subtype) - '(body . visible) - (cons 'body-presentation-method #'mime-display-image) - (cons 'image-format format)) - ))))) - '((image jpeg jpeg) - (image gif gif) - (image tiff tiff) - (image x-tiff tiff) - (image xbm xbm) - (image x-xbm xbm) - (image x-xpixmap xpm) - (image x-pic pic) - (image x-mag mag) - (image png png) - )) - - -;;; @ content filter for images -;;; -;; (for XEmacs 19.12 or later) - -(defun mime-display-image (entity situation) - (message "Decoding image...") - (let ((gl (image-normalize (cdr (assq 'image-format situation)) - (mime-entity-content entity)))) - (cond ((image-invalid-glyph-p gl) - (setq gl nil) - (message "Invalid glyph!") - ) - ((eq (aref gl 0) 'xbm) - (let ((xbm-file - (make-temp-name - (expand-file-name "tm" mime-temp-directory)))) - (with-temp-buffer - (insert (aref gl 2)) - (write-region (point-min)(point-max) xbm-file) - ) - (message "Decoding image...") - (bitmap-insert-xbm-file xbm-file) - (delete-file xbm-file) - ) - (message "Decoding image... done") - ) - (t - (setq gl (make-glyph gl)) - (let ((e (make-extent (point) (point)))) - (set-extent-end-glyph e gl) - ) - (message "Decoding image... done") - )) - ) - (insert "\n") - ) - - -;;; @ end -;;; - -(provide 'mime-image) - -;;; mime-image.el ends here diff --git a/mime-mc.el b/mime-mc.el deleted file mode 100644 index 7e5cb26..0000000 --- a/mime-mc.el +++ /dev/null @@ -1,164 +0,0 @@ -;;; mime-mc.el --- Mailcrypt interface for SEMI - -;; Copyright (C) 1996,1997,1998 MORIOKA Tomohiko - -;; Author: MORIOKA Tomohiko -;; Keywords: PGP, security, MIME, multimedia, mail, news - -;; This file is part of SEMI (Secure Emacs MIME Interface). - -;; This program 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. - -;; This program 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. - -;;; Code: - -(require 'mailcrypt) -(eval-and-compile (load "mc-pgp")) - -(defun mime-mc-pgp-generic-parser (result) - (let ((ret (mc-pgp-generic-parser result))) - (if (consp ret) - (vector (car ret)(cdr ret)) - ))) - -(defun mime-mc-process-region - (beg end passwd program args parser &optional buffer boundary) - (let ((obuf (current-buffer)) - (process-connection-type nil) - mybuf result rgn proc) - (unwind-protect - (progn - (setq mybuf (or buffer (generate-new-buffer " *mailcrypt temp"))) - (set-buffer mybuf) - (erase-buffer) - (set-buffer obuf) - (buffer-disable-undo mybuf) - (setq proc - (apply 'start-process "*PGP*" mybuf program args)) - (if passwd - (progn - (process-send-string proc (concat passwd "\n")) - (or mc-passwd-timeout (mc-deactivate-passwd t)))) - (process-send-region proc beg end) - (process-send-eof proc) - (while (eq 'run (process-status proc)) - (accept-process-output proc 5)) - (setq result (process-exit-status proc)) - ;; Hack to force a status_notify() in Emacs 19.29 - (delete-process proc) - (set-buffer mybuf) - (goto-char (point-max)) - (if (re-search-backward "\nProcess \\*PGP.*\n\\'" nil t) - (delete-region (match-beginning 0) (match-end 0))) - (goto-char (point-min)) - ;; CRNL -> NL - (while (search-forward "\r\n" nil t) - (replace-match "\n")) - ;; Hurm. FIXME; must get better result codes. - (if (stringp result) - (error "%s exited abnormally: '%s'" program result) - (setq rgn (funcall parser result)) - ;; If the parser found something, migrate it - (if (consp rgn) - (progn - (set-buffer obuf) - (if boundary - (save-restriction - (narrow-to-region beg end) - (goto-char beg) - (insert (format "--%s\n" boundary)) - (goto-char (point-max)) - (insert (format "\n--%s -Content-Type: application/pgp-signature -Content-Transfer-Encoding: 7bit - -" boundary)) - (insert-buffer-substring mybuf (car rgn) (cdr rgn)) - (goto-char (point-max)) - (insert (format "\n--%s--\n" boundary)) - ) - (delete-region beg end) - (goto-char beg) - (insert-buffer-substring mybuf (car rgn) (cdr rgn)) - ) - (set-buffer mybuf) - (delete-region (car rgn) (cdr rgn))))) - ;; Return nil on failure and exit code on success - (if rgn result)) - ;; Cleanup even on nonlocal exit - (if (and proc (eq 'run (process-status proc))) - (interrupt-process proc)) - (set-buffer obuf) - (or buffer (null mybuf) (kill-buffer mybuf))))) - -(defun mime-mc-pgp-sign-region (start end &optional id unclear boundary) - ;; (if (not (boundp 'mc-pgp-user-id)) - ;; (load "mc-pgp") - ;; ) - (let ((process-environment process-environment) - (buffer (get-buffer-create mc-buffer-name)) - passwd args key - (parser (function mc-pgp-generic-parser)) - (pgp-path mc-pgp-path) - ) - (setq key (mc-pgp-lookup-key (or id mc-pgp-user-id))) - (setq passwd - (mc-activate-passwd - (cdr key) - (format "PGP passphrase for %s (%s): " (car key) (cdr key)))) - (setenv "PGPPASSFD" "0") - (setq args - (cons - (if boundary - "-fbast" - "-fast") - (list "+verbose=1" "+language=en" - (format "+clearsig=%s" (if unclear "off" "on")) - "+batchmode" "-u" (cdr key)))) - (if mc-pgp-comment - (setq args (cons (format "+comment=%s" mc-pgp-comment) args)) - ) - (message "Signing as %s ..." (car key)) - (if (mime-mc-process-region - start end passwd pgp-path args parser buffer boundary) - (progn - (if boundary - (progn - (goto-char (point-min)) - (insert - (format "\ ---[[multipart/signed; protocol=\"application/pgp-signature\"; - boundary=\"%s\"; micalg=pgp-md5][7bit]]\n" boundary)) - )) - (message "Signing as %s ... Done." (car key)) - t) - nil))) - -(defun mime-mc-pgp-encrypt-region (recipients start end &optional id sign) - (let ((mc-pgp-always-sign (if (eq sign 'maybe) - mc-pgp-always-sign - 'never))) - (mc-pgp-encrypt-region - (mc-split "\\([ \t\n]*,[ \t\n]*\\)+" recipients) - start end id nil) - )) - - -;;; @ end -;;; - -(provide 'mime-mc) - -;;; mime-mc.el ends here diff --git a/mime-partial.el b/mime-partial.el deleted file mode 100644 index f5378eb..0000000 --- a/mime-partial.el +++ /dev/null @@ -1,99 +0,0 @@ -;;; mime-partial.el --- Grabbing all MIME "message/partial"s. - -;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. - -;; Author: OKABE Yasuo @ Kyoto University -;; MORIOKA Tomohiko -;; Keywords: message/partial, MIME, multimedia, mail, news - -;; This file is part of SEMI (Suite of Emacs MIME Interfaces). - -;; This program 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. - -;; This program 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. - -;;; Code: - -(require 'mime-view) -(require 'mime-play) - -(defun mime-combine-message/partial-pieces-automatically (entity situation) - "Internal method for mime-view to combine message/partial messages -automatically. This function refers variable -`mime-request-partial-message-method-alist' to select function to display -partial messages using mime-view." - (interactive) - (let* ((id (cdr (assoc "id" situation))) - (target (cdr (assq 'major-mode situation))) - (subject-buf (eval (cdr (assq 'summary-buffer-exp situation)))) - subject-id - (root-dir (expand-file-name - (concat "m-prts-" (user-login-name)) mime-temp-directory)) - (request-partial-message-method - (cdr (assq 'request-partial-message-method situation))) - full-file) - (setq root-dir (concat root-dir "/" (replace-as-filename id))) - (setq full-file (concat root-dir "/FULL")) - - (if (null target) - (error "%s is not supported. Sorry." target) - ) - - ;; if you can't parse the subject line, try simple decoding method - (if (or (file-exists-p full-file) - (not (y-or-n-p "Merge partials?")) - ) - (mime-store-message/partial-piece entity situation) - (setq subject-id (mime-read-field 'Subject entity)) - (if (string-match "[0-9\n]+" subject-id) - (setq subject-id (substring subject-id 0 (match-beginning 0))) - ) - (save-excursion - (set-buffer subject-buf) - (while (search-backward subject-id nil t)) - (catch 'tag - (while t - (let* ((message - ;; request message at the cursor in Subject buffer. - (save-window-excursion - (funcall request-partial-message-method) - )) - (situation (mime-entity-situation message)) - (the-id (cdr (assoc "id" situation)))) - (when (string= the-id id) - (save-excursion - (set-buffer (mime-entity-buffer message)) - (mime-store-message/partial-piece message situation) - ) - (if (file-exists-p full-file) - (throw 'tag nil) - )) - (if (not (progn - (end-of-line) - (search-forward subject-id nil t) - )) - (error "not found") - ) - )) - ))))) - - -;;; @ end -;;; - -(provide 'mime-partial) - -(run-hooks 'mime-partial-load-hook) - -;;; mime-partial.el ends here diff --git a/mime-pgp.el b/mime-pgp.el deleted file mode 100644 index fe2e1f2..0000000 --- a/mime-pgp.el +++ /dev/null @@ -1,265 +0,0 @@ -;;; mime-pgp.el --- mime-view internal methods for PGP. - -;; Copyright (C) 1995,1996,1997,1998 MORIOKA Tomohiko - -;; Author: MORIOKA Tomohiko -;; Created: 1995/12/7 -;; Renamed: 1997/2/27 from tm-pgp.el -;; Keywords: PGP, security, MIME, multimedia, mail, news - -;; This file is part of SEMI (Secure Emacs MIME Interface). - -;; This program 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. - -;; This program 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 module is based on - -;; [security-multipart] RFC 1847: "Security Multiparts for MIME: -;; Multipart/Signed and Multipart/Encrypted" by -;; Jim Galvin , Sandy Murphy , -;; Steve Crocker and -;; Ned Freed (1995/10) - -;; [PGP/MIME] RFC 2015: "MIME Security with Pretty Good Privacy -;; (PGP)" by Michael Elkins (1996/6) - -;; [PGP-kazu] draft-kazu-pgp-mime-00.txt: "PGP MIME Integration" -;; by Kazuhiko Yamamoto (1995/10; -;; expired) - -;;; Code: - -(require 'mime-play) - - -;;; @ Internal method for multipart/signed -;;; -;;; It is based on RFC 1847 (security-multipart). - -(defun mime-verify-multipart/signed (entity situation) - "Internal method to verify multipart/signed." - (mime-raw-play-entity - (nth 1 (mime-entity-children entity)) ; entity-info of signature - (cdr (assq 'mode situation)) ; play-mode - )) - - -;;; @ internal method for application/pgp -;;; -;;; It is based on draft-kazu-pgp-mime-00.txt (PGP-kazu). - -(defun mime-view-application/pgp (entity situation) - (let* ((start (mime-entity-point-min entity)) - (end (mime-entity-point-max entity)) - (entity-number (mime-raw-point-to-entity-number start)) - (p-win (or (get-buffer-window mime-preview-buffer) - (get-largest-window))) - (new-name (format "%s-%s" (buffer-name) entity-number)) - (the-buf (current-buffer)) - (mother mime-preview-buffer) - representation-type) - (set-buffer (get-buffer-create new-name)) - (erase-buffer) - (insert-buffer-substring the-buf start end) - (cond ((progn - (goto-char (point-min)) - (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t)) - (funcall (pgp-function 'verify)) - (goto-char (point-min)) - (delete-region - (point-min) - (and - (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+\n\n") - (match-end 0))) - (delete-region - (and (re-search-forward "^-+BEGIN PGP SIGNATURE-+") - (match-beginning 0)) - (point-max)) - (goto-char (point-min)) - (while (re-search-forward "^- -" nil t) - (replace-match "-") - ) - (setq representation-type (mime-entity-representation-type entity)) - ) - ((progn - (goto-char (point-min)) - (re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t)) - (as-binary-process (funcall (pgp-function 'decrypt))) - (goto-char (point-min)) - (delete-region (point-min) - (and - (search-forward "\n\n") - (match-end 0))) - (setq representation-type 'binary) - )) - (setq major-mode 'mime-show-message-mode) - (setq mime-raw-representation-type representation-type) - (save-window-excursion (mime-view-mode mother)) - (set-window-buffer p-win mime-preview-buffer) - )) - - -;;; @ Internal method for application/pgp-signature -;;; -;;; It is based on RFC 2015 (PGP/MIME). - -(defvar mime-pgp-command "pgp" - "*Name of the PGP command.") - -(defvar mime-pgp-default-language 'en - "*Symbol of language for pgp. -It should be ISO 639 2 letter language code such as en, ja, ...") - -(defvar mime-pgp-good-signature-regexp-alist - '((en . "Good signature from user.*$")) - "Alist of language vs regexp to detect ``Good signature''.") - -(defvar mime-pgp-key-expected-regexp-alist - '((en . "Key matching expected Key ID \\(\\S +\\) not found")) - "Alist of language vs regexp to detect ``Key expected''.") - -(defun mime-pgp-check-signature (output-buffer orig-file) - (save-excursion - (set-buffer output-buffer) - (erase-buffer)) - (let* ((lang (or mime-pgp-default-language 'en)) - (status (call-process-region (point-min)(point-max) - mime-pgp-command - nil output-buffer nil - orig-file (format "+language=%s" lang))) - (regexp (cdr (assq lang mime-pgp-good-signature-regexp-alist)))) - (if (= status 0) - (save-excursion - (set-buffer output-buffer) - (goto-char (point-min)) - (message - (cond ((not (stringp regexp)) - "Please specify right regexp for specified language") - ((re-search-forward regexp nil t) - (buffer-substring (match-beginning 0) (match-end 0))) - (t "Bad signature"))) - )))) - -(defun mime-verify-application/pgp-signature (entity situation) - "Internal method to check PGP/MIME signature." - (let* ((start (mime-entity-point-min entity)) - (end (mime-entity-point-max entity)) - (encoding (cdr (assq 'encoding situation))) - (entity-node-id (mime-raw-point-to-entity-node-id start)) - (mother (mime-entity-parent entity)) - (knum (car entity-node-id)) - (onum (if (> knum 0) - (1- knum) - (1+ knum))) - (orig-entity (nth onum (mime-entity-children mother))) - (basename (expand-file-name "tm" mime-temp-directory)) - (orig-file (make-temp-name basename)) - (sig-file (concat orig-file ".sig")) - ) - (mime-raw-write-region (mime-entity-point-min orig-entity) - (mime-entity-point-max orig-entity) - orig-file) - (save-excursion (mime-show-echo-buffer)) - (mime-write-decoded-region (save-excursion - (goto-char start) - (and (search-forward "\n\n") - (match-end 0)) - ) end sig-file encoding) - (or (mime-pgp-check-signature mime-echo-buffer-name orig-file) - (let (pgp-id) - (save-excursion - (set-buffer mime-echo-buffer-name) - (goto-char (point-min)) - (let ((regexp (cdr (assq (or mime-pgp-default-language 'en) - mime-pgp-key-expected-regexp-alist)))) - (cond ((not (stringp regexp)) - (message - "Please specify right regexp for specified language") - ) - ((re-search-forward regexp nil t) - (setq pgp-id - (concat "0x" (buffer-substring-no-properties - (match-beginning 1) - (match-end 1)))) - )))) - (if (and pgp-id - (y-or-n-p - (format "Key %s not found; attempt to fetch? " pgp-id)) - ) - (progn - (funcall (pgp-function 'fetch-key) (cons nil pgp-id)) - (mime-pgp-check-signature mime-echo-buffer-name orig-file) - )) - )) - (let ((other-window-scroll-buffer mime-echo-buffer-name)) - (scroll-other-window 8) - ) - (delete-file orig-file) - (delete-file sig-file) - )) - - -;;; @ Internal method for application/pgp-encrypted -;;; -;;; It is based on RFC 2015 (PGP/MIME). - -(defun mime-decrypt-application/pgp-encrypted (entity situation) - (let* ((entity-node-id (mime-entity-node-id entity)) - (mother (mime-entity-parent entity)) - (knum (car entity-node-id)) - (onum (if (> knum 0) - (1- knum) - (1+ knum))) - (orig-entity (nth onum (mime-entity-children mother)))) - (mime-view-application/pgp orig-entity situation) - )) - - -;;; @ Internal method for application/pgp-keys -;;; -;;; It is based on RFC 2015 (PGP/MIME). - -(defun mime-add-application/pgp-keys (entity situation) - (let* ((start (mime-entity-point-min entity)) - (end (mime-entity-point-max entity)) - (entity-number (mime-raw-point-to-entity-number start)) - (new-name (format "%s-%s" (buffer-name) entity-number)) - (encoding (cdr (assq 'encoding situation))) - str) - (setq str (buffer-substring start end)) - (switch-to-buffer new-name) - (setq buffer-read-only nil) - (erase-buffer) - (insert str) - (goto-char (point-min)) - (if (re-search-forward "^\n" nil t) - (delete-region (point-min) (match-end 0)) - ) - (mime-decode-region (point-min)(point-max) encoding) - (funcall (pgp-function 'snarf-keys)) - (kill-buffer (current-buffer)) - )) - - -;;; @ end -;;; - -(provide 'mime-pgp) - -(run-hooks 'mime-pgp-load-hook) - -;;; mime-pgp.el ends here diff --git a/mime-play.el b/mime-play.el deleted file mode 100644 index f9834bd..0000000 --- a/mime-play.el +++ /dev/null @@ -1,642 +0,0 @@ -;;; mime-play.el --- Playback processing module for mime-view.el - -;; Copyright (C) 1994,1995,1996,1997,1998 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; Created: 1995/9/26 (separated from tm-view.el) -;; Renamed: 1997/2/21 from tm-play.el -;; Keywords: MIME, multimedia, mail, news - -;; This file is part of SEMI (Secretariat of Emacs MIME Interfaces). - -;; This program 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. - -;; This program 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. - -;;; Code: - -(require 'mime-view) -(require 'alist) -(require 'filename) - -(eval-when-compile - (require 'mime-text) - (condition-case nil - (require 'bbdb) - (error (defvar bbdb-buffer-name nil))) - ) - -(defvar mime-acting-situation-examples nil) - -(defun mime-save-acting-situation-examples () - (let* ((file mime-acting-situation-examples-file) - (buffer (get-buffer-create " *mime-example*"))) - (unwind-protect - (save-excursion - (set-buffer buffer) - (setq buffer-file-name file) - (erase-buffer) - (insert ";;; " (file-name-nondirectory file) "\n") - (insert "\n;; This file is generated automatically by " - mime-view-version-string "\n\n") - (insert ";;; Code:\n\n") - (pp `(setq mime-acting-situation-examples - ',mime-acting-situation-examples) - (current-buffer)) - (insert "\n;;; " - (file-name-nondirectory file) - " ends here.\n") - (save-buffer)) - (kill-buffer buffer)))) - -(add-hook 'kill-emacs-hook 'mime-save-acting-situation-examples) - - -;;; @ content decoder -;;; - -(defvar mime-preview-after-decoded-position nil) - -(defun mime-preview-play-current-entity (&optional mode) - "Play current entity. -It decodes current entity to call internal or external method. The -method is selected from variable `mime-acting-condition'. -If MODE is specified, play as it. Default MODE is \"play\"." - (interactive (list "play")) - (let ((entity (get-text-property (point) 'mime-view-entity))) - (if entity - (let ((the-buf (current-buffer)) - (raw-buffer (mime-entity-buffer entity))) - (setq mime-preview-after-decoded-position (point)) - (set-buffer raw-buffer) - (mime-raw-play-entity entity mode) - (when (eq (current-buffer) raw-buffer) - (set-buffer the-buf) - (goto-char mime-preview-after-decoded-position) - ))))) - -(defun mime-sort-situation (situation) - (sort situation - #'(lambda (a b) - (let ((a-t (car a)) - (b-t (car b)) - (order '((type . 1) - (subtype . 2) - (mode . 3) - (method . 4) - (major-mode . 5) - (disposition-type . 6) - )) - a-order b-order) - (if (symbolp a-t) - (let ((ret (assq a-t order))) - (if ret - (setq a-order (cdr ret)) - (setq a-order 7) - )) - (setq a-order 8) - ) - (if (symbolp b-t) - (let ((ret (assq b-t order))) - (if ret - (setq b-order (cdr ret)) - (setq b-order 7) - )) - (setq b-order 8) - ) - (if (= a-order b-order) - (string< (format "%s" a-t)(format "%s" b-t)) - (< a-order b-order)) - ))) - ) - -(defsubst mime-delq-null-situation (situations field) - (let (dest) - (while situations - (let ((situation (car situations))) - (if (assq field situation) - (setq dest (cons situation dest)) - )) - (setq situations (cdr situations))) - dest)) - -(defun mime-raw-play-entity (entity &optional mode situation) - "Play entity specified by ENTITY. -It decodes the entity to call internal or external method. The method -is selected from variable `mime-acting-condition'. If MODE is -specified, play as it. Default MODE is \"play\"." - (let (method ret) - (or situation - (setq situation (mime-entity-situation entity))) - (if mode - (setq situation (cons (cons 'mode mode) situation)) - ) - (setq ret - (or (ctree-match-calist mime-acting-situation-examples situation) - (ctree-match-calist-partially mime-acting-situation-examples - situation) - situation)) - (setq ret - (or (mime-delq-null-situation - (ctree-find-calist mime-acting-condition ret - mime-view-find-every-acting-situation) - 'method) - (mime-delq-null-situation - (ctree-find-calist mime-acting-condition situation - mime-view-find-every-acting-situation) - 'method) - )) - (cond ((cdr ret) - (setq ret (select-menu-alist - "Methods" - (mapcar (function - (lambda (situation) - (cons - (format "%s" - (cdr (assq 'method situation))) - situation))) - ret))) - (setq ret (mime-sort-situation ret)) - (ctree-set-calist-strictly 'mime-acting-situation-examples ret) - ) - (t - (setq ret (car ret)) - )) - (setq method (cdr (assq 'method ret))) - (cond ((and (symbolp method) - (fboundp method)) - (funcall method entity ret) - ) - ((stringp method) - (mime-activate-mailcap-method entity ret) - ) - ;; ((and (listp method)(stringp (car method))) - ;; (mime-activate-external-method entity ret) - ;; ) - (t - (mime-show-echo-buffer "No method are specified for %s\n" - (mime-entity-type/subtype entity)) - )) - )) - - -;;; @ external decoder -;;; - -(defvar mime-mailcap-method-filename-alist nil) - -(defun mime-activate-mailcap-method (entity situation) - (save-excursion - (save-restriction - (let ((start (mime-entity-point-min entity)) - (end (mime-entity-point-max entity))) - (narrow-to-region start end) - (goto-char start) - (let ((method (cdr (assoc 'method situation))) - (name (mime-entity-safe-filename entity))) - (setq name - (if name - (expand-file-name name mime-temp-directory) - (make-temp-name - (expand-file-name "EMI" mime-temp-directory)) - )) - (mime-write-decoded-region (mime-entity-body-start entity) end - name (cdr (assq 'encoding situation))) - (message "External method is starting...") - (let ((process - (let ((command - (mailcap-format-command - method - (cons (cons 'filename name) situation)))) - (start-process command mime-echo-buffer-name - shell-file-name shell-command-switch command) - ))) - (set-alist 'mime-mailcap-method-filename-alist process name) - (set-process-sentinel process 'mime-mailcap-method-sentinel) - ) - ))))) - -(defun mime-mailcap-method-sentinel (process event) - (let ((file (cdr (assq process mime-mailcap-method-filename-alist)))) - (if (file-exists-p file) - (delete-file file) - )) - (remove-alist 'mime-mailcap-method-filename-alist process) - (message (format "%s %s" process event))) - -(defvar mime-echo-window-is-shared-with-bbdb t - "*If non-nil, mime-echo window is shared with BBDB window.") - -(defvar mime-echo-window-height - (function - (lambda () - (/ (window-height) 5) - )) - "*Size of mime-echo window. -It allows function or integer. If it is function, -`mime-show-echo-buffer' calls it to get height of mime-echo window. -Otherwise `mime-show-echo-buffer' uses it as height of mime-echo -window.") - -(defun mime-show-echo-buffer (&rest forms) - "Show mime-echo buffer to display MIME-playing information." - (get-buffer-create mime-echo-buffer-name) - (let ((the-win (selected-window)) - (win (get-buffer-window mime-echo-buffer-name)) - ) - (or win - (if (and mime-echo-window-is-shared-with-bbdb - (boundp 'bbdb-buffer-name) - (setq win (get-buffer-window bbdb-buffer-name)) - ) - (set-window-buffer win mime-echo-buffer-name) - (select-window (get-buffer-window mime-preview-buffer)) - (setq win (split-window-vertically - (- (window-height) - (if (functionp mime-echo-window-height) - (funcall mime-echo-window-height) - mime-echo-window-height) - ))) - (set-window-buffer win mime-echo-buffer-name) - )) - (select-window win) - (goto-char (point-max)) - (if forms - (insert (apply (function format) forms)) - ) - (select-window the-win) - )) - - -;;; @ file name -;;; - -(defvar mime-view-file-name-char-regexp "[A-Za-z0-9+_-]") - -(defvar mime-view-file-name-regexp-1 - (concat mime-view-file-name-char-regexp "+\\." - mime-view-file-name-char-regexp "+")) - -(defvar mime-view-file-name-regexp-2 - (concat (regexp-* mime-view-file-name-char-regexp) - "\\(\\." mime-view-file-name-char-regexp "+\\)*")) - -(defun mime-entity-safe-filename (entity) - (let ((filename - (or (mime-entity-filename entity) - (let ((subj - (or (mime-read-field 'Content-Description entity) - (mime-read-field 'Subject entity)))) - (if (and subj - (or (string-match mime-view-file-name-regexp-1 subj) - (string-match mime-view-file-name-regexp-2 subj))) - (substring subj (match-beginning 0)(match-end 0)) - ))))) - (if filename - (replace-as-filename filename) - ))) - - -;;; @ file extraction -;;; - -(defun mime-save-content (entity situation) - (let* ((name (mime-entity-safe-filename entity)) - (encoding (or (mime-entity-encoding entity) "7bit")) - (filename (if (and name (not (string-equal name ""))) - (expand-file-name name - (save-window-excursion - (call-interactively - (function - (lambda (dir) - (interactive "DDirectory: ") - dir))))) - (save-window-excursion - (call-interactively - (function - (lambda (file) - (interactive "FFilename: ") - (expand-file-name file))))))) - ) - (if (file-exists-p filename) - (or (yes-or-no-p (format "File %s exists. Save anyway? " filename)) - (error ""))) - (mime-write-decoded-region (mime-entity-body-start entity) - (mime-entity-body-end entity) - filename encoding) - )) - - -;;; @ file detection -;;; - -(defvar mime-file-content-type-alist - '(("JPEG" image jpeg) - ("GIF" image gif) - ) - "*Alist of \"file\" output patterns vs. corresponding media-types. -Each element looks like (REGEXP TYPE SUBTYPE). -REGEXP is pattern for \"file\" command output. -TYPE is symbol to indicate primary type of media-type. -SUBTYPE is symbol to indicate subtype of media-type.") - -(defun mime-detect-content (entity situation) - (let ((beg (mime-entity-point-min entity)) - (end (mime-entity-point-max entity))) - (goto-char beg) - (let* ((name (save-restriction - (narrow-to-region beg end) - (mime-entity-safe-filename entity) - )) - (encoding (or (cdr (assq 'encoding situation)) "7bit")) - (filename (if (and name (not (string-equal name ""))) - (expand-file-name name mime-temp-directory) - (make-temp-name - (expand-file-name "EMI" mime-temp-directory))))) - (mime-write-decoded-region (mime-entity-body-start entity) end - filename encoding) - (let (type subtype) - (with-temp-buffer - (call-process "file" nil t nil filename) - (goto-char (point-min)) - (if (search-forward (concat filename ": ") nil t) - (let ((rest mime-file-content-type-alist)) - (while (not (let ((cell (car rest))) - (if (looking-at (car cell)) - (setq type (nth 1 cell) - subtype (nth 2 cell)) - ))) - (setq rest (cdr rest)))))) - (if type - (mime-raw-play-entity - entity "play" - (put-alist 'type type - (put-alist 'subtype subtype - (mime-entity-situation entity)))) - )) - ))) - - -;;; @ mail/news message -;;; - -(defun mime-preview-quitting-method-for-mime-show-message-mode () - "Quitting method for mime-view. -It is registered to variable `mime-preview-quitting-method-alist'." - (let ((mother mime-mother-buffer) - (win-conf mime-preview-original-window-configuration) - ) - (kill-buffer mime-raw-buffer) - (mime-preview-kill-buffer) - (set-window-configuration win-conf) - (pop-to-buffer mother) - )) - -(defun mime-view-message/rfc822 (entity cal) - (let* ((beg (mime-entity-point-min entity)) - (end (mime-entity-point-max entity)) - (cnum (mime-raw-point-to-entity-number beg)) - (new-name (format "%s-%s" (buffer-name) cnum)) - (mother mime-preview-buffer) - (representation-type (mime-entity-representation-type entity)) - str) - (setq str (buffer-substring beg end)) - (switch-to-buffer new-name) - (erase-buffer) - (insert str) - (goto-char (point-min)) - (if (re-search-forward "^\n" nil t) - (delete-region (point-min) (match-end 0)) - ) - (setq major-mode 'mime-show-message-mode) - (setq mime-raw-representation-type representation-type) - (mime-view-mode mother) - )) - - -;;; @ message/partial -;;; - -(defun mime-raw-write-region (start end filename) - "Write current region into specified file. -When called from a program, takes three arguments: -START, END and FILENAME. START and END are buffer positions. -It refer `mime-raw-representation-type' or `major-mode -mime-raw-representation-type-alist'. If it is `binary', region is -saved as binary. Otherwise the region is saved by `write-region'." - (let ((presentation-type - (or mime-raw-representation-type - (cdr (or (assq major-mode mime-raw-representation-type-alist) - (assq t mime-raw-representation-type-alist)))))) - (if (eq presentation-type 'binary) - (write-region-as-binary start end filename) - (write-region start end filename) - ))) - -(defun mime-store-message/partial-piece (entity cal) - (goto-char (mime-entity-point-min entity)) - (let* ((root-dir - (expand-file-name - (concat "m-prts-" (user-login-name)) mime-temp-directory)) - (id (cdr (assoc "id" cal))) - (number (cdr (assoc "number" cal))) - (total (cdr (assoc "total" cal))) - file - (mother mime-preview-buffer) - ) - (or (file-exists-p root-dir) - (make-directory root-dir) - ) - (setq id (replace-as-filename id)) - (setq root-dir (concat root-dir "/" id)) - (or (file-exists-p root-dir) - (make-directory root-dir) - ) - (setq file (concat root-dir "/FULL")) - (if (file-exists-p file) - (let ((full-buf (get-buffer-create "FULL")) - (pwin (or (get-buffer-window mother) - (get-largest-window))) - ) - (save-window-excursion - (set-buffer full-buf) - (erase-buffer) - (as-binary-input-file (insert-file-contents file)) - (setq major-mode 'mime-show-message-mode) - (mime-view-mode mother) - ) - (set-window-buffer pwin - (save-excursion - (set-buffer full-buf) - mime-preview-buffer)) - (select-window pwin) - ) - (setq file (concat root-dir "/" number)) - (mime-raw-write-region (mime-entity-body-start entity) - (mime-entity-body-end entity) file) - (let ((total-file (concat root-dir "/CT"))) - (setq total - (if total - (progn - (or (file-exists-p total-file) - (save-excursion - (set-buffer - (get-buffer-create mime-temp-buffer-name)) - (erase-buffer) - (insert total) - (write-region (point-min)(point-max) total-file) - (kill-buffer (current-buffer)) - )) - (string-to-number total) - ) - (and (file-exists-p total-file) - (save-excursion - (set-buffer (find-file-noselect total-file)) - (prog1 - (and (re-search-forward "[0-9]+" nil t) - (string-to-number - (buffer-substring (match-beginning 0) - (match-end 0))) - ) - (kill-buffer (current-buffer)) - ))) - ))) - (if (and total (> total 0)) - (catch 'tag - (save-excursion - (set-buffer (get-buffer-create mime-temp-buffer-name)) - (let ((full-buf (current-buffer))) - (erase-buffer) - (let ((i 1)) - (while (<= i total) - (setq file (concat root-dir "/" (int-to-string i))) - (or (file-exists-p file) - (throw 'tag nil) - ) - (as-binary-input-file (insert-file-contents file)) - (goto-char (point-max)) - (setq i (1+ i)) - )) - (as-binary-output-file - (write-region (point-min)(point-max) - (expand-file-name "FULL" root-dir))) - (let ((i 1)) - (while (<= i total) - (let ((file (format "%s/%d" root-dir i))) - (and (file-exists-p file) - (delete-file file) - )) - (setq i (1+ i)) - )) - (let ((file (expand-file-name "CT" root-dir))) - (and (file-exists-p file) - (delete-file file) - )) - (save-window-excursion - (setq major-mode 'mime-show-message-mode) - (mime-view-mode mother) - ) - (let ((pwin (or (get-buffer-window mother) - (get-largest-window) - )) - (pbuf (save-excursion - (set-buffer full-buf) - mime-preview-buffer))) - (set-window-buffer pwin pbuf) - (select-window pwin) - ))))) - ))) - - -;;; @ message/external-body -;;; - -(defvar mime-raw-dired-function - (if (and (>= emacs-major-version 19) window-system) - (function dired-other-frame) - (function mime-raw-dired-function-for-one-frame) - )) - -(defun mime-raw-dired-function-for-one-frame (dir) - (let ((win (or (get-buffer-window mime-preview-buffer) - (get-largest-window)))) - (select-window win) - (dired dir) - )) - -(defun mime-view-message/external-anon-ftp (entity cal) - (let* ((site (cdr (assoc "site" cal))) - (directory (cdr (assoc "directory" cal))) - (name (cdr (assoc "name" cal))) - (pathname (concat "/anonymous@" site ":" directory))) - (message (concat "Accessing " (expand-file-name name pathname) " ...")) - (funcall mime-raw-dired-function pathname) - (goto-char (point-min)) - (search-forward name) - )) - -(defvar mime-raw-browse-url-function (function mime-browse-url)) - -(defun mime-view-message/external-url (entity cal) - (let ((url (cdr (assoc "url" cal)))) - (message (concat "Accessing " url " ...")) - (funcall mime-raw-browse-url-function url))) - - -;;; @ rot13-47 -;;; - -(defun mime-view-caesar (entity situation) - "Internal method for mime-view to display ROT13-47-48 message." - (let* ((new-name (format "%s-%s" (buffer-name) - (mime-entity-number entity))) - (mother mime-preview-buffer)) - (let ((pwin (or (get-buffer-window mother) - (get-largest-window))) - (buf (get-buffer-create new-name))) - (set-window-buffer pwin buf) - (set-buffer buf) - (select-window pwin) - ) - (setq buffer-read-only nil) - (erase-buffer) - (mime-text-insert-decoded-body entity) - (mule-caesar-region (point-min) (point-max)) - (set-buffer-modified-p nil) - (set-buffer mother) - (view-buffer new-name) - )) - - -;;; @ end -;;; - -(provide 'mime-play) - -(let* ((file mime-acting-situation-examples-file) - (buffer (get-buffer-create " *mime-example*"))) - (if (file-readable-p file) - (unwind-protect - (save-excursion - (set-buffer buffer) - (erase-buffer) - (insert-file-contents file) - (eval-buffer) - ;; format check - (or (eq (car mime-acting-situation-examples) 'type) - (setq mime-acting-situation-examples nil)) - ) - (kill-buffer buffer)))) - -;;; mime-play.el ends here diff --git a/mime-setup.el b/mime-setup.el deleted file mode 100644 index dae2871..0000000 --- a/mime-setup.el +++ /dev/null @@ -1,47 +0,0 @@ -;;; mime-setup.el --- setup file for MIME viewer and composer. - -;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; Keywords: MIME, multimedia, multilingual, mail, news - -;; This file is part of SEMI (Setting for Emacs MIME Interfaces). - -;; This program 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. - -;; This program 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. - -;;; Code: - -(load "mail-mime-setup") - -(condition-case nil - (load "gnus-mime-setup") - (error (message "gnus-mime-setup is not found.")) - ) - -(condition-case nil - (load "emh-setup") - (error (message "emh-setup is not found.")) - ) - - -;;; @ end -;;; - -(provide 'mime-setup) - -(run-hooks 'mime-setup-load-hook) - -;;; mime-setup.el ends here diff --git a/mime-text.el b/mime-text.el deleted file mode 100644 index d0860d2..0000000 --- a/mime-text.el +++ /dev/null @@ -1,94 +0,0 @@ -;;; mime-text.el --- mime-view content filter for text - -;; Copyright (C) 1994,1995,1996,1997,1998 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; Keywords: text, MIME, multimedia, mail, news - -;; This file is part of SEMI (Suite of Emacs MIME Interfaces). - -;; This program 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. - -;; This program 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. - -;;; Code: - -(require 'mime-view) - - -;;; @ code conversion -;;; - -(defun mime-text-insert-decoded-body (entity) - "Insert text body of ENTITY in SITUATION. -It decodes MIME-encoding then code-converts as MIME-charset. -MIME-encoding is value of field 'encoding of SITUATION. It must be -'nil or string. MIME-charset is value of field \"charset\" of -SITUATION. It must be symbol." - (let ((str (mime-entity-content entity))) - (insert - (if (and (mime-entity-cooked-p entity) - (member (mime-entity-encoding entity) - '(nil "7bit" "8bit" "binary"))) - str - (decode-mime-charset-string str - (or (mime-content-type-parameter - (mime-entity-content-type entity) - "charset") - default-mime-charset)) - ))) - (run-hooks 'mime-text-decode-hook) - ) - - -;;; @ content filters for mime-text -;;; - -(defun mime-display-text/plain (entity situation) - (save-restriction - (narrow-to-region (point-max)(point-max)) - (mime-text-insert-decoded-body entity) - (goto-char (point-max)) - (if (not (eq (char-after (1- (point))) ?\n)) - (insert "\n") - ) - (mime-add-url-buttons) - (run-hooks 'mime-display-text/plain-hook) - )) - -(defun mime-display-text/richtext (entity situation) - (save-restriction - (narrow-to-region (point-max)(point-max)) - (mime-text-insert-decoded-body entity) - (let ((beg (point-min))) - (remove-text-properties beg (point-max) '(face nil)) - (richtext-decode beg (point-max)) - ))) - -(defun mime-display-text/enriched (entity situation) - (save-restriction - (narrow-to-region (point-max)(point-max)) - (mime-text-insert-decoded-body entity) - (let ((beg (point-min))) - (remove-text-properties beg (point-max) '(face nil)) - (enriched-decode beg (point-max)) - ))) - - -;;; @ end -;;; - -(provide 'mime-text) - -;;; mime-text.el ends here diff --git a/mime-view-ja.sgml b/mime-view-ja.sgml deleted file mode 100644 index e0591a2..0000000 --- a/mime-view-ja.sgml +++ /dev/null @@ -1,278 +0,0 @@ - - -SEMI 1.6 MIME-View $B@bL@=q(B -<author>$B<i2,(B $BCNI'(B <mail>morioka@jaist.ac.jp</mail> -<date>1998/06/15 - -<toc> -</head> - -<body> - -<abstract> -<p> -This file documents MIME-View, a MIME Viewer for GNU Emacs. -<p> -GNU Emacs $BMQ$N(B MIME Viewer $B$G$"$k(B MIME-View $B$K$D$$$F@bL@$7$^$9!#(B -</abstract> - - -<h1> MIME-View $B$C$F2?!)(B -<node> Introduction -<p> -MIME-View $B$O(B GNU Emacs $B$GF0:n$9$kHFMQE*$J(B MIME viewer $B$G$9!#(B -<p> -MIME-View $B$O(B MIME message $B$r1\Mw$9$k$?$a$NMxMQ<T3&LL(B (user interface) -$B$N3K$G$"$j!"$3$N>e$G(B presentation-method $B$H8F$P$l$kI=<($r:n$k%W%m%0%i%`(B -$B$rF0$+$7$?$j!"(Bacting-method $B$H8F$P$l$k(B entity $B$N=hM}%W%m%0%i%`$rF0$+$9(B -$B$3$H$,2DG=$G!"$5$^$6$^$J<oN`$N(B entity $B$r07$&;v$,$G$-$k$h$&$K$J$C$F$$$^$9!#(B - - -<h1> MIME-View $B35@b(B -<node> Overview -<p> -Internet $B$NEE;R=q4J!&%M%C%H%K%e!<%9$J$I$N=qLL(B (message) $B$NI=8=7A<0$O(B -STD 11 $B$K4p$E$$$F$$$^$9!#(BSTD 11 $B$N=qLLK\BN(B (message body) $B$O9T$rM#0l$N(B -$B9=B$$H$9$k4J0WJ8LL(B (plain text) $B$G$"$j!"J8;zId9f$b(B us-ascii $B$HDj$a$i$l(B -$B$F$$$^$9!#<B:]$K$O!"J8;zId9f$r(B us-ascii $B$NBe$o$j$K$=$N8@8l7w$GMQ$$$i$l(B -$B$kJ8;zId9f$H$7$?!XCO0h2=$5$l$?(B STD 11$B!Y=qLL$bMQ$$$i$l$F$-$^$7$?$,!"$3(B -$B$N>l9g$b=qLL$NJ8;zId9f$O#1$D$G$9!#$3$N$?$a!"MxMQ<T3&LL(B (Message User -Agent) $B$O!"$7$P$7$P!"(Bbyte $BNs(B = us-ascii $BJ8;zNs!"$J$$$7$O!"(Bbyte $BNs(B = $B$=(B -$B$N8@8l7w$GMQ$$$kJ8;zId9f$NJ8;zNs$N$h$&$K8+Jo$7$F$-$^$7$?!#(B -<p> -$B$7$+$7$J$,$i!"(BMIME $B$G$O=qLL$O(B entity $B$rC10L$H$9$kLZ9=B$$K$J$j!"$^$?!"(B -$B#1$D$N=qLL$GJ#?t$NJ8;zId9f$rMQ$$$k$3$H$,$G$-$^$9!#$^$?!"(Bentity $B$NFbMF(B -$B$OJ8LL$d3($N$h$&$JC1=c$KI=<(2DG=$J$b$N$@$1$G$J$/!"2;@<$dF02h$J$I$N0lDj(B -$B;~4V:F@8$5$l$k$h$&$J$b$N$dFCDj$N%"%W%j%1!<%7%g%s$N%G!<%?$d%W%m%0%i%`$N(B -$B%=!<%9!"$"$k$$$O!"(Bftp $B$d(B mail service $B$NMxMQK!$d(B URL $B$H$$$C$?7A$GI=$5(B -$B$l$?30It;2>H$J$I$N$5$^$6$^$J$b$N$,9M$($i$^$9!#$3$N$?$a!"I=<($@$1$r9M$((B -$B$F$$$?(B STD 11 $B$K$*$1$kMxMQ<T3&LL$NC1=c$J1dD9$G$O(B MIME $B$NA4$F$N5!G=$r07(B -$B$&$3$H$O$G$-$^$;$s!#$D$^$j!"(BMIME $B$N7A<0$K9g$o$;$FI|9f$9$k$@$1$G$OIT==(B -$BJ,$G$"$j!"MxMQ<T$H$NBPOCE*$J:F@8=hM}$r9MN8$9$kI,MW$,$"$j$^$9!#(BMIME $B=q(B -$BLL$N7A<0$O<+F0=hM}$,$7$d$9$/@_7W$5$l$F$$$^$9$,!"(BMIME $B=qLL$K4^$^$l$kFb(B -$BMF$NCf$K$O%;%-%e%j%F%#!<>e$NLdBj$+$i<+F0=hM}$r$9$k$Y$-$G$J$$$b$N$,$"$j!"(B -$B$3$&$$$C$?$b$N$N:F@8$K4X$7$F$OMxMQ<T$NH=CG$r6D$0$h$&$K@_7W$5$l$k$Y$-$G(B -$B$7$g$&!#7k6I!"(BMIME $B=qLL$r07$&$?$a$K$O(B STD 11 $B$*$h$S(B MIME $B$N9=J8$G5-=R(B -$B$5$l$?%a%C%;!<%8$N>pJs8r49MQI=8=$H$=$N2r<a7k2L$G$"$kI=<(2hLL$d:F@8Ey$N(B -$B=hM}$r6hJL$7$F9M$($kI,MW$,$"$j$^$9!#$^$?!"MxMQ<T$H$NBPOCE*$J:F@8=hM}$,(B -$BI,MW$G$9!#(B -<p> -$B$3$N$?$a!"(BMIME-View $B$O#1$D$N=qLL$KBP$7$F!">pJs8r49MQI=8=$r3JG<$9$k(B -mime-raw-buffer $B$HI=<(MQI=8=$r3JG<$9$k(B mime-preview-buffer $B$N#2$D$N(B -buffer $B$rMQ$$$^$9!#(B -<p> -MIME-View $B$O(B mime-preview-buffer $B$KBP$7$F(B mime-view-mode $B$H$$$&(B MIME -message $B$r1\Mw$9$k$?$a$N(B mode $B$rDs6!$7$^$9!#MxMQ<T$O$3$3$G3F(B entity $B$K(B -$BBP$7$FA`:n$r9T$&$3$H$,$G$-$^$9!#(B - - -<h1> mime-preview-buffer $B$N2hLL9=@.(B -<node> MIME-Preview -<p> -mime-view-mode $B$G$O3F(B entity $B$KBP$7$F(B -<p> -<verb> - [entity-button] - (header) - - (body) - (separator) -</verb> -<p> -<noindent> -$B$H$$$&>pJs$rI=<($7$^$9!#$3$l$i$O>r7o$K=>$C$F(B design $B$rJQ99$7$?$j!"I=<((B -$B$rM^@)$9$k$3$H$b$G$-$^$9!#(B -<p> -$B0J2<$K!"I=<(Nc$r<($7$^$9!#(B - - -<verb> -From: morioka@jaist.ac.jp ($B<i2,(B $BCNI'(B / MORIOKA Tomohiko) -Subject: Re: $B<ALd!)(B -Newsgroups: zxr.message.mime -Date: 22 Oct 93 11:02:44 -Mime-Version: 1.0 -Organization: Japan Advanced Institute of Science and Technology, - Ishikawa, Japan - -[1 (text/plain)] - MIME-Edit mode $B$K$*$1$k!"(BMIME message $B$N:n$jJ}!#(B - - C-c C-x ? $B$r2!$9$H(B help $B$,=P$F$/$k!#(B - -C-c C-x C-t insert a text message. -C-c C-x TAB insert a (binary) file. -C-c C-x C-e insert a reference to external body. -C-c C-x C-v insert a voice message. -C-c C-x C-y insert a mail or news message. -C-c C-x RET insert a mail message. -C-c C-x C-s insert a signature file at end. -C-c C-x t insert a new MIME tag. -C-c C-x a enclose as multipart/alternative. -C-c C-x p enclose as multipart/parallel. -C-c C-x m enclose as multipart/mixed. -C-c C-x d enclose as multipart/digest. -C-c C-x s enclose as PGP signed. -C-c C-x e enclose as PGP encrypted. -C-c C-x C-k insert PGP public key. -C-c C-x C-p preview editing MIME message. -... - -$B$C$FLu$G!"(BC-c C-x C-i $B$r2!$7$F!"A^F~$7$?$$(B binary file $B$r;XDj$7$^$9!#(B - - binary file $B$N(B MIME encoding $B$K$O!"IaDL!"(BBase64 $B$r;XDj$7$^$9!#(B - -[2 (image/gif)] - -[3 (text/plain)] - - $B$3$s$JIw$K!"3(F~$j(B message $B$N$G$->e$,$j!#(B - -$B".".".".".".".".".".".(B $B%m%7%"%s!&%F%#!<$r0lGU!#(B $B".".".".".".".".".".".(B -$B".".".".".(B $B!y(B $B%8%c%`$G$O$J$/%^!<%^%l!<%I$G$b$J$/K*L*$G(B $B!y(B $B".".".".".(B -$B".".".".".(B $B'.'0'2$$'0','!(B $B'4'0'.'0'7'*','0(B $B".".".".".(B -$B".".".".".".".(B Internet E-mail: <morioka@jaist.ac.jp> $B".".".".".".".(B -</verb> - - -<h2> entity-button -<node> entity-button -<p> -<concept>entity-button</concept> $B$O(B entity $B$N@hF,$K$"$C$F!"$=$N(B entity -$B$K4X$9$kBg$^$+$J>pJs$rI=<($9$kItJ,$G$9!#(B -<p> -$BI8=`$G$O(B - -<verb> - [1.3 test (text/plain)] -</verb> - -<noindent> -$B$N$h$&$J46$8$KI=<($5$l$^$9!#(B -<p> -$B:G=i$N?t;z$O(B message $BCf$N$3$N(B entity $B$N0LCV$r@aHV9f$N$h$&$KI=$7$?$b$N(B -$B$G!"(B<concept>entity-number</concept> $B$H8F$S$^$9!#(B -<p> -$B#2HVL\$NJ8;zNs$OI=Bj$rI=$7$^$9!#$3$N>pJs$O!"(B - -<ol> -<li>Content-Description field $B$b$7$/$O(B Subject field $B$K=q$+$l$?I=Bj(B -<li>Content-Disposition field $B$N(B filename parameter $B$K=q$+$l$?(B file $BL>(B -<li>Content-Type field $B$N(B name parameter $B$K=q$+$l$?(B file $BL>(B -<li> uuencode $B$N>l9g$N(B file $BL>(B -</ol> - -<noindent> -$B$+$i:n$j$^$9!#$I$l$bB8:_$7$J$$>l9g$O6uGr$,I=<($5$l$^$9!#(B -<p> -$B#3HVL\$N3g8L$NCf$N>pJs$O$=$N(B entity $B$N(B media-type/subtype $B$rI=$7$^$9!#(B -$BHs(B MIME entity $B$N>l9g!"(B<code>nil</code> $B$,I=<($5$l$^$9!#(B -<p> -$B$3$N(B entity-button $B$O(B entity $B$NFbMF$r>]D'$9$k(B icon $B$N$h$&$JLr3d$r2L$?(B -$B$7$^$9!#Nc$($P!"(B - -<verb> - [2 (image/gif)] -</verb> - -<noindent> -$B$N>e$G(B <kbd>v</kbd> $B$r2!$;$P$3$3$KF~$C$F$$$k3($,I=<($5$l$^$9!#(B -<p> -$B$^$?!"(Bmouse $BA`:n$,2DG=$J>l9g!"(Bentity-button $B$rBh#2%\%?%s!J(B3 button -mouse $B$N>l9g!"Cf1{$N%\%?%s!K$G2!$;$P!"F1MM$K$=$N3($,I=<($5$l$^$9!#(B - - -<h2> entity-header -<node> entity-header -<p> -<concept>entity-header</concept> $B$O$"$k(B entity $B$N(B header $B$rI=<($9$kIt(B -$BJ,$G$9!J!V$=$N$^$^$d$s$1!W$C$FE\$i$J$$$G!#$=$&$$$&$b$s$J$s$G$9!K!#(B - - -<h2> entity-body -<node> entity-body -<p> -<concept>entity-body</concept> $B$O(B part $B$NFbMF$rI=<($9$kItJ,$G$9!#(B -<p> -$B$3$l$b$R$M$j$,B-$j$J$$$G$9$,!"$^$"!"$=$&$$$&$b$s$G$9!#(B -<p> -$B$H$O$$$(!"<B:]$K$O>/$7$R$M$C$F$^$9!#(B -<p> -text entity $B$N>l9g$O(B charset $B$K1~$8$F(B code $BJQ49$7$?$j$7$^$9$7!"(BXEmacs -$B$G$O(B image entity $B$rJQ49$7$J$$$H$$$1$J$$$7!#(B -<p> -$B>\$7$/$O$^$?8e$G!#(B - - -<h1> mime-preview-buffer $B$G$NA`:n(B -<node> mime-view-mode -<p> -mime-preview-buffer $B$K$O0J2<$N5!G=$,$"$j$^$9!#(B -<p> -<kl> -<kt>u -<kd> -$B>e$N(B part $B$KLa$k!J(Bmessage $B$N0lHV>e$N(B part $B$G$3$l$r9T$J$&$H(B Summary -mode $B$KLa$k(B (*1)$B!K(B -</kd> -<kt>p<kd>$BA0$N(B part $B$K0\F0$9$k(B -</kd> -<kt>M-TAB<kd>$BA0$N(B part $B$K0\F0$9$k(B -</kd> -<kt>n<kd>$B<!$N(B part $B$K0\F0$9$k(B -</kd> -<kt>TAB<kd>$B<!$N(B part $B$K0\F0$9$k(B -</kd> -<kt>SPC<kd>scroll up $B$9$k(B -</kd> -<kt>M-SPC<kd>scroll down $B$9$k(B -</kd> -<kt>DEL<kd>scroll down $B$9$k(B -</kd> -<kt>RET<kd>$B<!$N9T$K0\F0$9$k(B -</kd> -<kt>M-RET<kd>$BA0$N9T$K0\F0$9$k(B -</kd> -<kt>v<kd>part $B$r:F@8$9$k(B (*2) -</kd> -<kt>e<kd>part $B$+$i(B file $B$r<h$j=P$9(B (*2) -</kd> -<kt>C-c C-p<kd>part $B$r0u:~$9$k(B (*2) -</kd> -<kt>mouse-button-2 -<kd> -preview-buffer $BCf$N(B mouse button $B$r5/F0$9$k(B -<p> -content-button $B$r2!$;$P!"$=$N(B part $B$,:F@8$5$l$k(B(*2) -<p> -URL-button $B$r2!$;$P!"$=$N(B WWW browser $B$,5/F0$5$l$k(B -</kd> -</kl> -<p> -<memo title="$BCm0U(B"> -<p> -(*1) MUA $B$G(B mime-view $B$N@_Dj$r$7$F$$$J$$>l9g!"(BSummary mode $B$K$OLa$j$^(B -$B$;$s!#(B -<p> -(*2) $B<B:]$NF0:n$OBP1~$9$k(B method $B$K0M$j$^$9!#(B -</memo> - - -<h1> $B35G0:w0z(B -<node> Concept Index - -<cindex> - - -<h1> $B4X?t:w0z(B -<node> Function Index - -<findex> - - -<h1> $BJQ?t:w0z(B -<node> Variable Index - -<vindex> - -</body> diff --git a/mime-view-ja.texi b/mime-view-ja.texi deleted file mode 100644 index 3ee2adc..0000000 --- a/mime-view-ja.texi +++ /dev/null @@ -1,311 +0,0 @@ -\input texinfo.tex -@setfilename mime-view-ja.info -@settitle{SEMI 1.6 MIME-View $B@bL@=q(B} -@titlepage -@title SEMI 1.6 MIME-View $B@bL@=q(B -@author $B<i2,(B $BCNI'(B <morioka@@jaist.ac.jp> -@subtitle 1998/06/15 -@end titlepage -@node Top, Introduction, (dir), (dir) -@top SEMI 1.6 MIME-View $B@bL@=q(B - -@ifinfo - -This file documents MIME-View, a MIME Viewer for GNU Emacs.@refill - -GNU Emacs $BMQ$N(B MIME Viewer $B$G$"$k(B MIME-View $B$K$D$$$F@bL@$7$^$9!#(B -@end ifinfo - -@menu -* Introduction:: MIME-View $B$C$F2?!)(B -* Overview:: MIME-View $B35@b(B -* MIME-Preview:: mime-preview-buffer $B$N2hLL9=@.(B -* mime-view-mode:: mime-preview-buffer $B$G$NA`:n(B -* Concept Index:: $B35G0:w0z(B -* Function Index:: $B4X?t:w0z(B -* Variable Index:: $BJQ?t:w0z(B -@end menu - -@node Introduction, Overview, Top, Top -@chapter MIME-View $B$C$F2?!)(B - -MIME-View $B$O(B GNU Emacs $B$GF0:n$9$kHFMQE*$J(B MIME viewer $B$G$9!#(B@refill - -MIME-View $B$O(B MIME message $B$r1\Mw$9$k$?$a$NMxMQ<T3&LL(B (user interface) -$B$N3K$G$"$j!"$3$N>e$G(B presentation-method $B$H8F$P$l$kI=<($r:n$k%W%m%0%i%`(B -$B$rF0$+$7$?$j!"(Bacting-method $B$H8F$P$l$k(B entity $B$N=hM}%W%m%0%i%`$rF0$+$9(B -$B$3$H$,2DG=$G!"$5$^$6$^$J<oN`$N(B entity $B$r07$&;v$,$G$-$k$h$&$K$J$C$F$$$^$9!#(B - - -@node Overview, MIME-Preview, Introduction, Top -@chapter MIME-View $B35@b(B - -Internet $B$NEE;R=q4J!&%M%C%H%K%e!<%9$J$I$N=qLL(B (message) $B$NI=8=7A<0$O(B STD -11 $B$K4p$E$$$F$$$^$9!#(BSTD 11 $B$N=qLLK\BN(B (message body) $B$O9T$rM#0l$N9=B$$H(B -$B$9$k4J0WJ8LL(B (plain text) $B$G$"$j!"J8;zId9f$b(B us-ascii $B$HDj$a$i$l$F$$$^$9!#(B -$B<B:]$K$O!"J8;zId9f$r(B us-ascii $B$NBe$o$j$K$=$N8@8l7w$GMQ$$$i$l$kJ8;zId9f$H(B -$B$7$?!XCO0h2=$5$l$?(B STD 11$B!Y=qLL$bMQ$$$i$l$F$-$^$7$?$,!"$3$N>l9g$b=qLL$N(B -$BJ8;zId9f$O#1$D$G$9!#$3$N$?$a!"MxMQ<T3&LL(B (Message User Agent) $B$O!"$7$P$7(B -$B$P!"(Bbyte $BNs(B = us-ascii $BJ8;zNs!"$J$$$7$O!"(Bbyte $BNs(B = $B$=$N8@8l7w$GMQ$$$kJ8(B -$B;zId9f$NJ8;zNs$N$h$&$K8+Jo$7$F$-$^$7$?!#(B@refill - -$B$7$+$7$J$,$i!"(BMIME $B$G$O=qLL$O(B entity $B$rC10L$H$9$kLZ9=B$$K$J$j!"$^$?!"#1(B -$B$D$N=qLL$GJ#?t$NJ8;zId9f$rMQ$$$k$3$H$,$G$-$^$9!#$^$?!"(Bentity $B$NFbMF$OJ8(B -$BLL$d3($N$h$&$JC1=c$KI=<(2DG=$J$b$N$@$1$G$J$/!"2;@<$dF02h$J$I$N0lDj;~4V:F(B -$B@8$5$l$k$h$&$J$b$N$dFCDj$N%"%W%j%1!<%7%g%s$N%G!<%?$d%W%m%0%i%`$N%=!<%9!"(B -$B$"$k$$$O!"(Bftp $B$d(B mail service $B$NMxMQK!$d(B URL $B$H$$$C$?7A$GI=$5$l$?30It;2(B -$B>H$J$I$N$5$^$6$^$J$b$N$,9M$($i$^$9!#$3$N$?$a!"I=<($@$1$r9M$($F$$$?(B STD -11 $B$K$*$1$kMxMQ<T3&LL$NC1=c$J1dD9$G$O(B MIME $B$NA4$F$N5!G=$r07$&$3$H$O$G$-(B -$B$^$;$s!#$D$^$j!"(BMIME $B$N7A<0$K9g$o$;$FI|9f$9$k$@$1$G$OIT==J,$G$"$j!"MxMQ(B -$B<T$H$NBPOCE*$J:F@8=hM}$r9MN8$9$kI,MW$,$"$j$^$9!#(BMIME $B=qLL$N7A<0$O<+F0=h(B -$BM}$,$7$d$9$/@_7W$5$l$F$$$^$9$,!"(BMIME $B=qLL$K4^$^$l$kFbMF$NCf$K$O%;%-%e%j(B -$B%F%#!<>e$NLdBj$+$i<+F0=hM}$r$9$k$Y$-$G$J$$$b$N$,$"$j!"$3$&$$$C$?$b$N$N:F(B -$B@8$K4X$7$F$OMxMQ<T$NH=CG$r6D$0$h$&$K@_7W$5$l$k$Y$-$G$7$g$&!#7k6I!"(BMIME -$B=qLL$r07$&$?$a$K$O(B STD 11 $B$*$h$S(B MIME $B$N9=J8$G5-=R$5$l$?%a%C%;!<%8$N>pJs(B -$B8r49MQI=8=$H$=$N2r<a7k2L$G$"$kI=<(2hLL$d:F@8Ey$N=hM}$r6hJL$7$F9M$($kI,MW(B -$B$,$"$j$^$9!#$^$?!"MxMQ<T$H$NBPOCE*$J:F@8=hM}$,I,MW$G$9!#(B@refill - -$B$3$N$?$a!"(BMIME-View $B$O#1$D$N=qLL$KBP$7$F!">pJs8r49MQI=8=$r3JG<$9$k(B -mime-raw-buffer $B$HI=<(MQI=8=$r3JG<$9$k(B mime-preview-buffer $B$N#2$D$N(B -buffer $B$rMQ$$$^$9!#(B@refill - -MIME-View $B$O(B mime-preview-buffer $B$KBP$7$F(B mime-view-mode $B$H$$$&(B MIME -message $B$r1\Mw$9$k$?$a$N(B mode $B$rDs6!$7$^$9!#MxMQ<T$O$3$3$G3F(B entity $B$K(B -$BBP$7$FA`:n$r9T$&$3$H$,$G$-$^$9!#(B - - -@node MIME-Preview, mime-view-mode, Overview, Top -@chapter mime-preview-buffer $B$N2hLL9=@.(B - -mime-view-mode $B$G$O3F(B entity $B$KBP$7$F(B@refill - -@example - [entity-button] - (header) - - (body) - (separator) -@end example - -@noindent -$B$H$$$&>pJs$rI=<($7$^$9!#$3$l$i$O>r7o$K=>$C$F(B design $B$rJQ99$7$?$j!"I=<((B -$B$rM^@)$9$k$3$H$b$G$-$^$9!#(B - -$B0J2<$K!"I=<(Nc$r<($7$^$9!#(B - - -@example -From: morioka@@jaist.ac.jp ($B<i2,(B $BCNI'(B / MORIOKA Tomohiko) -Subject: Re: $B<ALd!)(B -Newsgroups: zxr.message.mime -Date: 22 Oct 93 11:02:44 -Mime-Version: 1.0 -Organization: Japan Advanced Institute of Science and Technology, - Ishikawa, Japan - -[1 (text/plain)] - MIME-Edit mode $B$K$*$1$k!"(BMIME message $B$N:n$jJ}!#(B - - C-c C-x ? $B$r2!$9$H(B help $B$,=P$F$/$k!#(B - -C-c C-x C-t insert a text message. -C-c C-x TAB insert a (binary) file. -C-c C-x C-e insert a reference to external body. -C-c C-x C-v insert a voice message. -C-c C-x C-y insert a mail or news message. -C-c C-x RET insert a mail message. -C-c C-x C-s insert a signature file at end. -C-c C-x t insert a new MIME tag. -C-c C-x a enclose as multipart/alternative. -C-c C-x p enclose as multipart/parallel. -C-c C-x m enclose as multipart/mixed. -C-c C-x d enclose as multipart/digest. -C-c C-x s enclose as PGP signed. -C-c C-x e enclose as PGP encrypted. -C-c C-x C-k insert PGP public key. -C-c C-x C-p preview editing MIME message. -... - -$B$C$FLu$G!"(BC-c C-x C-i $B$r2!$7$F!"A^F~$7$?$$(B binary file $B$r;XDj$7$^$9!#(B - - binary file $B$N(B MIME encoding $B$K$O!"IaDL!"(BBase64 $B$r;XDj$7$^$9!#(B - -[2 (image/gif)] - -[3 (text/plain)] - - $B$3$s$JIw$K!"3(F~$j(B message $B$N$G$->e$,$j!#(B - -$B".".".".".".".".".".".(B $B%m%7%"%s!&%F%#!<$r0lGU!#(B $B".".".".".".".".".".".(B -$B".".".".".(B $B!y(B $B%8%c%`$G$O$J$/%^!<%^%l!<%I$G$b$J$/K*L*$G(B $B!y(B $B".".".".".(B -$B".".".".".(B $B'.'0'2$$'0','!(B $B'4'0'.'0'7'*','0(B $B".".".".".(B -$B".".".".".".".(B Internet E-mail: <morioka@@jaist.ac.jp> $B".".".".".".".(B -@end example - - - -@menu -* entity-button:: -* entity-header:: -* entity-body:: -@end menu - -@node entity-button, entity-header, MIME-Preview, MIME-Preview -@section entity-button -@cindex entity-number -@cindex entity-button - -@strong{entity-button} $B$O(B entity $B$N@hF,$K$"$C$F!"$=$N(B entity $B$K4X$9$kBg(B -$B$^$+$J>pJs$rI=<($9$kItJ,$G$9!#(B@refill - -$BI8=`$G$O(B - -@example - [1.3 test (text/plain)] -@end example - -@noindent -$B$N$h$&$J46$8$KI=<($5$l$^$9!#(B - -$B:G=i$N?t;z$O(B message $BCf$N$3$N(B entity $B$N0LCV$r@aHV9f$N$h$&$KI=$7$?$b$N$G!"(B -@strong{entity-number} $B$H8F$S$^$9!#(B@refill - -$B#2HVL\$NJ8;zNs$OI=Bj$rI=$7$^$9!#$3$N>pJs$O!"(B - -@enumerate -@item -Content-Description field $B$b$7$/$O(B Subject field $B$K=q$+$l$?I=Bj(B -@item -Content-Disposition field $B$N(B filename parameter $B$K=q$+$l$?(B file $BL>(B -@item -Content-Type field $B$N(B name parameter $B$K=q$+$l$?(B file $BL>(B -@item - uuencode $B$N>l9g$N(B file $BL>(B -@end enumerate - -@noindent -$B$+$i:n$j$^$9!#$I$l$bB8:_$7$J$$>l9g$O6uGr$,I=<($5$l$^$9!#(B - -$B#3HVL\$N3g8L$NCf$N>pJs$O$=$N(B entity $B$N(B media-type/subtype $B$rI=$7$^$9!#Hs(B -MIME entity $B$N>l9g!"(B@code{nil} $B$,I=<($5$l$^$9!#(B@refill - -$B$3$N(B entity-button $B$O(B entity $B$NFbMF$r>]D'$9$k(B icon $B$N$h$&$JLr3d$r2L$?(B -$B$7$^$9!#Nc$($P!"(B - -@example - [2 (image/gif)] -@end example - -@noindent -$B$N>e$G(B @kbd{v} $B$r2!$;$P$3$3$KF~$C$F$$$k3($,I=<($5$l$^$9!#(B - -$B$^$?!"(Bmouse $BA`:n$,2DG=$J>l9g!"(Bentity-button $B$rBh#2%\%?%s!J(B3 button -mouse $B$N>l9g!"Cf1{$N%\%?%s!K$G2!$;$P!"F1MM$K$=$N3($,I=<($5$l$^$9!#(B - - -@node entity-header, entity-body, entity-button, MIME-Preview -@section entity-header -@cindex entity-header - -@strong{entity-header} $B$O$"$k(B entity $B$N(B header $B$rI=<($9$kIt(B -$BJ,$G$9!J!V$=$N$^$^$d$s$1!W$C$FE\$i$J$$$G!#$=$&$$$&$b$s$J$s$G$9!K!#(B - - -@node entity-body, , entity-header, MIME-Preview -@section entity-body -@cindex entity-body - -@strong{entity-body} $B$O(B part $B$NFbMF$rI=<($9$kItJ,$G$9!#(B@refill - -$B$3$l$b$R$M$j$,B-$j$J$$$G$9$,!"$^$"!"$=$&$$$&$b$s$G$9!#(B@refill - -$B$H$O$$$(!"<B:]$K$O>/$7$R$M$C$F$^$9!#(B@refill - -text entity $B$N>l9g$O(B charset $B$K1~$8$F(B code $BJQ49$7$?$j$7$^$9$7!"(BXEmacs $B$G(B -$B$O(B image entity $B$rJQ49$7$J$$$H$$$1$J$$$7!#(B@refill - -$B>\$7$/$O$^$?8e$G!#(B - - -@node mime-view-mode, Concept Index, MIME-Preview, Top -@chapter mime-preview-buffer $B$G$NA`:n(B - -mime-preview-buffer $B$K$O0J2<$N5!G=$,$"$j$^$9!#(B@refill - -@table @kbd -@item @key{u} -$B>e$N(B part $B$KLa$k!J(Bmessage $B$N0lHV>e$N(B part $B$G$3$l$r9T$J$&$H(B Summary -mode $B$KLa$k(B (*1)$B!K(B - -@item @key{p} -$BA0$N(B part $B$K0\F0$9$k(B - -@item @key{M-TAB} -$BA0$N(B part $B$K0\F0$9$k(B - -@item @key{n} -$B<!$N(B part $B$K0\F0$9$k(B - -@item @key{TAB} -$B<!$N(B part $B$K0\F0$9$k(B - -@item @key{SPC} -scroll up $B$9$k(B - -@item @key{M-SPC} -scroll down $B$9$k(B - -@item @key{DEL} -scroll down $B$9$k(B - -@item @key{RET} -$B<!$N9T$K0\F0$9$k(B - -@item @key{M-RET} -$BA0$N9T$K0\F0$9$k(B - -@item @key{v} -part $B$r:F@8$9$k(B (*2) - -@item @key{e} -part $B$+$i(B file $B$r<h$j=P$9(B (*2) - -@item @key{C-c C-p} -part $B$r0u:~$9$k(B (*2) - -@item @key{mouse-button-2} -preview-buffer $BCf$N(B mouse button $B$r5/F0$9$k(B - -content-button $B$r2!$;$P!"$=$N(B part $B$,:F@8$5$l$k(B(*2)@refill - -URL-button $B$r2!$;$P!"$=$N(B WWW browser $B$,5/F0$5$l$k(B@refill - -@end table - -@noindent -@strong{[$BCm0U(B]} -@quotation - -(*1) MUA $B$G(B mime-view $B$N@_Dj$r$7$F$$$J$$>l9g!"(BSummary mode $B$K$OLa$j$^$;(B -$B$s!#(B@refill - -(*2) $B<B:]$NF0:n$OBP1~$9$k(B method $B$K0M$j$^$9!#(B -@end quotation - - - -@node Concept Index, Function Index, mime-view-mode, Top -@chapter $B35G0:w0z(B - -@printindex cp - -@node Function Index, Variable Index, Concept Index, Top -@chapter $B4X?t:w0z(B - -@printindex fn - -@node Variable Index, , Function Index, Top -@chapter $BJQ?t:w0z(B - -@printindex vr -@bye diff --git a/mime-view.el b/mime-view.el deleted file mode 100644 index 1e0fe3f..0000000 --- a/mime-view.el +++ /dev/null @@ -1,1274 +0,0 @@ -;;; mime-view.el --- interactive MIME viewer for GNU Emacs - -;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> -;; Created: 1994/07/13 -;; Renamed: 1994/08/31 from tm-body.el -;; Renamed: 1997/02/19 from tm-view.el -;; Keywords: MIME, multimedia, mail, news - -;; This file is part of SEMI (Sophisticated Emacs MIME Interfaces). - -;; This program 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. - -;; This program 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. - -;;; Code: - -(require 'mime) -(require 'semi-def) -(require 'calist) -(require 'alist) -(require 'mailcap) - - -;;; @ version -;;; - -(defconst mime-view-version-string - `,(concat (car mime-user-interface-version) " MIME-View " - (mapconcat #'number-to-string - (cddr mime-user-interface-version) ".") - " (" (cadr mime-user-interface-version) ")")) - - -;;; @ variables -;;; - -(defgroup mime-view nil - "MIME view mode" - :group 'mime) - -(defcustom mime-view-find-every-acting-situation t - "*Find every available acting-situation if non-nil." - :group 'mime-view - :type 'boolean) - -(defcustom mime-acting-situation-examples-file "~/.mime-example" - "*File name of example about acting-situation demonstrated by user." - :group 'mime-view - :type 'file) - - -;;; @ in raw-buffer (representation space) -;;; - -(defvar mime-preview-buffer nil - "MIME-preview buffer corresponding with the (raw) buffer.") -(make-variable-buffer-local 'mime-preview-buffer) - - -(defvar mime-raw-representation-type nil - "Representation-type of mime-raw-buffer. -It must be nil, `binary' or `cooked'. -If it is nil, `mime-raw-representation-type-alist' is used as default -value. -Notice that this variable is usually used as buffer local variable in -raw-buffer.") - -(make-variable-buffer-local 'mime-raw-representation-type) - -(defvar mime-raw-representation-type-alist - '((mime-show-message-mode . binary) - (mime-temp-message-mode . binary) - (t . cooked) - ) - "Alist of major-mode vs. representation-type of mime-raw-buffer. -Each element looks like (SYMBOL . REPRESENTATION-TYPE). SYMBOL is -major-mode or t. t means default. REPRESENTATION-TYPE must be -`binary' or `cooked'. -This value is overridden by buffer local variable -`mime-raw-representation-type' if it is not nil.") - - -(defun mime-raw-find-entity-from-point (point &optional message-info) - "Return entity from POINT in mime-raw-buffer. -If optional argument MESSAGE-INFO is not specified, -`mime-message-structure' is used." - (or message-info - (setq message-info mime-message-structure)) - (if (and (<= (mime-entity-point-min message-info) point) - (<= point (mime-entity-point-max message-info))) - (let ((children (mime-entity-children message-info))) - (catch 'tag - (while children - (let ((ret - (mime-raw-find-entity-from-point point (car children)))) - (if ret - (throw 'tag ret) - )) - (setq children (cdr children))) - message-info)))) - - -;;; @ in preview-buffer (presentation space) -;;; - -(defvar mime-mother-buffer nil - "Mother buffer corresponding with the (MIME-preview) buffer. -If current MIME-preview buffer is generated by other buffer, such as -message/partial, it is called `mother-buffer'.") -(make-variable-buffer-local 'mime-mother-buffer) - -(defvar mime-raw-buffer nil - "Raw buffer corresponding with the (MIME-preview) buffer.") -(make-variable-buffer-local 'mime-raw-buffer) - -(defvar mime-preview-original-window-configuration nil - "Window-configuration before mime-view-mode is called.") -(make-variable-buffer-local 'mime-preview-original-window-configuration) - -(defun mime-preview-original-major-mode (&optional recursive) - "Return major-mode of original buffer. -If optional argument RECURSIVE is non-nil and current buffer has -mime-mother-buffer, it returns original major-mode of the -mother-buffer." - (if (and recursive mime-mother-buffer) - (save-excursion - (set-buffer mime-mother-buffer) - (mime-preview-original-major-mode recursive) - ) - (save-excursion - (set-buffer - (mime-entity-buffer - (get-text-property (point-min) 'mime-view-entity))) - major-mode))) - - -;;; @ entity information -;;; - -(defsubst mime-entity-representation-type (entity) - (with-current-buffer (mime-entity-buffer entity) - (or mime-raw-representation-type - (cdr (or (assq major-mode mime-raw-representation-type-alist) - (assq t mime-raw-representation-type-alist)))))) - -(defsubst mime-entity-cooked-p (entity) - (eq (mime-entity-representation-type entity) 'cooked)) - -(defun mime-entity-situation (entity) - "Return situation of ENTITY." - (append (or (mime-entity-content-type entity) - (make-mime-content-type 'text 'plain)) - (let ((d (mime-entity-content-disposition entity))) - (cons (cons 'disposition-type - (mime-content-disposition-type d)) - (mapcar (function - (lambda (param) - (let ((name (car param))) - (cons (cond ((string= name "filename") - 'filename) - ((string= name "creation-date") - 'creation-date) - ((string= name "modification-date") - 'modification-date) - ((string= name "read-date") - 'read-date) - ((string= name "size") - 'size) - (t (cons 'disposition (car param)))) - (cdr param))))) - (mime-content-disposition-parameters d)) - )) - (list (cons 'encoding (mime-entity-encoding entity)) - (cons 'major-mode - (save-excursion - (set-buffer (mime-entity-buffer entity)) - major-mode))) - )) - - -(defun mime-view-entity-title (entity) - (or (mime-read-field 'Content-Description entity) - (mime-read-field 'Subject entity) - (mime-entity-filename entity) - "")) - - -(defsubst mime-raw-point-to-entity-node-id (point &optional message-info) - "Return entity-node-id from POINT in mime-raw-buffer. -If optional argument MESSAGE-INFO is not specified, -`mime-message-structure' is used." - (mime-entity-node-id (mime-raw-find-entity-from-point point message-info))) - -(defsubst mime-raw-point-to-entity-number (point &optional message-info) - "Return entity-number from POINT in mime-raw-buffer. -If optional argument MESSAGE-INFO is not specified, -`mime-message-structure' is used." - (mime-entity-number (mime-raw-find-entity-from-point point message-info))) - -(defun mime-raw-flatten-message-info (&optional message-info) - "Return list of entity in mime-raw-buffer. -If optional argument MESSAGE-INFO is not specified, -`mime-message-structure' is used." - (or message-info - (setq message-info mime-message-structure)) - (let ((dest (list message-info)) - (rcl (mime-entity-children message-info))) - (while rcl - (setq dest (nconc dest (mime-raw-flatten-message-info (car rcl)))) - (setq rcl (cdr rcl))) - dest)) - - -;;; @ presentation of preview -;;; - -;;; @@ entity-button -;;; - -;;; @@@ predicate function -;;; - -(defun mime-view-entity-button-visible-p (entity) - "Return non-nil if header of ENTITY is visible. -Please redefine this function if you want to change default setting." - (let ((media-type (mime-entity-media-type entity)) - (media-subtype (mime-entity-media-subtype entity))) - (or (not (eq media-type 'application)) - (and (not (eq media-subtype 'x-selection)) - (or (not (eq media-subtype 'octet-stream)) - (let ((mother-entity (mime-entity-parent entity))) - (or (not (eq (mime-entity-media-type mother-entity) - 'multipart)) - (not (eq (mime-entity-media-subtype mother-entity) - 'encrypted))) - ) - ))))) - -;;; @@@ entity button generator -;;; - -(defun mime-view-insert-entity-button (entity) - "Insert entity-button of ENTITY." - (let ((entity-node-id (mime-entity-node-id entity)) - (params (mime-entity-parameters entity)) - (subject (mime-view-entity-title entity))) - (mime-insert-button - (let ((access-type (assoc "access-type" params)) - (num (or (cdr (assoc "x-part-number" params)) - (if (consp entity-node-id) - (mapconcat (function - (lambda (num) - (format "%s" (1+ num)) - )) - (reverse entity-node-id) ".") - "0")) - )) - (cond (access-type - (let ((server (assoc "server" params))) - (setq access-type (cdr access-type)) - (if server - (format "%s %s ([%s] %s)" - num subject access-type (cdr server)) - (let ((site (cdr (assoc "site" params))) - (dir (cdr (assoc "directory" params))) - ) - (format "%s %s ([%s] %s:%s)" - num subject access-type site dir) - ))) - ) - (t - (let ((media-type (mime-entity-media-type entity)) - (media-subtype (mime-entity-media-subtype entity)) - (charset (cdr (assoc "charset" params))) - (encoding (mime-entity-encoding entity))) - (concat - num " " subject - (let ((rest - (format " <%s/%s%s%s>" - media-type media-subtype - (if charset - (concat "; " charset) - "") - (if encoding - (concat " (" encoding ")") - "")))) - (if (>= (+ (current-column)(length rest))(window-width)) - "\n\t") - rest))) - ))) - (function mime-preview-play-current-entity)) - )) - - -;;; @@ entity-header -;;; - -(defvar mime-header-presentation-method-alist nil - "Alist of major mode vs. corresponding header-presentation-method functions. -Each element looks like (SYMBOL . FUNCTION). -SYMBOL must be major mode in raw-buffer or t. t means default. -Interface of FUNCTION must be (ENTITY SITUATION).") - -(defvar mime-view-ignored-field-list - '(".*Received" ".*Path" ".*Id" "References" - "Replied" "Errors-To" - "Lines" "Sender" ".*Host" "Xref" - "Content-Type" "Precedence" - "Status" "X-VM-.*") - "All fields that match this list will be hidden in MIME preview buffer. -Each elements are regexp of field-name.") - -(defvar mime-view-visible-field-list '("Dnas.*" "Message-Id") - "All fields that match this list will be displayed in MIME preview buffer. -Each elements are regexp of field-name.") - - -;;; @@ entity-body -;;; - -;;; @@@ predicate function -;;; - -(defun mime-calist::field-match-method-as-default-rule (calist - field-type field-value) - (let ((s-field (assq field-type calist))) - (cond ((null s-field) - (cons (cons field-type field-value) calist) - ) - (t calist)))) - -(define-calist-field-match-method - 'header #'mime-calist::field-match-method-as-default-rule) - -(define-calist-field-match-method - 'body #'mime-calist::field-match-method-as-default-rule) - - -(defvar mime-preview-condition nil - "Condition-tree about how to display entity.") - -(ctree-set-calist-strictly - 'mime-preview-condition '((type . application)(subtype . octet-stream) - (encoding . nil) - (body . visible))) -(ctree-set-calist-strictly - 'mime-preview-condition '((type . application)(subtype . octet-stream) - (encoding . "7bit") - (body . visible))) -(ctree-set-calist-strictly - 'mime-preview-condition '((type . application)(subtype . octet-stream) - (encoding . "8bit") - (body . visible))) - -(ctree-set-calist-strictly - 'mime-preview-condition '((type . application)(subtype . pgp) - (body . visible))) - -(ctree-set-calist-strictly - 'mime-preview-condition '((type . application)(subtype . x-latex) - (body . visible))) - -(ctree-set-calist-strictly - 'mime-preview-condition '((type . application)(subtype . x-selection) - (body . visible))) - -(ctree-set-calist-strictly - 'mime-preview-condition '((type . application)(subtype . x-comment) - (body . visible))) - -(ctree-set-calist-strictly - 'mime-preview-condition '((type . message)(subtype . delivery-status) - (body . visible))) - -(ctree-set-calist-strictly - 'mime-preview-condition - '((body . visible) - (body-presentation-method . mime-display-text/plain))) - -(ctree-set-calist-strictly - 'mime-preview-condition - '((type . nil) - (body . visible) - (body-presentation-method . mime-display-text/plain))) - -(ctree-set-calist-strictly - 'mime-preview-condition - '((type . text)(subtype . enriched) - (body . visible) - (body-presentation-method . mime-display-text/enriched))) - -(ctree-set-calist-strictly - 'mime-preview-condition - '((type . text)(subtype . richtext) - (body . visible) - (body-presentation-method . mime-display-text/richtext))) - -(ctree-set-calist-strictly - 'mime-preview-condition - '((type . text)(subtype . t) - (body . visible) - (body-presentation-method . mime-display-text/plain))) - -(ctree-set-calist-strictly - 'mime-preview-condition - '((type . multipart)(subtype . alternative) - (body . visible) - (body-presentation-method . mime-display-multipart/alternative))) - -(ctree-set-calist-strictly - 'mime-preview-condition '((type . message)(subtype . partial) - (body-presentation-method - . mime-display-message/partial-button))) - -(ctree-set-calist-strictly - 'mime-preview-condition '((type . message)(subtype . rfc822) - (body-presentation-method . nil) - (childrens-situation (header . visible) - (entity-button . invisible)))) - -(ctree-set-calist-strictly - 'mime-preview-condition '((type . message)(subtype . news) - (body-presentation-method . nil) - (childrens-situation (header . visible) - (entity-button . invisible)))) - - -;;; @@@ entity presentation -;;; - -(autoload 'mime-display-text/plain "mime-text") -(autoload 'mime-display-text/enriched "mime-text") -(autoload 'mime-display-text/richtext "mime-text") - -(defvar mime-view-announcement-for-message/partial - (if (and (>= emacs-major-version 19) window-system) - "\ -\[[ This is message/partial style split message. ]] -\[[ Please press `v' key in this buffer ]] -\[[ or click here by mouse button-2. ]]" - "\ -\[[ This is message/partial style split message. ]] -\[[ Please press `v' key in this buffer. ]]" - )) - -(defun mime-display-message/partial-button (&optional entity situation) - (save-restriction - (goto-char (point-max)) - (if (not (search-backward "\n\n" nil t)) - (insert "\n") - ) - (goto-char (point-max)) - (narrow-to-region (point-max)(point-max)) - (insert mime-view-announcement-for-message/partial) - (mime-add-button (point-min)(point-max) - #'mime-preview-play-current-entity) - )) - -(defun mime-display-multipart/mixed (entity situation) - (let ((children (mime-entity-children entity)) - (default-situation - (cdr (assq 'childrens-situation situation)))) - (while children - (mime-display-entity (car children) nil default-situation) - (setq children (cdr children)) - ))) - -(defcustom mime-view-type-subtype-score-alist - '(((text . enriched) . 3) - ((text . richtext) . 2) - ((text . plain) . 1) - (t . 0)) - "Alist MEDIA-TYPE vs corresponding score. -MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." - :group 'mime-view - :type '(repeat (cons (choice :tag "Media-Type" - (item :tag "Type/Subtype" - (cons symbol symbol)) - (item :tag "Type" symbol) - (item :tag "Default" t)) - integer))) - -(defun mime-display-multipart/alternative (entity situation) - (let* ((children (mime-entity-children entity)) - (default-situation - (cdr (assq 'childrens-situation situation))) - (i 0) - (p 0) - (max-score 0) - (situations - (mapcar (function - (lambda (child) - (let ((situation - (or (ctree-match-calist - mime-preview-condition - (append (mime-entity-situation child) - default-situation)) - default-situation))) - (if (cdr (assq 'body-presentation-method situation)) - (let ((score - (cdr - (or (assoc - (cons - (cdr (assq 'type situation)) - (cdr (assq 'subtype situation))) - mime-view-type-subtype-score-alist) - (assq - (cdr (assq 'type situation)) - mime-view-type-subtype-score-alist) - (assq - t - mime-view-type-subtype-score-alist) - )))) - (if (> score max-score) - (setq p i - max-score score) - ))) - (setq i (1+ i)) - situation) - )) - children))) - (setq i 0) - (while children - (let ((child (car children)) - (situation (car situations))) - (mime-display-entity child (if (= i p) - situation - (del-alist 'body-presentation-method - (copy-alist situation)))) - ) - (setq children (cdr children) - situations (cdr situations) - i (1+ i)) - ))) - - -;;; @ acting-condition -;;; - -(defvar mime-acting-condition nil - "Condition-tree about how to process entity.") - -(if (file-readable-p mailcap-file) - (let ((entries (mailcap-parse-file))) - (while entries - (let ((entry (car entries)) - view print shared) - (while entry - (let* ((field (car entry)) - (field-type (car field))) - (cond ((eq field-type 'view) (setq view field)) - ((eq field-type 'print) (setq print field)) - ((memq field-type '(compose composetyped edit))) - (t (setq shared (cons field shared)))) - ) - (setq entry (cdr entry)) - ) - (setq shared (nreverse shared)) - (ctree-set-calist-with-default - 'mime-acting-condition - (append shared (list '(mode . "play")(cons 'method (cdr view))))) - (if print - (ctree-set-calist-with-default - 'mime-acting-condition - (append shared - (list '(mode . "print")(cons 'method (cdr view)))) - )) - ) - (setq entries (cdr entries)) - ))) - -(ctree-set-calist-strictly - 'mime-acting-condition - '((type . application)(subtype . octet-stream) - (mode . "play") - (method . mime-detect-content) - )) - -(ctree-set-calist-with-default - 'mime-acting-condition - '((mode . "extract") - (method . mime-save-content))) - -(ctree-set-calist-strictly - 'mime-acting-condition - '((type . text)(subtype . x-rot13-47)(mode . "play") - (method . mime-view-caesar) - )) -(ctree-set-calist-strictly - 'mime-acting-condition - '((type . text)(subtype . x-rot13-47-48)(mode . "play") - (method . mime-view-caesar) - )) - -(ctree-set-calist-strictly - 'mime-acting-condition - '((type . message)(subtype . rfc822)(mode . "play") - (method . mime-view-message/rfc822) - )) -(ctree-set-calist-strictly - 'mime-acting-condition - '((type . message)(subtype . partial)(mode . "play") - (method . mime-store-message/partial-piece) - )) - -(ctree-set-calist-strictly - 'mime-acting-condition - '((type . message)(subtype . external-body) - ("access-type" . "anon-ftp") - (method . mime-view-message/external-anon-ftp) - )) - -(ctree-set-calist-strictly - 'mime-acting-condition - '((type . message)(subtype . external-body) - ("access-type" . "url") - (method . mime-view-message/external-url) - )) - -(ctree-set-calist-strictly - 'mime-acting-condition - '((type . application)(subtype . octet-stream) - (method . mime-save-content) - )) - - -;;; @ quitting method -;;; - -(defvar mime-preview-quitting-method-alist - '((mime-show-message-mode - . mime-preview-quitting-method-for-mime-show-message-mode)) - "Alist of major-mode vs. quitting-method of mime-view.") - -(defvar mime-preview-over-to-previous-method-alist nil - "Alist of major-mode vs. over-to-previous-method of mime-view.") - -(defvar mime-preview-over-to-next-method-alist nil - "Alist of major-mode vs. over-to-next-method of mime-view.") - - -;;; @ following method -;;; - -(defvar mime-preview-following-method-alist nil - "Alist of major-mode vs. following-method of mime-view.") - -(defvar mime-view-following-required-fields-list - '("From")) - - -;;; @ buffer setup -;;; - -(defun mime-display-entity (entity &optional situation - default-situation preview-buffer) - (or preview-buffer - (setq preview-buffer (current-buffer))) - (let* ((raw-buffer (mime-entity-buffer entity)) - (start (mime-entity-point-min entity)) - e nb ne) - (set-buffer raw-buffer) - (goto-char start) - (or situation - (setq situation - (or (ctree-match-calist mime-preview-condition - (append (mime-entity-situation entity) - default-situation)) - default-situation))) - (let ((button-is-invisible - (eq (cdr (assq 'entity-button situation)) 'invisible)) - (header-is-visible - (eq (cdr (assq 'header situation)) 'visible)) - (header-presentation-method - (or (cdr (assq 'header-presentation-method situation)) - (cdr (assq major-mode mime-header-presentation-method-alist)))) - (body-presentation-method - (cdr (assq 'body-presentation-method situation))) - (children (mime-entity-children entity))) - (set-buffer preview-buffer) - (setq nb (point)) - (narrow-to-region nb nb) - (or button-is-invisible - (if (mime-view-entity-button-visible-p entity) - (mime-view-insert-entity-button entity) - )) - (when header-is-visible - (if header-presentation-method - (funcall header-presentation-method entity situation) - (mime-insert-decoded-header entity - mime-view-ignored-field-list - mime-view-visible-field-list - (if (mime-entity-cooked-p entity) - nil - default-mime-charset)) - ) - (goto-char (point-max)) - (insert "\n") - (run-hooks 'mime-display-header-hook) - ) - (cond (children) - ((functionp body-presentation-method) - (funcall body-presentation-method entity situation) - ) - (t - (when button-is-invisible - (goto-char (point-max)) - (mime-view-insert-entity-button entity) - ) - (or header-is-visible - (progn - (goto-char (point-max)) - (insert "\n") - )) - )) - (setq ne (point-max)) - (widen) - (put-text-property nb ne 'mime-view-entity entity) - (goto-char ne) - (if children - (if (functionp body-presentation-method) - (funcall body-presentation-method entity situation) - (mime-display-multipart/mixed entity situation) - )) - ))) - - -;;; @ MIME viewer mode -;;; - -(defconst mime-view-menu-title "MIME-View") -(defconst mime-view-menu-list - '((up "Move to upper entity" mime-preview-move-to-upper) - (previous "Move to previous entity" mime-preview-move-to-previous) - (next "Move to next entity" mime-preview-move-to-next) - (scroll-down "Scroll-down" mime-preview-scroll-down-entity) - (scroll-up "Scroll-up" mime-preview-scroll-up-entity) - (play "Play current entity" mime-preview-play-current-entity) - (extract "Extract current entity" mime-preview-extract-current-entity) - (print "Print current entity" mime-preview-print-current-entity) - ) - "Menu for MIME Viewer") - -(cond (running-xemacs - (defvar mime-view-xemacs-popup-menu - (cons mime-view-menu-title - (mapcar (function - (lambda (item) - (vector (nth 1 item)(nth 2 item) t) - )) - mime-view-menu-list))) - (defun mime-view-xemacs-popup-menu (event) - "Popup the menu in the MIME Viewer buffer" - (interactive "e") - (select-window (event-window event)) - (set-buffer (event-buffer event)) - (popup-menu 'mime-view-xemacs-popup-menu)) - (defvar mouse-button-2 'button2) - ) - (t - (defvar mouse-button-2 [mouse-2]) - )) - -(defun mime-view-define-keymap (&optional default) - (let ((mime-view-mode-map (if (keymapp default) - (copy-keymap default) - (make-sparse-keymap) - ))) - (define-key mime-view-mode-map - "u" (function mime-preview-move-to-upper)) - (define-key mime-view-mode-map - "p" (function mime-preview-move-to-previous)) - (define-key mime-view-mode-map - "n" (function mime-preview-move-to-next)) - (define-key mime-view-mode-map - "\e\t" (function mime-preview-move-to-previous)) - (define-key mime-view-mode-map - "\t" (function mime-preview-move-to-next)) - (define-key mime-view-mode-map - " " (function mime-preview-scroll-up-entity)) - (define-key mime-view-mode-map - "\M- " (function mime-preview-scroll-down-entity)) - (define-key mime-view-mode-map - "\177" (function mime-preview-scroll-down-entity)) - (define-key mime-view-mode-map - "\C-m" (function mime-preview-next-line-entity)) - (define-key mime-view-mode-map - "\C-\M-m" (function mime-preview-previous-line-entity)) - (define-key mime-view-mode-map - "v" (function mime-preview-play-current-entity)) - (define-key mime-view-mode-map - "e" (function mime-preview-extract-current-entity)) - (define-key mime-view-mode-map - "\C-c\C-p" (function mime-preview-print-current-entity)) - (define-key mime-view-mode-map - "a" (function mime-preview-follow-current-entity)) - (define-key mime-view-mode-map - "q" (function mime-preview-quit)) - (define-key mime-view-mode-map - "\C-c\C-x" (function mime-preview-kill-buffer)) - ;; (define-key mime-view-mode-map - ;; "<" (function beginning-of-buffer)) - ;; (define-key mime-view-mode-map - ;; ">" (function end-of-buffer)) - (define-key mime-view-mode-map - "?" (function describe-mode)) - (define-key mime-view-mode-map - [tab] (function mime-preview-move-to-next)) - (define-key mime-view-mode-map - [delete] (function mime-preview-scroll-down-entity)) - (define-key mime-view-mode-map - [backspace] (function mime-preview-scroll-down-entity)) - (if (functionp default) - (cond (running-xemacs - (set-keymap-default-binding mime-view-mode-map default) - ) - (t - (setq mime-view-mode-map - (append mime-view-mode-map (list (cons t default)))) - ))) - (if mouse-button-2 - (define-key mime-view-mode-map - mouse-button-2 (function mime-button-dispatcher)) - ) - (cond (running-xemacs - (define-key mime-view-mode-map - mouse-button-3 (function mime-view-xemacs-popup-menu)) - ) - ((>= emacs-major-version 19) - (define-key mime-view-mode-map [menu-bar mime-view] - (cons mime-view-menu-title - (make-sparse-keymap mime-view-menu-title))) - (mapcar (function - (lambda (item) - (define-key mime-view-mode-map - (vector 'menu-bar 'mime-view (car item)) - (cons (nth 1 item)(nth 2 item)) - ) - )) - (reverse mime-view-menu-list) - ) - )) - (use-local-map mime-view-mode-map) - (run-hooks 'mime-view-define-keymap-hook) - )) - -(defsubst mime-maybe-hide-echo-buffer () - "Clear mime-echo buffer and delete window for it." - (let ((buf (get-buffer mime-echo-buffer-name))) - (if buf - (save-excursion - (set-buffer buf) - (erase-buffer) - (let ((win (get-buffer-window buf))) - (if win - (delete-window win) - )) - (bury-buffer buf) - )))) - -(defvar mime-view-redisplay nil) - -(defun mime-display-message (message &optional preview-buffer - mother default-keymap-or-function) - (mime-maybe-hide-echo-buffer) - (let ((win-conf (current-window-configuration)) - (raw-buffer (mime-entity-buffer message))) - (or preview-buffer - (setq preview-buffer - (concat "*Preview-" (buffer-name raw-buffer) "*"))) - (set-buffer raw-buffer) - (setq mime-preview-buffer preview-buffer) - (let ((inhibit-read-only t)) - (set-buffer (get-buffer-create preview-buffer)) - (widen) - (erase-buffer) - (setq mime-raw-buffer raw-buffer) - (if mother - (setq mime-mother-buffer mother) - ) - (setq mime-preview-original-window-configuration win-conf) - (setq major-mode 'mime-view-mode) - (setq mode-name "MIME-View") - (mime-display-entity message nil - '((entity-button . invisible) - (header . visible)) - preview-buffer) - (mime-view-define-keymap default-keymap-or-function) - (let ((point - (next-single-property-change (point-min) 'mime-view-entity))) - (if point - (goto-char point) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - )) - (run-hooks 'mime-view-mode-hook) - (set-buffer-modified-p nil) - (setq buffer-read-only t) - (or (get-buffer-window preview-buffer) - (let ((r-win (get-buffer-window raw-buffer))) - (if r-win - (set-window-buffer r-win preview-buffer) - (switch-to-buffer preview-buffer) - ))) - ))) - -(defun mime-view-buffer (&optional raw-buffer preview-buffer mother - default-keymap-or-function) - (interactive) - (mime-display-message - (mime-parse-buffer raw-buffer) - preview-buffer mother default-keymap-or-function)) - -(defun mime-view-mode (&optional mother ctl encoding - raw-buffer preview-buffer - default-keymap-or-function) - "Major mode for viewing MIME message. - -Here is a list of the standard keys for mime-view-mode. - -key feature ---- ------- - -u Move to upper content -p or M-TAB Move to previous content -n or TAB Move to next content -SPC Scroll up or move to next content -M-SPC or DEL Scroll down or move to previous content -RET Move to next line -M-RET Move to previous line -v Decode current content as `play mode' -e Decode current content as `extract mode' -C-c C-p Decode current content as `print mode' -a Followup to current content. -q Quit -button-2 Move to point under the mouse cursor - and decode current content as `play mode' -" - (interactive) - (let ((message - (save-excursion - (if raw-buffer (set-buffer raw-buffer)) - (or mime-view-redisplay - (setq mime-message-structure (mime-parse-message ctl))) - ))) - (or (mime-entity-encoding message) - (mime-entity-set-encoding-internal message encoding)) - (mime-display-message message preview-buffer - mother default-keymap-or-function) - )) - - -;;; @@ playing -;;; - -(autoload 'mime-preview-play-current-entity "mime-play" - "Play current entity." t) - -(defun mime-preview-extract-current-entity () - "Extract current entity into file (maybe). -It decodes current entity to call internal or external method as -\"extract\" mode. The method is selected from variable -`mime-acting-condition'." - (interactive) - (mime-preview-play-current-entity "extract") - ) - -(defun mime-preview-print-current-entity () - "Print current entity (maybe). -It decodes current entity to call internal or external method as -\"print\" mode. The method is selected from variable -`mime-acting-condition'." - (interactive) - (mime-preview-play-current-entity "print") - ) - - -;;; @@ following -;;; - -(defun mime-preview-follow-current-entity () - "Write follow message to current entity. -It calls following-method selected from variable -`mime-preview-following-method-alist'." - (interactive) - (let (entity) - (while (null (setq entity - (get-text-property (point) 'mime-view-entity))) - (backward-char) - ) - (let* ((p-beg - (previous-single-property-change (point) 'mime-view-entity)) - p-end - (entity-node-id (mime-entity-node-id entity)) - (len (length entity-node-id)) - ) - (cond ((null p-beg) - (setq p-beg - (if (eq (next-single-property-change (point-min) - 'mime-view-entity) - (point)) - (point) - (point-min))) - ) - ((eq (next-single-property-change p-beg 'mime-view-entity) - (point)) - (setq p-beg (point)) - )) - (setq p-end (next-single-property-change p-beg 'mime-view-entity)) - (cond ((null p-end) - (setq p-end (point-max)) - ) - ((null entity-node-id) - (setq p-end (point-max)) - ) - (t - (save-excursion - (goto-char p-end) - (catch 'tag - (let (e) - (while (setq e - (next-single-property-change - (point) 'mime-view-entity)) - (goto-char e) - (let ((rc (mime-entity-node-id - (get-text-property (point) - 'mime-view-entity)))) - (or (equal entity-node-id - (nthcdr (- (length rc) len) rc)) - (throw 'tag nil) - )) - (setq p-end e) - )) - (setq p-end (point-max)) - )) - )) - (let* ((mode (mime-preview-original-major-mode 'recursive)) - (new-name - (format "%s-%s" (buffer-name) (reverse entity-node-id))) - new-buf - (the-buf (current-buffer)) - (a-buf mime-raw-buffer) - fields) - (save-excursion - (set-buffer (setq new-buf (get-buffer-create new-name))) - (erase-buffer) - (insert-buffer-substring the-buf p-beg p-end) - (goto-char (point-min)) - (let ((entity-node-id (mime-entity-node-id entity)) ci str) - (while (progn - (setq - str - (save-excursion - (set-buffer a-buf) - (setq ci - (mime-find-entity-from-node-id entity-node-id)) - (save-restriction - (narrow-to-region - (mime-entity-point-min ci) - (mime-entity-point-max ci) - ) - (std11-header-string-except - (concat "^" - (apply (function regexp-or) fields) - ":") "")))) - (if (and - (eq (mime-entity-media-type ci) 'message) - (eq (mime-entity-media-subtype ci) 'rfc822)) - nil - (if str - (insert str) - ) - entity-node-id)) - (setq fields (std11-collect-field-names) - entity-node-id (cdr entity-node-id)) - ) - ) - (let ((rest mime-view-following-required-fields-list)) - (while rest - (let ((field-name (car rest))) - (or (std11-field-body field-name) - (insert - (format - (concat field-name - ": " - (save-excursion - (set-buffer the-buf) - (set-buffer mime-mother-buffer) - (set-buffer mime-raw-buffer) - (std11-field-body field-name) - ) - "\n"))) - )) - (setq rest (cdr rest)) - )) - (eword-decode-header) - ) - (let ((f (cdr (assq mode mime-preview-following-method-alist)))) - (if (functionp f) - (funcall f new-buf) - (message - (format - "Sorry, following method for %s is not implemented yet." - mode)) - )) - )))) - - -;;; @@ moving -;;; - -(defun mime-preview-move-to-upper () - "Move to upper entity. -If there is no upper entity, call function `mime-preview-quit'." - (interactive) - (let (cinfo) - (while (null (setq cinfo - (get-text-property (point) 'mime-view-entity))) - (backward-char) - ) - (let ((r (mime-entity-parent cinfo)) - point) - (catch 'tag - (while (setq point (previous-single-property-change - (point) 'mime-view-entity)) - (goto-char point) - (if (eq r (get-text-property (point) 'mime-view-entity)) - (throw 'tag t) - ) - ) - (mime-preview-quit) - )))) - -(defun mime-preview-move-to-previous () - "Move to previous entity. -If there is no previous entity, it calls function registered in -variable `mime-preview-over-to-previous-method-alist'." - (interactive) - (while (null (get-text-property (point) 'mime-view-entity)) - (backward-char) - ) - (let ((point (previous-single-property-change (point) 'mime-view-entity))) - (if point - (if (get-text-property (1- point) 'mime-view-entity) - (goto-char point) - (goto-char (1- point)) - (mime-preview-move-to-previous) - ) - (let ((f (assq (mime-preview-original-major-mode) - mime-preview-over-to-previous-method-alist))) - (if f - (funcall (cdr f)) - )) - ))) - -(defun mime-preview-move-to-next () - "Move to next entity. -If there is no previous entity, it calls function registered in -variable `mime-preview-over-to-next-method-alist'." - (interactive) - (while (null (get-text-property (point) 'mime-view-entity)) - (forward-char) - ) - (let ((point (next-single-property-change (point) 'mime-view-entity))) - (if point - (progn - (goto-char point) - (if (null (get-text-property point 'mime-view-entity)) - (mime-preview-move-to-next) - )) - (let ((f (assq (mime-preview-original-major-mode) - mime-preview-over-to-next-method-alist))) - (if f - (funcall (cdr f)) - )) - ))) - -(defun mime-preview-scroll-up-entity (&optional h) - "Scroll up current entity. -If reached to (point-max), it calls function registered in variable -`mime-preview-over-to-next-method-alist'." - (interactive) - (or h - (setq h (1- (window-height))) - ) - (if (= (point) (point-max)) - (let ((f (assq (mime-preview-original-major-mode) - mime-preview-over-to-next-method-alist))) - (if f - (funcall (cdr f)) - )) - (let ((point - (or (next-single-property-change (point) 'mime-view-entity) - (point-max)))) - (forward-line h) - (if (> (point) point) - (goto-char point) - ) - ))) - -(defun mime-preview-scroll-down-entity (&optional h) - "Scroll down current entity. -If reached to (point-min), it calls function registered in variable -`mime-preview-over-to-previous-method-alist'." - (interactive) - (or h - (setq h (1- (window-height))) - ) - (if (= (point) (point-min)) - (let ((f (assq (mime-preview-original-major-mode) - mime-preview-over-to-previous-method-alist))) - (if f - (funcall (cdr f)) - )) - (let ((point - (or (previous-single-property-change (point) 'mime-view-entity) - (point-min)))) - (forward-line (- h)) - (if (< (point) point) - (goto-char point) - )))) - -(defun mime-preview-next-line-entity () - (interactive) - (mime-preview-scroll-up-entity 1) - ) - -(defun mime-preview-previous-line-entity () - (interactive) - (mime-preview-scroll-down-entity 1) - ) - - -;;; @@ quitting -;;; - -(defun mime-preview-quit () - "Quit from MIME-preview buffer. -It calls function registered in variable -`mime-preview-quitting-method-alist'." - (interactive) - (let ((r (assq (mime-preview-original-major-mode) - mime-preview-quitting-method-alist))) - (if r - (funcall (cdr r)) - ))) - -(defun mime-preview-kill-buffer () - (interactive) - (kill-buffer (current-buffer)) - ) - - -;;; @ end -;;; - -(provide 'mime-view) - -(run-hooks 'mime-view-load-hook) - -;;; mime-view.el ends here diff --git a/mime-w3.el b/mime-w3.el deleted file mode 100644 index 2c0655b..0000000 --- a/mime-w3.el +++ /dev/null @@ -1,64 +0,0 @@ -;;; mime-w3.el --- mime-view content filter for text - -;; Copyright (C) 1994,1995,1996,1997,1998 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> -;; Keywords: HTML, MIME, multimedia, mail, news - -;; This file is part of SEMI (Suite of Emacs MIME Interfaces). - -;; This program 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. - -;; This program 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. - -;;; Code: - -(require 'w3) -(require 'mime-text) - -(defmacro mime-put-keymap-region (start end keymap) - `(put-text-property ,start ,end - ',(if (featurep 'xemacs) - 'keymap - 'local-map) - ,keymap) - ) - -(defmacro mime-save-background-color (&rest body) - (if (featurep 'xemacs) - `(let ((color (color-name (face-background 'default)))) - (prog1 - (progn ,@body) - (font-set-face-background 'default color (current-buffer)) - )) - (cons 'progn body))) - -(defun mime-preview-text/html (entity situation) - (mime-save-background-color - (save-restriction - (narrow-to-region (point-max)(point-max)) - (mime-text-insert-decoded-body entity) - (let ((beg (point-min))) - (remove-text-properties beg (point-max) '(face nil)) - (w3-region beg (point-max)) - (mime-put-keymap-region beg (point-max) w3-mode-map) - )))) - - -;;; @ end -;;; - -(provide 'mime-w3) - -;;; mime-w3.el ends here diff --git a/semi-def.el b/semi-def.el deleted file mode 100644 index 38508b0..0000000 --- a/semi-def.el +++ /dev/null @@ -1,250 +0,0 @@ -;;; semi-def.el --- definition module for REMI - -;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> -;; Keywords: definition, MIME, multimedia, mail, news - -;; This file is part of SEMI (Sample of Emacs MIME Implementation). - -;; This program 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. - -;; This program 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. - -;;; Code: - -(require 'emu) - -(eval-when-compile (require 'cl)) - -(require 'custom) - -(defconst mime-user-interface-version '("SEMI" "Toyama" 1 8 0) - "Implementation name, version name and numbers of MIME-kernel package.") - -(autoload 'mule-caesar-region "mule-caesar" - "Caesar rotation of current region." t) - - -;;; @ constants -;;; - -(defconst mime-echo-buffer-name "*MIME-echo*" - "Name of buffer to display MIME-playing information.") - -(defconst mime-temp-buffer-name " *MIME-temp*") - - -;;; @ button -;;; - -(defcustom mime-button-face 'bold - "Face used for content-button or URL-button of MIME-Preview buffer." - :group 'mime - :type 'face) - -(defcustom mime-button-mouse-face 'highlight - "Face used for MIME-preview buffer mouse highlighting." - :group 'mime - :type 'face) - -(defsubst mime-add-button (from to function &optional data) - "Create a button between FROM and TO with callback FUNCTION and DATA." - (let ((overlay (make-overlay from to))) - (and mime-button-face - (overlay-put overlay 'face mime-button-face)) - (and mime-button-mouse-face - (overlay-put overlay 'mouse-face mime-button-mouse-face)) - (add-text-properties from to (list 'mime-button-callback function)) - (and data - (add-text-properties from to (list 'mime-button-data data))) - )) - -(defsubst mime-insert-button (string function &optional data) - "Insert STRING as button with callback FUNCTION and DATA." - (save-restriction - (narrow-to-region (point)(point)) - (insert (concat "[" string "]\n")) - (mime-add-button (point-min)(point-max) function data) - )) - -(defvar mime-button-mother-dispatcher nil) - -(defun mime-button-dispatcher (event) - "Select the button under point." - (interactive "e") - (let (buf point func data) - (save-window-excursion - (mouse-set-point event) - (setq buf (current-buffer) - point (point) - func (get-text-property (point) 'mime-button-callback) - data (get-text-property (point) 'mime-button-data) - )) - (save-excursion - (set-buffer buf) - (goto-char point) - (if func - (apply func data) - (if (fboundp mime-button-mother-dispatcher) - (funcall mime-button-mother-dispatcher event) - ))))) - - -;;; @ for URL -;;; - -(defcustom mime-browse-url-regexp - (concat "\\(http\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):" - "\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?" - "[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*[-a-zA-Z0-9_=#$@~`%&*+|\\/]") - "*Regexp to match URL in text body." - :group 'mime - :type 'regexp) - -(defcustom mime-browse-url-function (function browse-url) - "*Function to browse URL." - :group 'mime - :type 'function) - -(defsubst mime-add-url-buttons () - "Add URL-buttons for text body." - (goto-char (point-min)) - (while (re-search-forward mime-browse-url-regexp nil t) - (let ((beg (match-beginning 0)) - (end (match-end 0))) - (mime-add-button beg end mime-browse-url-function - (list (buffer-substring beg end)))))) - - -;;; @ menu -;;; - -(if window-system - (if (featurep 'xemacs) - (defun select-menu-alist (title menu-alist) - (let (ret) - (popup-menu - (list* title - "---" - (mapcar (function - (lambda (cell) - (vector (car cell) - `(progn - (setq ret ',(cdr cell)) - (throw 'exit nil) - ) - t) - )) - menu-alist) - )) - (recursive-edit) - ret)) - (defun select-menu-alist (title menu-alist) - (x-popup-menu - (list '(1 1) (selected-window)) - (list title (cons title menu-alist)) - )) - ) - (defun select-menu-alist (title menu-alist) - (cdr - (assoc (completing-read (concat title " : ") menu-alist) - menu-alist) - )) - ) - - -;;; @ PGP -;;; - -(defvar pgp-function-alist - '( - ;; for mime-pgp - (verify mc-verify "mc-toplev") - (decrypt mc-decrypt "mc-toplev") - (fetch-key mc-pgp-fetch-key "mc-pgp") - (snarf-keys mc-snarf-keys "mc-toplev") - ;; for mime-edit - (mime-sign mime-mc-pgp-sign-region "mime-mc") - (traditional-sign mc-pgp-sign-region "mc-pgp") - (encrypt mime-mc-pgp-encrypt-region "mime-mc") - (insert-key mc-insert-public-key "mc-toplev") - ) - "Alist of service names vs. corresponding functions and its filenames. -Each element looks like (SERVICE FUNCTION FILE). - -SERVICE is a symbol of PGP processing. It allows `verify', `decrypt', -`fetch-key', `snarf-keys', `mime-sign', `traditional-sign', `encrypt' -or `insert-key'. - -Function is a symbol of function to do specified SERVICE. - -FILE is string of filename which has definition of corresponding -FUNCTION.") - -(defmacro pgp-function (method) - "Return function to do service METHOD." - `(cadr (assq ,method (symbol-value 'pgp-function-alist)))) - -(mapcar (function - (lambda (method) - (autoload (cadr method)(nth 2 method)) - )) - pgp-function-alist) - - -;;; @ Other Utility -;;; - -(defvar mime-condition-type-alist - '((preview . mime-preview-condition) - (action . mime-acting-condition))) - -(defvar mime-condition-mode-alist - '((with-default . ctree-set-calist-with-default) - (t . ctree-set-calist-strictly))) - -(defun mime-add-condition (target-type condition &optional mode file) - "Add CONDITION to database specified by TARGET-TYPE. -TARGET-TYPE must be 'preview or 'action. -If optional argument MODE is 'strict or nil (omitted), CONDITION is -added strictly. -If optional argument MODE is 'with-default, CONDITION is added with -default rule. -If optional argument FILE is specified, it is loaded when CONDITION is -activate." - (let ((sym (cdr (assq target-type mime-condition-type-alist)))) - (if sym - (let ((func (cdr (or (assq mode mime-condition-mode-alist) - (assq t mime-condition-mode-alist))))) - (if (fboundp func) - (progn - (funcall func sym condition) - (if file - (let ((method (cdr (assq 'method condition)))) - (autoload method file) - )) - ) - (error "Function for mode `%s' is not found." mode) - )) - (error "Variable for target-type `%s' is not found." target-type) - ))) - - -;;; @ end -;;; - -(provide 'semi-def) - -;;; semi-def.el ends here diff --git a/semi-setup.el b/semi-setup.el deleted file mode 100644 index e7decc8..0000000 --- a/semi-setup.el +++ /dev/null @@ -1,195 +0,0 @@ -;;; semi-setup.el --- setup file for MIME-View. - -;; Copyright (C) 1994,1995,1996,1997,1998 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> -;; Keywords: mail, news, MIME, multimedia, multilingual, encoded-word - -;; This file is part of SEMI (Setting for Emacs MIME Interfaces). - -;; This program 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. - -;; This program 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. - -;;; Code: - -(require 'semi-def) -(require 'path-util) - -(defun call-after-loaded (module func &optional hook-name) - "If MODULE is provided, then FUNC is called. -Otherwise func is set to MODULE-load-hook. -If optional argument HOOK-NAME is specified, -it is used as hook to set." - (if (featurep module) - (funcall func) - (or hook-name - (setq hook-name (intern (concat (symbol-name module) "-load-hook"))) - ) - (add-hook hook-name func) - )) - - -;; for image/* and X-Face -(defvar mime-setup-enable-inline-image - (and window-system - (or running-xemacs - (and (featurep 'mule)(module-installed-p 'bitmap)) - )) - "*If it is non-nil, semi-setup sets up to use mime-image.") - -(if mime-setup-enable-inline-image - (call-after-loaded 'mime-view - (function - (lambda () - (require 'mime-image) - ))) - ) - - -;; for text/html -(defvar mime-setup-enable-inline-html - (module-installed-p 'w3) - "*If it is non-nil, semi-setup sets up to use mime-w3.") - -(if mime-setup-enable-inline-html - (call-after-loaded - 'mime-view - (function - (lambda () - (autoload 'mime-preview-text/html "mime-w3") - - (ctree-set-calist-strictly - 'mime-preview-condition - '((type . text)(subtype . html) - (body . visible) - (body-presentation-method . mime-preview-text/html))) - - (set-alist 'mime-view-type-subtype-score-alist - '(text . html) 3) - ))) - ) - - -;; for PGP -(defvar mime-setup-enable-pgp - (module-installed-p 'mailcrypt) - "*If it is non-nil, semi-setup sets uf to use mime-pgp.") - -(if mime-setup-enable-pgp - (eval-after-load "mime-view" - '(progn - (mime-add-condition - 'preview '((type . application)(subtype . pgp) - (message-button . visible))) - (mime-add-condition - 'action '((type . application)(subtype . pgp) - (method . mime-view-application/pgp)) - 'strict "mime-pgp") - (mime-add-condition - 'action '((type . text)(subtype . x-pgp) - (method . mime-view-application/pgp))) - - (mime-add-condition - 'action '((type . multipart)(subtype . signed) - (method . mime-verify-multipart/signed)) - 'strict "mime-pgp") - - (mime-add-condition - 'action - '((type . application)(subtype . pgp-signature) - (method . mime-verify-application/pgp-signature)) - 'strict "mime-pgp") - - (mime-add-condition - 'action - '((type . application)(subtype . pgp-encrypted) - (method . mime-decrypt-application/pgp-encrypted)) - 'strict "mime-pgp") - - (mime-add-condition - 'action - '((type . application)(subtype . pgp-keys) - (method . mime-add-application/pgp-keys)) - 'strict "mime-pgp") - )) - ) - - -;;; @ for mime-edit -;;; - -(defun mime-setup-decode-message-header () - (save-excursion - (save-restriction - (goto-char (point-min)) - (narrow-to-region - (point-min) - (if (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") - nil t) - (match-beginning 0) - (point-max) - )) - (eword-decode-header) - (set-buffer-modified-p nil) - ))) - -(add-hook 'mime-edit-mode-hook 'mime-setup-decode-message-header) - - -;;; @@ variables -;;; - -(defvar mime-setup-use-signature t - "If it is not nil, mime-setup sets up to use signature.el.") - -(defvar mime-setup-default-signature-key "\C-c\C-s" - "*Key to insert signature.") - -(defvar mime-setup-signature-key-alist '((mail-mode . "\C-c\C-w")) - "Alist of major-mode vs. key to insert signature.") - - -;;; @@ for signature -;;; - -(defun mime-setup-set-signature-key () - (let ((keymap (current-local-map))) - (if keymap - (let ((key - (or (cdr (assq major-mode mime-setup-signature-key-alist)) - mime-setup-default-signature-key))) - (define-key keymap key (function insert-signature)) - )))) - -(when mime-setup-use-signature - (autoload 'insert-signature "signature" "Insert signature" t) - (add-hook 'mime-edit-mode-hook 'mime-setup-set-signature-key) - ;; (setq message-signature nil) - ) - - -;;; @ for mu-cite -;;; - -(add-hook 'mu-cite/pre-cite-hook 'eword-decode-header) - - -;;; @ end -;;; - -(provide 'semi-setup) - -;;; semi-setup.el ends here diff --git a/signature.el b/signature.el deleted file mode 100644 index f06f53c..0000000 --- a/signature.el +++ /dev/null @@ -1,159 +0,0 @@ -;;; signature.el --- a signature utility for GNU Emacs - -;; Copyright (C) 1994,1995,1996,1997 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> -;; OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp> -;; Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp> -;; Maintainer: Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp> -;; Created: 1994/7/11 -;; Version: $Id: signature.el,v 7.16 1997/09/24 23:17:38 shuhei-k Exp $ -;; Keywords: mail, news, signature - -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). - -;; This program 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. - -;; This program 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 this program; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Code: - -(require 'std11) - - -;;; @ valiables -;;; - -(defvar signature-insert-at-eof nil - "*If non-nil, insert signature at the end of file.") - -(defvar signature-delete-blank-lines-at-eof nil - "*If non-nil, signature-insert-at-eof deletes blank lines at the end -of file.") - -(defvar signature-load-hook nil - "*List of functions called after signature.el is loaded.") - -(defvar signature-separator "-- \n" - "*String to separate contents and signature. -It is inserted when signature is inserted at end of file.") - -(defvar signature-file-name "~/.signature" - "*Name of file containing the user's signature.") - -(defvar signature-file-alist nil - "*Alist of the form: - (((FIELD . PATTERN) . FILENAME) - ...) -PATTERN is a string or list of string. If PATTERN matches the contents of -FIELD, the contents of FILENAME is inserted.") - -(defvar signature-file-prefix nil - "*String containing optional prefix for the signature file names") - -(defvar signature-insert-hook nil - "*List of functions called before inserting a signature.") - -(defvar signature-use-bbdb nil - "*If non-nil, Register sigtype to BBDB.") - -(autoload 'signature/get-sigtype-from-bbdb "mime-bbdb") - -(defun signature/get-sigtype-interactively (&optional default) - (read-file-name "Insert your signature: " - (or default (concat signature-file-name "-")) - (or default signature-file-name) - nil)) - -(defun signature/get-signature-file-name () - (save-excursion - (save-restriction - (narrow-to-region - (goto-char (point-min)) - (if (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") - nil t) - (match-beginning 0) - (point-max) - )) - (catch 'found - (let ((alist signature-file-alist) cell field value) - (while alist - (setq cell (car alist) - field (std11-field-body (car (car cell))) - value (cdr (car cell))) - (cond ((functionp value) - (let ((name (apply value field (cdr cell)))) - (if name - (throw 'found - (concat signature-file-prefix name)) - ))) - ((stringp field) - (cond ((consp value) - (while value - (if (string-match (car value) field) - (throw 'found - (concat - signature-file-prefix (cdr cell))) - (setq value (cdr value)) - ))) - ((stringp value) - (if (string-match value field) - (throw 'found - (concat - signature-file-prefix (cdr cell))) - ))))) - (setq alist (cdr alist)) - )) - signature-file-name)))) - -(defun insert-signature (&optional arg) - "Insert the file named by signature-file-name. -It is inserted at the end of file if signature-insert-at-eof is non-nil, -and otherwise at the current point. A prefix argument enables user to -specify a file named <signature-file-name>-DISTRIBUTION interactively." - (interactive "P") - (let ((signature-file-name - (expand-file-name - (or (and signature-use-bbdb - (signature/get-sigtype-from-bbdb arg)) - (and arg - (signature/get-sigtype-interactively)) - (signature/get-signature-file-name)) - ))) - (or (file-readable-p signature-file-name) - (error "Cannot open signature file: %s" signature-file-name)) - (if signature-insert-at-eof - (progn - (goto-char (point-max)) - (or (bolp) (insert "\n")) - (if signature-delete-blank-lines-at-eof (delete-blank-lines)) - )) - (run-hooks 'signature-insert-hook) - (if (= (point)(point-max)) - (insert signature-separator) - ) - (insert-file-contents signature-file-name) - (force-mode-line-update) - signature-file-name)) - - -;;; @ end -;;; - -(provide 'signature) - -(run-hooks 'signature-load-hook) - -;;; signature.el ends here -- 1.7.10.4