From: yamaoka Date: Tue, 7 May 2002 02:58:38 +0000 (+0000) Subject: Remove. X-Git-Tag: t-gnus-6_15_6-01~2 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=7583488358df6d55c16aee5a52131e8bff7c6edc;p=elisp%2Fgnus.git- Remove. --- diff --git a/lisp/smiley-ems.el b/lisp/smiley-ems.el deleted file mode 100644 index d05a713..0000000 --- a/lisp/smiley-ems.el +++ /dev/null @@ -1,168 +0,0 @@ -;;; smiley-ems.el --- displaying smiley faces - -;; Copyright (C) 2000, 2001, 2002 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 -;; 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. - -;; 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 -;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; A re-written, simplified version of Wes Hardaker's XEmacs smiley.el -;; which might be merged back to smiley.el if we get an assignment for -;; that. We don't have assignments for the images smiley.el uses, but -;; 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: :-) :-\ :-( :-/ - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'nnheader) -(require 'gnus-art) - -(defgroup smiley nil - "Turn :-)'s into real images." - :group 'gnus-visual) - -;; Maybe this should go. -(defcustom smiley-data-directory (nnheader-find-etc-directory "smilies") - "*Location of the smiley faces files." - :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 "forced") - ("\\(8-)\\)\\W" 1 "braindamaged") - ("\\(:-|\\)\\W" 1 "indifferent") - ("\\(:-[/\\]\\)\\W" 1 "wry") - ("\\(:-(\\)\\W" 1 "sad") - ("\\(:-{\\)\\W" 1 "frown")) - "*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 -`smiley-data-directory'." - :type '(repeat (list regexp - (integer :tag "Regexp match number") - (string :tag "Image name"))) - :set (lambda (symbol value) - (set-default symbol value) - (smiley-update-cache)) - :initialize 'custom-initialize-default - :group 'smiley) - -(defcustom gnus-smiley-file-types - (let ((types (list "pbm"))) - (when (gnus-image-type-available-p 'xpm) - (push "xpm" types)) - types) - "*List of suffixes on picon file names to try." - :type '(repeat string) - :group 'smiley) - -(defvar smiley-cached-regexp-alist nil) - -(defun smiley-update-cache () - (dolist (elt (if (symbolp smiley-regexp-alist) - (symbol-value smiley-regexp-alist) - smiley-regexp-alist)) - (let ((types gnus-smiley-file-types) - file type) - (while (and (not file) - (setq type (pop types))) - (unless (file-exists-p - (setq file (expand-file-name (concat (nth 2 elt) "." type) - smiley-data-directory))) - (setq file nil))) - (when type - (let ((image (find-image (list (list :type (intern type) - :file file - :ascent 'center))))) - (when image - (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)) - -(defun smiley-region (start end) - "Replace in the region `smiley-regexp-alist' matches with corresponding images. -A list of images is returned." - (interactive "r") - (when (and (fboundp 'display-graphic-p) - (display-graphic-p)) - (mapcar (lambda (o) - (if (eq 'smiley (overlay-get o 'smiley)) - (delete-overlay o))) - (overlays-in start end)) - (unless smiley-cached-regexp-alist - (smiley-update-cache)) - (save-excursion - (let ((beg (or start (point-min))) - group overlay image images) - (dolist (entry smiley-cached-regexp-alist) - (setq group (nth 1 entry) - image (nth 2 entry)) - (goto-char beg) - (while (re-search-forward (car entry) end t) - (when image - (push image images) - (gnus-add-wash-type 'smiley) - (gnus-add-image 'smiley image) - (add-text-properties - (match-beginning group) (match-end group) - `(display ,image - mouse-face highlight - smiley t - help-echo "mouse-2: toggle smilies in buffer" - keymap smiley-mouse-map))))) - images)))) - -(defun smiley-toggle-buffer (&optional arg) - "Toggle displaying smiley faces in article buffer. -With arg, turn displaying on if and only if arg is positive." - (interactive "P") - (gnus-with-article-buffer - (if (if (numberp arg) - (> arg 0) - (not (memq 'smiley gnus-article-wash-types))) - (smiley-region (point-min) (point-max)) - (gnus-delete-images 'smiley)))) - -(defun smiley-mouse-toggle-buffer (event) - "Toggle displaying smiley faces. -With arg, turn displaying on if and only if arg is positive." - (interactive "e") - (save-excursion - (save-window-excursion - (mouse-set-point event) - (smiley-toggle-buffer)))) - -(provide 'smiley) - -;;; smiley-ems.el ends here