macos compatibility

1 files changed, 251 insertions, 0 deletions

diff --git a/custom/jao-custom-browse.el b/custom/jao-custom-browse.el
new file mode 100644
index 0000000..5b956e7
--- /dev/null
+++ b/custom/jao-custom-browse.el
@@ -0,0 +1,251 @@
+;; -*- lexical-binding: t -*-
+
+;;; Browsing
+;;;; variables
+(defvar jao-browse-doc-use-emacs-p (jao-is-linux))
+(defvar jao-browse-url-function nil)
+(defvar jao-browse-url-external-function nil)
+
+;;;; url around point
+(defun jao-url-around-point (&optional current-url)
+  (or (and (fboundp 'w3m-anchor) (w3m-anchor))
+      (shr-url-at-point nil)
+      (ffap-url-at-point)
+      (thing-at-point 'url)
+      (when current-url
+        (or (and (fboundp 'w3m-anchor) (w3m-anchor))
+            (and (derived-mode-p 'eww-mode) (plist-get eww-data :url))))))
+
+(defun jao--url-prompt (&optional prefix)
+  (let* ((def (jao-url-around-point t))
+         (prompt (concat prefix "URL" (if def (format " (%s): " def) ": "))))
+    (read-string prompt nil nil def)))
+
+;;;; downloads using wget
+(defun jao-wget--get-title (filename)
+  (or (and (derived-mode-p 'w3m-mode) (w3m-current-title))
+      (plist-get eww-data :title)
+      (and (not (string-blank-p (or filename "")))
+           (subst-char-in-string ?- ?
+                                 (capitalize (file-name-base filename))))))
+
+(defun jao-wget (url &optional user pwd)
+  "Download URL using wget and kill a link for an org note."
+  (let* ((def (file-name-nondirectory url))
+         (pmt (format "Save %s to: " url))
+         (read-file-name-function nil)
+         (dest (expand-file-name
+                (read-file-name pmt jao-sink-dir nil nil def)))
+         (title (jao-wget--get-title dest))
+         (src-url (or (jao-url-around-point t) (file-name-directory url)))
+         (auth (when (and user pwd)
+                 `(,(format "--http-user=%s" user)
+                   ,(format "--http-password=%s" pwd))))
+         (lnk (concat "doc:" (file-name-nondirectory dest))))
+    (switch-to-buffer-other-window (get-buffer-create "*downloads*"))
+    (erase-buffer)
+    (kill-new (format "%s (from %s)"
+                      (org-link-make-string lnk title)
+                      (org-link-make-string src-url "here")))
+    (apply 'make-term `("downloads" "wget" nil ,@auth "-O" ,dest ,url))))
+
+(defun jao-download (url &optional pws)
+  "Download URL using wget"
+  (interactive (list (jao--url-prompt)))
+  (when url
+    (let ((usr (and pws (read-string "Login name: ")))
+          (pwd (and pws (read-passwd "Password: "))))
+      (jao-wget url usr pwd))))
+
+(with-eval-after-load "embark"
+  (define-key embark-url-map (kbd "d") #'jao-download))
+
+;;;; video
+(defvar jao-video--url-rx
+  (format "^https?://\\(?:www\\.\\)?%s/.+"
+          (regexp-opt '("youtu.be"
+                        "youtube.com"
+                        "blip.tv"
+                        "vimeo.com"
+                        "infoq.com")
+                      t)))
+
+(defvar jao-video--ext-rx
+  (format "^https?://.+/.+\\.%s" (regexp-opt '("mp3" "webm" "mp4"))))
+
+(defun jao-video--url-p (url)
+  (or (string-match-p jao-video--url-rx url)
+      (string-match-p jao-video--ext-rx url)))
+
+(defun jao--remote-run (url prg)
+  (let ((args (format "%s %s" prg (shell-quote-argument url))))
+    (start-process-shell-command prg nil args)))
+
+(defun jao--mpv (url &rest _args) (jao--remote-run url "mpv"))
+(defun jao--vlc (url &rest _args) (jao--remote-run url "vlc"))
+
+(defvar jao--video-player 'jao--mpv)
+
+(defun jao-view-video (url)
+  "Tries to stream a video from the current or given URL"
+  (interactive (list (jao--url-prompt "Video ")))
+  (when url (funcall jao--video-player url)))
+
+(defun jao-maybe-view-video (url &rest _ignored)
+  (interactive)
+  (let ((w (read-char "View video (v) or web page (w)? ")))
+    (cond ((eq w ?v) (jao-view-video url))
+          ((eq w ?w) (funcall jao-browse-url-function url))
+          (t (message "Aborted")))))
+
+;;;; web browsers
+(defun jao-www--buffer-p (b)
+  (with-current-buffer b
+    (or (derived-mode-p 'w3m-mode 'eww-mode)
+        (and (boundp 'exwm-class-name)
+             (member exwm-class-name '("vlc" "mpv"))))))
+
+;;;; browse-url
+(require 'browse-url)
+
+(setq browse-url-generic-program "~/bin/firehog")
+
+(defun jao-browse-with-external-browser (&rest url)
+  "Browse with external hogging"
+  (interactive "s")
+  (let ((url (or (car url) (jao-url-around-point))))
+    (if (not url)
+        (message "No URL at point")
+      (cond ((and (jao-exwm-enabled-p) (fboundp 'jao-exwm-firefox))
+             (jao-exwm-firefox))
+            (jao-river-enabled (jao-river-to-ws 2))
+            (jao-sway-enabled (jao-sway-firefox)))
+      (browse-url-generic url))))
+(setq jao-browse-url-external-function 'jao-browse-with-external-browser)
+
+(defun jao--fln (url)
+  (shell-quote-argument
+   (if (string-match "^[^:]*:/*?\\(/?[^/].*\\)" url)
+       (match-string-no-properties 1 url)
+     url)))
+
+(defun jao--browse-doc (url &rest _ignored)
+  (let* ((url (substring-no-properties url))
+         (file (jao--fln url)))
+    (when file
+      (unless (file-exists-p file)
+        (error "File %s does not exist" file))
+      (jao-open-doc file))))
+
+(defun jao--make-file-rx (exts)
+  (format "file:/?/?.+\\.%s$" (regexp-opt exts)))
+
+(defvar jao--see-exts (jao--make-file-rx '("jpg" "jpeg" "png")))
+
+(defvar jao--doc-exts
+  (jao--make-file-rx '("ps" "ps.gz" "pdf" "dvi" "djvu" "chm")))
+
+(defvar jao-browse-url-wget-exts
+  '("ps" "pdf" "dvi" "djvu" "zip" "gz" "tgz"))
+
+(defvar jao-browse-external-domains
+  '("github.com" "gitlab.com" "slack.com" "spotify.com" "drive.google.com"
+    "meet.google.com" "docs.google.com" "x.com" "twitter.com"
+    "t.com" "linkedin.com" "bigml.com" "slack.com" "zoom.us"))
+
+(defvar jao-browse--external-regexp
+  (format "https?://.*%s\\(/.*\\)?"
+          (regexp-opt jao-browse-external-domains)))
+
+(defun jao-wget--regexp ()
+  (concat "^http[s]?://.+\\(\\."
+          (mapconcat 'identity jao-browse-url-wget-exts "\\|\\.")
+          "\\)\\'"))
+
+(defun jao--see (url &rest _r)
+  (start-process-shell-command "see" nil (format "see %s" (jao--fln url))))
+
+(defun jao--find-file-other-window (url &rest _)
+  (find-file-other-window (jao--fln url)))
+
+(defvar jao-browse--sound-rx
+  (format "^https?://.*/.*\\.%s" (regexp-opt '("mp3" "flv"))))
+
+(defun jao-browse-play-sound-url (url &rest _)
+  (jao-mpc-add-or-play-url url))
+
+(defun jao-browse-url-browse (&rest args)
+  (apply jao-browse-url-function args))
+
+(setq browse-url-handlers
+      `((jao-video--url-p . jao-maybe-view-video)
+        (,jao--doc-exts . jao--browse-doc)
+        (,jao--see-exts . jao--see)
+        ("^file://?.+\\.html?$" . ,jao-browse-url-function)
+        ("^file://?" . jao--find-file-other-window)
+        (,jao-browse--external-regexp . ,jao-browse-url-external-function)
+        ("^https?://.*\\.gotomeeting\\.com\\.*" . browse-url-chrome)
+        (,jao-browse--sound-rx . jao-browse-play-sound-url)
+        (,(jao-wget--regexp) . jao-download)
+        ("." . jao-browse-url-browse)))
+
+(when (< emacs-major-version 28)
+  (setf (alist-get 'jao-video--url-p browse-url-handlers nil t) nil)
+  (setq browse-url-browser-function browse-url-handlers))
+
+;;;; subscribe to rss using r2e
+(autoload 'View-quit "view")
+
+(defun jao-rss--find-url ()
+  (save-excursion
+    (when (derived-mode-p 'w3m-mode 'eww-mode)
+      (if (fboundp 'w3m-view-source) (w3m-view-source) (eww-view-source)))
+    (goto-char (point-min))
+    (when (re-search-forward
+           "type=\"application/\\(?:atom\\|rss\\)\\+xml\" +" nil t)
+      (let ((url (save-excursion
+                   (when (re-search-forward
+                          "href=\"\\([^\n\"]+\\)\"" nil t)
+                     (match-string-no-properties 1))))
+            (title (when (re-search-forward
+                          "\\(?:title=\"\\([^\n\"]+\\)\" +\\)" nil t)
+                     (match-string-no-properties 1))))
+        (cond ((derived-mode-p 'w3m-view-mode) (w3m-view-source))
+              ((string-match-p ".*\\*eww-source\\b.*" (buffer-name))
+               (View-quit)))
+        (when url (cons url (or title "")))))))
+
+(defun jao-rss2e-append (name url mbox)
+  (with-current-buffer (find-file-noselect "~/.config/rss2email.cfg")
+    (goto-char (point-max))
+    (insert "[feed." name "]\nurl = " url)
+    (insert "\nto = " mbox "+" name "@localhost")
+    (insert "\nmaildir-mailbox = " mbox "\n\n")
+    (save-buffer)))
+
+(defun jao-rss--feeds-dirs ()
+  (mapcar (lambda (d) (cadr (split-string d "\\.")))
+          (directory-files "~/.emacs.d/gnus/Mail/" nil "^feeds")))
+
+(defun jao-rss-subscribe (url)
+  "Subscribe to a given RSS URL.  If URL not given, look for it."
+  (interactive (list (or (jao-url-around-point)
+                         (jao-rss--find-url)
+                         (read-string "Feed URL: "))))
+  (let* ((url+title (ensure-list url))
+         (url (car url+title))
+         (title (cdr url+title)))
+    (unless url (error "No feeds found"))
+    (let ((url (if (string-match "^feed:" url) (substring url 5) url)))
+      (when (y-or-n-p (format "Subscribe to <%s>? " url))
+        (let* ((name (read-string "Feed name: " title))
+               (cats (cons "prog" (jao-notmuch--subtags "feeds")))
+               (cat (completing-read "Category: " cats nil t))
+               (subs (format "r2e add %s '%s' feeds.%s@localhost"
+                             name url cat)))
+          ;; (jao-rss2e-append name url cat)
+          (shell-command-to-string subs)
+          (shell-command (format "r2e run %s" name)))))))
+
+(provide 'jao-custom-org)
+;;; jao-custom-org.el ends here