Subject: shr.el align support patch

From: Bad Blue Bull <[email-masked]>
Date: Thu, 26 Jul 2018 17:06:29 +0300

Here's a patch for shr.el that makes it handle "align" attribute for headers, paragraphs and lists, works only when monospace font is used (becoz of lame implementation of fill-paragraph). Also default value of shr-use-fonts set to nil so monospace fonts are used by default.

So now if shr-use-fonts is nil then page gets filled, if it's non nil then then it will be rendered like current version of shr.el does it, without filling and justification (see pics).

shr.el.diff is a diff file, shr.el is a patched version of shr.el

--- shr-old.el	2018-07-21 03:37:08.299506430 +0300
+++ shr.el	2018-07-22 16:49:02.803829992 +0300
@@ -62,7 +62,7 @@
   :group 'shr
   :type '(choice (const nil) regexp))
 
-(defcustom shr-use-fonts t
+(defcustom shr-use-fonts nil ; set default value to nil because monospace fonts are better for Emacs
   "If non-nil, use proportional fonts for text."
   :version "25.1"
   :group 'shr
@@ -292,6 +292,45 @@
     (when shr-warning
       (message "%s" shr-warning))))
 
+(defun shr-fill-paragraph-with-breaks (&optional justify bre-del bre-regexp)
+  "Fill paragraph at or after point, breaking lines at positions matching regexp argument BRE-REGEXP.
+If JUSTIFY is non-nil justify as well.
+Delete matched text if BRE-DEL is non nil
+BRE-REGEXP must be a regexp that determines positions where to break lines, default value is \\x2028."
+  (unless bre-regexp (setq bre-regexp "\x2028"))
+  (setq bre-regexp (concat bre-regexp "\\|\x2029"))
+  (save-excursion
+   (let ((line-begin) (paragraph-end))
+	 (forward-paragraph)
+	 (insert "\x2029") ; use \x2029 (unicode paragraph separator) to mark end of a paragraph
+	 (backward-paragraph)
+	 (setq line-begin (point))
+	 (while (not paragraph-end)
+			(re-search-forward bre-regexp)
+			(if (equal (match-string 0) "\x2029") (setq paragraph-end t)) ; end of paragraph reached
+			(if (or bre-del paragraph-end) (replace-match ""))
+			(unless (equal (char-after) ?\n) (insert "\n")) ; I don't know why but two adjacent \n leave an empty line after fill
+			(fill-region-as-paragraph line-begin (- (point) 1) justify)
+			(setq line-begin (point)))
+	 (delete-char -1)
+	 )))
+
+(defun shr-fill-paragraph (dom)
+  "Fill paragraph"
+  (when (not shr-use-fonts) ;fill-paragraph is useful only with monospace fonts
+ 	(shr-fill-paragraph-with-breaks
+	 ((lambda (x)
+	   (cond
+ 		 ((equal x "right") 'right)
+ 		 ((equal x "center") 'center)
+ 		 ((equal x "left") 'left)
+ 		 ))
+ 	 (cdr (assq 'align (dom-attributes dom)))) ; justify parameter
+	 t) ; bre-del t
+ 	)
+  )
+
+
 (defun shr--remove-blank-lines-at-the-end (start end)
   (save-restriction
     (save-excursion
@@ -1191,6 +1230,7 @@
 (defun shr-heading (dom &rest types)
   (shr-ensure-paragraph)
   (apply #'shr-fontize-dom dom types)
+  (shr-fill-paragraph dom)
   (shr-ensure-paragraph))
 
 (defun shr-urlify (start url &optional title)
@@ -1354,6 +1394,7 @@
 (defun shr-tag-p (dom)
   (shr-ensure-paragraph)
   (shr-generic dom)
+  (shr-fill-paragraph dom)
   (shr-ensure-paragraph))
 
 (defun shr-tag-div (dom)
@@ -1742,12 +1783,14 @@
   ;; paragraph.
   (unless (bolp)
     (insert "\n"))
+  (shr-fill-paragraph dom)
   (shr-ensure-paragraph))
 
 (defun shr-tag-ol (dom)
   (shr-ensure-paragraph)
   (let ((shr-list-mode 1))
     (shr-generic dom))
+  (shr-fill-paragraph dom)
   (shr-ensure-paragraph))
 
 (defun shr-tag-li (dom)
@@ -1770,6 +1813,7 @@
 	(put-text-property start (1+ start) 'shr-prefix-length (length bullet))
 	(shr-generic dom))))
   (unless (bolp)
+	(unless shr-use-fonts (insert "\x2028")) ; insert a line separator
     (insert "\n")))
 
 (defun shr-mark-fill (start)
@@ -1785,7 +1829,8 @@
 	     (or (not (bolp))
 		 (and (> (- (point) 2) (point-min))
 		      (not (= (char-after (- (point) 2)) ?\n)))))
-    (insert "\n"))
+	(unless shr-use-fonts (insert "\x2028")) ; insert a line separator
+	(insert "\n"))
   (shr-generic dom))
 
 (defun shr-tag-span (dom)