;;; my-web.el -- web related extensions for emacs core -*- lexical-binding: t -*- ;; Copyright (C) 2023 Free Software Foundation. ;; Author: Yuchen Pei ;; 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 . ;;; 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)) ;; TODO: change to using hmm matching url with default app ;; override browse-url (defun my-browse-url (url &optional arg) (interactive "P") (cond ((equal arg '(4)) (funcall browse-url-secondary-browser-function url)) ((equal arg '(16)) (my-browse-url-tor-browser url)) (t (luwak-open url)))) ;; this fixes clicking url buttons like those in gnus messages (defalias 'browse-url-button-open-url 'my-browse-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-open-spectator-au (url &optional no-overwrite) (interactive "sspectator.com.au link: ") (let ((url-request-extra-headers '(("X-Forwarded-For" . "66.249.66.1"))) (url-user-agent "Mozilla/5.0 (compatible; Googlebot/2.1; +http://www.google.com/bot.html)")) (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) my-download-dir)))) (url-copy-file url file-name (not no-overwrite)) (browse-url-firefox (format "file://%s" file-name))))) (defun my-mastodon-url-p (url) "Guess if a url is a mastodon post. e.g. https://hostux.social/@fsf/113709722998924141 " (pcase-let* ((urlobj (url-generic-parse-url url)) (`(,path . _) (url-path-and-query urlobj))) (string-match-p "^/@[^/]+/[0-9]\\{18\\}$" path))) (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))))) (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)) (provide 'my-web) ;;; my-web.el ends here