1;;; semi-def.el --- definition module for SEMI -*- lexical-binding: t -*- 2 3;; Copyright (C) 1995,96,97,98,99,2000,01,03,05 Free Software Foundation, Inc. 4 5;; Author: MORIOKA Tomohiko <tomo@m17n.org> 6;; Keywords: definition, MIME, multimedia, mail, news 7 8;; This file is part of SEMI (Sample of Emacs MIME Implementation). 9 10;; This program is free software; you can redistribute it and/or 11;; modify it under the terms of the GNU General Public License as 12;; published by the Free Software Foundation; either version 2, or (at 13;; your option) any later version. 14 15;; This program is distributed in the hope that it will be useful, but 16;; WITHOUT ANY WARRANTY; without even the implied warranty of 17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 18;; General Public License for more details. 19 20;; You should have received a copy of the GNU General Public License 21;; along with GNU Emacs; see the file COPYING. If not, write to the 22;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 23;; Boston, MA 02110-1301, USA. 24 25;;; Code: 26 27(defconst mime-user-interface-product ["SEMI-EPG" (1 14 7) "Harue"] 28 "Product name, version number and code name of MIME-kernel package.") 29 30(autoload 'mule-caesar-region "mule-caesar" 31 "Caesar rotation of current region." t) 32 33 34;;; @ constants 35;;; 36 37(defconst mime-echo-buffer-name "*MIME-echo*" 38 "Name of buffer to display MIME-playing information.") 39 40(defconst mime-temp-buffer-name " *MIME-temp*") 41 42 43;;; @ button 44;;; 45 46(defcustom mime-button-face 'bold 47 "Face used for content-button or URL-button of MIME-Preview buffer." 48 :group 'mime 49 :type 'face) 50 51(defcustom mime-button-mouse-face 'highlight 52 "Face used for MIME-preview buffer mouse highlighting." 53 :group 'mime 54 :type 'face) 55 56(defsubst mime-add-button (from to function &optional data) 57 "Create a button between FROM and TO with callback FUNCTION and DATA." 58 (and mime-button-face 59 (put-text-property from to 'face mime-button-face)) 60 (and mime-button-mouse-face 61 (put-text-property from to 'mouse-face mime-button-mouse-face)) 62 (put-text-property from to 'mime-button-callback function) 63 (and data 64 (put-text-property from to 'mime-button-data data))) 65 66(defsubst mime-insert-button (string function &optional data) 67 "Insert STRING as button with callback FUNCTION and DATA." 68 (save-restriction 69 (narrow-to-region (point)(point)) 70 (insert "[" string "]\n") 71 (mime-add-button (point-min)(point-max) function data))) 72 73(defvar mime-button-mother-dispatcher nil) 74 75(defun mime-button-dispatcher (event) 76 "Select the button under point." 77 (interactive "e") 78 (let (buf point func data) 79 (save-window-excursion 80 (mouse-set-point event) 81 (setq buf (current-buffer) 82 point (point) 83 func (get-text-property (point) 'mime-button-callback) 84 data (get-text-property (point) 'mime-button-data))) 85 ;; Do not use `with-current-buffer'. 86 ;; buf may be the current buffer. 87 (save-excursion 88 (set-buffer buf) 89 (goto-char point) 90 (if func 91 (apply func data) 92 (if (fboundp mime-button-mother-dispatcher) 93 (funcall mime-button-mother-dispatcher event)))))) 94 95 96;;; @ for URL 97;;; 98 99(defcustom mime-browse-url-regexp 100 (concat "\\(https?\\|ftps?\\|file\\|gopher\\|news\\|nntps?\\|telnets?\\|wais\\|mailto\\):" 101 "\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?" 102 "[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*[-a-zA-Z0-9_=#$@~`%&*+|\\/]") 103 "*Regexp to match URL in text body." 104 :group 'mime 105 :type 'regexp) 106 107(defcustom mime-browse-url-function (function browse-url) 108 "*Function to browse URL." 109 :group 'mime 110 :type 'function) 111 112(defsubst mime-add-url-buttons () 113 "Add URL-buttons for text body." 114 (goto-char (point-min)) 115 (while (re-search-forward mime-browse-url-regexp nil t) 116 (let ((beg (match-beginning 0)) 117 (end (match-end 0))) 118 (mime-add-button beg end mime-browse-url-function 119 (list (buffer-substring beg end)))))) 120 121 122;;; @ menu 123;;; 124 125(defun mime-should-use-popup-menu () 126 (and window-system 127 (memq (event-basic-type last-command-event) 128 '(mouse-1 mouse-2 mouse-3)))) 129(defun mime-select-menu-alist (title menu-alist) 130 (if (mime-should-use-popup-menu) 131 (x-popup-menu 132 (list '(1 1) (selected-window)) 133 (list title (cons title menu-alist))) 134 (cdr 135 (assoc (completing-read (concat title " : ") menu-alist) 136 menu-alist)))) 137 138;;; @ Other Utility 139;;; 140 141(defvar mime-condition-type-alist 142 '((preview . mime-preview-condition) 143 (action . mime-acting-condition))) 144 145(defvar mime-condition-mode-alist 146 '((with-default . ctree-set-calist-with-default) 147 (t . ctree-set-calist-strictly))) 148 149(defun mime-add-condition (target-type condition &optional mode file) 150 "Add CONDITION to database specified by TARGET-TYPE. 151TARGET-TYPE must be 'preview or 'action. 152If optional argument MODE is 'strict or nil (omitted), CONDITION is 153added strictly. 154If optional argument MODE is 'with-default, CONDITION is added with 155default rule. 156If optional argument FILE is specified, it is loaded when CONDITION is 157activate." 158 (let ((sym (cdr (assq target-type mime-condition-type-alist)))) 159 (if sym 160 (let ((func (cdr (or (assq mode mime-condition-mode-alist) 161 (assq t mime-condition-mode-alist))))) 162 (if (fboundp func) 163 (progn 164 (funcall func sym condition) 165 (if file 166 (mapc (lambda (parameter) 167 (when (setq func (cdr (assq parameter condition))) 168 (autoload func file))) 169 '(method body-presentation-method)))) 170 (error "Function for mode `%s' is not found." mode))) 171 (error "Variable for target-type `%s' is not found." target-type)))) 172 173 174;;; @ end 175;;; 176 177(provide 'semi-def) 178 179;;; semi-def.el ends here 180