X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=semi-def.el;h=8e5c4124db094946c0c141cccff420d6be978415;hb=3d8f61a42e7afa440511d0db730ae45d32b2b101;hp=2679a2b693723f10583a7d4e88c68a040d803935;hpb=3b119150d46353251cef6d8ca264571cdea40485;p=elisp%2Fsemi.git diff --git a/semi-def.el b/semi-def.el index 2679a2b..8e5c412 100644 --- a/semi-def.el +++ b/semi-def.el @@ -1,11 +1,11 @@ -;;; semi-def.el --- definition module for SEMI +;;; semi-def.el --- definition module for WEMI ;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. ;; 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 WEMI (Widget based 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,26 +26,16 @@ (require 'emu) -(defconst mime-module-version '("SEMI" "Naoetsu" 1 2 2) +(eval-when-compile (require 'cl)) + + +(defconst mime-module-version '("WEMI" "Kamonomiya" 1 5 0) "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/use-multi-frame - (and (>= emacs-major-version 19) window-system)) - -(defvar mime/find-file-function - (if mime/use-multi-frame - (function find-file-other-frame) - (function find-file) - )) - - ;;; @ constants ;;; @@ -68,32 +58,32 @@ :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)) - )) - (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) + (mapcar #'(lambda (line) + (widget-create + 'push-button + :action `(lambda (widget &optional event) + (,function) + ) + :mouse-down-action `(lambda (widget event) + (let (buf point) + (save-window-excursion + (mouse-set-point event) + (setq buf (current-buffer) + point (point))) + (save-excursion + (set-buffer buf) + (goto-char point) + (,function) + ))) + line) + (insert "\n") + ) + (split-string string "\n")) + ;;(mime-add-button (point-min)(point-max) function data) )) (defvar mime-button-mother-dispatcher nil) @@ -108,8 +98,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) @@ -121,6 +110,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 ;;; @@ -151,8 +177,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) @@ -161,24 +186,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 ;;; @@ -246,16 +253,6 @@ FUNCTION.") )) -;;; @ 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 ;;; @@ -273,6 +270,41 @@ it is used as hook to set." )) +(defvar mime-condition-type-alist + '((preview . mime-preview-condition) + (action . mime-acting-condition))) + +(defvar mime-condition-mode-alist + '((with-default . ctree-set-calist-with-default) + (t . ctree-set-calist-strictly))) + +(defun mime-add-condition (target-type condition &optional mode file) + "Add CONDITION to database specified by TARGET-TYPE. +TARGET-TYPE must be 'preview or 'action. +If optional argument MODE is 'strict or nil (omitted), CONDITION is +added strictly. +If optional argument MODE is 'with-default, CONDITION is added with +default rule. +If optional argument FILE is specified, it is loaded when CONDITION is +activate." + (let ((sym (cdr (assq target-type mime-condition-type-alist)))) + (if sym + (let ((func (cdr (or (assq mode mime-condition-mode-alist) + (assq t mime-condition-mode-alist))))) + (if (fboundp func) + (progn + (funcall func sym condition) + (if file + (let ((method (cdr (assq 'method condition)))) + (autoload method file) + )) + ) + (error "Function for mode `%s' is not found." mode) + )) + (error "Variable for target-type `%s' is not found." target-type) + ))) + + ;;; @ end ;;;