From b11adad984e8160e366d7e154d12c378a9545b9a Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Mon, 13 Dec 2021 10:29:50 -0600 Subject: Lots of changes, most interestingly browse-url stuff --- lisp/+browse-url.el | 117 ++++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/+elfeed.el | 24 +++++++++++ lisp/+emacs.el | 1 - lisp/+key.el | 14 +++++-- lisp/+modeline.el | 8 ++++ lisp/+org.el | 55 ++++++++++++++++++++++++ lisp/+util.el | 8 ++++ 7 files changed, 223 insertions(+), 4 deletions(-) create mode 100644 lisp/+browse-url.el create mode 100644 lisp/+elfeed.el (limited to 'lisp') diff --git a/lisp/+browse-url.el b/lisp/+browse-url.el new file mode 100644 index 0000000..fad0826 --- /dev/null +++ b/lisp/+browse-url.el @@ -0,0 +1,117 @@ +;;; +browse-url.el -*- lexical-binding: t; -*- + +;;; Code: + +(require 'cl-lib) + +(defgroup +browse-url nil + "Group for my `browse-url' extras." + :group 'browse-url) + +;;; URL Handlers + +(defun +browse-url-set-handlers (handlers) + "Set handlers for `browse-url'. +Set `browse-url-handlers', if they exist; else +`browse-url-browser-function'. The reason for this switch is +that the latter is deprecated in Emacs 28+." + (set-default (if (boundp 'browse-url-handlers) + 'browse-url-handlers + 'browse-url-browser-function) + handlers)) + +(cl-defmacro +browse-url-make-external-viewer-handler + (viewer default-args &optional (prompt "URL: ") + &key + (custom-group '+browse-url) + (name (format "+browse-url-with-%s" viewer))) + "Create a `browse-url' handler function that calls VIEWER on the url. +Also create a `customize' setting in CUSTOM-GROUP for VIEWER's +arguments. DEFAULT-ARGS specifies the default arguments that +setting should have. PROMPT will be shown to user in the +function's `interactive' spec, as an argument to +`browse-url-interactive-arg'. The resulting function will be +named NAME, defaulting to \"+browse-url-with-VIEWER\", and the variable +\"NAME-args\"." + (declare (indent 1)) + `(progn + (defcustom ,(intern (format "%s-args" name)) + ,default-args + ,(format "Arguments to pass to %s in `%s'." viewer name) + :type '(repeat :tag "Command-line argument" string) + :group ',custom-group) + (defun ,(intern name) (url &optional _new-window) + ,(format "Open URL in %s." viewer) + (interactive (browse-url-interactive-arg ,prompt)) + (let* ((url (browse-url-encode-url url)) + (process-environment (browse-url-process-environment))) + (message ,(format "Opening %%s in %s..." viewer) url) + (apply #'start-process + (concat ,viewer " " url) nil + ,viewer + (append ,(intern (format "%s-args" name)) (list url))))))) + +;; Reference implementation: mpv +(+browse-url-make-external-viewer-handler "mpv" nil "Video URL: ") +;; And feh too +(+browse-url-make-external-viewer-handler "feh" '("--auto-zoom" + "--geometry" "800x600")) +;; And ... mpv, but for images +(+browse-url-make-external-viewer-handler "mpv" + '("--image-display-duration=inf") + "Image URL: " + :name "+browse-image-with-mpv") + +;;; URL Transformation Functions +;; There's a lot of bad websites out there. Luckily we can easily redirect +;; requests to more privacy-respecting, or just less javascript-ridden, sites +;; using some basic regex magic. Inspired by add-ons like +;; https://einaregilsson.com/redirector/. + +(defcustom +browse-url-transformations nil + "Transformation rules for various URLs. +This is an alist, the keys of which are regexen to match URLs +against, and the values are how to transform them. Match capture +data will be used in the transformations." + :type + '(alist :key-type (string :tag "URL regex match") + :value-type (string :tag "URL regex transformation")) + :group '+browse-url) + +(defun +browse-url-transform-advice (url &rest args) + "ADVICE to transform URL for later opening by `browse-url'. +ARGS are ignored here, but passed on for later processing." + ;; Basically, loop through `+browse-url-transformations' until finding a CAR + ;; that matches the URL. If one is found, transform it using `replace-match' + ;; with the CDR of that cell, or if one isn't, just pass the URL unchanged, + ;; along with the rest of the args, in a list to the original caller (probably + ;; `browse-url'.) + (apply 'list + (cl-loop with url = (substring-no-properties + (if (consp url) (car url) url)) + for (regex . transformation) in +browse-url-transformations + if (string-match regex url) + return (replace-match transformation nil nil url) + ;; else + finally return url) + args)) + +(define-minor-mode +browse-url-transform-url-mode + "Minor mode to transform a URL before passing it to `browse-url'. +This can be used to \"redirect\" URLs, for example from an +information silo to a more privacy-respecting one (e.g., +\"twitter.com\" -> \"nitter.com\"), by adding advice to `browse-url'. + +When using this mode, ensure that the transformed URL is also in +`browse-url-handlers', since that's what `browse-url' will see." + :lighter " Xurl" + :keymap nil + (if +browse-url-transform-url-mode + (advice-add 'browse-url :filter-args '+browse-url-transform-advice) + (advice-remove 'browse-url '+browse-url-transform-advice))) + +(define-global-minor-mode +browse-url-transform-url-global-mode + +browse-url-transform-url-mode +browse-url-transform-url-mode) + +(provide '+browse-url) +;;; +browse-url.el ends here diff --git a/lisp/+elfeed.el b/lisp/+elfeed.el new file mode 100644 index 0000000..823902b --- /dev/null +++ b/lisp/+elfeed.el @@ -0,0 +1,24 @@ +;;; +elfeed.el -*- lexical-binding: t; -*- + +;;; Code: + +(require 'elfeed) + +(defun +elfeed-scroll-up-command (&optional arg) + "Scroll up or go to next feed item in Elfeed" + (interactive "^P") + (let ((scroll-error-top-bottom nil)) + (condition-case-unless-debug nil + (scroll-up-command arg) + (error (elfeed-show-next))))) + +(defun +elfeed-scroll-down-command (&optional arg) + "Scroll up or go to next feed item in Elfeed" + (interactive "^P") + (let ((scroll-error-top-bottom nil)) + (condition-case-unless-debug nil + (scroll-down-command arg) + (error (elfeed-show-prev))))) + +(provide '+elfeed) +;;; +elfeed.el ends here diff --git a/lisp/+emacs.el b/lisp/+emacs.el index 147bb76..a858cf6 100644 --- a/lisp/+emacs.el +++ b/lisp/+emacs.el @@ -69,7 +69,6 @@ Do this only if the buffer is not visiting a file." kill-do-not-save-duplicates t kill-read-only-ok t kill-ring-max 500 - kill-whole-line t kmacro-ring-max 20 load-prefer-newer t major-mode '+set-major-mode-from-buffer-name diff --git a/lisp/+key.el b/lisp/+key.el index 5b4f467..7a51be1 100644 --- a/lisp/+key.el +++ b/lisp/+key.el @@ -14,6 +14,9 @@ ;;; Code: +(require 'easy-mmode) +(require 'setup nil t) + ;; I need to define this map before the proper mode map. (defvar +key-leader-map (let ((map (make-sparse-keymap)) (c-z (global-key-binding "\C-z"))) @@ -30,13 +33,18 @@ (define-minor-mode +key-mode "A minor mode with keybindings that will override every other mode." :init-value t - :lighter " +" - :keymap +key-mode-map) + :lighter " +") +(add-to-list 'emulation-mode-map-alists `((+key-mode . ,+key-mode-map))) ;;;###autoload (define-globalized-minor-mode +key-global-mode +key-mode +key-mode) -(add-to-list 'emulation-mode-map-alists `((+key-mode . ,+key-mode-map))) +;;;###autoload +(defun +key-setup () + "Setup `+key-mode' after everything else." + (if after-init-time + (+key-global-mode +1) + (add-hook 'after-init-hook '+key-global-mode))) (defun turn-off-+key-mode () "Turn off `+key-mode'." diff --git a/lisp/+modeline.el b/lisp/+modeline.el index 0dc34c7..7c74f76 100644 --- a/lisp/+modeline.el +++ b/lisp/+modeline.el @@ -153,5 +153,13 @@ The order of elements matters: whichever one matches first is applied." "Display `anzu--update-mode-line'." (concat " " (anzu--update-mode-line))) +(defun +modeline-text-scale () + "Display text scaling level." + ;; adapted from https://github.com/seagle0128/doom-modeline + (when (and (boundp 'text-scale-mode-amount) + (/= text-scale-mode-amount 0)) + (format (if (> text-scale-mode-amount 0) " (%+d)" " (%-d)") + text-scale-mode-amount))) + (provide '+modeline) ;;; +modeline.el ends here diff --git a/lisp/+org.el b/lisp/+org.el index a4ce230..9a91ef1 100644 --- a/lisp/+org.el +++ b/lisp/+org.el @@ -337,5 +337,60 @@ the deletion might narrow the column." (backward-delete-char-untabify N) (org-fix-tags-on-the-fly)))) +;;; Smarter {super,sub}scripts +;; https://old.reddit.com/r/emacs/comments/qzlzm0/what_are_your_top_key_bindings_rebindings_minor/hmwyhm3/ +;; I don't use this currently because I found out about +;; `org-pretty-entities-include-sub-superscripts', which really does exactly +;; what I wanted. + +(defface +org-script-markers '((t :inherit shadow)) + "Face to be used for sub/superscripts markers i.e., ^, _, {, }.") + +;; Hiding the super and subscript markers is extremely annoying +;; since any remotely complex equation becomes a chore. And leaving +;; it not raised is jarring to the eye. So this fontifies the +;; buffer just like how auctex does -- use a muted colour to +;; highlight the markup and raise the script. +(defun +org-raise-scripts (limit) + "Differences from `org-raise-scripts' are: + +- It doesn't actually hide the markup used for super and subscript. +- It uses a custom face to highlight the markup: +org-script-markers. +- It doesn't require `org-pretty-entities' to be t." + (when (and org-pretty-entities-include-sub-superscripts + (re-search-forward + (if (eq org-use-sub-superscripts t) + org-match-substring-regexp + org-match-substring-with-braces-regexp) + limit t)) + (let* ((pos (point)) table-p comment-p + (mpos (match-beginning 3)) + (emph-p (get-text-property mpos 'org-emphasis)) + (link-p (get-text-property mpos 'mouse-face)) + (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face)))) + (goto-char (point-at-bol)) + (setq table-p (looking-at-p org-table-dataline-regexp) + comment-p (looking-at-p "^[ \t]*#[ +]")) + (goto-char pos) + ;; Handle a_b^c + (when (member (char-after) '(?_ ?^)) (goto-char (1- pos))) + (unless (or comment-p emph-p link-p keyw-p) + (put-text-property (match-beginning 3) (match-end 0) + 'display + (if (equal (char-after (match-beginning 2)) ?^) + ;; (nth (if table-p 3 1) org-script-display) + (nth 3 org-script-display) + ;; (nth (if table-p 2 0) org-script-display) + (nth 2 org-script-display))) + (put-text-property (match-beginning 2) (match-end 2) + 'face 'vz/org-script-markers) + (when (and (eq (char-after (match-beginning 3)) ?{) + (eq (char-before (match-end 3)) ?})) + (put-text-property (match-beginning 3) (1+ (match-beginning 3)) + 'face '+org-script-markers) + (put-text-property (1- (match-end 3)) (match-end 3) + 'face '+org-script-markers))) + t))) + (provide '+org) ;;; +org.el ends here diff --git a/lisp/+util.el b/lisp/+util.el index 0184a48..fb77278 100644 --- a/lisp/+util.el +++ b/lisp/+util.el @@ -79,6 +79,14 @@ ALIGNMENT can be one of these: ;;; COMMANDS +(defun +dos2unix (buffer) + "Replace \r\n with \n in BUFFER." + (interactive "*b") + (save-excursion + (with-current-buffer buffer + (goto-char (point-min)) + (while (search-forward (string ?\C-m ?\C-j) nil t) + (replace-match (string ?\C-j) nil t))))) (provide '+util) ;;; +util.el ends here -- cgit 1.4.1-21-gabe81