Re: shr - span elements with title attribute, tooltip?

[Ted Zlatanov <tzz@lifelogs.com>]

[-- Attachment #1: Type: text/plain, Size: 1029 bytes --]

On Mon, 28 Mar 2011 22:34:08 +0200 asjo@koldfront.dk (Adam Sjøgren) wrote: 

AS> When I try that, I get the same colours and the same tooltips as in
AS> Firefox.

AS> Otherwise I wouldn't have linked to the example.

AS> (With the patch applied, of course.)

I must be doing something wrong, Adam.  I eval-ed your `shr-tag-span'
function and the buffer still looks the same.  

I'd just like to provide a more direct way of viewing the titles *in
addition* to tooltips as you had it.  See attached patch.

AS> On Mon, 28 Mar 2011 15:14:46 -0500, Ted wrote:
>> Anyhow, what's wrong with a "toggle-titles" command for shr.el?
AS> Nothing, I think you should go for it :-)

It would be great if someone who knew shr.el did it similarly to the way
`shr-show-alt-text' and `shr-insert-image' work, plus added a way (maybe
with display properties) to toggle the titles in the buffer.  My first
attempt is attached but I think it's overeager: on your example, 
"M-: (shr-show-title)" shows "Blue" everywhere in the buffer.

Thanks
Ted


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: shr-titles.patch --]
[-- Type: text/x-diff, Size: 1042 bytes --]

diff --git a/lisp/shr.el b/lisp/shr.el
index 113137a..3a217f8 100644
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -161,6 +161,14 @@ redirects somewhere else."
 	(copy-region-as-kill (point-min) (point-max))
 	(message "Copied %s" url))))))
 
+(defun shr-show-title ()
+  "Show the title text of the image under point."
+  (interactive)
+  (let ((text (get-text-property (point) 'shr-title)))
+    (if (not text)
+	(message "No title under point")
+      (message "%s" text))))
+
 (defun shr-show-alt-text ()
   "Show the ALT text of the image under point."
   (interactive)
@@ -896,6 +904,14 @@ ones, in case fg and bg are nil."
     (shr-indent))
   (shr-generic cont))
 
+(defun shr-tag-span (cont)
+  (let ((title (cdr (assq :title cont))))
+    (shr-generic cont)
+    (when title
+      (put-text-property (or start shr-start) (point) 'shr-title title)
+      (let ((overlay (make-overlay (or start shr-start) (point))))
+        (overlay-put overlay 'help-echo title)))))
+
 (defun shr-tag-h1 (cont)
   (shr-heading cont 'bold 'underline))