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