[Date Prev][Date Next][Thread Prev][][Date Index][Thread Index]

about://header in org-mode with font-lock highighting and no spaghetti [PATCH]



If you follow the code for w3m-view-header, you see that it performs a lot
of (AFAICT) unnecessary and circuitous operations re: history
bookkeeping, and then calls w3m-goto-url (AFAICTL) unnecessarily because
all the information is already persent.

Attached is a patch that replaces the two relevant functions with a much
simpler and straightforward method that also adds several usability and
visibility enhancements:

1] The output is set-up as an org-mode buffer, so you can collapse /
   expand / navigate sections accordingly, and section headings are
   highlighted.

2] Data is better aligned

3] Font-lock highlighting is used to aid readability.

There is a minimal behavioral alteration, because this implementation
creates a new org-mode buffer instead of re-using the current emacs-w3m
buffer. What I did to minimize the consequences of this is to remap to
function kill-this-buffer, for that local org-mode buffer only, the
functions w3m-view-header (usually '=') and w3m-view-previous-page
(usually 'B'). That should cover most use-cases to make the behavior
identical when wanting to leave the about://header page. What I wasn't
successful in doing was to also re-bind function w3m-delete-buffer;
org-mode seems to insist on its own bindings for the default C-c C-w and
C-w.

Give the patch a try; the output is pretty neat and pretty IISSM.


-- 
hkp://keys.gnupg.net
CA45 09B5 5351 7C11 A9D1  7286 0036 9E45 1595 8BC0
Index: ChangeLog
===================================================================
RCS file: /storage/cvsroot/emacs-w3m/ChangeLog,v
retrieving revision 1.3670
diff -u -r1.3670 ChangeLog
--- ChangeLog	18 May 2018 07:59:06 -0000	1.3670
+++ ChangeLog	27 May 2018 18:15:27 -0000
@@ -1,3 +1,10 @@
+2018-05-27  Boruch Baum  <boruch_baum@xxxxxxx>
+
+	* w3m.el (w3m-view-header): Replace spaghetti code with direct presentation of
+	header information.
+	(w3m-about-header): Produce an org-mode pretty-printed header
+	with font-lock highlighting.
+
 2018-05-18  Katsumi Yamaoka  <yamaoka@xxxxxxx>

 	* w3m-proc.el (w3m-process-stop): Don't move point ([emacs-w3m:12976]).
Index: w3m.el
===================================================================
RCS file: /storage/cvsroot/emacs-w3m/w3m.el,v
retrieving revision 1.1711
diff -u -r1.1711 w3m.el
--- w3m.el	17 May 2018 04:21:01 -0000	1.1711
+++ w3m.el	27 May 2018 18:15:29 -0000
@@ -10586,101 +10598,106 @@
     (make-string (w3m-display-width) ?-)))

