X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-def.el;h=9a6feb7d5143ae7c7fc236c3978999844edfe4b9;hb=99ab8f6d85fead2c6a0c333e4f8b11ad5b814ecc;hp=8e3ef6962a44a1e6b7ca51d6350d883309ecf948;hpb=de68cedb7a8ed206310d7b8b4873ea438e819561;p=elisp%2Fsemi.git

diff --git a/mime-def.el b/mime-def.el
index 8e3ef69..9a6feb7 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.14 1997-02-26 02:42:16 tmorioka Exp $
+;; Version: $Id: mime-def.el,v 0.57 1997-07-03 11:57:44 morioka Exp $
 ;; Keywords: definition, MIME, multimedia, mail, news
 
 ;; This file is part of SEMI (SEMI is Emacs MIME Interfaces).
@@ -25,14 +25,18 @@
 
 ;;; Code:
 
+(require 'cl)
 (require 'emu)
 
+(defconst semi-version-name "Kaga-Ichinomiya")
+
+(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))
 
@@ -42,42 +46,69 @@
     (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-media-type/subtype-regexp
+  (concat mime-token-regexp "/" mime-token-regexp))
+
+(defconst mime/disposition-type-regexp mime-token-regexp)
 
 
 ;;; @ button
 ;;;
 
-(defvar tm:button-face 'bold
-  "Face used for content-button or URL-button of MIME-Preview buffer.
-\[mime-def.el]")
-
-(defvar tm:mouse-face 'highlight
-  "Face used for MIME-preview buffer mouse highlighting. [mime-def.el]")
-
-(defun tm:add-button (from to func &optional data)
-  "Create a button between FROM and TO with callback FUNC and data DATA."
-  (and tm:button-face
-       (overlay-put (tl:make-overlay from to) 'face tm:button-face))
-  (tl:add-text-properties from to
-			  (append (and tm:mouse-face
-				       (list 'mouse-face tm:mouse-face))
-				  (list 'mime-callback func)
-				  (and data (list 'mime-data data))
-				  ))
-  )
+(defvar mime-button-face 'bold
+  "Face used for content-button or URL-button of MIME-Preview buffer.")
+
+(defvar mime-button-mouse-face 'highlight
+  "Face used for MIME-preview buffer mouse highlighting.")
+
+(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))
+    ))
 
-(defvar tm:mother-button-dispatcher nil)
+(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)
 
-(defun tm:button-dispatcher (event)
+(defun mime-button-dispatcher (event)
   "Select the button under point."
   (interactive "e")
   (let (buf point func data)
@@ -85,8 +116,8 @@
       (mouse-set-point event)
       (setq buf (current-buffer)
 	    point (point)
-	    func (get-text-property (point) 'mime-callback)
-	    data (get-text-property (point) 'mime-data)
+	    func (get-text-property (point) 'mime-button-callback)
+	    data (get-text-property (point) 'mime-button-data)
 	    )
       )
     (save-excursion
@@ -94,8 +125,8 @@
       (goto-char point)
       (if func
 	  (apply func data)
-	(if (fboundp tm:mother-button-dispatcher)
-	    (funcall tm:mother-button-dispatcher event)
+	(if (fboundp mime-button-mother-dispatcher)
+	    (funcall mime-button-mother-dispatcher event)
 	  )
 	))))
 
@@ -111,9 +142,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.
@@ -140,77 +171,30 @@ 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))
+(require 'atype)
 
-(defconst mime/disposition-type-regexp mime/token-regexp)
-
-
-;;; @ 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
 ;;;
 
+(defsubst regexp-or (&rest args)
+  (concat "\\(" (mapconcat (function identity) args "\\|") "\\)"))
+
 (defun tm:set-fields (sym field-list &optional regexp-sym)
   (or regexp-sym
       (setq regexp-sym
@@ -285,6 +269,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
 ;;;