X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=mime-def.el;h=e9ef9e3cc26232058c1c0ffa52dcf34e42919f6d;hb=21601a6dd42dc8b645ac88bee0a944c2ea2ba756;hp=9cb13254a2b7f086048e3cf868f0085571a004cc;hpb=f3667967c14d35ecf13551dc64569c4b06cf22a6;p=elisp%2Fsemi.git

diff --git a/mime-def.el b/mime-def.el
index 9cb1325..e9ef9e3 100644
--- a/mime-def.el
+++ b/mime-def.el
@@ -1,12 +1,11 @@
 ;;; mime-def.el --- definition module for SEMI
 
-;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
+;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
 
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version: $Id: mime-def.el,v 0.9 1997-02-25 06:17:50 tmorioka Exp $
 ;; Keywords: definition, MIME, multimedia, mail, news
 
-;; This file is part of SEMI (SEMI is Emacs MIME Interfaces).
+;; This file is part of SEMI (Spadework 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
@@ -26,13 +25,42 @@
 ;;; Code:
 
 (require 'emu)
+(require 'custom)
+
+(defgroup mime nil
+  "Emacs MIME Interfaces"
+  :group 'news
+  :group 'mail)
+
+(custom-handle-keyword 'default-mime-charset :group 'mime
+		       'custom-variable)
+
+(unless (fboundp 'butlast)
+  (defun butlast (x &optional n)
+    "Returns a copy of LIST with the last N elements removed."
+    (if (and n (<= n 0)) x
+      (nbutlast (copy-sequence x) n)))
+  
+  (defun nbutlast (x &optional n)
+    "Modifies LIST to remove the last N elements."
+    (let ((m (length x)))
+      (or n (setq n 1))
+      (and (< n m)
+	   (progn
+	     (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil))
+	     x))))
+  )
+
+(defconst mime-module-version '("SEMI" "Naoetsu" 1 2 2)
+  "Implementation name, version name and numbers of MIME-kernel package.")
+
+(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,67 +70,71 @@
     (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*")
 
 
-;;; @ charset and encoding
+;;; @ definitions about MIME
 ;;;
 
-(defun mime/make-charset-default-encoding-alist (transfer-level)
-  (mapcar (function
-	   (lambda (charset-type)
-	     (let ((charset  (upcase (symbol-name (car charset-type))))
-		   (type     (nth 1 charset-type))
-		   (encoding (nth 2 charset-type))
-		   )
-	       (if (<= type transfer-level)
-		   (cons charset (mime/encoding-name type))
-		 (cons charset encoding)
-		 ))))
-	  mime-charset-type-list))
+(defconst mime-tspecials "][()<>@,\;:\\\"/?=")
+(defconst mime-token-regexp (concat "[^" mime-tspecials "\000-\040]+"))
+(defconst mime-charset-regexp mime-token-regexp)
+
+(defconst mime-media-type/subtype-regexp
+  (concat mime-token-regexp "/" mime-token-regexp))
 
 
 ;;; @ button
 ;;;
 
-(defun tm:set-face-region (b e face)
-  (let ((overlay (tl:make-overlay b e)))
-    (tl:overlay-put overlay 'face face)
+(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)))
+    ;;(add-text-properties from to (list 'keymap widget-keymap))
     ))
 
-(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]")
-
-(defvar tm:warning-face nil
-  "Face used for invalid encoded-word.")
-
-(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
-       (tl: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))
-				  ))
-  )
+(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-preview-play-current-entity)
+    ;;                            )
+    ;;                  string))
+    (insert "\n")
+    (mime-add-button (point-min)(point-max) function data)
+    ))
 
-(defvar tm:mother-button-dispatcher nil)
+(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)
@@ -110,8 +142,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
@@ -119,31 +151,12 @@
       (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)
 	  )
 	))))
 
 
-;;; @ for URL
-;;;
-
-(defvar tm:URL-regexp
-  "\\(http\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*[-a-zA-Z0-9_=#$@~`%&*+|\\/]")
-
-(defvar browse-url-browser-function nil)
-
-(defun tm:browse-url (&optional url)
-  (if (fboundp browse-url-browser-function)
-      (if url 
-        (funcall browse-url-browser-function url)
-      (call-interactively browse-url-browser-function))
-    (if (fboundp tm:mother-button-dispatcher)
-	(call-interactively tm:mother-button-dispatcher)
-      )
-    ))
-
-
 ;;; @ PGP
 ;;;
 
@@ -155,9 +168,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.
@@ -174,87 +187,40 @@ FUNCTION.")
 
 (defmacro pgp-function (method)
   "Return function to do service METHOD."
-  (` (car (cdr (assq (, method) (symbol-value 'pgp-function-alist)))))
+  `(cadr (assq ,method (symbol-value 'pgp-function-alist)))
   )
 
 (mapcar (function
 	 (lambda (method)
-	   (autoload (second method)(third method))
+	   (autoload (cadr method)(nth 2 method))
 	   ))
 	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)
+(require 'atype)
 
-(defconst mime/content-type-subtype-regexp
-  (concat mime/token-regexp "/" mime/token-regexp))
-
-(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
@@ -329,6 +295,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
 ;;;