Mercurial > emacs
changeset 31789:ff5eb810214a
*** empty log message ***
author | Dave Love <fx@gnu.org> |
---|---|
date | Wed, 20 Sep 2000 17:08:54 +0000 |
parents | 1142ff68054d |
children | c31d17444869 |
files | lisp/gnus/ChangeLog lisp/gnus/frown.xbm lisp/gnus/smile.xbm lisp/gnus/smiley-ems.el lisp/gnus/wry.xbm |
diffstat | 5 files changed, 174 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog Wed Sep 20 17:07:24 2000 +0000 +++ b/lisp/gnus/ChangeLog Wed Sep 20 17:08:54 2000 +0000 @@ -1,5 +1,7 @@ 2000-09-20 Dave Love <fx@gnu.org> + * smiley-ems.el, frown.xbm, smile.xbm, wry.xbm: New files. + * mail-source.el (mail-source-delete-incoming): Set to t, assuming we'll be careful merging development changes.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/frown.xbm Wed Sep 20 17:08:54 2000 +0000 @@ -0,0 +1,6 @@ +#define frown_width 13 +#define frown_height 14 +static unsigned char frown_bits[] = { + 0xf8, 0x03, 0x0c, 0x06, 0x02, 0x08, 0x0d, 0x16, 0x59, 0x13, 0x41, 0x10, + 0x41, 0x10, 0xe1, 0x10, 0x01, 0x10, 0xf1, 0x11, 0x1a, 0x0b, 0x06, 0x0c, + 0x18, 0x03, 0xe0, 0x00};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/smile.xbm Wed Sep 20 17:08:54 2000 +0000 @@ -0,0 +1,6 @@ +#define smile_width 13 +#define smile_height 14 +static unsigned char smile_bits[] = { + 0xf8, 0x03, 0x0c, 0x06, 0x02, 0x08, 0x19, 0x13, 0x59, 0x13, 0x41, 0x10, + 0x41, 0x10, 0xe5, 0x14, 0x0d, 0x16, 0x19, 0x13, 0xf2, 0x09, 0x46, 0x0c, + 0x18, 0x03, 0xe0, 0x00};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/smiley-ems.el Wed Sep 20 17:08:54 2000 +0000 @@ -0,0 +1,154 @@ +;;; smiley-ems.el --- displaying smiley faces +;; Copyright (C) 2000 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 +;; 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 they shouldn't +;; have a yellow background by default. Also, using XBM means we can +;; display the images more generally. -- fx + +;;; Test smileys: :-) :-\ :-( :-/ + +;;; Code: + +(require 'nnheader) + +(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.xbm") + ("\\(:-[/\\]\\)\\W" 1 "wry.xbm") + ("\\(:-[({]\\)\\W" 1 "frown.xbm")) + "*A list of regexps to map smilies to images. +The elements are (REGEXP MATCH FILE), where MATCH is the submatch in +rgexp to replace with IMAGE. IMAGE is the name of an XBM 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) + +(defvar smiley-cached-regexp-alist nil) + +(defun smiley-update-cache () + (dolist (elt smiley-regexp-alist) + (let* ((data-directory smiley-data-directory) + (image (find-image (list (list :type 'xbm + :file (nth 2 elt) + :ascent 100))))) + (if image + (push (list (car elt) (cadr elt) image) + smiley-cached-regexp-alist))))) + +(defvar smiley-active nil + "Non-nil means smilies in the buffer will be displayed.") +(make-variable-buffer-local 'smiley-active) + +(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) + "Replace in the region `smiley-regexp-alist' matches with corresponding images." + (interactive "r") + (when (display-graphic-p) + (mapc (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))) + buffer-read-only entry beg group overlay image) + (dolist (entry smiley-cached-regexp-alist) + (setq group (nth 1 entry)) + (goto-char beg) + (while (re-search-forward (car entry) end t) + (when image + (setq overlay (make-overlay (match-beginning group) + (match-end group))) + (overlay-put overlay + 'display `(when smiley-active ,@(nth 2 entry))) + (overlay-put overlay 'mouse-face 'highlight) + (overlay-put overlay 'smiley t) + (overlay-put overlay + 'help-echo "mouse-2: toggle smilies in buffer") + (overlay-put overlay 'keymap smiley-mouse-map)))))) + (setq smiley-active t))) + +(defun smiley-toggle-buffer (&optional arg) + "Toggle displaying smiley faces. +With arg, turn displaying on if and only if arg is positive." + (interactive "P") + (if (numberp arg) + (setq smiley-active (> arg 0)) + (setq smiley-active (not smiley-active)))) + +(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)))) + +(eval-when-compile (defvar gnus-article-buffer)) + +(defun gnus-smiley-display (&optional arg) + "Display textual emoticaons (\"smilies\") as small graphical icons. +With arg, turn displaying on if and only if arg is positive." + (interactive "P") + (save-excursion + (set-buffer gnus-article-buffer) + (save-restriction + (widen) + (article-goto-body) + (smiley-region (point-min) (point-max)) + (if (and (numberp arg) (<= arg 0)) + (smiley-toggle-buffer arg))))) + +(provide 'smiley) + +;;; smiley-ems.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/wry.xbm Wed Sep 20 17:08:54 2000 +0000 @@ -0,0 +1,6 @@ +#define wry_width 13 +#define wry_height 14 +static unsigned char wry_bits[] = { + 0xf8, 0x03, 0x0c, 0x06, 0x02, 0x08, 0x19, 0x13, 0x59, 0x12, 0x41, 0x10, + 0x41, 0x10, 0xe1, 0x10, 0x0d, 0x10, 0x79, 0x10, 0xe2, 0x0b, 0x06, 0x0f, + 0x18, 0x03, 0xe0, 0x00};