X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime%2Fsemi-def.el;fp=mime%2Fsemi-def.el;h=483fd1be333eb41d191fded4178dc2268323e03d;hb=b0a4de308365b414daaa778f22c0676fab5415ec;hp=0000000000000000000000000000000000000000;hpb=b53f8e9f39a63b564ff6385a0ee8a8c182846295;p=elisp%2Flemi.git diff --git a/mime/semi-def.el b/mime/semi-def.el new file mode 100644 index 0000000..483fd1b --- /dev/null +++ b/mime/semi-def.el @@ -0,0 +1,210 @@ +;;; semi-def.el --- definition module for SEMI -*- coding: iso-8859-4; -*- + +;; Copyright (C) 1995,96,97,98,99,2000 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Keywords: definition, MIME, multimedia, mail, news + +;; 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 +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(require 'poe) + +(eval-when-compile (require 'cl)) + +(require 'custom) + +(defconst mime-user-interface-product ["REMI" (1 14 3) "Matsudai"] + "Product name, version number and code name of MIME-kernel package.") + +(autoload 'mule-caesar-region "mule-caesar" + "Caesar rotation of current region." t) + + +;;; @ constants +;;; + +(defconst mime-echo-buffer-name "*MIME-echo*" + "Name of buffer to display MIME-playing information.") + +(defconst mime-temp-buffer-name " *MIME-temp*") + + +;;; @ button +;;; + +(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." + (and mime-button-face + (put-text-property from to 'face mime-button-face)) + (and mime-button-mouse-face + (put-text-property from to 'mouse-face mime-button-mouse-face)) + (put-text-property from to 'mime-button-callback function) + (and data + (put-text-property from to 'mime-button-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 "]\n")) + (mime-add-button (point-min)(point-max) function data) + )) + +(defvar mime-button-mother-dispatcher nil) + +(defun mime-button-dispatcher (event) + "Select the button under point." + (interactive "e") + (let (buf point func data) + (save-window-excursion + (mouse-set-point event) + (setq buf (current-buffer) + 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) + (if func + (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 +;;; + +(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) + )) + ) + + +;;; @ Other Utility +;;; + +(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 +;;; + +(provide 'semi-def) + +;;; semi-def.el ends here