X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=semi-def.el;h=12311ddfc89765d916820401cbb5d6f070ddf92f;hb=2387b24d6cd3b91fe4010096f364d92b08007a67;hp=aad094e7dddc1ff5159ed9a5f173d6df93e9d5d5;hpb=14d53a1f40f05f2af85895e34dae90bfa1e12dc8;p=elisp%2Fsemi.git diff --git a/semi-def.el b/semi-def.el index aad094e..12311dd 100644 --- a/semi-def.el +++ b/semi-def.el @@ -5,7 +5,7 @@ ;; Author: MORIOKA Tomohiko ;; Keywords: definition, MIME, multimedia, mail, news -;; This file is part of SEMI (Spadework for Emacs MIME Interfaces). +;; 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 @@ -24,25 +24,19 @@ ;;; Code: -(require 'emu) +(require 'poe) (eval-when-compile (require 'cl)) +(require 'custom) -(defconst mime-module-version '("SEMI" "Ecch.DN~-Miyazaki" 1 4 4) - "Implementation name, version name and numbers of MIME-kernel package.") +(defconst mime-user-interface-product ["SEMI" (1 12 1) "[JR] Nonoichi"] + "Product name, version number and code name of MIME-kernel package.") (autoload 'mule-caesar-region "mule-caesar" "Caesar rotation of current region." t) -;;; @ variables -;;; - -(defvar mime/use-multi-frame - (and (>= emacs-major-version 19) window-system)) - - ;;; @ constants ;;; @@ -75,21 +69,13 @@ (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-preview-play-current-entity) - ;; ) - ;; string)) - (insert "\n") + (insert (concat "[" string "]\n")) (mime-add-button (point-min)(point-max) function data) )) @@ -105,8 +91,7 @@ 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) @@ -114,8 +99,33 @@ (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 @@ -185,8 +195,7 @@ FUNCTION.") (defmacro pgp-function (method) "Return function to do service METHOD." - `(cadr (assq ,method (symbol-value 'pgp-function-alist))) - ) + `(cadr (assq ,method (symbol-value 'pgp-function-alist)))) (mapcar (function (lambda (method) @@ -195,100 +204,9 @@ FUNCTION.") pgp-function-alist) -;;; @ field -;;; - -(defun tm:set-fields (sym field-list &optional regexp-sym) - (or regexp-sym - (setq regexp-sym - (let ((name (symbol-name sym))) - (intern - (concat (if (string-match "\\(.*\\)-list" name) - (substring name 0 (match-end 1)) - name) - "-regexp") - ))) - ) - (set sym field-list) - (set regexp-sym - (concat "^" (apply (function regexp-or) field-list) ":")) - ) - -(defun tm:add-fields (sym field-list &optional regexp-sym) - (or regexp-sym - (setq regexp-sym - (let ((name (symbol-name sym))) - (intern - (concat (if (string-match "\\(.*\\)-list" name) - (substring name 0 (match-end 1)) - name) - "-regexp") - ))) - ) - (let ((fields (eval sym))) - (mapcar (function - (lambda (field) - (or (member field fields) - (setq fields (cons field fields)) - ) - )) - (reverse field-list) - ) - (set regexp-sym - (concat "^" (apply (function regexp-or) fields) ":")) - (set sym fields) - )) - -(defun tm:delete-fields (sym field-list &optional regexp-sym) - (or regexp-sym - (setq regexp-sym - (let ((name (symbol-name sym))) - (intern - (concat (if (string-match "\\(.*\\)-list" name) - (substring name 0 (match-end 1)) - name) - "-regexp") - ))) - ) - (let ((fields (eval sym))) - (mapcar (function - (lambda (field) - (setq fields (delete field fields)) - )) - field-list) - (set regexp-sym - (concat "^" (apply (function regexp-or) fields) ":")) - (set sym fields) - )) - - -;;; @ RCS version -;;; - -(defsubst get-version-string (id) - "Return a version-string from RCS ID." - (and (string-match ",v \\([0-9][0-9.][0-9.]+\\)" id) - (substring id (match-beginning 1)(match-end 1)) - )) - - ;;; @ Other Utility ;;; -(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) - )) - - (defvar mime-condition-type-alist '((preview . mime-preview-condition) (action . mime-acting-condition)))