X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fsmiley.el;h=8b8cad719044f31f0c0af775af0cb4ecf0c48793;hp=d7657e444b88a409c22d5a3bfdcbbb8506bac3d0;hb=559e4108ff97c334f5affb3519657e73dfe3dad7;hpb=75880493a6a9dad9607a4002d4c6ab2895b110ca diff --git a/lisp/smiley.el b/lisp/smiley.el index d7657e444..8b8cad719 100644 --- a/lisp/smiley.el +++ b/lisp/smiley.el @@ -1,27 +1,24 @@ ;;; smiley.el --- displaying smiley faces -;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006 Free Software Foundation, Inc. +;; Copyright (C) 2000-2015 Free Software Foundation, Inc. ;; Author: Dave Love ;; 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 . ;;; Commentary: @@ -31,8 +28,22 @@ ;; 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: @@ -44,26 +55,74 @@ "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"))) @@ -77,15 +136,18 @@ regexp to replace with IMAGE. IMAGE is the name of a PBM file in (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)) @@ -104,12 +166,13 @@ regexp to replace with IMAGE. IMAGE is the name of a PBM file in (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) @@ -139,8 +202,8 @@ A list of images is returned." ;;;###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 @@ -169,5 +232,4 @@ With arg, turn displaying on if and only if arg is positive." (provide 'smiley) -;;; arch-tag: 5beb161b-4321-40af-8ac9-876afb8ee818 ;;; smiley.el ends here