From 90fd81d2748c52ded81e92c6b271aaabc32c2da9 Mon Sep 17 00:00:00 2001 From: morioka Date: Sat, 2 May 1998 12:57:13 +0000 Subject: [PATCH] Sync with SEMI 1.3.4 (Kajiyashiki). --- mail-mime-setup.el | 1 + mime-edit.el | 106 ++++++++++++++--------------- mime-pgp.el | 40 ++++++----- mime-play.el | 93 ++++++++++++++++++++------ mime-view.el | 187 ++++++++++++++++++++++++++++++++-------------------- semi-def.el | 60 +++++++++++------ 6 files changed, 304 insertions(+), 183 deletions(-) diff --git a/mail-mime-setup.el b/mail-mime-setup.el index d11ef6d..c95b304 100644 --- a/mail-mime-setup.el +++ b/mail-mime-setup.el @@ -25,6 +25,7 @@ ;;; Code: (require 'semi-setup) +(require 'alist) (autoload 'turn-on-mime-edit "mime-edit" diff --git a/mime-edit.el b/mime-edit.el index c4f69d2..b9f0d3e 100644 --- a/mime-edit.el +++ b/mime-edit.el @@ -523,7 +523,7 @@ If it is not specified for a major-mode, :type 'list) (defconst mime-edit-split-ignored-field-regexp - "\\(^Content-\\|^Subject:\\|^Mime-Version:\\)") + "\\(^Content-\\|^Subject:\\|^Mime-Version:\\|Message-Id:\\)") (defvar mime-edit-split-blind-field-regexp "\\(^[BDFbdf]cc:\\|^cc:[ \t]*$\\)") @@ -634,65 +634,59 @@ Tspecials means any character that matches with it in header must be quoted.") (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-signed-region) +(define-key mime-edit-mode-enclosure-map + "\C-e" 'mime-edit-enclose-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 - "\C-c\C-x\C-t" 'mime-edit-insert-text) -(define-key mime-edit-mode-map - "\C-c\C-x\C-i" 'mime-edit-insert-file) -(define-key mime-edit-mode-map - "\C-c\C-x\C-e" 'mime-edit-insert-external) -(define-key mime-edit-mode-map - "\C-c\C-x\C-v" 'mime-edit-insert-voice) -(define-key mime-edit-mode-map - "\C-c\C-x\C-y" 'mime-edit-insert-message) -(define-key mime-edit-mode-map - "\C-c\C-x\C-m" 'mime-edit-insert-mail) -(define-key mime-edit-mode-map - "\C-c\C-x\C-w" 'mime-edit-insert-signature) -(define-key mime-edit-mode-map - "\C-c\C-x\C-s" 'mime-edit-insert-signature) -(define-key mime-edit-mode-map - "\C-c\C-x\C-k" 'mime-edit-insert-key) -(define-key mime-edit-mode-map - "\C-c\C-xt" 'mime-edit-insert-tag) - -(define-key mime-edit-mode-map - "\C-c\C-m\C-a" 'mime-edit-enclose-alternative-region) -(define-key mime-edit-mode-map - "\C-c\C-m\C-p" 'mime-edit-enclose-parallel-region) -(define-key mime-edit-mode-map - "\C-c\C-m\C-m" 'mime-edit-enclose-mixed-region) -(define-key mime-edit-mode-map - "\C-c\C-m\C-d" 'mime-edit-enclose-digest-region) -(define-key mime-edit-mode-map - "\C-c\C-m\C-s" 'mime-edit-enclose-signed-region) -(define-key mime-edit-mode-map - "\C-c\C-m\C-e" 'mime-edit-enclose-encrypted-region) -(define-key mime-edit-mode-map - "\C-c\C-m\C-q" 'mime-edit-enclose-quote-region) - -(define-key mime-edit-mode-map - "\C-c\C-x7" 'mime-edit-set-transfer-level-7bit) -(define-key mime-edit-mode-map - "\C-c\C-x8" 'mime-edit-set-transfer-level-8bit) -(define-key mime-edit-mode-map - "\C-c\C-x/" 'mime-edit-set-split) -(define-key mime-edit-mode-map - "\C-c\C-xs" 'mime-edit-set-sign) -(define-key mime-edit-mode-map - "\C-c\C-xv" 'mime-edit-set-sign) -(define-key mime-edit-mode-map - "\C-c\C-xe" 'mime-edit-set-encrypt) -(define-key mime-edit-mode-map - "\C-c\C-xh" 'mime-edit-set-encrypt) -(define-key mime-edit-mode-map - "\C-c\C-x\C-p" 'mime-edit-preview-message) (define-key mime-edit-mode-map - "\C-c\C-x\C-z" 'mime-edit-exit) + mime-edit-mode-entity-prefix mime-edit-mode-entity-map) (define-key mime-edit-mode-map - "\C-c\C-x?" 'mime-edit-help) + mime-edit-mode-enclosure-prefix mime-edit-mode-enclosure-map) (defconst mime-edit-menu-title "MIME-Edit") diff --git a/mime-pgp.el b/mime-pgp.el index 6e3611d..498cbf7 100644 --- a/mime-pgp.el +++ b/mime-pgp.el @@ -108,13 +108,13 @@ 'mime-preview-condition '((type . application)(subtype . pgp) (message-button . visible))) -(set-atype 'mime-acting-condition - '((type . application)(subtype . pgp) - (method . mime-method-for-application/pgp))) +(ctree-set-calist-strictly + 'mime-acting-condition '((type . application)(subtype . pgp) + (method . mime-method-for-application/pgp))) -(set-atype 'mime-acting-condition - '((type . text)(subtype . x-pgp) - (method . mime-method-for-application/pgp))) +(ctree-set-calist-strictly + 'mime-acting-condition '((type . text)(subtype . x-pgp) + (method . mime-method-for-application/pgp))) ;;; @ Internal method for multipart/signed @@ -131,9 +131,10 @@ (cdr (assq 'mode cal)) ; play-mode )) -(set-atype 'mime-acting-condition - '((type . multipart)(subtype . signed) - (method . mime-method-to-verify-multipart/signed))) +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . multipart)(subtype . signed) + (method . mime-method-to-verify-multipart/signed))) ;;; @ Internal method for application/pgp-signature @@ -234,9 +235,10 @@ It should be ISO 639 2 letter language code such as en, ja, ...") (delete-file sig-file) )) -(set-atype 'mime-acting-condition - '((type . application)(subtype . pgp-signature) - (method . mime-method-to-verify-application/pgp-signature))) +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . application)(subtype . pgp-signature) + (method . mime-method-to-verify-application/pgp-signature))) ;;; @ Internal method for application/pgp-encrypted @@ -258,9 +260,10 @@ It should be ISO 639 2 letter language code such as en, ja, ...") (mime-method-for-application/pgp obeg oend cal) )) -(set-atype 'mime-acting-condition - '((type . application)(subtype . pgp-encrypted) - (method . mime-method-to-decrypt-application/pgp-encrypted))) +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . application)(subtype . pgp-encrypted) + (method . mime-method-to-decrypt-application/pgp-encrypted))) ;;; @ Internal method for application/pgp-keys @@ -286,9 +289,10 @@ It should be ISO 639 2 letter language code such as en, ja, ...") (kill-buffer (current-buffer)) )) -(set-atype 'mime-acting-condition - '((type . application)(subtype . pgp-keys) - (method . mime-method-to-add-application/pgp-keys))) +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . application)(subtype . pgp-keys) + (method . mime-method-to-add-application/pgp-keys))) ;;; @ end diff --git a/mime-play.el b/mime-play.el index 41f7fca..f5d1499 100644 --- a/mime-play.el +++ b/mime-play.el @@ -32,6 +32,32 @@ (eval-when-compile (require 'mime-text)) + +(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 ;;; @@ -89,7 +115,31 @@ specified, play as it. Default MODE is \"play\"." (if mode (setq cal (cons (cons 'mode mode) cal)) ) - (setq ret (mime/get-content-decoding-alist cal)) + (setq ret + (or (ctree-match-calist mime-acting-situation-examples cal) + (ctree-match-calist-partially mime-acting-situation-examples cal) + cal)) + (setq ret + (or (ctree-find-calist mime-acting-condition ret + mime-view-find-every-acting-situation) + (ctree-find-calist mime-acting-condition cal + mime-view-find-every-acting-situation) + )) + (cond ((cdr ret) + (setq ret (select-menu-alist + "Methods" + (mapcar (function + (lambda (situation) + (cons + (format "%s" + (cdr (assq 'method situation))) + 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)) @@ -107,14 +157,6 @@ specified, play as it. Default MODE is \"play\"." )) -;;; @ method selector -;;; - -(defun mime/get-content-decoding-alist (al) - (get-unified-alist mime-acting-condition al) - ) - - ;;; @ external decoder ;;; @@ -270,16 +312,18 @@ window.") (filename (if (and name (not (string-equal name ""))) (expand-file-name name - (call-interactively - (function - (lambda (dir) - (interactive "DDirectory: ") - dir)))) - (call-interactively - (function - (lambda (file) - (interactive "FFilename: ") - (expand-file-name file)))))) + (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)) @@ -534,4 +578,15 @@ to write." (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-current-buffer)) + (kill-buffer buffer)))) + ;;; mime-play.el ends here diff --git a/mime-view.el b/mime-view.el index 0647978..5a55593 100644 --- a/mime-view.el +++ b/mime-view.el @@ -44,6 +44,24 @@ " (" (cadr mime-module-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) + + ;;; @ buffer local variables ;;; @@ -488,65 +506,102 @@ Please press `v' key in this buffer. " ;;; @ acting-condition ;;; -(defvar mime-acting-condition - '(((type . text)(subtype . plain) - (method "tm-plain" nil 'file "" 'encoding 'mode 'name) - (mode "play" "print") - ) - ((type . text)(subtype . html) - (method "tm-html" nil 'file "" 'encoding 'mode 'name) - (mode . "play") - ) - ((type . text)(subtype . x-rot13-47) - (method . mime-method-to-display-caesar) - (mode . "play") - ) - ((type . text)(subtype . x-rot13-47-48) - (method . mime-method-to-display-caesar) - (mode . "play") - ) - - ((type . audio)(subtype . basic) - (method "tm-au" nil 'file "" 'encoding 'mode 'name) - (mode . "play") - ) - - ((type . image) - (method "tm-image" nil 'file "" 'encoding 'mode 'name) - (mode "play" "print") - ) - - ((type . video)(subtype . mpeg) - (method "tm-mpeg" nil 'file "" 'encoding 'mode 'name) - (mode . "play") - ) - - ((type . application)(subtype . postscript) - (method "tm-ps" nil 'file "" 'encoding 'mode 'name) - (mode "play" "print") - ) - ((type . application)(subtype . octet-stream) - (method . mime-method-to-save)(mode "play" "print") - ) - - ((type . message)(subtype . external-body) - ("access-type" . "anon-ftp") - (method . mime-method-to-display-message/external-ftp) - ) - ((type . message)(subtype . rfc822) - (method . mime-method-to-display-message/rfc822) - (mode . "play") - ) - ((type . message)(subtype . partial) - (method . mime-method-to-store-message/partial) - (mode . "play") - ) - - ((method "metamail" t "-m" "tm" "-x" "-d" "-z" "-e" 'file) - (mode . "play") - ) - ((method . mime-method-to-save)(mode . "extract")) - )) +(defvar mime-acting-condition nil + "Condition-tree about how to process entity.") + +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . t)(subtype . t)(mode . "play") + (method "metamail" t "-m" "tm" "-x" "-d" "-z" "-e" 'file) + )) +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . t)(subtype . t)(mode . "extract") + (method . mime-method-to-save))) + +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . text)(subtype . plain)(mode . "play") + (method "tm-plain" nil 'file "" 'encoding 'mode 'name) + )) +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . text)(subtype . plain)(mode . "print") + (method "tm-plain" nil 'file "" 'encoding 'mode 'name) + )) +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . text)(subtype . html)(mode . "play") + (method "tm-html" nil 'file "" 'encoding 'mode 'name) + )) +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . text)(subtype . x-rot13-47)(mode . "play") + (method . mime-method-to-display-caesar) + )) +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . text)(subtype . x-rot13-47-48)(mode . "play") + (method . mime-method-to-display-caesar) + )) + +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . audio)(subtype . basic)(mode . "play") + (method "tm-au" nil 'file "" 'encoding 'mode 'name) + )) + +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . image)(mode . "play") + (method "tm-image" nil 'file "" 'encoding 'mode 'name) + )) +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . image)(mode . "print") + (method "tm-image" nil 'file "" 'encoding 'mode 'name) + )) + +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . video)(subtype . mpeg)(mode . "play") + (method "tm-mpeg" nil 'file "" 'encoding 'mode 'name) + )) + +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . application)(subtype . postscript)(mode . "play") + (method "tm-ps" nil 'file "" 'encoding 'mode 'name) + )) +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . application)(subtype . postscript)(mode . "print") + (method "tm-ps" nil 'file "" 'encoding 'mode 'name) + )) + +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . message)(subtype . rfc822)(mode . "play") + (method . mime-method-to-display-message/rfc822) + )) +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . message)(subtype . partial)(mode . "play") + (method . mime-method-to-store-message/partial) + )) + +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . message)(subtype . external-body) + ("access-type" . "anon-ftp") + (method . mime-method-to-display-message/external-ftp) + )) + +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . application)(subtype . octet-stream) + (method . mime-method-to-save) + )) ;;; @ quitting method @@ -1076,8 +1131,7 @@ of the mother-buffer." It calls following-method selected from variable `mime-view-following-method-alist'." (interactive) - (let ((message-info (get-text-property (point-min) 'mime-view-entity)) - entity) + (let (entity) (while (null (setq entity (get-text-property (point) 'mime-view-entity))) (backward-char) @@ -1140,16 +1194,7 @@ It calls following-method selected from variable (erase-buffer) (insert-buffer-substring the-buf p-beg p-end) (goto-char (point-min)) - ;; (if (mime-view-header-visible-p entity message-info) - ;; (delete-region (goto-char (point-min)) - ;; (if (re-search-forward "^$" nil t) - ;; (match-end 0) - ;; (point-min))) - ;; ) - ;;(goto-char (point-min)) - ;;(insert "\n") - (goto-char (point-min)) - (let ((entity-node-id (mime-entity-node-id entity)) ci str) + (let ((entity-node-id (mime-entity-node-id entity)) ci str) (while (progn (setq str diff --git a/semi-def.el b/semi-def.el index 951da60..9f0a8c4 100644 --- a/semi-def.el +++ b/semi-def.el @@ -26,7 +26,10 @@ (require 'emu) -(defconst mime-module-version '("WEMI" "Yokohama" 1 2 4) +(eval-when-compile (require 'cl)) + + +(defconst mime-module-version '("WEMI" "Totsuka" 1 3 0) "Implementation name, version name and numbers of MIME-kernel package.") (autoload 'mule-caesar-region "mule-caesar" @@ -117,6 +120,43 @@ )))) +;;; @ 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 ;;; @@ -157,24 +197,6 @@ FUNCTION.") pgp-function-alist) -;;; @ method selector kernel -;;; - -(require 'atype) - -;;; @@ field unifier -;;; - -(defun field-unifier-for-mode (a b) - (let ((va (cdr a))) - (if (if (consp va) - (member (cdr b) va) - (equal va (cdr b)) - ) - (list nil b nil) - ))) - - ;;; @ field ;;; -- 1.7.10.4