1 ;;; smiley.el --- displaying smiley faces
3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006 Free Software Foundation, Inc.
6 ;; Author: Dave Love <fx@gnu.org>
7 ;; Keywords: news mail multimedia
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02110-1301, USA.
28 ;; A re-written, simplified version of Wes Hardaker's XEmacs smiley.el
29 ;; which might be merged back to smiley.el if we get an assignment for
30 ;; that. We don't have assignments for the images smiley.el uses, but
31 ;; I'm not sure we need that degree of rococoness and defaults like a
32 ;; yellow background. Also, using PBM means we can display the images
33 ;; more generally. -- fx
34 ;; `smiley.el' was replaced by `smiley-ems.el' on 2002-01-26 (after fx'
53 (eval-when-compile (require 'cl))
58 "Turn :-)'s into real images."
61 (defcustom smiley-data-directory (smiley-directory)
62 "*Location of the smiley faces files."
63 :set (lambda (symbol value)
64 (set-default symbol value)
65 (smiley-update-cache))
66 :initialize 'custom-initialize-default
70 ;; Maybe this should go.
71 (defcustom smiley-style 'low-color
73 :type '(choice (const :tag "small, 3 colors" low-color)
74 (const :tag "medium, ~10 colors" medium)
75 (const :tag "dull, grayscale" grayscale))
76 :set (lambda (symbol value)
77 (set-default symbol value)
78 (setq smiley-data-directory (smiley-directory))
79 (smiley-update-cache))
80 :initialize 'custom-initialize-default
81 :version "23.0" ;; No Gnus
84 ;; For compatibility, honor the variable `smiley-data-directory' if the user
87 (defun smiley-directory (&optional style)
88 "Return a the location of the smiley faces files.
89 STYLE specifies which style to use, see `smiley-style'. If STYLE
90 is nil, use `smiley-style'."
91 (unless style (setq style smiley-style))
92 (nnheader-find-etc-directory
93 (concat "images/smilies"
94 (cond ((eq smiley-style 'low-color) "")
95 ((eq smiley-style 'medium) "/medium")
96 ((eq smiley-style 'grayscale) "/grayscale")))))
98 ;; The XEmacs version has a baroque, if not rococo, set of these.
99 (defcustom smiley-regexp-alist
100 '(("\\(;-?)\\)\\W" 1 "blink")
101 ("\\(:-]\\)\\W" 1 "forced")
102 ("\\(8-)\\)\\W" 1 "braindamaged")
103 ("\\(:-|\\)\\W" 1 "indifferent")
104 ("\\(:-[/\\]\\)\\W" 1 "wry")
105 ("\\(:-(\\)\\W" 1 "sad")
106 ("\\(:-{\\)\\W" 1 "frown")
107 ("\\(>:-)\\)\\W" 1 "evil")
108 ("\\(;-(\\)\\W" 1 "cry")
109 ("\\(X-)\\)\\W" 1 "dead")
110 ("\\(:-D\\)\\W" 1 "grin")
111 ;; "smile" must be come after "evil"
112 ("\\(\\^?:-?)\\)\\W" 1 "smile"))
113 "*A list of regexps to map smilies to images.
114 The elements are (REGEXP MATCH IMAGE), where MATCH is the submatch in
115 regexp to replace with IMAGE. IMAGE is the name of an image file in
116 `smiley-data-directory'."
117 :type '(repeat (list regexp
118 (integer :tag "Regexp match number")
119 (string :tag "Image name")))
120 :set (lambda (symbol value)
121 (set-default symbol value)
122 (smiley-update-cache))
123 :initialize 'custom-initialize-default
126 (defcustom gnus-smiley-file-types
127 (let ((types (list "pbm")))
128 (when (gnus-image-type-available-p 'xpm)
131 "*List of suffixes on smiley file names to try."
133 :type '(repeat string)
136 (defvar smiley-cached-regexp-alist nil)
138 (defun smiley-update-cache ()
139 (setq smiley-cached-regexp-alist nil)
140 (dolist (elt (if (symbolp smiley-regexp-alist)
141 (symbol-value smiley-regexp-alist)
142 smiley-regexp-alist))
143 (let ((types gnus-smiley-file-types)
145 (while (and (not file)
146 (setq type (pop types)))
147 (unless (file-exists-p
148 (setq file (expand-file-name (concat (nth 2 elt) "." type)
149 smiley-data-directory)))
152 (let ((image (gnus-create-image file (intern type) nil
155 (push (list (car elt) (cadr elt) image)
156 smiley-cached-regexp-alist)))))))
159 ;; (defvar smiley-mouse-map
160 ;; (let ((map (make-sparse-keymap)))
161 ;; (define-key map [down-mouse-2] 'ignore) ; override widget
162 ;; (define-key map [mouse-2]
163 ;; 'smiley-mouse-toggle-buffer)
167 (defun smiley-region (start end)
168 "Replace in the region `smiley-regexp-alist' matches with corresponding images.
169 A list of images is returned."
171 (when (gnus-graphic-display-p)
172 (unless smiley-cached-regexp-alist
173 (smiley-update-cache))
175 (let ((beg (or start (point-min)))
176 group image images string)
177 (dolist (entry smiley-cached-regexp-alist)
178 (setq group (nth 1 entry)
181 (while (re-search-forward (car entry) end t)
182 (setq string (match-string group))
183 (goto-char (match-end group))
184 (delete-region (match-beginning group) (match-end group))
187 (gnus-add-wash-type 'smiley)
188 (gnus-add-image 'smiley image)
189 (gnus-put-image image string 'smiley))))
193 (defun smiley-buffer (&optional buffer)
194 "Run `smiley-region' at the buffer, specified in the argument or
195 interactively. If there's no argument, do it at the current buffer"
196 (interactive "bBuffer to run smiley-region: ")
199 (set-buffer (get-buffer buffer)))
200 (smiley-region (point-min) (point-max))))
202 (defun smiley-toggle-buffer (&optional arg)
203 "Toggle displaying smiley faces in article buffer.
204 With arg, turn displaying on if and only if arg is positive."
206 (gnus-with-article-buffer
207 (if (if (numberp arg)
209 (not (memq 'smiley gnus-article-wash-types)))
210 (smiley-region (point-min) (point-max))
211 (gnus-delete-images 'smiley))))
213 (defun smiley-mouse-toggle-buffer (event)
214 "Toggle displaying smiley faces.
215 With arg, turn displaying on if and only if arg is positive."
218 (save-window-excursion
219 (mouse-set-point event)
220 (smiley-toggle-buffer))))
224 ;;; arch-tag: 5beb161b-4321-40af-8ac9-876afb8ee818
225 ;;; smiley.el ends here