mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-30 12:21:25 -08:00
Code Issues Projects Releases Wiki Activity

Use variable-pitch fonts in the eww headers

Browse source 
* lisp/net/eww.el (eww--limit-string-pixelwise)
(eww--pixel-column): New functions.
(eww-update-header-line-format): Use variable pitch fonts in the
header line.
This commit is contained in:
Lars Ingebrigtsen 2020-09-07 02:26:02 +02:00
parent 670c41cf12
commit d39ae6f586
2 changed files with 54 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

1
lisp/gnus/gnus-fun.el
View file

@ -181,6 +181,7 @@ different input formats."
(gnus-message 9 "Length %d; trying quant %d"
(length attempt) quant))
(setq done t)))
(setq a attempt)
(if done
(mm-with-unibyte-buffer
(insert attempt)

74
lisp/net/eww.el
View file

@ -667,41 +667,73 @@ Currently this means either text/html or application/xhtml+xml."
eww-image-link-keymap
eww-link-keymap))))
(defun eww--limit-string-pixelwise (string pixels)
(if (not pixels)
string
(with-temp-buffer
(insert string)
(if (< (eww--pixel-column) pixels)
string
;; Iterate to find appropriate length.
(while (and (> (eww--pixel-column) pixels)
(not (bobp)))
(forward-char -1))
;; Return at least one character.
(buffer-substring (point-min) (max (point)
(1+ (point-min))))))))
(defun eww--pixel-column ()
(if (not (get-buffer-window (current-buffer)))
(save-window-excursion
;; Avoid errors if the selected window is a dedicated one,
;; and they just want to insert a document into it.
(set-window-dedicated-p nil nil)
(set-window-buffer nil (current-buffer))
(car (window-text-pixel-size nil (line-beginning-position) (point))))
(car (window-text-pixel-size nil (line-beginning-position) (point)))))
(defun eww-update-header-line-format ()
(setq header-line-format
(and eww-header-line-format
(let ((title (plist-get eww-data :title))
(let ((title (propertize (plist-get eww-data :title)
'face 'variable-pitch))
(peer (plist-get eww-data :peer))
(url (plist-get eww-data :url)))
(url (propertize (plist-get eww-data :url)
'face 'variable-pitch)))
(when (zerop (length title))
(setq title "[untitled]"))
(setq title (propertize "[untitled]" 'face 'variable-pitch)))
;; This connection has is https.
(when peer
(add-face-text-property 0 (length title)
(if (plist-get peer :warnings)
'eww-invalid-certificate
'eww-valid-certificate)
t title))
;; Limit the length of the title so that the host name
;; of the URL is always visible.
(when url
(let* ((parsed (url-generic-parse-url url))
(host-length (length (format "%s://%s"
(url-type parsed)
(url-host parsed))))
(width (window-width)))
(host-length (shr-string-pixel-width
(format "%s://%s" (url-type parsed)
(url-host parsed))))
(width (window-width nil t)))
(cond
;; The host bit is wider than the window, so nix
;; the title.
((> (+ host-length 5) width)
((> (+ host-length (shr-string-pixel-width "xxxxx")) width)
(setq title ""))
;; Trim the title.
((> (+ (length title) host-length 2) width)
(setq title (concat
(substring title 0 (- width
host-length
5))
"..."))))))
;; This connection has is https.
(when peer
(setq title
(propertize title 'face
(if (plist-get peer :warnings)
'eww-invalid-certificate
'eww-valid-certificate))))
((> (+ (shr-string-pixel-width (concat title "xx"))
host-length)
width)
(setq title
(concat
(eww--limit-string-pixelwise
title (- width host-length
(shr-string-pixel-width
(propertize "...: " 'face
'variable-pitch))))
(propertize "..." 'face 'variable-pitch)))))))
(replace-regexp-in-string
"%" "%%"
(format-spec