;;; my-web.el -- web related extensions for emacs core -*- lexical-binding: t -*-
;; Copyright (C) 2023 Free Software Foundation.
;; Author: Yuchen Pei <id@ypei.org>
;; Package-Requires: ((emacs "28.2"))
;; This file is part of dotfiles.
;; dotfiles is free software: you can redistribute it and/or modify it under
;; the terms of the GNU Affero General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; dotfiles is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General
;; Public License for more details.
;; You should have received a copy of the GNU Affero General Public
;; License along with dotfiles. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; web related extensions for emacs core. Covers eww etc.
;;; Code:
(defun my-eww-next-path ()
(interactive)
(let ((url (plist-get eww-data :url)))
(when (string-match "^\\(.*?\\)\\([0-9]+\\)\\(.*\\)$" url)
(eww (concat
(match-string 1 url)
(number-to-string
(1+ (string-to-number (match-string 2 url))))
(match-string 3 url))))))
(defun my-eww-prev-path ()
(interactive)
(let ((url (plist-get eww-data :url)))
(when (string-match "^\\(.*\\)\\([0-9]+\\)\\(.*\\)$" url)
(eww (concat
(match-string 1 url)
(number-to-string
(1- (string-to-number (match-string 2 url))))
(match-string 3 url))))))
(defun my-eww-up-path ()
(interactive)
(let ((url (plist-get eww-data :url)))
(when (and (string-match "^\\(.*//.*/\\)[^/]+\\(/\\)?$" url)
(match-string 1 url))
(eww (match-string 1 url)))))
(defun my-eww-top-path ()
(interactive)
(let ((url (plist-get eww-data :url)))
(when (and (string-match "^\\(.*//.*?/\\).*$" url)
(match-string 1 url))
(eww (match-string 1 url)))))
(defun my-browse-url-tor-browser (url)
"Browse URL with tor-browser."
(setq url (browse-url-encode-url url))
(start-process (concat "tor-browser " url) nil "tor-browser"
"--allow-remote" url))
(defun my-browse-url-firefox-private (url)
"Browse URL in a private firefox window."
(setq url (browse-url-encode-url url))
(start-process (concat "firefox-private " url) nil "firefox"
"--private-window" url))
(defun my-browse-url-qutebrowser (url)
"Browse URL with qutebrowser."
(setq url (browse-url-encode-url url))
(start-process (concat "qutebrowser " url) nil "qutebrowser"
url))
(defun my-browse-url-mullvad (url)
"Browse URL with Mullvad browser."
(setq url (browse-url-encode-url url))
(start-process (concat "mullvad-browser " url) nil "mullvad-browser"
url))
(defun my-browse-url-at-point (arg)
(interactive "P")
(my-browse-url (browse-url-url-at-point) arg))
;; override eww-copy-page-url to work with bookmark id frags.
(defun eww-copy-page-url ()
"Copy the URL of the current page into the kill ring."
(interactive)
(let* ((url (plist-get eww-data :url))
(id (get-text-property (point) 'shr-frag-id))
(url-no-frag
(if (string-match "^\\(.*\\)#.*$" url)
(match-string 1 url)
url))
(final-url
(if id (concat url-no-frag "#" id)
url))
)
(message "%s" final-url)
(kill-new final-url)))
(defun my-eww-switch-by-title (title-and-buffer)
"Switches to an eww buffer with selected title."
(interactive
(list
(let ((com-table))
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (equal major-mode 'eww-mode)
(add-to-list
'com-table
(concat (plist-get eww-data :title)
(propertize (concat " " (buffer-name))
'invisible t))))))
(completing-read "Eww buffer title: " com-table))))
(string-match "^.* \\(.*\\)$" title-and-buffer)
(switch-to-buffer (match-string 1 title-and-buffer)))
(defun my-red-energy-copy-clean-url (beg end)
"Clean up the payment url in a raw red energy bill email."
(interactive "r")
(let ((url (url-unhex-string
(replace-regexp-in-string
"^.*url=" "" (replace-regexp-in-string
"=3D" "=" (replace-regexp-in-string "=
" "" (buffer-substring-no-properties beg end)))))))
(kill-new url)
(message "Copied link: %s" url)))
;;; webgetter
(require 'my-net)
(defun my-fetch-browse (url &optional no-overwrite)
"Fetch URL to a local file then browse it with firefox.
Useful for bypassing \"Enable JavaScript and cookies to continue\"."
(interactive "sUrl to fetch and browse: ")
(let ((file-name
(if no-overwrite
(my-make-unique-file-name
(my-make-file-name-from-url url)
my-download-dir)
(expand-file-name
(my-make-file-name-from-url url "html")
my-download-dir))))
(url-copy-file url file-name (not no-overwrite))
(browse-url-firefox (format "file://%s" file-name))))
(defun my-fetch-browse-as-googlebot (url &optional no-overwrite)
"Same as `my-fetch-browse', but spoofing googlebot.
Useful for bypassing some paywalls."
(interactive "sUrl to fetch and browse as googlebot: ")
(my-url-as-googlebot
(my-fetch-browse url no-overwrite)))
(require 'hmm)
(defvar my-url-context-function 'hmm-url "Context function for urls.")
(defvar my-file-context-function 'hmm-file "Context function for files.")
(defun my-hacker-news-url-p (url)
"Check if a url is a hacker news post.
e.g. https://news.ycombinator.com/item?id=42505454"
(let ((urlobj (url-generic-parse-url url)))
(and (equal "news.ycombinator.com" (url-host urlobj))
(string-match-p "^/item\\?id=[0-9]+$" (url-filename urlobj)))))
(defvar my-newscorp-au-amp-nk nil)
(defun my-open-newscorp-au (url)
(interactive "sNews Corp AU link: ")
(pcase-let* ((urlobj (url-generic-parse-url url))
(`(,path . _) (url-path-and-query urlobj)))
(setf (url-filename urlobj)
(format "%s?amp&nk=%s" path my-newscorp-au-amp-nk))
(browse-url-firefox (url-recreate-url urlobj))))
(defun my-newscorp-au-url-p (url)
(string-match-p "^\\(www\\.\\)?\\(heraldsun\\|theaustralian\\)\\.com\\.au$"
(url-host (url-generic-parse-url url))))
(defun my-stack-overflow-url-p (url)
"Guess whether a url stack overflow question
e.g.
https://emacs.stackexchange.com/questions/40887/in-org-mode-how-do-i-link-to-internal-documentation"
(pcase-let* ((urlobj (url-generic-parse-url url))
(`(,path . _) (url-path-and-query urlobj)))
(string-match-p "^/questions/[0-9]+/.+$" path)) )
(advice-add 'server-visit-files :around #'my-ec-handle-http)
(defun my-ec-handle-http (orig-fun files client &rest args)
;; (message "GOT %s" files)
(dolist (var files)
(let ((fname (expand-file-name (car var))))
(when (string-match ".*/?\\(https?:\\)/+" fname)
(browse-url (replace-match "\\1//" nil nil fname))
(setq files (delq var files)))))
(apply orig-fun files client args))
(defvar my-firefox-profile-dir nil "Firefox profile dir")
(defvar my-firefox-place-limit 1000 "Firefox urls result limit")
(defun my-firefox-places (&optional query)
(let ((where
(mapconcat
(lambda (word) (format "(url LIKE '%%%s%%' OR title LIKE '%%%s%%')" word word))
(split-string (or query ""))
" AND ")))
(unless (string-empty-p where) (setq where (format "WHERE %s" where)))
(with-temp-buffer
(call-process "sqlite3" nil t nil
(format "file://%s/places.sqlite?immutable=1"
(expand-file-name my-firefox-profile-dir))
(format
"SELECT url,title FROM moz_places %s ORDER BY visit_count desc limit %d"
where
my-firefox-place-limit))
(string-lines (buffer-string))
)))
(defun my-firefox-places-collection (query pred action)
(if (eq action 'metadata)
`(metadata (display-sort-function . ,#'identity)
;; Needed for icomplete to respect list order
(cycle-sort-function . ,#'identity))
(let ((candidates (my-firefox-places query)))
(message "Got %d candidates for query %s. Current action is %s" (length candidates) query action)
(cl-loop for str in-ref candidates do
(setf str (orderless--highlight regexps ignore-case (substring str))))
candidates
;; Does not show remotely as many results
;; (complete-with-action action candidates query pred)
)))
(defun my-browse-url (url)
(interactive (list (completing-read "URL to browse: "
#'my-firefox-places-collection)))
(message url))
(defun my-forge-infobox-format-url (url)
(concat url
" -- " (buttonize "clone"
(lambda (_)
(my-magit-clone url current-prefix-arg)))
" " (buttonize "context"
(lambda (_)
(funcall my-url-context-function url)))))
(provide 'my-web)
;;; my-web.el ends here