From: Lars Magne Ingebrigtsen <larsi@gnus.org>
Date: Sat, 13 Dec 2014 15:23:40 +0000 (+0100)
Subject: Make shr fold long title texts
X-Git-Tag: emacs-25.0.90~2635^2~89
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=76f9994d677e0440584216e4e47be37e2d3dc312;p=emacs.git

Make shr fold long title texts

* net/shr.el (shr-fold-text): New function.
(shr-show-alt-text, shr-urlify, shr-tag-img): Use it to fold long
alt/title texts.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 6955c3c6cca..5caf37672c7 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,9 @@
 2014-12-13  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
+	* net/shr.el (shr-fold-text): New function.
+	(shr-show-alt-text, shr-urlify, shr-tag-img): Use it to fold long
+	alt/title texts.
+
 	* files.el (directory-files-recursively): Really check whether
 	files are symlinks.
 	(directory-name-p): New function.
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 695b91dcb1b..2fff3603546 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -301,7 +301,7 @@ redirects somewhere else."
   (let ((text (get-text-property (point) 'shr-alt)))
     (if (not text)
 	(message "No image under point")
-      (message "%s" text))))
+      (message "%s" (shr-fold-text text)))))
 
 (defun shr-browse-image (&optional copy-url)
   "Browse the image under point.
@@ -412,6 +412,13 @@ size, and full-buffer size."
 	   (cdr (assq 'color shr-stylesheet))
 	   (cdr (assq 'background-color shr-stylesheet))))))))
 
+(defun shr-fold-text (text)
+  (with-temp-buffer
+    (let ((shr-indentation 0)
+	  (shr-internal-width (window-width)))
+      (shr-insert text)
+      (buffer-string))))
+
 (define-inline shr-char-breakable-p (char)
   "Return non-nil if a line can be broken before and after CHAR."
   (inline-quote (aref fill-find-break-point-function-table ,char)))
@@ -881,7 +888,7 @@ START, and END.  Note that START and END should be markers."
   (add-text-properties
    start (point)
    (list 'shr-url url
-	 'help-echo (if title (format "%s (%s)" url title) url)
+	 'help-echo (if title (shr-fold-text (format "%s (%s)" url title)) url)
 	 'follow-link t
 	 'mouse-face 'highlight
 	 'keymap shr-map)))
@@ -1283,7 +1290,7 @@ The preference is a float determined from `shr-prefer-media-type'."
 	  (put-text-property start (point) 'image-displayer
 			     (shr-image-displayer shr-content-function))
 	  (put-text-property start (point) 'help-echo
-			     (or (dom-attr dom 'title) alt)))
+			     (shr-fold-text (or (dom-attr dom 'title) alt))))
 	(setq shr-state 'image)))))
 
 (defun shr-tag-pre (dom)