diff options
Diffstat (limited to 'emacs/.emacs.d/lisp/my/my-web.el')
| -rw-r--r-- | emacs/.emacs.d/lisp/my/my-web.el | 203 |
1 files changed, 187 insertions, 16 deletions
diff --git a/emacs/.emacs.d/lisp/my/my-web.el b/emacs/.emacs.d/lisp/my/my-web.el index 311bcf9..87c319f 100644 --- a/emacs/.emacs.d/lisp/my/my-web.el +++ b/emacs/.emacs.d/lisp/my/my-web.el @@ -59,14 +59,15 @@ (interactive) (let ((url (plist-get eww-data :url))) (when (and (string-match "^\\(.*//.*?/\\).*$" url) - (match-string 1 url)) + (match-string 1 url)) (eww (match-string 1 url))))) +(defvar my-tor-browser-bin "tor-browser") + (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)) + (start-process "tor-browser" nil my-tor-browser-bin "--allow-remote" url)) (defun my-browse-url-firefox-private (url) "Browse URL in a private firefox window." @@ -86,19 +87,6 @@ (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)) @@ -148,5 +136,188 @@ (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-webpage-incoming-dir) + (expand-file-name + (my-make-file-name-from-url url "html") + my-webpage-incoming-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))))) + +(defvar my-dw-host "dw.com") + +(defun my-dw-parse-article-url (url) + "Returns (lang . article-id)" + (let* ((urlobj (url-generic-parse-url url)) + (path (url-filename urlobj)) + (components (string-split path "/"))) + `(,(elt components 1) . ,(string-remove-prefix "a-" (elt components 3))))) + +(defun my-dw-article-api (url) + (pcase-let ((`(,lang . ,id) (my-dw-parse-article-url url))) + (my-url-fetch-json + (format "https://%s/graph-api/%s/content/article/%s" my-dw-host lang id)))) + +(defun my-dw-extract (info) + "Returns list of (url . file-name) pairs." + (let* ((content (alist-get 'content (alist-get 'data info))) + (dir (file-name-concat my-audio-incoming-dir + (my-make-doc-file-name + (alist-get 'title content)))) + (audios (alist-get 'audios content))) + (seq-map + (lambda (audio) + (let ((url (alist-get 'mp3Src audio))) + `(,url + . + ,(expand-file-name + (file-name-concat dir (file-name-with-extension + (my-make-doc-file-name + (alist-get 'name audio)) + (file-name-extension url))))))) + audios))) + +(defun my-dw-download (pairs) + "Download list of (url . file-name) pairs with aria2." + (let ((file (make-temp-file "/tmp/aria2")) + (n (length pairs))) + (with-temp-file file + (dolist (pair pairs) + (insert (car pair) "\n out=" (cdr pair) "\n")) + ;; (buffer-string) + ) + (message "Downloading %d files..." n) + (set-process-sentinel + (start-process "aria2" "*aria2*" "aria2c" "-x" "5" "-d" "/" + "-R" "true" "-i" file) + (lambda (proc event) + (let ((status (process-exit-status proc))) + (if (eq status 0) + (progn + (message "Downloading %d files...Done" n)) + (message "Downloading %d files...Failed: %s" n event))))))) + +(defun my-dw-download-url (url) + (interactive "sDW Download URL: ") + (my-dw-download (my-dw-extract (my-dw-article-api url)))) + +(defun my-dw-download-urls (urls) + (my-dw-download (seq-mapcat + (lambda (url) (my-dw-extract (my-dw-article-api url))) + urls))) + +(defun my-local-archive-open-url (url) + "Open url from local archive." + ) + (provide 'my-web) ;;; my-web.el ends here |