[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
about://header in org-mode with font-lock highighting and no spaghetti [PATCH]
- From: Boruch Baum <boruch_baum@xxxxxxx>
- Date: Sun, 27 May 2018 14:25:31 -0400
- X-ml-name: emacs-w3m
- X-mail-count: 12992
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.