]> git.eshelyaron.com Git - emacs.git/commitdiff
*** empty log message ***
authorDave Love <fx@gnu.org>
Wed, 20 Sep 2000 17:08:54 +0000 (17:08 +0000)
committerDave Love <fx@gnu.org>
Wed, 20 Sep 2000 17:08:54 +0000 (17:08 +0000)
lisp/gnus/ChangeLog
lisp/gnus/frown.xbm [new file with mode: 0644]
lisp/gnus/smile.xbm [new file with mode: 0644]
lisp/gnus/smiley-ems.el [new file with mode: 0644]
lisp/gnus/wry.xbm [new file with mode: 0644]

index 847ab7eb5860bc7802b237cd871295716388d547..8d9173344ab5d734f41193da4d0b85918d093006 100644 (file)
@@ -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.
 
diff --git a/lisp/gnus/frown.xbm b/lisp/gnus/frown.xbm
new file mode 100644 (file)
index 0000000..838a5bd
--- /dev/null
@@ -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};
diff --git a/lisp/gnus/smile.xbm b/lisp/gnus/smile.xbm
new file mode 100644 (file)
index 0000000..80504fb
--- /dev/null
@@ -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};
diff --git a/lisp/gnus/smiley-ems.el b/lisp/gnus/smiley-ems.el
new file mode 100644 (file)
index 0000000..3ccb8b1
--- /dev/null
@@ -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
diff --git a/lisp/gnus/wry.xbm b/lisp/gnus/wry.xbm
new file mode 100644 (file)
index 0000000..1716f11
--- /dev/null
@@ -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};