procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Make shr fold long title texts

Browse source 
* 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.
This commit is contained in:
Lars Magne Ingebrigtsen 2014-12-13 16:23:40 +01:00
parent 987d2f9421
commit 76f9994d67
2 changed files with 14 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
lisp/ChangeLog
View file

@ -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.

13
lisp/net/shr.el
View file

@ -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)