;;; smiley.el --- displaying smiley faces
-;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Free Software Foundation, Inc.
;; Author: Wes Hardaker <hardaker@ece.ucdavis.edu>
;; Keywords: fun
;; The smilies were drawn by Joe Reiss <jreiss@vt.edu>.
-(require 'annotations)
-(require 'messagexmas)
(require 'cl)
(require 'custom)
+(eval-and-compile
+ (when (featurep 'xemacs)
+ (require 'annotations)
+ (require 'messagexmas)))
+
(defgroup smiley nil
- "Turn :-)'s into real images (XEmacs)."
+ "Turn :-)'s into real images."
:group 'gnus-visual)
-(defcustom smiley-data-directory (message-xmas-find-glyph-directory "smilies")
+;; FIXME: Where is the directory when using Emacs?
+(defcustom smiley-data-directory
+ (if (featurep 'xemacs)
+ (message-xmas-find-glyph-directory "smilies")
+ "/usr/local/lib/xemacs/xemacs-packages/etc/smilies")
"*Location of the smiley faces files."
:type 'directory
:group 'smiley)
:group 'smiley)
(defvar smiley-glyph-cache nil)
-(defvar smiley-running-xemacs (string-match "XEmacs" emacs-version))
(defvar smiley-map (make-sparse-keymap "smiley-keys")
- "Keymap to toggle smiley states.")
+ "Keymap to toggle smiley states.")
(define-key smiley-map [(button2)] 'smiley-toggle-extent)
(define-key smiley-map [(button3)] 'smiley-popup-menu)
["Toggle All Smilies" (smiley-toggle-extents ,e) t])))
(defun smiley-create-glyph (smiley pixmap)
- (and
- smiley-running-xemacs
- (or
- (cdr-safe (assoc pixmap smiley-glyph-cache))
- (let* ((xpm-color-symbols
- (and (featurep 'xpm)
- (append `(("flesh" ,smiley-flesh-color)
- ("features" ,smiley-features-color)
- ("tongue" ,smiley-tongue-color))
- xpm-color-symbols)))
- (glyph (make-glyph
- (list
- (cons 'x (expand-file-name pixmap smiley-data-directory))
- (cons 'mswindows
- (expand-file-name pixmap smiley-data-directory))
- (cons 'tty smiley)))))
- (setq smiley-glyph-cache (cons (cons pixmap glyph) smiley-glyph-cache))
- (set-glyph-face glyph 'default)
- glyph))))
+ (or
+ (cdr-safe (assoc pixmap smiley-glyph-cache))
+ (let* ((xpm-color-symbols
+ (and (featurep 'xpm)
+ (append `(("flesh" ,smiley-flesh-color)
+ ("features" ,smiley-features-color)
+ ("tongue" ,smiley-tongue-color))
+ xpm-color-symbols)))
+ (glyph (make-glyph
+ (list
+ (cons (if (featurep 'gtk) 'gtk 'x)
+ (expand-file-name pixmap smiley-data-directory))
+ (cons 'mswindows
+ (expand-file-name pixmap smiley-data-directory))
+ (cons 'tty smiley)))))
+ (setq smiley-glyph-cache (cons (cons pixmap glyph) smiley-glyph-cache))
+ (set-glyph-face glyph 'default)
+ glyph)))
;;;###autoload
(defun smiley-region (beg end)
(defun smiley-toggle-extents (e)
(interactive "e")
(map-extents
- '(lambda (e void)
- (let (ant)
- (if (annotationp (setq ant (extent-property e 'smiley-annotation)))
- (progn
- (if (eq (extent-property e 'invisible) nil)
- (progn
- (reveal-annotation ant)
- (set-extent-property e 'invisible t)
- )
- (hide-annotation ant)
- (set-extent-property e 'invisible nil))))
- nil))
+ (lambda (e void)
+ (let (ant)
+ (if (annotationp (setq ant (extent-property e 'smiley-annotation)))
+ (if (eq (extent-property e 'invisible) nil)
+ (progn
+ (reveal-annotation ant)
+ (set-extent-property e 'invisible t)
+ )
+ (hide-annotation ant)
+ (set-extent-property e 'invisible nil)))
+ nil))
(event-buffer e)))
;;;###autoload
(defun smiley-buffer (&optional buffer st nd)
(interactive)
- (when (featurep '(or x mswindows))
+ (when (featurep '(or x gtk mswindows))
(save-excursion
(when buffer
(set-buffer buffer))
(case-fold-search nil)
entry regexp beg group file)
(map-extents
- '(lambda (e void)
- (when (or (extent-property e 'smiley-extent)
- (extent-property e 'smiley-annotation))
- (delete-extent e)))
+ (lambda (e void)
+ (when (or (extent-property e 'smiley-extent)
+ (extent-property e 'smiley-annotation))
+ (delete-extent e)))
buffer st nd)
(goto-char (or st (point-min)))
(setq beg (point))
(eq (char-after (1- (point))) ?\()))
t)))
+(defun smiley-toggle-buffer (&optional arg buffer st nd)
+ "Toggle displaying smiley faces.
+With arg, turn displaying on if and only if arg is positive."
+ (interactive "P")
+ (let (on off)
+ (map-extents
+ (lambda (e void)
+ (let (ant)
+ (if (annotationp (setq ant (extent-property e 'smiley-annotation)))
+ (if (eq (extent-property e 'invisible) nil)
+ (setq off (cons (cons ant e) off))
+ (setq on (cons (cons ant e) on)))))
+ nil)
+ buffer st nd)
+ (if (and (not (and (numberp arg) (< arg 0)))
+ (or (and (numberp arg) (> arg 0))
+ (null on)))
+ (if off
+ (while off
+ (reveal-annotation (caar off))
+ (set-extent-property (cdar off) 'invisible t)
+ (setq off (cdr off)))
+ (smiley-buffer))
+ (while on
+ (hide-annotation (caar on))
+ (set-extent-property (cdar on) 'invisible nil)
+ (setq on (cdr on))))))
+
(defvar gnus-article-buffer)
;;;###autoload
-(defun gnus-smiley-display ()
- "Display \"smileys\" as small graphical icons."
- (interactive)
+(defun gnus-smiley-display (&optional arg)
+ "Display \"smileys\" 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)
(article-goto-body)
- (smiley-buffer (current-buffer) (point-min) (point-max))))
+ (let (buffer-read-only)
+ (smiley-toggle-buffer arg (current-buffer) (point) (point-max)))))
(provide 'smiley)
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
;;; smiley.el ends here