From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/5838 Path: main.gmane.org!not-for-mail From: Mark Borges Newsgroups: gmane.emacs.gnus.general Subject: Re: X-Face support in XEmacs Date: 03 Apr 1996 09:07:30 -0700 Organization: CIRES, University of Colorado Sender: mdb@cdc.noaa.gov Message-ID: References: NNTP-Posting-Host: coloc-standby.netfonds.no X-Trace: main.gmane.org 1035146382 1533 80.91.224.250 (20 Oct 2002 20:39:42 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Sun, 20 Oct 2002 20:39:42 +0000 (UTC) Return-Path: ding-request@ifi.uio.no Original-Received: from ifi.uio.no (ifi.uio.no [129.240.64.2]) by deanna.miranova.com (8.7.5/8.6.9) with SMTP id JAA04123 for ; Wed, 3 Apr 1996 09:05:20 -0800 Original-Received: from cdc.noaa.gov (manager.Colorado.EDU [128.138.218.210]) by ifi.uio.no with ESMTP (8.6.11/ifi2.4) id for ; Wed, 3 Apr 1996 18:07:56 +0200 Original-Received: from suomi by cdc.noaa.gov (SMI-8.6/SMI-SVR4) id JAA02623; Wed, 3 Apr 1996 09:07:32 -0700 Original-Received: by suomi (5.0) id AA03504; Wed, 3 Apr 1996 09:07:32 -0700 Original-To: ding@ifi.uio.no X-Attribution: mb In-Reply-To: Pekka Marjola's message of 25 Mar 1996 18:05:42 +0200 Original-Lines: 148 Xref: main.gmane.org gmane.emacs.gnus.general:5838 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:5838 >> On 25 Mar 1996 18:05:42 +0200, >> Pekka Marjola(p) wrote: p> Since XEmacs can show X-Face without external processes, shouldn't p> something like this be included in gnus-xmas.el? (Coincidentally, I p> was planning to rip exactly same code from VM, but never bothered Appended is an alternative patch to gnus-xmas.el that works for me. I like it more better because it has different behavior than the one based on Kyle's work (background/foreground faces are definable by user, optional hiding of X-Face data, maybe something else, I forget). If you don't have highlight headers loaded (or don't want to use it) you'll have to uncomment the line containing the call to gnus-xmas-embed-xface-to-pixmap() below). -mb- --- gnus-xmas.el.orig Tue Apr 2 06:58:56 1996 +++ gnus-xmas.el Tue Apr 2 09:58:35 1996 @@ -422,7 +422,8 @@ (fset 'gnus-tree-minimize 'gnus-xmas-tree-minimize) (fset 'gnus-appt-select-lowest-window 'gnus-xmas-appt-select-lowest-window) - (fset 'gnus-mail-strip-quoted-names 'gnus-xmas-mail-strip-quoted-names) + (if (< emacs-minor-version 14) + (fset 'gnus-mail-strip-quoted-names 'gnus-xmas-mail-strip-quoted-names)) (fset 'gnus-make-local-hook 'make-local-variable) (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add) @@ -434,6 +435,15 @@ (add-hook 'gnus-binary-mode-hook 'gnus-xmas-binary-menu-add) (add-hook 'gnus-grouplens-mode-hook 'gnus-xmas-grouplens-menu-add) + ;; Note that this hook into gnus-article-display-hook needs to be + ;; run last -- hence the trailing t (for append). Alternatively, + ;; you could comment it out and have the users put it in their + ;; gnus-init-file instead; this may be the right thing to do anyway, + ;; since the decision is left to the user to enable it or not. But + ;; then again, if one has xface support compiled in one should use + ;; it. So I don't know. Lars? + (add-hook 'gnus-article-display-hook '(lambda() (gnus-xmas-embed-xface t)) t) + (add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar) (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar)) @@ -742,6 +752,100 @@ (after-find-file error (not nowarn))))) buf))) + +;;; gnus-xmas-embed-xface() --- embed an X-Face in the article buffer. +;;; Coded by Mark Borges , based on original ideas +;;; in highlight-headers.el by Jamie Zawinski (which see). +;;; +;;; The auxilliary function gnus-xmas-embed-xface-to-pixmap() is +;;; called to do the actual conversion. +;;; The variable gnus-xmas-embed-xface-p is consulted to determine if +;;; xface conversion is possible. +;;; + +(defvar gnus-xmas-embed-xface-p (featurep 'xface) + "*If true, then the bitmap in an X-Face header will be displayed +in the buffer.") + +(defun gnus-xmas-embed-xface (&optional hide-data) + "Search for an X-Face header line; if found, display next to the From line. +Optional argument HIDE-DATA makes the original X-Face header invisible. +" + ;; make sure a face exists + (if (find-face 'x-face) + nil + (make-face 'x-face) + (or (face-differs-from-default-p 'x-face) + (progn + (set-face-background 'x-face "white") + (set-face-foreground 'x-face "black")))) + + ;; delete previous highlighting + (map-extents (function (lambda (extent ignore) + (if (extent-property extent 'is-xface) + (delete-extent extent)) + nil)) + (current-buffer) (point-min) (point-max)) + + (save-excursion + (let* (e) + + (goto-char (point-min)) + ;; + (cond + ( (and gnus-xmas-embed-xface-p + (re-search-forward "^X-Face: *\\(.*\\(\n[ \t].*\\)*\n\\)" nil t)) + (setq e (make-extent (match-beginning 0) (match-end 0))) + + ;; if requested, make the whole header invisible + (if hide-data + (set-extent-property e 'invisible t)) + + ;; now extract the xface and put it somewhere interesting +; (let ((xface (gnus-xmas-embed-xface-to-pixmap + (let ((xface (highlight-headers-x-face-to-pixmap + (match-beginning 1) + (match-end 1)))) + (if (not xface) + nil ; just leave the header invisible if we can't convert + ; the face for some reason + (cond + ( (save-excursion + (goto-char (point-min)) + (save-excursion (re-search-forward "^From: *" + nil t))) + (setq e (make-extent (match-end 0) + (match-end 0)))) + (t + ;; okay, make the beginning of the the invisible + ;; move forward to only hide the modem noise... + (set-extent-endpoints e + (match-beginning 2) + (1- (match-end 2))) + ;; kludge: if a zero-length extent exists at the + ;; starting point of an invisible extent, then + ;; it's invisible... even if the invisible extent + ;; is start-open. + (setq e (make-extent (1- (match-beginning 2)) + (match-beginning 2))) + )) + (set-extent-property e 'is-xface t) + (set-extent-end-glyph e xface)) + ) + ))) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; auxilliary function for X-Face header conversion: +(defun gnus-xmas-embed-xface-to-pixmap (start end) + (let* ((string (if (stringp start) start (buffer-substring start end)))) + (if (featurep 'xface) + (let ((new-face (make-glyph (concat "X-Face: " string)))) + (set-glyph-face new-face 'x-face) + new-face) + (message "This cannot happen when called from gnus-xmas-embed-xface!") + )) + ) (defun gnus-xmas-mail-strip-quoted-names (address) "Protect mail-strip-quoted-names from NIL input. XEmacs compatibility workaround."