From: Kim-Minh Kaplan <KimMinh.Kaplan@utopia.eunet.fr>
Subject: Re: Picons
Date: 26 Feb 1998 01:30:46 +0100 [thread overview]
Message-ID: <yg4afbfyzy6.fsf@lombric.s-ip.eunet.fr> (raw)
In-Reply-To: Wes Hardaker's message of "13 Feb 1998 11:23:36 -0800"
[-- Attachment #1: Type: text/plain, Size: 1035 bytes --]
>>>>> On 13 Feb 1998 Lars Magne Ingebrigtsen said:
Lars> Picons don't work if you have more than one article buffer
Lars> open at the same time.
OK, I changed them. They now work correctly when `gnus-picons-display-where'
is `article'.
When it is `picons' (the default) then the *Picons* buffer only shows
the picons for the last loaded message. If you'd ask me we would just
remove this variable and always use the article buffer...
We could also remove the X-Face display functionnality that is already
available with `gnus-article-display-xface'
Note that you should also remove `gnus-group-display-picons' from the
`gnus-summary-prepare-hook' ; it is now done inside
`gnus-article-display-picons'.
>>>>> On February 13, 1998, Wes Hardaker said:
Wes> (there is other bugs in the picons code that got inserted in
Wes> the last few patches people sent to you as well).
This patch fixes the problem about deleted extents that you must have
seen if you are displaying picons in the article buffer.
Kim-Minh.
[-- Attachment #2: Type: text/plain, Size: 9984 bytes --]
--- /usr/local/lib/xemacs/gnus/lisp/gnus-picon.el.orig Wed Feb 25 19:44:11 1998
+++ /usr/local/lib/xemacs/gnus/lisp/gnus-picon.el Thu Feb 26 01:17:54 1998
@@ -90,7 +90,7 @@
:group 'picons)
(defcustom gnus-picons-x-face-file-name
- '(format "/tmp/picon-xface.%s.xbm" (user-login-name))
+ (format "/tmp/picon-xface.%s.xbm" (user-login-name))
"*The name of the file in which to store the converted X-face header."
:type 'string
:group 'picons)
@@ -159,13 +159,6 @@
"Picons file names cache.
List of pairs (KEY . NAME) where KEY is (USER HOST DBS) and NAME is an URL.")
-(defvar gnus-group-annotations nil
- "List of annotations added/removed when selecting/exiting a group")
-(defvar gnus-article-annotations nil
- "List of annotations added/removed when selecting an article")
-(defvar gnus-x-face-annotations nil
- "List of annotations added/removed when selecting an article with an X-Face.")
-
(defvar gnus-picons-jobs-alist nil
"List of jobs that still need be done.
This is a list of (SYM-ANN TAG ARGS...) where SYM-ANN three annotations list,
@@ -178,28 +171,16 @@
;;; Functions:
-(defun gnus-picons-remove (symbol)
- "Remove all annotations in variable named SYMBOL.
-This function is careful to set it to nil before removing anything so that
-asynchronous process don't get crazy."
- (setq gnus-picons-jobs-alist (remassq symbol gnus-picons-jobs-alist))
- ;; notify running job that it may have been preempted
- (if (and (listp gnus-picons-job-already-running)
- (eq (car gnus-picons-job-already-running) symbol))
- (setq gnus-picons-job-already-running t))
- ;; clear all annotations
- (mapc (function (lambda (item)
- (if (annotationp item)
- (delete-annotation item))))
- (prog1 (symbol-value symbol)
- (set symbol nil))))
-
(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)
- (gnus-picons-remove 'gnus-x-face-annotations))
+ (map-extents (function (lambda (ext unused) (delete-annotation ext) nil))
+ nil nil nil nil nil 'gnus-picon)
+ (setq gnus-picons-jobs-alist '())
+ ;; notify running job that it may have been preempted
+ (if (and (listp gnus-picons-job-already-running)
+ gnus-picons-job-already-running)
+ (setq gnus-picons-job-already-running t)))
(defun gnus-get-buffer-name (variable)
"Returns the buffer name associated with the contents of a variable."
@@ -226,41 +207,33 @@
(list (list (current-buffer)
(cons nil gnus-picons-has-modeline-p)))))))
-(defun gnus-picons-prepare-for-annotations (annotations)
- "Prepare picons buffer for puting annotations memorized in ANNOTATIONS.
-ANNOTATIONS should be a symbol naming a variable wich contains a list of
-annotations. Sets buffer to `gnus-picons-display-where'."
+(defun gnus-picons-prepare-for-annotations ()
+ "Prepare picons buffer for putting annotations."
;; let drawing catch up
(when gnus-picons-refresh-before-display
(sit-for 0))
(gnus-picons-set-buffer)
- (gnus-picons-remove annotations))
+ (gnus-picons-remove-all))
-(defsubst gnus-picons-make-annotation (&rest args)
+(defun gnus-picons-make-annotation (&rest args)
(let ((annot (apply 'make-annotation args)))
- (set-extent-property annot 'duplicable nil)
+ (set-extent-property annot 'gnus-picon t)
+ (set-extent-property annot 'duplicable t)
annot))
(defun gnus-picons-article-display-x-face ()
"Display the x-face header bitmap in the 'gnus-picons-display-where buffer."
- ;; delete any old ones.
- ;; This is needed here because gnus-picons-display-x-face will not
- ;; be called if there is no X-Face header
- (gnus-picons-remove 'gnus-x-face-annotations)
- ;; display the new one.
(let ((gnus-article-x-face-command 'gnus-picons-display-x-face))
(gnus-article-display-x-face)))
(defun gnus-picons-x-face-sentinel (process event)
- (let* ((env (assq process gnus-picons-processes-alist))
- (annot (cdr env)))
+ (when (memq process gnus-picons-processes-alist)
(setq gnus-picons-processes-alist
- (remassq process gnus-picons-processes-alist))
- (when (annotationp annot)
- (set-annotation-glyph annot
- (make-glyph gnus-picons-x-face-file-name))
- (if (memq annot gnus-x-face-annotations)
- (delete-file gnus-picons-x-face-file-name)))))
+ (delq process gnus-picons-processes-alist))
+ (gnus-picons-set-buffer)
+ (gnus-picons-make-annotation (make-glyph gnus-picons-x-face-file-name)
+ nil 'text)
+ (delete-file gnus-picons-x-face-file-name)))
(defun gnus-picons-display-x-face (beg end)
"Function to display the x-face header in the picons window.
@@ -268,26 +241,17 @@
(interactive)
(if (featurep 'xface)
;; Use builtin support
- (let ((buf (current-buffer)))
- (save-excursion
- (gnus-picons-prepare-for-annotations 'gnus-x-face-annotations)
- (setq gnus-x-face-annotations
- (cons (gnus-picons-make-annotation
- (vector 'xface
- :data (concat "X-Face: "
- (buffer-substring beg end buf)))
- nil 'text)
- gnus-x-face-annotations))))
+ (save-excursion
+ (gnus-picons-set-buffer)
+ (gnus-picons-make-annotation
+ (vector 'xface
+ :data (concat "X-Face: " (buffer-substring beg end buf)))
+ nil 'text))
;; convert the x-face header to a .xbm file
(let* ((process-connection-type nil)
- (annot (save-excursion
- (gnus-picons-prepare-for-annotations
- 'gnus-x-face-annotations)
- (gnus-picons-make-annotation nil nil 'text)))
(process (start-process-shell-command "gnus-x-face" nil
gnus-picons-convert-x-face)))
- (push annot gnus-x-face-annotations)
- (push (cons process annot) gnus-picons-processes-alist)
+ (push process gnus-picons-processes-alist)
(process-kill-without-query process)
(set-process-sentinel process 'gnus-picons-x-face-sentinel)
(process-send-region process beg end)
@@ -312,37 +276,28 @@
(message-tokenize-header gnus-local-domain "."))
(message-tokenize-header (substring from (1+ at-idx))
"."))))
- (gnus-picons-prepare-for-annotations 'gnus-article-annotations)
- ;; if display in article buffer, the group annotations
- ;; wrongly placed. Move them here
- (if (eq gnus-picons-display-where 'article)
- (dolist (ext gnus-group-annotations)
- (when (extent-live-p ext)
- (set-extent-endpoints ext (point) (point)))))
+ (gnus-picons-prepare-for-annotations)
+ (gnus-group-display-picons)
(if (null gnus-picons-piconsearch-url)
- (setq gnus-article-annotations
- (nconc gnus-article-annotations
- (gnus-picons-display-pairs
- (gnus-picons-lookup-pairs
- addrs gnus-picons-domain-directories)
- gnus-picons-display-as-address
- "." t)
- (if (and gnus-picons-display-as-address addrs)
- (list (gnus-picons-make-annotation
- [string :data "@"] nil
- 'text nil nil nil t)))
- (gnus-picons-display-picon-or-name
- (gnus-picons-lookup-user username addrs)
- username t)))
+ (progn
+ (gnus-picons-display-pairs (gnus-picons-lookup-pairs
+ addrs
+ gnus-picons-domain-directories)
+ gnus-picons-display-as-address
+ "." t)
+ (if (and gnus-picons-display-as-address addrs)
+ (gnus-picons-make-annotation
+ [string :data "@"] nil 'text nil nil nil t))
+ (gnus-picons-display-picon-or-name
+ (gnus-picons-lookup-user username addrs)
+ username t))
(push (list 'gnus-article-annotations 'search username addrs
gnus-picons-domain-directories t)
gnus-picons-jobs-alist)
- (gnus-picons-next-job))
-
- (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all))))))
+ (gnus-picons-next-job)))))))
(defun gnus-group-display-picons ()
- "Display icons for the group in the gnus-picons-display-where buffer."
+ "Display icons for the group in the `gnus-picons-display-where' buffer."
(interactive)
(when (and (featurep 'xpm)
(or (not (fboundp 'device-type)) (equal (device-type) 'x))
@@ -350,16 +305,15 @@
(not (string-match gnus-picons-group-excluded-groups
gnus-newsgroup-name))))
(save-excursion
- (gnus-picons-prepare-for-annotations 'gnus-group-annotations)
+ (gnus-picons-prepare-for-annotations)
(if (null gnus-picons-piconsearch-url)
- (setq gnus-group-annotations
- (gnus-picons-display-pairs
+ (gnus-picons-display-pairs
(gnus-picons-lookup-pairs
(reverse (message-tokenize-header
(gnus-group-real-name gnus-newsgroup-name)
"."))
gnus-picons-news-directories)
- t "."))
+ t ".")
(push (list 'gnus-group-annotations 'search nil
(message-tokenize-header
(gnus-group-real-name gnus-newsgroup-name) ".")
@@ -372,7 +326,7 @@
(add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all))))
-(defsubst gnus-picons-lookup-internal (addrs dir)
+(defun gnus-picons-lookup-internal (addrs dir)
(setq dir (expand-file-name dir gnus-picons-database))
(gnus-picons-try-face (dolist (part (reverse addrs) dir)
(setq dir (expand-file-name part dir)))))
@@ -601,8 +555,7 @@
(defun gnus-picons-network-display-internal (sym-ann glyph part right-p)
(gnus-picons-set-buffer)
- (set sym-ann (nconc (symbol-value sym-ann)
- (gnus-picons-display-picon-or-name glyph part right-p)))
+ (gnus-picons-display-picon-or-name glyph part right-p)
(gnus-picons-next-job-internal))
(defun gnus-picons-network-display-callback (url part sym-ann right-p)
@@ -697,6 +650,7 @@
(prog1 (gnus-picons-parse-filenames)
(kill-buffer (current-buffer)))))
+;; Initiate a query on the picon database
(defun gnus-picons-network-search (user addrs dbs sym-ann right-p)
(let* ((host (mapconcat 'identity addrs "."))
(key (list (or user "unknown") host (if user
next prev parent reply other threads:[~1998-02-26 0:30 UTC|newest]
Thread overview: 13+ messages / expand[flat|nested] mbox.gz Atom feed top
1998-02-13 16:50 Picons Lars Magne Ingebrigtsen
1998-02-13 19:23 ` Picons Wes Hardaker
1998-02-14 15:53 ` Picons Lars Magne Ingebrigtsen
1998-02-26 0:30 ` Kim-Minh Kaplan [this message]
1998-02-26 0:57 ` Picons Wes Hardaker
1998-02-28 18:09 ` Picons Hans de Graaff
1998-03-02 16:43 ` Picons Wes Hardaker
1998-03-01 15:05 ` Picons Kim-Minh Kaplan
1999-04-20 10:00 picons David Hedbor
1999-06-12 2:17 ` picons Lars Magne Ingebrigtsen
2001-12-29 19:05 picons Henrik Enberg
2001-12-29 20:44 ` picons ShengHuo ZHU
2001-12-29 21:13 ` picons Lars Magne Ingebrigtsen
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=yg4afbfyzy6.fsf@lombric.s-ip.eunet.fr \
--to=kimminh.kaplan@utopia.eunet.fr \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).