-(defun w3m-about-header (url &optional no-uncompress no-cache &rest args)
-  (when (string-match "\\`about://header/" url)
-    (setq url (substring url (match-end 0)))
-    (insert "Page Information\n"
-	    "\nTitle:          " (or (w3m-arrived-title
-				      (w3m-url-strip-authinfo url))
-				     "")
-	    "\nURL:            " url
-	    "\nDocument Type:  " (or (w3m-content-type url) "")
-	    "\nLast Modified:  "
-	    (let ((time (w3m-last-modified url)))
-	      (if time (current-time-string time) "")))
-
-    (let (anchor anchor-title
-		 image-url image-alt image-size)
-      (with-current-buffer w3m-current-buffer
-	(when (equal url w3m-current-url)
-	  (setq anchor (w3m-anchor)
-		anchor-title (w3m-anchor-title)
-		image-url (w3m-image)
-		image-alt (w3m-image-alt)
-		image-size (w3m-get-text-property-around 'w3m-image-size))))
-      (if anchor
-	  (insert "\nCurrent Anchor: " anchor))
-      (if anchor-title
-	  (insert "\nAnchor Title:   " anchor-title))
-      (if image-url
-	  (insert "\nImage:      " image-url))
-      (if image-alt
-	  (insert "\nImage Alt:  " image-alt))
-      (if image-size
-	  (insert (format "\nImage Size: %sx%s"
-			  (car image-size) (cdr image-size)))))
-
-    (let ((ct (w3m-arrived-content-type url))
-	  (charset (w3m-arrived-content-charset url))
-	  (separator (w3m-make-separator))
-	  (case-fold-search t)
-	  header ssl beg)
-      (when (or ct charset)
-	(insert "\n\n" separator "\n\nModifier Information\n")
-	(insert "\nDocument Content-Type:  " (or ct ""))
-	(insert "\nDocument Charset:       " (or charset "")))
-      (when (and (not (w3m-url-local-p url))
-		 (setq header (condition-case nil
-				  (or (unless no-cache
-					(w3m-cache-request-header url))
-				      (w3m-process-with-wait-handler
-				       (w3m-w3m-dump-head url handler)))
-				(w3m-process-timeout nil))))
-	(insert "\n\n" separator "\n\nHeader Information\n\n" header)
-	(goto-char (point-min))
-	(when (re-search-forward "^w3m-ssl-certificate: " nil t)
-	  (setq beg (match-end 0))
-	  (forward-line)
-	  (while (and (not (eobp)) (looking-at "^[ \t]"))
-	    (forward-line))
-	  (setq ssl (buffer-substring beg (point)))
-	  (delete-region beg (point))
-	  (goto-char beg)
-	  (insert "SSL\n")
-	  (goto-char (point-max))
-	  (insert separator "\n\nSSL Information\n\n")
-	  (setq beg (point))
-	  (insert ssl)
-	  (goto-char beg)
-	  (while (re-search-forward "^\t" nil t)
-	    (delete-char -1)
-	    (when (looking-at "Certificate:")
-	      (insert "\n"))))))
-    "text/plain"))
+(defun w3m-about-header (url &optional anchor anchor-title
+                                       image-url image-alt image-size no-cache)
+  (switch-to-buffer
+    (get-buffer-create (concat "about://header/" w3m-current-url)))
+  (insert
+     "* Page Information\n"
+     "\nTitle: " (or (w3m-arrived-title
+                              (w3m-url-strip-authinfo url)) "")
+     "\nURL: " url
+     "\nDocument,A (BType: " (or (w3m-content-type url) "")
+     "\nLast,A (BModified: "
+          (let ((time (w3m-last-modified url)))
+            (if time (current-time-string time) "")))
+  (if anchor
+      (insert "\nCurrent,A (BAnchor: " anchor))
+  (if anchor-title
+      (insert "\nAnchor,A (BTitle: " anchor-title))
+  (if image-url
+      (insert "\nImage: " image-url))
+  (if image-alt
+      (insert "\nImage,A (BAlt: " image-alt))
+  (if image-size
+      (insert (format "\nImage,A (BSize: %sx%s"
+                      (car image-size) (cdr image-size))))
+  (let ((ct (w3m-arrived-content-type url))
+        (charset (w3m-arrived-content-charset url))
+        (case-fold-search t)
+        header ssl beg end)
+    (when (or ct charset)
+      (insert "\n\n* Modifier Information\n")
+      (insert "\nDocument,A (BContent-Type: " (or ct ""))
+      (insert "\nDocument,A (BCharset: " (or charset "")))
+    (when (and (not (w3m-url-local-p url))
+               (setq header (condition-case nil
+                                (or (unless no-cache
+                                      (w3m-cache-request-header url))
+                                    (w3m-process-with-wait-handler
+                                     (w3m-w3m-dump-head url handler)))
+                              (w3m-process-timeout nil))))
+      (insert "\n\n* Header Information\n\n" header)
+      (goto-char (point-min))
+;     (when (re-search-forward "^Title: [^\n]+" nil t)
+;       (fill-region (match-beginning 0) (match-end 0)))
+      (when (re-search-forward "^w3m-ssl-certificate: " nil t)
+        (setq beg (match-end 0))
+        (setq end (if (re-search-forward "^[^ \t]" nil t)
+                    (match-beginning 0)
+                   (point-max)))
+        (setq ssl (buffer-substring beg end))
+        (delete-region beg end)
+        (goto-char beg)
+        (insert "SSL\n")
+        (setq end (goto-char (point-max)))
+        (while (re-search-backward "^\* [^\n]+" nil t)
+          (align-regexp (1+ (match-end 0)) end "\\(\\s-*\\) ")
+          (setq end  (match-beginning 0))
+          (goto-char end))
+        (setq beg (goto-char (point-max)))
+        (insert "* SSL Information\n\n"
+                (replace-regexp-in-string "^\t" "" ssl))
+        (goto-char (1+ beg))
+        (when (re-search-forward "^C" nil t)
+          (replace-match "\n** C"))
+        (while (re-search-forward "^    " nil t)
+          (replace-match "")
+          (forward-line 1)))))
+  (read-only-mode)
+  (org-mode)
+  (org-cycle '(64))
+  (set (make-local-variable 'nobreak-char-display) nil)
+  (font-lock-add-keywords nil  '(("^ *[[:alpha:]].[^:\n]+:" . 'font-lock-string-face)
+                                 ("^ +Validity$\\|^HTTP[^ ]+" . 'font-lock-string-face)
+                                 ("valid certificate". 'font-lock-warning-face)))
+  (local-set-key (kbd "\\<w3m-mode-map>\\[w3m-view-header]") 'kill-this-buffer)
+  (local-set-key (kbd "\\<w3m-mode-map>\\[w3m-view-previous-page]") 'kill-this-buffer)
+  ; FIXME: This next binding (remap for w3m-delete-buffer) isn't working for me!
+  (local-set-key (kbd "\\<w3m-mode-map>\\[w3m-delete-buffer]") 'kill-this-buffer)
+  (goto-char (point-min)))

 (defun w3m-view-header ()
   "Display the header of the current page."
   (interactive)
-  (if w3m-current-url
-      (let ((w3m-prefer-cache t)
-	    (w3m-history-reuse-history-elements t)
-	    (url (cond
-		  ((string-match "\\`about://header/" w3m-current-url)
-		   (substring w3m-current-url (match-end 0)))
-		  ((string-match "\\`about://source/" w3m-current-url)
-		   (let ((real-url (substring w3m-current-url (match-end 0))))
-		     (unless (string-match "\\`about:" real-url)
-		       (concat "about://header/" real-url))))
-		  ((string-match "\\`about:" w3m-current-url)
-		   nil)
-		  (t
-		   (concat "about://header/" w3m-current-url)))))
-	(if url
-	    (progn
-	      (w3m-history-store-position)
-	      (w3m-goto-url url)
-	      (w3m-history-restore-position))
-	  (w3m-message "Can't load a header for %s" w3m-current-url)))
-    (w3m-message "Can't view page header")))
+  (if (not w3m-current-url)
+    (w3m-message "No current url to view header for.")
+   (cond
+    ((string-match "\\`about://header/" w3m-current-url)
+      (kill-buffer))
+    ((string-match "\\`about://source/" w3m-current-url)
+                   (let ((real-url (substring w3m-current-url (match-end 0))))
+                     (unless (string-match "\\`about:" real-url)
+                       (concat "about://header/" real-url))))
+    ((string-match "\\`about:" w3m-current-url)
+      (w3m-message "Can't view page header for this type of \"about\" page."))
+    (t
+      (let ((url w3m-current-url)
+            (anchor (w3m-anchor))
+            (anchor-title (w3m-anchor-title))
+            (image-url (w3m-image))
+            (image-alt (w3m-image-alt))
+            (image-size (w3m-get-text-property-around 'w3m-image-size)))
+       (w3m-about-header url anchor anchor-title image-url image-alt image-size))))))

 (defvar w3m-about-history-max-indentation '(/ (* (window-width) 2) 3)
   "*Number used to limit the identation level when showing a history.