X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fsmiley.el;h=d227e26116dabff29598dfb34c96233bef07adec;hb=9bff3e1ed66aee0c93773573fc662b10c4b72a1b;hp=6f71d05bacd06ac8a5e13e3ffe56b7320efbd4ec;hpb=1a96d7bf660263f25557962103bc0ec2495d1d07;p=gnus diff --git a/lisp/smiley.el b/lisp/smiley.el index 6f71d05ba..d227e2611 100644 --- a/lisp/smiley.el +++ b/lisp/smiley.el @@ -1,5 +1,5 @@ ;;; smiley.el --- displaying smiley faces -;; Copyright (C) 1996 Free Software Foundation, Inc. +;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. ;; Author: Wes Hardaker ;; Keywords: fun @@ -31,28 +31,44 @@ ;; To use: ;; (require 'smiley) -;; (add-hook 'gnus-article-display-hook 'gnus-smiley-display t) +;; (setq gnus-treat-display-smileys t) -;; The smilies were drawn by Joe Reiss . +;; The smilies were drawn by Joe Reiss . (require 'annotations) (require 'messagexmas) -(eval-when-compile (require 'cl)) +(require 'cl) +(require 'custom) -(defvar smiley-data-directory (message-xmas-find-glyph-directory "smilies") - "Location of the smiley faces files.") +(defgroup smiley nil + "Turn :-)'s into real images (XEmacs)." + :group 'gnus-visual) -;; Notice the subtle differences in the regular expessions in the two alists below +(defcustom smiley-data-directory (message-xmas-find-glyph-directory "smilies") + "*Location of the smiley faces files." + :type 'directory + :group 'smiley) -(defvar smiley-deformed-regexp-alist - '(("\\(:-*[<«]+\\)\\W" 1 "FaceAngry.xpm") +;; Notice the subtle differences in the regular expressions in the +;; two alists below. + +(defcustom smiley-deformed-regexp-alist + '(("\\(\\^_?\\^;;;\\)\\W" 1 "WideFaceAse3.xbm") + ("\\(\\^_?\\^;;\\)\\W" 1 "WideFaceAse2.xbm") + ("\\(\\^_?\\^;\\)\\W" 1 "WideFaceAse1.xbm") + ("\\(\\^_?\\^\\)\\W" 1 "WideFaceSmile.xbm") + ("\\(;_;\\)\\W" 1 "WideFaceWeep.xbm") + ("\\(T_T\\)\\W" 1 "WideFaceWeep.xbm") + ("\\(:-*[<«]+\\)\\W" 1 "FaceAngry.xpm") ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm") ("\\(:-*D\\)\\W" 1 "FaceGrinning.xpm") ("\\(:-*[)>}»]+\\)\\W" 1 "FaceHappy.xpm") - ("\\(:-*[/\\\"]\\)[^/]" 1 "FaceIronic.xpm") + ("\\(=[)»]+\\)\\W" 1 "FaceHappy.xpm") + ("\\(:-*[/\\\"]\\)[^/]\\W" 1 "FaceIronic.xpm") ("\\([8|]-*[|Oo%]\\)\\W" 1 "FaceKOed.xpm") ("\\([:|]-*#+\\)\\W" 1 "FaceNyah.xpm") ("\\(:-*[({]+\\)\\W" 1 "FaceSad.xpm") + ("\\(=[({]+\\)\\W" 1 "FaceSad.xpm") ("\\(:-*[Oo\*]\\)\\W" 1 "FaceStartled.xpm") ("\\(:-*|\\)\\W" 1 "FaceStraight.xpm") ("\\(:-*p\\)\\W" 1 "FaceTalking.xpm") @@ -60,60 +76,102 @@ ("\\(;-*[>)}»]+\\)\\W" 1 "FaceWinking.xpm") ("\\(:-*[Vvµ]\\)\\W" 1 "FaceWry.xpm") ("\\([:|]-*P\\)\\W" 1 "FaceYukky.xpm")) - "Normal and deformed faces for smilies.") + "*Normal and deformed faces for smilies." + :type '(repeat (list regexp + (integer :tag "Match") + (string :tag "Image"))) + :group 'smiley) -(defvar smiley-nosey-regexp-alist +(defcustom smiley-nosey-regexp-alist '(("\\(:-+[<«]+\\)\\W" 1 "FaceAngry.xpm") ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm") ("\\(:-+D\\)\\W" 1 "FaceGrinning.xpm") ("\\(:-+[}»]+\\)\\W" 1 "FaceHappy.xpm") - ("\\(:-*)+\\)\\W" 1 "FaceHappy.xpm") ;; The exception that confirms the rule + ("\\(:-*)+\\)\\W" 1 "FaceHappy.xpm") + ("\\(=[)]+\\)\\W" 1 "FaceHappy.xpm") ("\\(:-+[/\\\"]+\\)\\W" 1 "FaceIronic.xpm") ("\\([8|]-+[|Oo%]\\)\\W" 1 "FaceKOed.xpm") ("\\([:|]-+#+\\)\\W" 1 "FaceNyah.xpm") ("\\(:-+[({]+\\)\\W" 1 "FaceSad.xpm") + ("\\(=[({]+\\)\\W" 1 "FaceSad.xpm") ("\\(:-+[Oo\*]\\)\\W" 1 "FaceStartled.xpm") ("\\(:-+|\\)\\W" 1 "FaceStraight.xpm") ("\\(:-+p\\)\\W" 1 "FaceTalking.xpm") ("\\(:-+d\\)\\W" 1 "FaceTasty.xpm") ("\\(;-+[>)}»]+\\)\\W" 1 "FaceWinking.xpm") ("\\(:-+[Vvµ]\\)\\W" 1 "FaceWry.xpm") + ("\\(][:8B]-[)>]\\)\\W" 1 "FaceDevilish.xpm") ("\\([:|]-+P\\)\\W" 1 "FaceYukky.xpm")) - "Smileys with noses. These get less false matches.") + "*Smileys with noses. These get less false matches." + :type '(repeat (list regexp + (integer :tag "Match") + (string :tag "Image"))) + :group 'smiley) + +(defcustom smiley-regexp-alist smiley-deformed-regexp-alist + "*A list of regexps to map smilies to real images. +Defaults to the contents of `smiley-deformed-regexp-alist'. +An alternative is `smiley-nosey-regexp-alist' that matches less +aggressively. +If this is a symbol, take its value." + :type '(radio (variable-item smiley-deformed-regexp-alist) + (variable-item smiley-nosey-regexp-alist) + symbol + (repeat (list regexp + (integer :tag "Match") + (string :tag "Image")))) + :group 'smiley) + +(defcustom smiley-flesh-color "yellow" + "*Flesh color." + :type 'string + :group 'smiley) -(defvar smiley-regexp-alist smiley-deformed-regexp-alist - "A list of regexps to map smilies to real images. -Defaults to the content of smiley-deformed-regexp-alist. -An alternative smiley-nose-regexp-alist that -matches less aggresively is available. -If this is a symbol, take its value.") +(defcustom smiley-features-color "black" + "*Features color." + :type 'string + :group 'smiley) -(defvar smiley-flesh-color "yellow" - "Flesh color.") +(defcustom smiley-tongue-color "red" + "*Tongue color." + :type 'string + :group 'smiley) -(defvar smiley-features-color "black" - "Features color.") +(defcustom smiley-circle-color "black" + "*Circle color." + :type 'string + :group 'smiley) -(defvar smiley-tongue-color "red" - "Tongue color.") +(defcustom smiley-mouse-face 'highlight + "*Face used for mouse highlighting in the smiley buffer. -(defvar smiley-circle-color "black" - "Circle color.") +Smiley buttons will be displayed in this face when the cursor is +above them." + :type 'face + :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) + +(defun smiley-popup-menu (e) + (interactive "e") + (popup-menu + `("Smilies" + ["Toggle This Smiley" (smiley-toggle-extent ,e) t] + ["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 + (let* ((xpm-color-symbols (and (featurep 'xpm) (append `(("flesh" ,smiley-flesh-color) ("features" ,smiley-features-color) @@ -134,7 +192,7 @@ If this is a symbol, take its value.") (smiley-buffer (current-buffer) beg end)) (defun smiley-toggle-extent (event) - "Toggle smiley at given point" + "Toggle smiley at given point." (interactive "e") (let* ((ant (event-glyph-extent event)) (pt (event-closest-point event)) @@ -143,12 +201,29 @@ If this is a symbol, take its value.") (when (extentp (setq ext (extent-property ant 'smiley-extent))) (set-extent-property ext 'invisible nil) (hide-annotation ant)) - (if pt - (while (setq ext (extent-at pt (event-buffer event) nil ext 'at)) - (when (annotationp (setq ant - (extent-property ext 'smiley-annotation))) - (reveal-annotation ant) - (set-extent-property ext 'invisible t))))))) + (when pt + (while (setq ext (extent-at pt (event-buffer event) nil ext 'at)) + (when (annotationp (setq ant + (extent-property ext 'smiley-annotation))) + (reveal-annotation ant) + (set-extent-property ext 'invisible t))))))) + +(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)) + (event-buffer e))) ;;;###autoload (defun smiley-buffer (&optional buffer st nd) @@ -161,7 +236,14 @@ If this is a symbol, take its value.") (alist (if (symbolp smiley-regexp-alist) (symbol-value smiley-regexp-alist) smiley-regexp-alist)) + (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))) + buffer st nd) (goto-char (or st (point-min))) (setq beg (point)) ;; loop through alist @@ -180,17 +262,31 @@ If this is a symbol, take its value.") (let ((ext (make-extent start end)) (ant (make-annotation glyph end 'text))) ;; set text extent params - (set-extent-property ext 'invisible t) (set-extent-property ext 'end-open t) + (set-extent-property ext 'start-open t) + (set-extent-property ext 'invisible t) (set-extent-property ext 'keymap smiley-map) - (set-extent-property ext 'mouse-face gnus-article-mouse-face) -; (set-extent-property ext 'intangible t) + (set-extent-property ext 'mouse-face smiley-mouse-face) + (set-extent-property ext 'intangible t) ;; set annotation params - (set-extent-property ant 'mouse-face gnus-article-mouse-face) + (set-extent-property ant 'mouse-face smiley-mouse-face) (set-extent-property ant 'keymap smiley-map) ;; remember each other (set-extent-property ant 'smiley-extent ext) - (set-extent-property ext 'smiley-annotation ant)) + (set-extent-property ext 'smiley-annotation ant) + ;; Help + (set-extent-property + ext 'help-echo + "button2 toggles smiley, button3 pops up menu") + (set-extent-property + ant 'help-echo + "button2 toggles smiley, button3 pops up menu") + (set-extent-property ext 'balloon-help + "Mouse button2 - toggle smiley +Mouse button3 - menu") + (set-extent-property ant 'balloon-help + "Mouse button2 - toggle smiley +Mouse button3 - menu")) (when (smiley-end-paren-p start end) (make-annotation ")" end 'text)) (goto-char end))))))))) @@ -200,14 +296,16 @@ If this is a symbol, take its value.") (save-excursion (goto-char start) (when (and (re-search-backward "[()]" nil t) - (= (following-char) ?\() + (eq (char-after) ?\() (goto-char end) (or (not (re-search-forward "[()]" nil t)) - (= (char-after (1- (point))) ?\())) + (eq (char-after (1- (point))) ?\())) t))) -;;;###autoload +(defvar gnus-article-buffer) +;;;###autoload (defun gnus-smiley-display () + "Display \"smileys\" as small graphical icons." (interactive) (save-excursion (set-buffer gnus-article-buffer)