*** empty log message ***

[gnus] / lisp / gnus-picon.el

diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el
index 7f04650..be64979 100644 (file)
--- a/lisp/gnus-picon.el
+++ b/lisp/gnus-picon.el
@@ -184,17 +184,42 @@ arguments necessary for the job.")
 
 (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)))
+  (let ((buf (get-buffer-create (gnus-window-to-buffer-helper
+                                (cdr 
+                                 (assq variable gnus-window-to-buffer))))))
+    (and buf
+        (buffer-name buf))))
+
+(defun gnus-picons-buffer-name ()
+  (cond ((or (stringp gnus-picons-display-where)
+            (bufferp gnus-picons-display-where))
+        gnus-picons-display-where)
+       ((eq gnus-picons-display-where 'picons)
+        (if gnus-single-article-buffer
+            "*Picons*"
+          (concat "*Picons " gnus-newsgroup-name "*")))
+       (t
+        (gnus-get-buffer-name gnus-picons-display-where))))
+
+(defun gnus-picons-kill-buffer ()
+  (let ((buf (get-buffer (gnus-picons-buffer-name))))
+    (if (buffer-live-p buf)
+       (kill-buffer buf))))
+
+(defun gnus-picons-setup-buffer ()
+  (let ((name (gnus-picons-buffer-name)))
+    (save-excursion
+      (if (get-buffer name)
+         (set-buffer name)
+       (set-buffer (get-buffer-create name))
+       (buffer-disable-undo)
+       (setq buffer-read-only t)
+       (gnus-add-current-to-buffer-list)
+       (add-hook 'gnus-summary-prepare-exit-hook 'gnus-picons-kill-buffer))
+      (current-buffer))))
 
 (defun gnus-picons-set-buffer ()
-  (set-buffer
-   (get-buffer-create (gnus-get-buffer-name gnus-picons-display-where)))
-  (gnus-add-current-to-buffer-list)
+  (set-buffer (gnus-picons-setup-buffer))
   (goto-char (point-min))
   (if (and (eq gnus-picons-display-where 'article)
           gnus-picons-display-article-move-p)
@@ -233,7 +258,8 @@ arguments necessary for the job.")
     (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)))
+    (when (file-exists-p gnus-picons-x-face-file-name)
+      (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.
@@ -242,11 +268,16 @@ To use:  (setq gnus-article-x-face-command 'gnus-picons-display-x-face)"
   (if (featurep 'xface)
       ;; Use builtin support
       (save-excursion
-       (gnus-picons-set-buffer)
-       (gnus-picons-make-annotation
-        (vector 'xface
-                :data (concat "X-Face: " (buffer-substring beg end)))
-        nil 'text))
+       ;; Don't remove this binding, it is really needed: when
+       ;; `gnus-picons-set-buffer' changes buffer (like when it is
+       ;; set to display picons outside of the article buffer), BEG
+       ;; and END still refer the buffer current now !
+       (let ((buf (current-buffer)))
+         (gnus-picons-set-buffer)
+         (gnus-picons-make-annotation
+          (vector 'xface
+                  :data (concat "X-Face: " (buffer-substring beg end buf)))
+          nil 'text nil nil nil t)))
     ;; convert the x-face header to a .xbm file
     (let* ((process-connection-type nil)
           (process (start-process-shell-command "gnus-x-face" nil 
@@ -436,7 +467,7 @@ none, and whose CDR is the corresponding element of DOMAINS."
                                            'text nil nil nil rightp))))))
 
 (defun gnus-picons-action-toggle (data)
-  "Toggle annotation"
+  "Toggle annotation."
   (interactive "e")
   (let* ((annot (car data))
         (glyph (annotation-glyph annot)))
@@ -444,7 +475,7 @@ none, and whose CDR is the corresponding element of DOMAINS."
     (set-annotation-data annot (cons annot glyph))))
 
 (defun gnus-picons-clear-cache ()
-  "Clear the picons cache"
+  "Clear the picons cache."
   (interactive)
   (setq gnus-picons-glyph-alist nil
        gnus-picons-url-alist nil))
@@ -700,7 +731,7 @@ none, and whose CDR is the corresponding element of DOMAINS."
                     (error "Unknown picon job tag %s" tag)))))))
 
 (defun gnus-picons-next-job ()
-  "Start processing the job queue if it is not in progress"
+  "Start processing the job queue if it is not in progress."
   (unless gnus-picons-job-already-running
     (gnus-picons-next-job-internal)))