1 files changed, 117 insertions, 13 deletions
diff --git a/emacs/.emacs.d/lisp/my/my-web.el b/emacs/.emacs.d/lisp/my/my-web.el
index 311bcf9..7c9c567 100644
--- a/emacs/.emacs.d/lisp/my/my-web.el
+++ b/emacs/.emacs.d/lisp/my/my-web.el
@@ -86,19 +86,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 +135,122 @@
     (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-download-dir)
+           (expand-file-name
+            (my-make-file-name-from-url url "html")
+            my-webpage-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