X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-def.el;h=0ec8938cba7ad9bdde4a5dd2032429b617a3633d;hb=b1b7af83289c67097404b9e5360cbb8f4d608118;hp=a6f8abcfe006758e43e4a0a281ccaf520219efce;hpb=676474325aee1b7ebcb94b77982b8afabbb879f4;p=elisp%2Fsemi.git

diff --git a/mime-def.el b/mime-def.el
index a6f8abc..0ec8938 100644
--- a/mime-def.el
+++ b/mime-def.el
@@ -3,7 +3,7 @@
 ;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
 
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version: $Id: mime-def.el,v 0.24 1997-02-26 06:32:03 tmorioka Exp $
+;; Version: $Id: mime-def.el,v 0.53 1997-07-02 16:28:48 morioka Exp $
 ;; Keywords: definition, MIME, multimedia, mail, news
 
 ;; This file is part of SEMI (SEMI is Emacs MIME Interfaces).
@@ -25,21 +25,16 @@
 
 ;;; Code:
 
-;;; @ for XEmacs
-;;;
-
-(defvar running-xemacs (string-match "XEmacs" emacs-version))
+(require 'cl)
+(require 'emu)
 
-(if running-xemacs
-    (require 'overlay)
-  )
+(autoload 'mule-caesar-region "mule-caesar"
+  "Caesar rotation of current region." t)
 
 
 ;;; @ variables
 ;;;
 
-(defvar mime/tmp-dir (or (getenv "TM_TMP_DIR") "/tmp/"))
-
 (defvar mime/use-multi-frame
   (and (>= emacs-major-version 19) window-system))
 
@@ -49,15 +44,27 @@
     (function find-file)
     ))
 
-(defvar mime/output-buffer-window-is-shared-with-bbdb t
-  "*If t, mime/output-buffer window is shared with BBDB window.")
-
 
 ;;; @ constants
 ;;;
 
-(defconst mime/output-buffer-name "*MIME-out*")
-(defconst mime/temp-buffer-name " *MIME-temp*")
+(defconst mime-echo-buffer-name "*MIME-echo*"
+  "Name of buffer to display MIME-playing information.")
+
+(defconst mime-temp-buffer-name " *MIME-temp*")
+
+
+;;; @ definitions about MIME
+;;;
+
+(defconst mime/tspecials "][\000-\040()<>@,\;:\\\"/?.=")
+(defconst mime/token-regexp (concat "[^" mime/tspecials "]+"))
+(defconst mime-charset-regexp mime/token-regexp)
+
+(defconst mime/content-type-subtype-regexp
+  (concat mime/token-regexp "/" mime/token-regexp))
+
+(defconst mime/disposition-type-regexp mime/token-regexp)
 
 
 ;;; @ button
@@ -69,18 +76,33 @@
 (defvar mime-button-mouse-face 'highlight
   "Face used for MIME-preview buffer mouse highlighting.")
 
-(defun tm:add-button (from to func &optional data)
-  "Create a button between FROM and TO with callback FUNC and data DATA."
-  (and mime-button-face
-       (overlay-put (make-overlay from to) 'face mime-button-face))
-  (tl:add-text-properties from to
-			  (nconc
-			   (and mime-button-mouse-face
-				(list 'mouse-face mime-button-mouse-face))
-			   (list 'mime-button-callback func)
-			   (and data (list 'mime-button-data data))
-			   ))
-  )
+(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)))
+    ;;(add-text-properties from to (list 'keymap widget-keymap))
+    ))
+
+(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 "]"))
+    ;; (widget-push-button-value-create
+    ;;  (widget-convert 'push-button
+    ;;                  :notify (lambda (&rest ignore)
+    ;;                            (mime-view-play-current-entity)
+    ;;                            )
+    ;;                  string))
+    (insert "\n")
+    (mime-add-button (point-min)(point-max) function data)
+    ))
 
 (defvar mime-button-mother-dispatcher nil)
 
@@ -118,9 +140,9 @@
     (fetch-key		mc-pgp-fetch-key		"mc-pgp")
     (snarf-keys		mc-snarf-keys			"mc-toplev")
     ;; for mime-edit
-    (mime-sign		tm:mc-pgp-sign-region		"mime-edit-mc")
+    (mime-sign		mime-mc-pgp-sign-region		"mime-mc")
     (traditional-sign	mc-pgp-sign-region		"mc-pgp")
-    (encrypt		tm:mc-pgp-encrypt-region	"mime-edit-mc")
+    (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.
@@ -147,72 +169,22 @@ FUNCTION.")
 	pgp-function-alist)
 
 
-;;; @ definitions about MIME
+;;; @ method selector kernel
 ;;;
 
-(defconst mime/tspecials "][\000-\040()<>@,\;:\\\"/?.=")
-(defconst mime/token-regexp (concat "[^" mime/tspecials "]+"))
-(defconst mime-charset-regexp mime/token-regexp)
-
-(defconst mime/content-type-subtype-regexp
-  (concat mime/token-regexp "/" mime/token-regexp))
-
-(defconst mime/disposition-type-regexp mime/token-regexp)
-
+(require 'atype)
 
-;;; @ rot13-47
+;;; @@ field unifier
 ;;;
-;; caesar-region written by phr@prep.ai.mit.edu  Nov 86
-;; modified by tower@prep Nov 86
-;; gnus-caesar-region
-;; Modified by umerin@flab.flab.Fujitsu.JUNET for ROT47.
-(defun tm:caesar-region (&optional n)
-  "Caesar rotation of region by N, default 13, for decrypting netnews.
-ROT47 will be performed for Japanese text in any case."
-  (interactive (if current-prefix-arg	; Was there a prefix arg?
-		   (list (prefix-numeric-value current-prefix-arg))
-		 (list nil)))
-  (cond ((not (numberp n)) (setq n 13))
-	(t (setq n (mod n 26))))	;canonicalize N
-  (if (not (zerop n))		; no action needed for a rot of 0
-      (progn
-	(if (or (not (boundp 'caesar-translate-table))
-		(/= (aref caesar-translate-table ?a) (+ ?a n)))
-	    (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper)
-	      (message "Building caesar-translate-table...")
-	      (setq caesar-translate-table (make-vector 256 0))
-	      (while (< i 256)
-		(aset caesar-translate-table i i)
-		(setq i (1+ i)))
-	      (setq lower (concat lower lower) upper (upcase lower) i 0)
-	      (while (< i 26)
-		(aset caesar-translate-table (+ ?a i) (aref lower (+ i n)))
-		(aset caesar-translate-table (+ ?A i) (aref upper (+ i n)))
-		(setq i (1+ i)))
-	      ;; ROT47 for Japanese text.
-	      ;; Thanks to ichikawa@flab.fujitsu.junet.
-	      (setq i 161)
-	      (let ((t1 (logior ?O 128))
-		    (t2 (logior ?! 128))
-		    (t3 (logior ?~ 128)))
-		(while (< i 256)
-		  (aset caesar-translate-table i
-			(let ((v (aref caesar-translate-table i)))
-			  (if (<= v t1) (if (< v t2) v (+ v 47))
-			    (if (<= v t3) (- v 47) v))))
-		  (setq i (1+ i))))
-	      (message "Building caesar-translate-table...done")))
-	(let ((from (region-beginning))
-	      (to (region-end))
-	      (i 0) str len)
-	  (setq str (buffer-substring from to))
-	  (setq len (length str))
-	  (while (< i len)
-	    (aset str i (aref caesar-translate-table (aref str i)))
-	    (setq i (1+ i)))
-	  (goto-char from)
-	  (delete-region from to)
-	  (insert str)))))
+
+(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
@@ -295,6 +267,29 @@ ROT47 will be performed for Japanese text in any case."
        ))
 
 
+;;; @ Other Utility
+;;;
+
+(defsubst eliminate-top-spaces (string)
+  "Eliminate top sequence of space or tab in STRING."
+  (if (string-match "^[ \t]+" string)
+      (substring string (match-end 0))
+    string))
+
+(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)
+    ))
+
+
 ;;; @ end
 ;;;