From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/4612 Path: main.gmane.org!not-for-mail From: Wes Hardaker Newsgroups: gmane.emacs.gnus.general Subject: My latest in pretty pictures: picons support Date: Tue, 09 Jan 1996 16:33:14 -0800 Message-ID: <199601100033.AA177293996@chroma.ece.ucdavis.edu> NNTP-Posting-Host: coloc-standby.netfonds.no Mime-Version: 1.0 Content-Type: multipart/mixed ; boundary="===_0_Tue_Jan__9_16:30:04_PST_1996" X-Trace: main.gmane.org 1035145336 30265 80.91.224.250 (20 Oct 2002 20:22:16 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Sun, 20 Oct 2002 20:22:16 +0000 (UTC) Return-Path: ding-request@ifi.uio.no Original-Received: from ifi.uio.no (ifi.uio.no [129.240.64.2]) by miranova.com (8.7.3/8.6.9) with SMTP id RAA23337 for ; Tue, 9 Jan 1996 17:26:45 -0800 Original-Received: from chroma.ece.ucdavis.edu (hardaker@chroma.cipic.ucdavis.edu [128.120.67.31]) by ifi.uio.no with ESMTP (8.6.11/ifi2.4) id for ; Wed, 10 Jan 1996 01:33:21 +0100 Original-Received: by chroma.ece.ucdavis.edu (1.37.109.16/Ultrix3.0-C/eecs 1.1) id AA177293996; Tue, 9 Jan 1996 16:33:16 -0800 X-Mailer: exmh version 1.6.5 12/8/95 Original-To: ding@ifi.uio.no X-Face: #qW^}a%m*T^{A:Cp}$R\"38+d}41-Z}uU8,r%F#c#s:~Nzp0G9](s?,K49KJ]s"*7g vRgASrAvQc4@/}L7Qc=w{)]ACO\R{LF@S{pXfojjjGg6c;q6{~C}CxC^^&~(F]`1W)%9j/iS/I M",B1M.?{w8ckLTYD'`|kTr\i\cgY)P4 X-Url: http://www.ece.ucdavis.edu/~hardaker Xref: main.gmane.org gmane.emacs.gnus.general:4612 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:4612 This is a multipart MIME message. --===_0_Tue_Jan__9_16:30:04_PST_1996 Content-Type: text/plain; charset="us-ascii" Content-ID: <17715.821233753.1@chroma.ece.ucdavis.edu> Well, I've played with things quiet a bit since the last time I sent this out. It now can display the icons practically anywhere in any buffer. I have it set so that it displays them in its own (and this is the default). See the top of the lisp code for documentation on its usage. Note that there are now TWO hooks, not one like previously. One is for displaying the group icons, and the other is for displaying the user/domain icons. The code should replace gnus-picon.el in the .26 distribution. Also enclosed is a patch to gnus.el, for v0.26. It changes the names of some of the variables to be 'picons' instead of 'picon'. This patch and this code will probably be in .27 or .28, assuming Lars puts it there :-) _____ Wes Hardaker / ___ \ Department of Electrical and Computer Engineering / / \//\ University of California at Davis __________________ \--/ /--\ Davis CA 95616 / Recycle! \ \//\___/ / (hardaker@ece.ucdavis.edu) / It's not too late! \ \_____/ --===_0_Tue_Jan__9_16:30:04_PST_1996 Content-Type: application/x-patch Content-Description: gnus.diff *** gnus.el Thu Dec 21 16:31:59 1995 --- gnus.el.dist Wed Dec 20 19:09:47 1995 *************** *** 382,388 **** (defvar gnus-use-scoring t "*If non-nil, enable scoring.") ! (defvar gnus-use-picons nil "*If non-nil, display picons.") (defvar gnus-fetch-old-headers nil --- 382,388 ---- (defvar gnus-use-scoring t "*If non-nil, enable scoring.") ! (defvar gnus-use-picon nil "*If non-nil, display picons.") (defvar gnus-fetch-old-headers nil *************** *** 787,800 **** (summary 1.0 point) (if gnus-carpal (summary-carpal 4)))) (article ! (if gnus-use-picons '(frame 1.0 (vertical 1.0 (summary 0.25 point) (if gnus-carpal (summary-carpal 4)) (article 1.0)) (vertical 1.0 ! (picons 1.0))) '(vertical 1.0 (summary 0.25 point) (if gnus-carpal (summary-carpal 4)) --- 787,800 ---- (summary 1.0 point) (if gnus-carpal (summary-carpal 4)))) (article ! (if gnus-use-picon '(frame 1.0 (vertical 1.0 (summary 0.25 point) (if gnus-carpal (summary-carpal 4)) (article 1.0)) (vertical 1.0 ! (picon 1.0))) '(vertical 1.0 (summary 0.25 point) (if gnus-carpal (summary-carpal 4)) *************** *** 902,908 **** (mail . gnus-mail-buffer) (post . gnus-post-news-buffer) (faq . gnus-faq-buffer) ! (picons . gnus-picons-buffer) (draft . gnus-draft-buffer)) "Mapping from short symbols to buffer names or buffer variables.") --- 902,908 ---- (mail . gnus-mail-buffer) (post . gnus-post-news-buffer) (faq . gnus-faq-buffer) ! (picon . gnus-picon-buffer) (draft . gnus-draft-buffer)) "Mapping from short symbols to buffer names or buffer variables.") *************** *** 11621,11629 **** (gnus-summary-catchup all quietly nil 'fast) ;; Select next newsgroup or exit. (if (eq gnus-auto-select-next 'quietly) ! (progn ! (run-hooks 'gnus-summary-exit-hook) ! (gnus-summary-next-group nil)) (gnus-summary-exit))) (defun gnus-summary-catchup-all-and-exit (&optional quietly) --- 11621,11627 ---- (gnus-summary-catchup all quietly nil 'fast) ;; Select next newsgroup or exit. (if (eq gnus-auto-select-next 'quietly) ! (gnus-summary-next-group nil) (gnus-summary-exit))) (defun gnus-summary-catchup-all-and-exit (&optional quietly) --===_0_Tue_Jan__9_16:30:04_PST_1996 Content-Type: application/x-elisp Content-Description: gnus-picons.el ;;; gnus-picons.el: Icon hacks for displaying pretty icons in Gnus. ;; Author: Wes hardaker ;; Keywords: gnus xpm annotation glyph faces ;;; Commentary: ;; Usage: ;; - You must have XEmacs (19.12 or above I think) to use this. ;; - Read the variable descriptions below. ;; ;; - chose a setup: ;; ;; 1) display the icons in its own buffer: ;; ;; (add-hook 'gnus-article-display-hook 'gnus-article-display-picons t) ;; (add-hook 'gnus-summary-display-hook 'gnus-group-display-picons t) ;; (setq gnus-picons-display-where 'picons) ;; ;; Then add the picons buffer to your display configuration: ;; The picons buffer needs to be at least 48 pixels high, ;; which for me is 5 lines: ;; ;; (gnus-add-configuration ;; '(article (vertical 1.0 ;; (group 6) ;; (picons 5) ;; (summary .25 point) ;; (article 1.0)))) ;; ;; (gnus-add-configuration ;; '(summary (vertical 1.0 (group 6) ;; (picons 5) ;; (summary 1.0 point)))) ;; ;; 2) display the icons in the summary buffer ;; ;; (add-hook 'gnus-article-display-hook 'gnus-article-display-picons t) ;; (add-hook 'gnus-summary-display-hook 'gnus-group-display-picons t) ;; (setq gnus-picons-display-where 'summary) ;; ;; 3) display the icons in the article buffer ;; ;; (add-hook 'gnus-article-display-hook 'gnus-article-display-picons t) ;; (add-hook 'gnus-article-display-hook 'gnus-group-display-picons t) ;; (setq gnus-picons-display-where 'article) ;; ;; ;; Warnings: ;; - I'm not even close to being a lisp expert. ;; - The 't' (append) flag MUST be in the add-hook line ;; ;; TODO: ;; - Remove the TODO section in the headers. ;; ;;; Code: (require 'xpm) (require 'annotations) (defvar gnus-picons-buffer "*Icon Buffer*" "Buffer name to display the icons in if gnus-picons-display-where is 'picons.") (defvar gnus-picons-display-where 'picons "Where to display the group and article icons.") (defvar gnus-picons-database "/usr/local/faces" "Defines the location of the faces database. For information on obtaining this database of pretty pictures, please see http://www.cs.indiana.edu/picons/ftp/index.html" ) (defvar gnus-picons-news-directory "news" "Sub-directory of the faces database containing the icons for newsgroups." ) (defvar gnus-picons-user-directories '("local" "users" "usenix" "misc/MISC") "List of directories to search for user faces." ) (defvar gnus-picons-domain-directories '("domains") "List of directories to search for domain faces. Some people may want to add \"unknown\" to this list." ) (setq gnus-group-annotations nil) (setq gnus-article-annotations nil) (defun gnus-picons-remove (plist) (let ((listitem (car plist))) (while (setq listitem (car plist)) (if (annotationp listitem) (delete-annotation listitem)) (setq plist (cdr plist)))) ) (defun gnus-picons-remove-all () "Removes all picons from the Gnus display(s)." (interactive) (gnus-picons-remove gnus-article-annotations) (gnus-picons-remove gnus-group-annotations) (setq gnus-article-annotations nil gnus-group-annotations nil) (if (bufferp gnus-picons-buffer) (kill-buffer gnus-picons-buffer)) ) (defun gnus-get-buffer-name (variable) "Returns the buffer name associated with the contents of a variable." (cond ((symbolp variable) (let ((newvar (cdr (assq variable gnus-window-to-buffer)))) (cond ((symbolp newvar) (symbol-value newvar)) ((stringp newvar) newvar)))) ((stringp variable) variable))) (defun gnus-article-display-picons () "Display faces for an author and his/her domain in gnus-picons-display-where." (interactive) (if (and (featurep 'xpm) (or (not (fboundp 'device-type)) (equal (device-type) 'x))) (save-excursion (let* ((iconpoint (point)) (from (mail-fetch-field "from")) (username (progn (string-match "\\([-_a-zA-Z0-9]+\\)@" from) (match-string 1 from))) (hostpath (concat (gnus-picons-reverse-domain-path (replace-in-string (replace-in-string from ".*@\\([_a-zA-Z0-9-.]+\\).*" "\\1") "\\." "/")) "/"))) (switch-to-buffer (gnus-get-buffer-name gnus-picons-display-where)) (beginning-of-buffer) (setq iconpoint (point)) (if (not (looking-at "^$")) (if buffer-read-only (progn (toggle-read-only) (open-line 1) (toggle-read-only) ) (open-line 1))) (end-of-line) (gnus-picons-remove gnus-article-annotations) (setq gnus-article-annotations 'nil) (if (equal username from) (setq username (progn (string-match "<\\([_a-zA-Z0-9-.]+\\)>" from) (match-string 1 from)))) (mapcar '(lambda (pathpart) (setq gnus-article-annotations (append (gnus-picons-insert-face-if-exists (concat (file-name-as-directory gnus-picons-database) pathpart) (concat hostpath username) iconpoint) gnus-article-annotations))) gnus-picons-user-directories) (mapcar '(lambda (pathpart) (setq gnus-article-annotations (append (gnus-picons-insert-face-if-exists (concat (file-name-as-directory gnus-picons-database) pathpart) (concat hostpath "unknown") iconpoint) gnus-article-annotations))) gnus-picons-domain-directories) (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all) )))) (defun gnus-group-display-picons () "Display icons for the group in the gnus-picons-display-where buffer." (interactive) (if (and (featurep 'xpm) (or (not (fboundp 'device-type)) (equal (device-type) 'x))) (save-excursion (let ((iconpoint (point))) (switch-to-buffer (gnus-get-buffer-name gnus-picons-display-where)) (beginning-of-buffer) (cond ((listp gnus-group-annotations) (mapcar 'delete-annotation gnus-group-annotations) (setq gnus-group-annotations nil)) ((annotationp gnus-group-annotations) (delete-annotation gnus-group-annotations) (setq gnus-group-annotations nil)) ) (setq iconpoint (point)) (if (not (looking-at "^$")) (open-line 1)) (gnus-picons-remove gnus-group-annotations) (setq gnus-group-annotations nil) (setq gnus-group-annotations (gnus-picons-insert-face-if-exists (concat (file-name-as-directory gnus-picons-database) gnus-picons-news-directory) (concat (replace-in-string gnus-newsgroup-name "\\." "/") "/unknown") iconpoint t)) (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all))))) (defun gnus-picons-insert-face-if-exists (path filename ipoint &optional rev) "Inserts a face at point if I can find one" (let ((pathfile (concat path "/" filename "/face")) (newfilename (replace-in-string filename "[_a-zA-Z0-9-]+/\\([_A-Za-z0-9-]+\\)$" "\\1")) (annotations nil)) (if (and rev (not (equal filename newfilename))) (setq annotations (append (gnus-picons-insert-face-if-exists path newfilename ipoint rev) annotations))) (if (eq (length annotations) (length (setq annotations (append (gnus-picons-try-to-find-face (concat pathfile ".xpm") ipoint) annotations)))) (setq annotations (append (gnus-picons-try-to-find-face (concat pathfile ".xbm") ipoint) annotations))) (if (and (not rev) (not (equal filename newfilename))) (setq annotations (append (gnus-picons-insert-face-if-exists path newfilename ipoint rev) annotations))) annotations ) ) (defun gnus-picons-try-to-find-face (path ipoint) "If PATH exists, display it as a bitmap. Returns t if succedded." (if (file-exists-p path) (progn ; (insert (format "yes: %s\n" path)) (setq gl (make-glyph path)) (set-glyph-face gl 'default) (list (make-annotation gl ipoint 'text))) ; (insert (format "no: %s\n" path)) nil)) (defun gnus-picons-reverse-domain-path (str) "a/b/c/d -> d/c/b/a" (if (equal (replace-in-string str "^[^/]*$" "") "") str (concat (replace-in-string str "^.*/\\([_a-zA-Z0-9-]+\\)$" "\\1") "/" (gnus-picons-reverse-domain-path (replace-in-string str "^\\(.*\\)/[_a-zA-Z0-9-]+$" "\\1"))))) --===_0_Tue_Jan__9_16:30:04_PST_1996--