;;; smiley.el --- displaying smiley faces
-;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2016 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: news mail multimedia
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs 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.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs 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
+;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; I'm not sure we need that degree of rococoness and defaults like a
;; yellow background. Also, using PBM means we can display the images
;; more generally. -- fx
-
-;;; Test smileys: :-) :-\ :-( :-/
+;; `smiley.el' was replaced by `smiley-ems.el' on 2002-01-26 (after fx'
+;; comment).
+
+;; Test smileys:
+;; smile ^:-) ^:)
+;; blink ;-) ;)
+;; forced :-]
+;; braindamaged 8-)
+;; indifferent :-|
+;; wry :-/ :-\
+;; sad :-(
+;; frown :-{
+;; evil >:-)
+;; cry ;-(
+;; dead X-)
+;; grin :-D
;;; Code:
"Turn :-)'s into real images."
:group 'gnus-visual)
-;; Maybe this should go.
-(defcustom smiley-data-directory (nnheader-find-etc-directory "images/smilies")
+(defvar smiley-data-directory)
+
+(defcustom smiley-style
+ (if (or (and (fboundp 'face-attribute)
+ ;; In batch mode, attributes can be unspecified.
+ (condition-case nil
+ (>= (face-attribute 'default :height) 160)
+ (error nil)))
+ (and (fboundp 'face-height)
+ (>= (face-height 'default) 14)))
+ 'medium
+ 'low-color)
+ "Smiley style."
+ :type '(choice (const :tag "small, 3 colors" low-color) ;; 13x14
+ (const :tag "medium, ~10 colors" medium) ;; 16x16
+ (const :tag "dull, grayscale" grayscale));; 14x14
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (setq smiley-data-directory (smiley-directory))
+ (smiley-update-cache))
+ :initialize 'custom-initialize-default
+ :version "23.1" ;; No Gnus
+ :group 'smiley)
+
+;; For compatibility, honor the variable `smiley-data-directory' if the user
+;; has set it.
+
+(defun smiley-directory (&optional style)
+ "Return a the location of the smiley faces files.
+STYLE specifies which style to use, see `smiley-style'. If STYLE
+is nil, use `smiley-style'."
+ (unless style (setq style smiley-style))
+ (nnheader-find-etc-directory
+ (concat "images/smilies"
+ (cond ((eq smiley-style 'low-color) "")
+ ((eq smiley-style 'medium) "/medium")
+ ((eq smiley-style 'grayscale) "/grayscale")))))
+
+(defcustom smiley-data-directory (smiley-directory)
"*Location of the smiley faces files."
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (smiley-update-cache))
+ :initialize 'custom-initialize-default
:type 'directory
:group 'smiley)
;; The XEmacs version has a baroque, if not rococo, set of these.
(defcustom smiley-regexp-alist
- '(("\\(:-?)\\)\\W" 1 "smile")
- ("\\(;-?)\\)\\W" 1 "blink")
+ '(("\\(;-)\\)\\W" 1 "blink")
+ ("[^;]\\(;)\\)\\W" 1 "blink")
("\\(:-]\\)\\W" 1 "forced")
("\\(8-)\\)\\W" 1 "braindamaged")
("\\(:-|\\)\\W" 1 "indifferent")
("\\(:-[/\\]\\)\\W" 1 "wry")
("\\(:-(\\)\\W" 1 "sad")
- ("\\(:-{\\)\\W" 1 "frown"))
+ ("\\(X-)\\)\\W" 1 "dead")
+ ("\\(:-{\\)\\W" 1 "frown")
+ ("\\(>:-)\\)\\W" 1 "evil")
+ ("\\(;-(\\)\\W" 1 "cry")
+ ("\\(:-D\\)\\W" 1 "grin")
+ ;; "smile" must be come after "evil"
+ ("\\(\\^?:-?)\\)\\W" 1 "smile"))
"*A list of regexps to map smilies to images.
-The elements are (REGEXP MATCH FILE), where MATCH is the submatch in
-regexp to replace with IMAGE. IMAGE is the name of a PBM file in
+The elements are (REGEXP MATCH IMAGE), where MATCH is the submatch in
+regexp to replace with IMAGE. IMAGE is the name of an image file in
`smiley-data-directory'."
+ :version "24.1"
:type '(repeat (list regexp
(integer :tag "Regexp match number")
(string :tag "Image name")))
(let ((types (list "pbm")))
(when (gnus-image-type-available-p 'xpm)
(push "xpm" types))
+ (when (gnus-image-type-available-p 'gif)
+ (push "gif" types))
types)
- "*List of suffixes on picon file names to try."
- :version "22.1"
+ "*List of suffixes on smiley file names to try."
+ :version "24.1"
:type '(repeat string)
:group 'smiley)
(defvar smiley-cached-regexp-alist nil)
(defun smiley-update-cache ()
+ (setq smiley-cached-regexp-alist nil)
(dolist (elt (if (symbolp smiley-regexp-alist)
(symbol-value smiley-regexp-alist)
smiley-regexp-alist))
(push (list (car elt) (cadr elt) image)
smiley-cached-regexp-alist)))))))
-(defvar smiley-mouse-map
- (let ((map (make-sparse-keymap)))
- (define-key map [down-mouse-2] 'ignore) ; override widget
- (define-key map [mouse-2]
- 'smiley-mouse-toggle-buffer)
- map))
+;; Not implemented:
+;; (defvar smiley-mouse-map
+;; (let ((map (make-sparse-keymap)))
+;; (define-key map [down-mouse-2] 'ignore) ; override widget
+;; (define-key map [mouse-2]
+;; 'smiley-mouse-toggle-buffer)
+;; map))
;;;###autoload
(defun smiley-region (start end)
;;;###autoload
(defun smiley-buffer (&optional buffer)
- "Run `smiley-region' at the buffer, specified in the argument or
-interactively. If there's no argument, do it at the current buffer"
+ "Run `smiley-region' at the BUFFER, specified in the argument or
+interactively. If there's no argument, do it at the current buffer."
(interactive "bBuffer to run smiley-region: ")
(save-excursion
(if buffer
(provide 'smiley)
-;;; arch-tag: 5beb161b-4321-40af-8ac9-876afb8ee818
;;; smiley.el ends here
projects / gnus / blobdiff