* gnus-picons update
@ 1996-09-06 13:11 Wesley.Hardaker
1996-09-09 8:53 ` Hans de Graaff
0 siblings, 1 reply; 5+ messages in thread
From: Wesley.Hardaker @ 1996-09-06 13:11 UTC (permalink / raw)
Heh...
Ok, I've out-done myself in stupid useless coding projects with this
one. There is no reason what-so-ever for actually using the following
features... You have been warned...
The following patch is against rgnus-0.27 and does 2 things:
1) speed improvements:
- first, I put a sit-for at the top of the display routines so that
you can begin reading the article in question before the icons
show up... This really should be an option... Oh well...
- Lars, in order to simplify and shorten the code length, searched
both the domains and users database for both types of icons
(username and "unknown"). I removed this, as you will never find
username directories under the domains section and likewise for
the users section... IE, half the number of searches (I realize
this is only a slight speed gain).
2) Stupid useless improvements:
- The icons are now displayed as a real email address rather than
just as icons. It relpaces the parts of the address that can be
represented by icons with icons, and replaces the user name with a
face for the user, if present. You can, of course, click on the
appropriate graphic symbol and have it change into text and
vise-versa. As I said... Stupid... But cute...
3) gnus-group-display-picons: Hey... Can't have it all in a day. I
still have to munge this one... It can actually be done fairly
easily, providing you don't mind the newsgroup tokens being
backwards (ie, gnus.emacs.gnu instead of gnu.emacs.gnus)... sigh...
Hey! I hate that! What a stupid idea! Please make it go away! :
(setq gnus-picons-display-as-address nil)
Lars, I greatly @#$#ed up the nice pretty code you had in there...
Sorry about that... It needs to be visually cleaned up a bit,
reworking the indentation sceme... Sorry...
Wes
Index: ChangeLog
===================================================================
RCS file: /home/whardake/src/cvsroot/rgnus/ChangeLog,v
retrieving revision 1.1.1.5
retrieving revision 1.6
diff -c -r1.1.1.5 -r1.6
*** 1.1.1.5 1996/09/06 12:35:19
--- 1.6 1996/09/06 12:45:19
***************
*** 1,3 ****
--- 1,14 ----
+ Fri Sep 6 14:38:54 1996 Wes Hardaker <Wesley.Hardaker@sphys.unil.ch>
+
+ * gnus-picons.el (gnus-picons-display-as-address): New variable.
+ (gnus-picons-map): New keymap for picons.
+ (gnus-picons-toggle-extent): New function.
+ (gnus-article-display-picons): use them.
+ (gnus-picons-insert-face-if-exists): ditto.
+ (gnus-picons-try-to-find-face): ditto.
+ (gnus-group-display-picons): let display catch up.
+ (gnus-article-display-picons): ditto.
+
Thu Sep 5 19:50:19 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
* gnus-xmas.el (gnus-xmas-modeline-glyph): Set string properly.
Index: gnus-picon.el
===================================================================
RCS file: /home/whardake/src/cvsroot/rgnus/gnus-picon.el,v
retrieving revision 1.1.1.1
retrieving revision 1.3
diff -c -r1.1.1.1 -r1.3
*** 1.1.1.1 1996/08/20 07:06:45
--- 1.3 1996/09/06 12:32:53
***************
*** 110,115 ****
--- 110,118 ----
"Command to convert the x-face header into a xbm file."
)
+ (defvar gnus-picons-display-as-address t
+ "*If t display textual email addresses along with pictures.")
+
(defvar gnus-picons-file-suffixes
(when (featurep 'x)
(let ((types (list "xbm")))
***************
*** 124,129 ****
--- 127,137 ----
"*Whether to move point to first empty line when displaying picons.
This has only an effect if `gnus-picons-display-where' hs value article.")
+ (defvar gnus-picons-map (make-sparse-keymap "gnus-picons-keys")
+ "keymap to hide/show picon glpyhs")
+
+ (define-key gnus-picons-map [(button2)] 'gnus-picons-toggle-extent)
+
;;; Internal variables.
(defvar gnus-group-annotations nil)
***************
*** 207,212 ****
--- 215,222 ----
(defun gnus-article-display-picons ()
"Display faces for an author and his/her domain in gnus-picons-display-where."
(interactive)
+ ;; let drawing catch up
+ (sit-for 0)
(let (from at-idx databases)
(when (and (featurep 'xpm)
(or (not (fboundp 'device-type)) (equal (device-type) 'x))
***************
*** 240,264 ****
(gnus-picons-remove gnus-article-annotations)
(setq gnus-article-annotations nil)
! (setq databases (append gnus-picons-user-directories
! gnus-picons-domain-directories))
(while databases
(setq gnus-article-annotations
(nconc (gnus-picons-insert-face-if-exists
(car databases)
addrs
! "unknown")
! (gnus-picons-insert-face-if-exists
! (car databases)
! addrs
! (downcase username) t)
gnus-article-annotations))
(setq databases (cdr databases)))
(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)
(when (and (featurep 'xpm)
(or (not (fboundp 'device-type)) (equal (device-type) 'x)))
(save-excursion
--- 250,300 ----
(gnus-picons-remove gnus-article-annotations)
(setq gnus-article-annotations nil)
! ;; look for domain paths.
! (setq databases gnus-picons-domain-directories)
(while databases
(setq gnus-article-annotations
(nconc (gnus-picons-insert-face-if-exists
(car databases)
addrs
! "unknown" t)
gnus-article-annotations))
(setq databases (cdr databases)))
+
+ ;; add an '@' if displaying as address
+ (when gnus-picons-display-as-address
+ (setq gnus-article-annotations
+ (nconc gnus-article-annotations
+ (list
+ (make-annotation "@" (point) 'text nil nil nil t)))))
+
+ ;; then do user directories,
+ (let (found)
+ (setq databases gnus-picons-user-directories)
+ (setq username (downcase username))
+ (while databases
+ (setq found
+ (nconc (gnus-picons-insert-face-if-exists
+ (car databases)
+ addrs
+ username)
+ found))
+ (setq databases (cdr databases)))
+ ;; add their name if no face exists
+ (when (and gnus-picons-display-as-address (not found))
+ (setq found
+ (list
+ (make-annotation username (point) 'text nil nil nil t))))
+ (setq gnus-article-annotations
+ (nconc found gnus-article-annotations)))
+
(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)
+ ;; let display catch up so far
+ (sit-for 0)
(when (and (featurep 'xpm)
(or (not (fboundp 'device-type)) (equal (device-type) 'x)))
(save-excursion
***************
*** 312,345 ****
;; 1. MISC/Name
;; The special treatment of MISC doesn't conform with the conventions for
;; picon databases, but otherwise we would always see the MISC/unknown face.
! (let ((bar (and (not nobar-p)
(annotations-in-region
(point) (min (point-max) (1+ (point)))
(current-buffer))))
(path (concat (file-name-as-directory gnus-picons-database)
database "/"))
! picons found bar-ann)
(if (string-match "/MISC" database)
(setq addrs '("")))
(while (and addrs
(file-accessible-directory-p path))
! (setq path (concat path (pop addrs) "/"))
! (when (setq found
! (gnus-picons-try-suffixes
! (concat path filename "/face.")))
! (when bar
! (setq bar-ann (gnus-picons-try-to-find-face
! (concat gnus-xmas-glyph-directory "bar.xbm")))
! (when bar-ann
! (setq picons (nconc picons bar-ann))
! (setq bar nil)))
! (setq picons (nconc (gnus-picons-try-to-find-face found)
! picons))))
! (nreverse picons)))
(defvar gnus-picons-glyph-alist nil)
! (defun gnus-picons-try-to-find-face (path &optional xface-p)
"If PATH exists, display it as a bitmap. Returns t if succedded."
(let ((glyph (and (not xface-p)
(cdr (assoc path gnus-picons-glyph-alist)))))
--- 348,398 ----
;; 1. MISC/Name
;; The special treatment of MISC doesn't conform with the conventions for
;; picon databases, but otherwise we would always see the MISC/unknown face.
! (let ((bar (and (not gnus-picons-display-as-address)
! (not nobar-p)
(annotations-in-region
(point) (min (point-max) (1+ (point)))
(current-buffer))))
(path (concat (file-name-as-directory gnus-picons-database)
database "/"))
! (domainp (and gnus-picons-display-as-address nobar-p))
! picons found bar-ann cur first)
(if (string-match "/MISC" database)
(setq addrs '("")))
(while (and addrs
(file-accessible-directory-p path))
! (setq cur (pop addrs)
! path (concat path cur "/"))
! (if (setq found
! (gnus-picons-try-suffixes (concat path filename "/face.")))
! (progn
! (when bar
! (setq bar-ann (gnus-picons-try-to-find-face
! (concat gnus-xmas-glyph-directory "bar.xbm")))
! (when bar-ann
! (setq picons (nconc picons bar-ann))
! (setq bar nil)))
! (setq picons (nconc (when (and domainp first)
! (list (make-annotation "." (point) 'text
! nil nil nil t) picons))
! (gnus-picons-try-to-find-face
! found nil (if domainp cur filename))
! picons)))
! (when domainp
! (setq picons
! (nconc (list (make-annotation (if first (concat cur ".") cur)
! (point) 'text nil nil nil t))
! picons))))
! (setq first t))
! (when (and addrs domainp)
! (let ((it (mapconcat 'downcase addrs ".")))
! (make-annotation
! (if first (concat it ".") it) (point) 'text nil nil nil t)))
! picons))
(defvar gnus-picons-glyph-alist nil)
! (defun gnus-picons-try-to-find-face (path &optional xface-p part)
"If PATH exists, display it as a bitmap. Returns t if succedded."
(let ((glyph (and (not xface-p)
(cdr (assoc path gnus-picons-glyph-alist)))))
***************
*** 349,362 ****
(unless xface-p
(push (cons path glyph) gnus-picons-glyph-alist))
(set-glyph-face glyph 'default))
! (nconc
! (list (make-annotation glyph (point) 'text))
! (when (eq major-mode 'gnus-article-mode)
! (list (make-annotation " " (point) 'text)))))))
(defun gnus-picons-reverse-domain-path (str)
"a/b/c/d -> d/c/b/a"
(mapconcat 'downcase (nreverse (message-tokenize-header str "/")) "/"))
(gnus-add-shutdown 'gnus-picons-close 'gnus)
--- 402,435 ----
(unless xface-p
(push (cons path glyph) gnus-picons-glyph-alist))
(set-glyph-face glyph 'default))
! (let ((new (make-annotation glyph (point) 'text nil nil nil t)))
! (nconc
! (list new)
! (when (and (eq major-mode 'gnus-article-mode)
! (not gnus-picons-display-as-address)
! (not part))
! (list (make-annotation " " (point) 'text nil nil nil t)))
! (when (and part gnus-picons-display-as-address)
! (let ((txt (make-annotation part (point) 'text nil nil nil t)))
! (hide-annotation txt)
! (set-extent-property txt 'its-partner new)
! (set-extent-property txt 'keymap gnus-picons-map)
! (set-extent-property txt 'mouse-face gnus-article-mouse-face)
! (set-extent-property new 'its-partner txt)
! (set-extent-property new 'keymap gnus-picons-map))))))))
(defun gnus-picons-reverse-domain-path (str)
"a/b/c/d -> d/c/b/a"
(mapconcat 'downcase (nreverse (message-tokenize-header str "/")) "/"))
+
+ (defun gnus-picons-toggle-extent (event)
+ "Toggle picon glyph at given point"
+ (interactive "e")
+ (let* ((ant1 (event-glyph-extent event))
+ (ant2 (extent-property ant1 'its-partner)))
+ (when (and (annotationp ant1) (annotationp ant2))
+ (reveal-annotation ant2)
+ (hide-annotation ant1))))
(gnus-add-shutdown 'gnus-picons-close 'gnus)
^ permalink raw reply [flat|nested] 5+ messages in thread* Re: gnus-picons update
1996-09-06 13:11 gnus-picons update Wesley.Hardaker
@ 1996-09-09 8:53 ` Hans de Graaff
1996-09-09 15:02 ` Wesley.Hardaker
0 siblings, 1 reply; 5+ messages in thread
From: Hans de Graaff @ 1996-09-09 8:53 UTC (permalink / raw)
Wesley.Hardaker@sphys.unil.ch writes:
Cool... but some comments ;-)
> 1) speed improvements:
> - first, I put a sit-for at the top of the display routines so that
> you can begin reading the article in question before the icons
> show up... This really should be an option... Oh well...
What is irritating about this is that the initial line is just
text. As soon as the icons get inserted this changes the line height,
and shifts all other text down. Annoying. How about inserting a small
blank xpm of the proper height immediately, to reserve the line height.
> 2) Stupid useless improvements:
> - The icons are now displayed as a real email address rather than
> just as icons. It relpaces the parts of the address that can be
> represented by icons with icons, and replaces the user name with a
> face for the user, if present. You can, of course, click on the
> appropriate graphic symbol and have it change into text and
> vise-versa. As I said... Stupid... But cute...
Also redundant. I'd rather see this changed in the From: line. Then
the X-Face, which is currently shown there just after the From: could
be included in the email-address as well, and we would have the picons
all in one place.
Hans
--
Hans de Graaff http://is.twi.tudelft.nl/~graaff/
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: gnus-picons update
1996-09-09 8:53 ` Hans de Graaff
@ 1996-09-09 15:02 ` Wesley.Hardaker
1996-09-09 16:51 ` William Perry
0 siblings, 1 reply; 5+ messages in thread
From: Wesley.Hardaker @ 1996-09-09 15:02 UTC (permalink / raw)
Hans de Graaff <J.J.deGraaff@twi.tudelft.nl> writes:
> What is irritating about this is that the initial line is just
> text. As soon as the icons get inserted this changes the line height,
> and shifts all other text down. Annoying. How about inserting a small
> blank xpm of the proper height immediately, to reserve the line
> height.
I've thought about this... However, this would slow it down more and
additionally require reading yet one more image file...
What should be done (and will be I promise) is to create a variable so
that it will optionally update the buffer first rather than force it
to, as is being done now... That way you can pick if it does said
improvement.
> Also redundant. I'd rather see this changed in the From: line. Then
> the X-Face, which is currently shown there just after the From: could
> be included in the email-address as well, and we would have the picons
> all in one place.
Yep, its on my todo list in fact... I want to essentially zap the
address out of the From: line and replace it with icons... This
should be an option though. Maybe set gnus-picons-display-where to
'from-line or something instead of 'article. That way its
user-pickable...
Wes
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: gnus-picons update
1996-09-09 15:02 ` Wesley.Hardaker
@ 1996-09-09 16:51 ` William Perry
1996-09-10 13:55 ` Wesley.Hardaker
0 siblings, 1 reply; 5+ messages in thread
From: William Perry @ 1996-09-09 16:51 UTC (permalink / raw)
Cc: ding
Wesley Hardaker writes:
>Hans de Graaff <J.J.deGraaff@twi.tudelft.nl> writes:
>
>> What is irritating about this is that the initial line is just
>> text. As soon as the icons get inserted this changes the line height,
>> and shifts all other text down. Annoying. How about inserting a small
>> blank xpm of the proper height immediately, to reserve the line
>> height.
>
>I've thought about this... However, this would slow it down more and
>additionally require reading yet one more image file...
You would only need to do this once at startup. And you can build a
pixmap pretty easily in memory. I've got the code to do it for Emacs-W3.
Try something like:
(defun create-blank-pixmap (width height)
(let ((retval
(concat "/* XPM */\n"
"static char *pixmap[] = {\n"
;;"/* width height num_colors chars_per_pixel */\n"
(format "\" %d %d 2 1\",\n" width height)
;;"/* colors */\n"
"\". c #000000 s background\",\n"
"\"# c #FFFFFF s foreground\",\n"
;;"/* pixels /*\n"
))
(line (concat "\"" (make-string width ?.) "\"")))
(while (/= 1 height)
(setq retval (concat retval line ",\n")
height (1- height)))
(concat retval line "\n};")))
Then:
(make-glyph (vector 'xpm :data (create-blank-pixmap 40 40))))
Wheee.
-Bill P.
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~1996-09-10 13:55 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
1996-09-06 13:11 gnus-picons update Wesley.Hardaker
1996-09-09 8:53 ` Hans de Graaff
1996-09-09 15:02 ` Wesley.Hardaker
1996-09-09 16:51 ` William Perry
1996-09-10 13:55 ` Wesley.Hardaker
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).