path: root/attic/w3m.org

#+title: Customizations for emacs-w3m

* Custom variables:
  #+BEGIN_SRC emacs-lisp
    (use-package w3m
      :ensure t
      :custom ((w3m-key-binding 'info)
               (w3m-display-mode 'dual-pane))
      :init
      (setq w3m-add-user-agent nil
            w3m-command "w3m"
            w3m-confirm-leaving-secure-page nil
            w3m-cookie-accept-bad-cookies t
            w3m-use-tab nil
            w3m-display-mode 'dual-pane
            w3m-do-cleanup-temp-files t
            w3m-doc-view-content-types ()
            w3m-fill-column 110
            w3m-form-input-textarea-buffer-lines 40
            w3m-history-minimize-in-new-session t
            w3m-history-reuse-history-elements nil
            w3m-image-no-idle-timer t
            w3m-make-new-session t
            w3m-profile-directory "~/.w3m"
            w3m-redisplay-pages-automatically-p nil
            w3m-safe-url-regexp nil
            w3m-search-default-engine "duckduckgo" ; "google-en"
            w3m-select-buffer-horizontal-window nil
            w3m-select-buffer-window-ratio '(20 . 40)
            w3m-session-load-last-sessions t
            w3m-session-load-crashed-sessions 'ask
            w3m-show-graphic-icons-in-header-line t
            w3m-space-before-favicon "|"
            w3m-tab-separator ""
            w3m-use-cookies t
            w3m-use-favicon nil
            w3m-use-header-line nil
            w3m-use-refresh nil)

      (with-eval-after-load 'org (require 'ol-w3m nil t))
      (setq jao-browse-url-function 'jao-w3m-browse-url)
      :config (defalias 'jao-goto-w3m-frame 'jao-afio--goto-www)
      :bind (:map w3m-mode-map (("C-c C-@" . tracking-next-buffer)
                                ("C-c C-SPC" . tracking-next-buffer))))
    (require 'w3m)
  #+END_SRC
* Coding systems and content type
  #+begin_src emacs-lisp
    (mapc (lambda (v) (set v 'utf-8))
          '(w3m-default-coding-system
            w3m-bookmark-file-coding-system
            w3m-coding-system
            w3m-file-coding-system
            w3m-file-name-coding-system
            w3m-terminal-coding-system))

    (jao-when-linux
     (setq w3m-content-type-alist
           '(("text/plain" "\\.\\(?:txt\\|tex\\|el\\)\\'" nil nil)
             ("text/html" "\\.s?html?\\'" jao-browse-with-external-browser nil)
             ("text/html" "." jao-browse-with-external-browser nil)
             ("text/sgml" "\\.sgml?\\'" nil "text/plain")
             ("text/xml" "\\.xml\\'" nil "text/plain")
             ("image/jpeg" "\\.jpe?g\\'" ("emacsclient" file) nil)
             ("image/png" "\\.png\\'" ("emacsclient" file) nil)
             ("image/gif" "\\.gif\\'" ("emacsclient" file) nil)
             ("image/tiff" "\\.tif?f\\'" ("emacsclient" file) nil)
             ("image/x-xwd" "\\.xwd\\'" ("emacsclient" file) nil)
             ("image/x-xbm" "\\.xbm\\'" ("emacsclient" file) nil)
             ("image/x-xpm" "\\.xpm\\'" ("emacsclient" file) nil)
             ("image/x-bmp" "\\.bmp\\'" ("emacsclient" file) nil)
             ("video/mpeg" "\\.mpe?g\\'" jao-maybe-view-video nil)
             ("video/quicktime" "\\.mov\\'" jao-maybe-view-video nil)
             ("video/*" "\\.mpe?g\\'" jao-maybe-view-video nil)
             ("application/dvi" "\\.dvi\\'" ("xdvi" file) nil)
             ("application/postscript" "\\.e?ps\\'" ("/usr/bin/see" file) nil)
             ("application/pdf" "\\.pdf\\'" ("viewpdf.sh" file) nil)
             ("application/xml" "\\.xml\\'" nil w3m-detect-xml-type)
             ("application/rdf+xml" "\\.rdf\\'" nil "text/plain")
             ("application/rss+xml" "\\.rss\\'" nil "text/plain")
             ("application/xhtml+xml" nil nil "text/html")
             ("unknown" nil nil "text/plain"))))
  #+end_src
* Filters
  #+begin_src emacs-lisp
    (setq w3m-use-filter t
          w3m-filter-configuration
          '((t "Strip Google's click-tracking"
               "\\`https?://[a-z]+\\.google\\."
               w3m-filter-google-click-tracking)
            (t "Align table columns vertically to shrink the table width in Google"
               "\\`http://\\(www\\|images\\|news\\|maps\\|groups\\)\\.google\\."
               w3m-filter-google-shrink-table-width)
           (t "Add name anchors that w3m can handle in all pages"
              ""
              w3m-filter-add-name-anchors)
           (t "Substitute disabled attr with readonly attr in forms"
              ""
              w3m-filter-subst-disabled-with-readonly)
           (t "Filter top and bottom cruft for stackexchange.com"
              "\\`https://\\(?:[0-9A-Za-z_~-]+\\.\\)*stackexchange\\.com\\(?:\\'\\|/\\)"
              w3m-filter-stackexchange)
           (t "filter for github.com repository main page"
              "\\`http[s]?://github\\.com/[^/]+/[^/]+[/]?\\'"
              w3m-filter-github-repo-main-page)
           (t "xkcd filter" "\\`http[s]?://xkcd.com/" w3m-filter-xkcd)
           (nil "Prefer a lazy image specified with data-src= in img tags"
                ""
                w3m-filter-prefer-lazy-images)))
  #+end_src
* Symbols and drawing
  #+BEGIN_SRC emacs-lisp
    (setq w3m-default-symbol '("┼" "├" "┬" "┌" "┤" "│" "┐" ""
                               "┴" "└" "─" ""  "┘" ""  ""  ""
                               "┼" "├" "┬" "┌" "┤" "│" "┐" ""
                               "┴" "└" "─" ""  "┘" ""  ""  ""
                               "•" "•" "•" "•" " • "
                               "•" "•" "•" "•" "•" "•" "•" "•"
                               "≪ ↑ ↓ "))
    (setq w3m-symbol w3m-default-symbol)
    (setq-default w3m-use-symbol t)
  #+END_SRC
* Browse url (with unique buffer support)
  #+BEGIN_SRC emacs-lisp
    (defvar jao-w3m-unique-buffer-rxs
      '("^file:.*hyperspec/.*"
        "^file:.*/usr/\\(local/\\)?share/doc/racket/.*"
        "^file:///home/jao/src/racket/doc/.*"
        "^file:.*/usr/local/plt/doc/.*"
        "^file:.*/\\(usr/share/doc/ghc6-doc/html/.*\\|\\.cabal/\\).*"
        "^file:.*/doc/hyperspec/.*"
        ("/tmp/jde_meta\.html" . "^file:.*/java/docs/.*")))

    (defun jao-w3m-url-matcher (url)
      (let* ((url (w3m-canonicalize-url url))
             (urx (format "^%s$" url)))
        (dolist (rx jao-w3m-unique-buffer-rxs)
          (let ((m (if (consp rx) (car rx) rx))
                (r (if (consp rx) (cdr rx) rx)))
            (when (string-match m url) (setq urx r))))
        urx))

    (defun jao-w3m-find-url (url)
      ;; (message "finding %s" url)
      (let ((urx (jao-w3m-url-matcher url))
            (buffers (w3m-list-buffers))
            (found nil))
        (save-current-buffer
          (while (not (or found (null buffers)))
            (let ((b (car buffers)))
              (set-buffer b)
              (if (and w3m-current-url
                       (string-match urx
                                     (w3m-canonicalize-url w3m-current-url)))
                  (setq found b)
                (setq buffers (cdr buffers))))))
        (when found
          (let ((pop-up-windows nil)
                (display-buffer-reuse-frames nil))
            (pop-to-buffer found)))
        found))

    (defun jao-w3m-browse-url (url &rest r)
      "Browse URL using w3m.

    If a frame running w3m already exists, reuses it creating
    a new tab.  If the URL is already open, though, the tab
    containing it is selected."
      (jao-goto-w3m-frame)
      (select-window (frame-first-window))
      (or (jao-w3m-find-url url)
          (w3m-goto-url-new-session url)))

    (defun jao-w3m-do-browse ()
      "Use the generic browse-url with URL at point."
      (interactive)
      (let ((uri (or (w3m-anchor) (w3m-image) w3m-current-url)))
        (browse-url uri)))

    (defun jao-w3m-download (arg)
      (interactive "P")
      (jao-download (w3m-anchor) arg))

    (setq w3m-goto-article-function 'jao-w3m-browse-url)
  #+END_SRC
* Tweeting and tooting
  #+BEGIN_SRC emacs-lisp
    (defun jao-w3m--toot-text (from to title)
      (let ((a (or (jao-url-around-point)
                   w3m-current-url
                   (error "No URL to tweet!")))
            (txt (or title
                     (if (and from to)
                         (buffer-substring from to)
                       (w3m-current-title)))))
        (if (string-empty-p (or txt ""))
            a
          (format "'%s' -- %s" txt a))))

    (defun jao-w3m-tweet (&optional from to title buff)
      (interactive (when (use-region-p) (list (region-beginning) (region-end))))
      (let ((txt (jao-w3m--toot-text from to title)))
        (pop-to-buffer (or buff "#twitter_jaotwits"))
        (goto-char (point-max))
        (insert "post " txt)))

    (defun jao-w3m-toot (&optional from to title)
      (interactive (when (use-region-p) (list (region-beginning) (region-end))))
      (jao-w3m-tweet from to title "#mastodon"))
  #+END_SRC
* Cookies
  #+begin_src emacs-lisp
    ;; for reddit http://i.reddit.com is non-js friendly
    (setq w3m-cookie-reject-domains '(".")
          w3m-cookie-accept-domains '(".github.com"
                                      ".librarything.com"
                                      ".goodreads.com"
                                      ".sr.ht"
                                      ".gnu.org"
                                      ".codeberg.org"
                                      "codeberg.org"
                                      ".bookshop.org"
                                      ".reddit.com"))
  #+end_src
