From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/4430 Path: main.gmane.org!not-for-mail From: Wes Hardaker Newsgroups: gmane.emacs.gnus.general Subject: picon code enclosed Date: Thu, 14 Dec 1995 17:01:41 -0800 Message-ID: <199512150101.AA071709303@chroma.ece.ucdavis.edu> NNTP-Posting-Host: coloc-standby.netfonds.no X-Trace: main.gmane.org 1035145176 29548 80.91.224.250 (20 Oct 2002 20:19:36 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Sun, 20 Oct 2002 20:19:36 +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.6.11/8.6.9) with ESMTP id RAA29953 for ; Thu, 14 Dec 1995 17:37:05 -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 ; Fri, 15 Dec 1995 02:01:46 +0100 Original-Received: by chroma.ece.ucdavis.edu (1.37.109.16/Ultrix3.0-C/eecs 1.1) id AA071709303; Thu, 14 Dec 1995 17:01:43 -0800 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:4430 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:4430 (You wouldn't believe how much news I've read today just playing with this) Anyway, here it is... I'm not an elisp expert, so there is a lot of it I'm planning on cleaning up. _____ 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! \ \_____/ -- ;; ;; Icon hacks for displaying pretty icons in Gnus. ;; ;; Author: Wes hardaker ;; hardaker@ece.ucdavis.edu ;; ;; Usage: ;; - You must have XEmacs to use this. ;; - (add-hook 'gnus-article-display-hook 'gnus-article-display-picons t) ;; This HAS to have the 't' flag above to make sure it appends the hook. ;; - Read the variable descriptions below. ;; ;; Warnings: ;; - I'm not even close to being a lisp expert. ;; ;; TODO: ;; - Following the Gnus motto: We've got to build him bigger, ;; better, stronger, faster than before... errr.... sorry. ;; - Create a seperate frame to store icons in so icons are ;; visibile immediately upon entering a group rather than just ;; at the top of the article buffer. ;; ;; (require 'xpm) (require 'annotations) (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." ) (defun gnus-article-display-picons () "prepare article buffer with pretty pictures" (interactive) (if (featurep 'xpm) (save-excursion (beginning-of-buffer) (open-line 1) (let* ((iconpoint (point)) (from (mail-fetch-field "from")) (username (progn (string-match "\\([-_a-zA-Z0-9]+\\)@" from) (match-string 1 from))) (hostpath (gnus-picons-reverse-domain-path (replace-in-string (replace-in-string from ".*@\\([_a-zA-Z0-9-.]+\\).*" "\\1") "\\." "/")))) (if (equal username from) (setq username (replace-in-string from ".*<\\([_a-zA-Z0-9-.]+\\)>.*" "\\1"))) (insert username) (gnus-picons-insert-face-if-exists (concat gnus-picons-database "/" gnus-picons-news-directory) (concat (replace-in-string gnus-newsgroup-name "\\." "/") "/unknown") iconpoint) (mapcar '(lambda (pathpart) (gnus-picons-insert-face-if-exists (concat gnus-picons-database "/" pathpart) (concat hostpath "/" username) iconpoint)) gnus-picons-user-directories) (mapcar '(lambda (pathpart) (gnus-picons-insert-face-if-exists (concat gnus-picons-database "/" pathpart) (concat hostpath "/" "unknown") iconpoint)) gnus-picons-domain-directories) )))) (defun gnus-picons-insert-face-if-exists (path filename ipoint) "inserts a face at point if I can find one" (let ((pathfile (concat path "/" filename "/face"))) (let ((newfilename (replace-in-string filename "[_a-zA-Z0-9-]+/\\([_A-Za-z0-9-]+\\)$" "\\1"))) (if (not (equal filename newfilename)) (gnus-picons-insert-face-if-exists path newfilename ipoint))) (if (not (gnus-picons-try-to-find-face (concat pathfile ".xpm") ipoint)) (gnus-picons-try-to-find-face (concat pathfile ".xbm") ipoint)) ) ) (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 (setq gl (make-glyph path)) (set-glyph-face gl 'default) (setq annot (make-annotation gl ipoint 'text)) t) ; (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")))))