* Email
  #+begin_src emacs-lisp
    (defun jao-w3m-gmail-mark-all (unmark)
      (interactive "P")
      (goto-char (point-min))
      (when (search-forward (if unmark "[*]" "[ ]") nil t)
        (backward-char 4)
        (w3m-form-goto-next-field)
        (while (looking-at (if unmark "\\*\\]" " \\]"))
          (w3m-view-this-url)
          (w3m-form-goto-next-field))))

    (defun jao-w3m-mail-page ()
      (interactive)
      (let ((wb (w3m-alive-p)))
        (when wb
          (compose-mail nil
                        (read-string "Subject: " (w3m-buffer-title wb)))
          (message-goto-body)
          (insert "\n\n<" (with-current-buffer wb w3m-current-url) ">\n")
          (message-goto-to))))

    (defun jao-w3m-gnus-html-renderer (handle)
        (let ((w3m-message-silent t)
              (mm-w3m-safe-url-regexp nil)
              (shr-use-colors nil)
              (shr-use-fonts nil)
              (fill-column (min (window-width) 110)))
          (condition-case nil
              (mm-inline-text-html-render-with-w3m handle)
            (error (delete-region (point) (point-max))
                   (mm-shr handle)))))

  #+end_src
* Proxies
  #+BEGIN_SRC emacs-lisp
    (defun jao-w3m-activate-proxy ()
      (interactive)
      (setq w3m-command-arguments
            (nconc w3m-command-arguments
                   '("-o" "http_proxy=http://localhost:8888"))))

    (defun jao-w3m-deactivate-proxy ()
      (interactive)
      (setq w3m-command-arguments (cdr w3m-command-arguments)))
  #+END_SRC
* Switch buffers
  #+BEGIN_SRC emacs-lisp
    (defun jao-w3m-switch-buffers (dist)
      (interactive "p")
      (let* ((dist (if (zerop dist) 1 dist))
             (current (current-buffer))
             (current-no (w3m-buffer-number current))
             (next (progn (w3m-next-buffer dist)
                          (current-buffer)))
             (next-no (w3m-buffer-number next)))
        (with-current-buffer current
          (rename-buffer "*w3m*<*>")
          (w3m-buffer-set-number next current-no)
          (w3m-buffer-set-number current next-no)
          (w3m-pack-buffer-numbers))
        (switch-to-buffer current)))
  #+END_SRC
* Capture page
  #+BEGIN_SRC emacs-lisp
    (defun jao-w3m-capture-page ()
      (interactive)
      (let* ((title (w3m-current-title))
             (url w3m-current-url)
             (html (y-or-n-p "Save as HTML (y) or PS (n)? "))
             (basename (concat (read-string "File name: ")
                               (if html ".html" ".ps")))
             (name (expand-file-name basename jao-sink-dir)))
        (if html
            (progn
              (w3m-view-source)
              (write-region (point-min) (point-max) name nil nil nil t)
              (w3m-view-source))
          (progn
            (split-window-horizontally 85)
            (w3m-redisplay-this-page)
            (ps-print-buffer name)
            (delete-other-windows)
            (w3m-redisplay-this-page)))
        (kill-new (format "[[doc:%s][%s]] ([[%s][original]])"
                          basename title url))))

    (defun jao-w3m-get-link ()
      (let ((wb (w3m-alive-p)))
        (when wb
          (let ((url (with-current-buffer wb w3m-current-url))
                (title (w3m-buffer-title wb)))
            (cons url title)))))

    (defun jao-insert-w3m-link ()
      (interactive)
      (let ((link (jao-w3m-get-link)))
        (when link (insert "[[" (car link) "][" (cdr link) "]]"))))
  #+END_SRC
* Keybindings
  #+BEGIN_SRC emacs-lisp
    (define-key w3m-mode-map "B" 'jao-w3m-do-browse)
    (define-key w3m-mode-map "d" 'jao-w3m-download)
    (define-key w3m-mode-map (kbd "\C-ck") 'jao-w3m-gmail-mark-all)
    (define-key w3m-mode-map (kbd "\C-c\C-f") 'jao-w3m-switch-buffers)
    (define-key w3m-mode-map (kbd "\C-cc") 'jao-w3m-capture-page)
    (define-key w3m-mode-map "\M-\r" 'w3m-view-this-url-new-session)
    (define-key w3m-mode-map "+" 'w3m-zoom-in-image)
    (define-key w3m-mode-map "-" 'w3m-zoom-out-image)
    (define-key w3m-mode-map "m" 'jao-w3m-mail-page)
    (define-key w3m-mode-map "M" 'w3m-view-url-with-external-browser)
    (define-key w3m-mode-map "t" 'jao-w3m-tweet)
    (define-key w3m-mode-map "T" 'jao-w3m-toot)
    (define-key w3m-mode-map "f" 'w3m-lnum-follow)
    (define-key w3m-mode-map "c" 'w3m-print-this-url)
    (define-key w3m-mode-map "v" 'jao-view-video)
    (define-key w3m-mode-map "V" 'w3m-download)
    (define-key w3m-mode-map "x" 'jao-rss-subscribe-rss)
    (define-key w3m-mode-map "Y" 'w3m-print-current-url)
  #+END_SRC