From 43bed1f97e6f1a229553d7a25dc437741326772e Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 10 May 2023 13:08:35 -0500 Subject: Bankruptcy 10 --- lisp/+completions.el | 65 ------ lisp/+link-hint.el | 175 ---------------- lisp/+org-capture.el | 49 ----- lisp/+scratch.el | 75 ------- lisp/acdw-chat.el | 206 ------------------- lisp/acdw-mail.el | 439 ----------------------------------------- lisp/acdw-org.el | 548 --------------------------------------------------- lisp/acdw-shell.el | 141 ------------- lisp/acdw-web.el | 374 ----------------------------------- lisp/acdw.el | 384 ------------------------------------ lisp/ical2org.el | 56 ------ 11 files changed, 2512 deletions(-) delete mode 100644 lisp/+completions.el delete mode 100644 lisp/+link-hint.el delete mode 100644 lisp/+org-capture.el delete mode 100644 lisp/+scratch.el delete mode 100644 lisp/acdw-chat.el delete mode 100644 lisp/acdw-mail.el delete mode 100644 lisp/acdw-org.el delete mode 100644 lisp/acdw-shell.el delete mode 100644 lisp/acdw-web.el delete mode 100644 lisp/acdw.el delete mode 100644 lisp/ical2org.el (limited to 'lisp') diff --git a/lisp/+completions.el b/lisp/+completions.el deleted file mode 100644 index 9baaaf8..0000000 --- a/lisp/+completions.el +++ /dev/null @@ -1,65 +0,0 @@ -;;; +completions.el --- Better default completions -*- lexical-binding: t; -*- - -;; From https://robbmann.io/posts/emacs-29-completions/ - -(defun minibuffer@bindings () - (unless vertico-mode - ;; Up/down when completing in the minibuffer - (define-key minibuffer-local-map (kbd "C-p") #'minibuffer-previous-completion) - (define-key minibuffer-local-map (kbd "C-n") #'minibuffer-next-completion) - - ;; Up/down when competing in a normal buffer - (define-key completion-in-region-mode-map (kbd "C-p") - #'minibuffer-previous-completion) - (define-key completion-in-region-mode-map (kbd "C-n") - #'minibuffer-next-completion))) - -(add-hook 'vertico-mode-hook #'minibuffer@bindings) - -(defun renz/sort-by-alpha-length (elems) - "Sort ELEMS first alphabetically, then by length." - (sort elems (lambda (c1 c2) - (or (string-version-lessp c1 c2) - (< (length c1) (length c2)))))) - -(defun renz/sort-by-history (elems) - "Sort ELEMS by minibuffer history. -Use `mct-sort-sort-by-alpha-length' if no history is available." - (if-let ((hist (and (not (eq minibuffer-history-variable t)) - (symbol-value minibuffer-history-variable)))) - (minibuffer--sort-by-position hist elems) - (renz/sort-by-alpha-length elems))) - -(defun renz/completion-category () - "Return completion category." - (when-let ((window (active-minibuffer-window))) - (with-current-buffer (window-buffer window) - (completion-metadata-get - (completion-metadata (buffer-substring-no-properties - (minibuffer-prompt-end) - (max (minibuffer-prompt-end) (point))) - minibuffer-completion-table - minibuffer-completion-predicate) - 'category)))) - -(defun renz/sort-multi-category (elems) - "Sort ELEMS per completion category." - (pcase (renz/completion-category) - ('nil elems) ; no sorting - ('kill-ring elems) - ('project-file (renz/sort-by-alpha-length elems)) - (_ (renz/sort-by-history elems)))) - -(setq completion-auto-help 'always - completion-auto-select 'second-tab - completions-max-height 10 - completions-header-format nil - completion-show-help nil - completions-format 'one-column - save-completions-file-name (etc/ "completions") - completions-sort #'renz/sort-multi-category) - -(add-hook 'completion-list-mode-hook #'truncate-lines-local-mode) - -(provide '+completions) -;;; +completions.el ends here diff --git a/lisp/+link-hint.el b/lisp/+link-hint.el deleted file mode 100644 index 0e0b9b1..0000000 --- a/lisp/+link-hint.el +++ /dev/null @@ -1,175 +0,0 @@ -;;; +link-hint.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) -(require 'link-hint) - -(defgroup +link-hint nil - "Extra customizations for `link-hint'." - :group 'link-hint) - -(defcustom +link-hint-open-secondary-types '(gnus-w3m-image-url - gnus-w3m-url - markdown-link - mu4e-attachment - mu4e-url - notmuch-hello - nov-link - org-link - shr-url - text-url - w3m-link - w3m-message-link) - "Link types to define `:open-secondary' for.") - -(defvar +link-hint-map (make-sparse-keymap) - "Keymap for `link-hint' functionality.") - -(cl-defmacro +link-hint-define-keyword (keyword handler docstring - &optional (types 'link-hint-types) - &rest rest - &key multiple &allow-other-keys) - "Set up a `link-hint' KEYWORD, with optional TYPES. -If TYPES is not present, use `link-hint-types'. - -KEYWORD defines the link-hint type. It will be used to create a -function for opening links of the form \"link-hint-openKEYWORD\". - -HANDLER is the function to open a link with. - -DOCSTRING is the macro's documentation. - -Keyword arguments are passed to `link-hint-define-type' prefixed -with the KEYWORD." - (declare (indent 2) - (doc-string 3)) - (let ((types (symbol-value types)) - (func-sym (intern (format "+link-hint-open%s" keyword))) - (mult-sym (intern (format "%s-multiple" keyword))) - (expr)) - ;; Define the type - (push `(dolist (type ',types) - (link-hint-define-type type - ,keyword ,handler - ,@(mapcar (lambda (el) - (if (eq el :multiple) - mult-sym - el)) - rest))) - expr) - ;; Define an opener - (push `(defun ,func-sym () - ,(format "%s\n\nDefined by `+link-hint-define'." docstring) - (interactive) - (avy-with link-hint-open-link - (link-hint--one ,keyword))) - expr) - ;; Handle `:multiple' - (when multiple - (push `(defun ,(intern (format "+link-hint-open-multiple%s" keyword)) () - ,(format "Open multiple links with `%s'.\n\nDefined by `+link-hint-define'." - func-sym) - (avy-with link-hint-open-multiple-links - (link-hint--multiple ,keyword))) - expr) - (push `(defun ,(intern (format "+link-hint-open-all%s" keyword)) () - ,(format "Open all visible links with `%s'.\n\nDefined by `+link-hint-define'." - func-sym) - (avy-with link-hint-open-all-links - (link-hint--all ,keyword))) - expr)) - ;; Return the built expression - `(progn ,@(nreverse expr)))) - -(+link-hint-define-keyword :secondary browse-url-secondary-browser-function - "Open a link in the secondary browser." - +link-hint-open-secondary-types - :multiple t) - -(progn - (dolist - (type - '(gnus-w3m-image-url gnus-w3m-url markdown-link mu4e-attachment mu4e-url notmuch-hello nov-link org-link shr-url text-url w3m-link w3m-message-link)) - (link-hint-define-type type :download - (function +browse-url-download) - :download-multiple t)) - (defun +link-hint-open:download nil "Download a link to `eww-download-directory'. - -Defined by `+link-hint-define'." - (interactive) - (avy-with link-hint-open-link - (link-hint--one :download))) - (defun +link-hint-open-multiple:download nil "Open multiple links with `+link-hint-open:download'. - -Defined by `+link-hint-define'." - (avy-with link-hint-open-multiple-links - (link-hint--multiple :download))) - (defun +link-hint-open-all:download nil "Open all visible links with `+link-hint-open:download'. - -Defined by `+link-hint-define'." - (avy-with link-hint-open-all-links - (link-hint--all :download)))) - -;; (defun +link-hint-open-secondary-setup (&optional types) -;; "Define the `:open-secondary' link-hint type for TYPES. -;; If TYPES is nil, define it for `+link-hint-open-secondary-types'." -;; (dolist (type (or types +link-hint-open-secondary-types)) -;; (link-hint-define-type type -;; :open-secondary browse-url-secondary-browser-function -;; :open-secondary-multiple t))) - -;; (defun +link-hint-open-secondary () -;; "Open a link in the secondary browser." -;; (interactive) -;; (avy-with link-hint-open-link -;; (link-hint--one :open-secondary))) - -(+link-hint-define-keyword :chrome #'browse-url-chrome - "Open a link with `browse-url-chrome'." - +link-hint-open-secondary-types - :multiple t) - -;; (defun +link-hint-open-chrome-setup (&optional types) -;; "Define the `:open-chrome' link-hint type for TYPES. -;; If TYPES is nil, define it for `+link-hint-open-secondary-types'." -;; (dolist (type (or types +link-hint-open-secondary-types)) -;; (link-hint-define-type type -;; :open-chrome #'browse-url-chrome -;; :open-chrome-multiple t))) - -;; (defun +link-hint-open-chrome () -;; "Open a link with chrome." -;; (interactive) -;; (avy-with link-hint-open-link -;; (link-hint--one :open-chrome))) - -(defun +link-hint-open-link (prefix) - "Open a link. -Without a PREFIX, open using `browse-url-browser-function'; with -a PREFIX, use `browse-url-secondary-browser-function'." - (interactive "P") - (let ((current-prefix-arg nil)) - (avy-with link-hint-open-link - (link-hint--one (if prefix :open-secondary :open))))) - -;; test: https://www.acdw.net - -(defun +link-hint-open-multiple-links (prefix) - "Open multiple links. -Without a PREFIX, open using `browse-url-browser-function'; with -a PREFIX, use `browse-url-secondary-browser-function'." - (interactive "P") - (avy-with link-hint-open-multiple-links - (link-hint--one (if prefix :open-secondary :open)))) - -(defun +link-hint-open-all-links (prefix) - "Open all visible links. -Without a PREFIX, open using `browse-url-browser-function'; with -a PREFIX, use `browse-url-secondary-browser-function'." - (interactive "P") - (avy-with link-hint-open-all-links - (link-hint--one (if prefix :open-secondary :open)))) - -(provide '+link-hint) -;;; +link-hint.el ends here diff --git a/lisp/+org-capture.el b/lisp/+org-capture.el deleted file mode 100644 index 2f7bf6a..0000000 --- a/lisp/+org-capture.el +++ /dev/null @@ -1,49 +0,0 @@ -;;; +org-capture.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) -;; Don't /require/ `org-capture', since that'll pull in all of `org' and that'll -;; take a minute. Just let the compiler know that this variable exists. -(defvar org-capture-templates nil) - -;; https://github.com/cadadr/configuration/blob/39813a771286e542af3aa333172858532c3bb257/emacs.d/gk/gk-org.el#L1573 -(defun +org-capture-template-define (description &rest args) - "Define a capture template. -Creates a list and adds it to `org-capture-templates', if it's -not already there. ARGS is a plist, which in addition to the -additional options `org-capture-templates' accepts (which see), -takes the following and puts them in the right spot: `:keys', -`:description', `:type', `:target', and `:template'." - (declare (indent 1)) - (let* ((keys (plist-get args :keys)) - (type (plist-get args :type)) - (target (plist-get args :target)) - (template (plist-get args :template)) - (template-value (append - (list description) - (when (or type target template) - (list (or type 'entry) target template)) - (cl-loop for i from 0 below (length args) by 2 - unless (member (nth i args) - '(:keys :description :type - :target :template)) - append (list (nth i args) - (plist-get args (nth i - args))))))) - ;; The only way I know how to do this properly (add a value to the end of - ;; the list, if it exists; otherwise update it) is to do this weird if-setf - ;; dance. - (if (seq-find (lambda (el) (equal (car el) keys)) - org-capture-templates) - (setf (alist-get keys org-capture-templates nil nil #'equal) - template-value) - (setf org-capture-templates - (append org-capture-templates - (list (cons keys template-value))))) - ;; Regardless of what we do, return the new value of - ;; `org-capture-templates'. - org-capture-templates)) - -(provide '+org-capture) -;;; +org-capture.el diff --git a/lisp/+scratch.el b/lisp/+scratch.el deleted file mode 100644 index 5d749c6..0000000 --- a/lisp/+scratch.el +++ /dev/null @@ -1,75 +0,0 @@ -;;; +scratch.el --- *scratch* improvements -*- lexical-binding: t; -*- - -;; Copyright (C) 2023 Case Duckworth - -;; Author: Case Duckworth -;; Keywords: convenience - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program 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 General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; - -;;; Code: - -(defcustom +scratch-save-dir (locate-user-emacs-file "scratch.d") - "Where to save scratch files." - :type 'file) - -(defcustom +scratch-max-age (* 60 60 24 365) - "Maximum age of a saved scratch buffer. Default: one year." - :type 'natnum) - -(defun +scratch@immortal () - "Don't kill *scratch* with `kill-buffer'." - (if (equal (buffer-name) "*scratch*") - (progn (bury-buffer) nil) - t)) - -(defun +scratch-save (time-format) - "Save *scratch* buffer to `+scratch-save-dir'. -TIME-FORMAT will be used to name the buffer." - (interactive (list "%FT%H%z")) - (with-current-buffer (get-scratch-buffer-create) - (let ((buffer-file-name (expand-file-name (format "%s.%s" - (format-time-string - time-format) - (pcase major-mode - ('org-mode "org") - ('emacs-lisp-mode "el") - (_ "txt"))) - +scratch-save-dir))) - (unless (string-equal (buffer-substring (point-min) (point-max)) - initial-scratch-message) - (save-buffer 0))))) - -(defun +scratch-save-on-exit () - (+scratch-save "%FT%T%z") - (+scratch-clean)) - -(defun +scratch-clean () - "Clean up saved scratches. -Scratch files older than `+scratch-max-age' will be removed." - (dolist (f (directory-files +scratch-save-dir)) - (when (and (not (equal f ".")) - (not (equal f "..")) - (> (time-convert (file-attribute-modification-time - (file-attributes f)) - 'integer) - +scratch-max-age)) - (delete-file (expand-file-name f +scratch-save-dir) :trash)))) - -(provide '+scratch) -;;; +scratch.el ends here diff --git a/lisp/acdw-chat.el b/lisp/acdw-chat.el deleted file mode 100644 index 9294ffe..0000000 --- a/lisp/acdw-chat.el +++ /dev/null @@ -1,206 +0,0 @@ -;;; acdw-chat.el --- Chat applications (mostly jabber) -*- lexical-binding: t; -*- - -;;; Code: - -(defcustom jabber-prefix-width 10 - "Width of jabber prompts and other prefixes." - :type 'number - :group 'jabber) - -(defun jabber-ui-setup () - "Setup the `jabber' user interface." - (visual-fill-column-mode) - (electric-pair-local-mode -1) - (auto-fill-mode -1) - (setq-local wrap-prefix (make-string (+ 3 jabber-prefix-width) #x20) - visual-fill-column-extra-text-width `(,(+ 3 jabber-prefix-width) - . 1))) - -(defcustom jabber-biboumi-server "localhost" - "Biboumi server for `jabber-biboumi-muc-connect'." - :type 'string - :group 'jabber) - -(defcustom jabber-biboumi-irc-servers '("irc.libera.chat") - "IRC servers for the user to choose from with `jabber-biboumi-muc-connect'." - :type '(repeat string) - :group 'jabber) - -(defcustom jabber-biboumi-default-nick "" - "Default nick for biboumi rooms." - :type 'string - :group 'jabber) - -(defun jabber-biboumi-muc-connect (channel server nick &optional biboumi-server) - "Connect to a biboumi (IRC gateway) server MUC. -CHANNEL, SERVER, NICK, and BIBOUMI-SERVER are passed to -`jabber-muc-join'. If BIBOUMI-SERVER isn't given, -`jabber-biboumi-server' is used." - (interactive (list (concat "#" (string-remove-prefix "#" (read-string - "Channel: "))) - (completing-read "Server: " jabber-biboumi-irc-servers) - (read-string (format "Nick [%s]: " - jabber-biboumi-default-nick) - nil nil jabber-biboumi-default-nick))) - (let ((room (format "%s%%%s@%s" channel server (or biboumi-server - jabber-biboumi-server)))) - (if (assoc room *jabber-active-groupchats*) - (switch-to-buffer (jabber-muc-get-buffer room)) - (jabber-muc-join (jabber-read-account) - room - nick - 'popup)))) - -(defalias 'jabber-irc-join 'jabber-biboumi-muc-connect) - -(defun jabber-connect-all* (&optional arg) - "Run `jabber-connect-all'. -With a prefix ARG, disconnect first." - (interactive "p") - (when arg - (jabber-disconnect)) - (jabber-connect-all)) - -(defun jabber-group-yank-join-url () - "Yank a url for joining the focused group." - (interactive) - (let ((s (format "xmpp:%s?join" jabber-group))) - (kill-new s) - (message s))) - - -;;; Packages - -(use-package jabber - :load-path "~/src/jabber.el/" - :custom-face - (jabber-activity-face ((t :inherit jabber-chat-prompt-foreign - :foreground unspecified - :weight normal))) - (jabber-activity-personal-face ((t :inherit jabber-chat-prompt-local - :foreground unspecified - :weight bold))) - (jabber-chat-prompt-local ((t :inherit minibuffer-prompt - :foreground unspecified - :weight normal - :slant italic))) - (jabber-chat-prompt-foreign ((t :inherit warning - :foreground unspecified - :weight normal))) - (jabber-chat-prompt-system ((t :inherit font-lock-doc-face - :foreground unspecified))) - (jabber-rare-time-face ((t :inherit font-lock-comment-face - :foreground unspecified - :underline nil))) - :bind-keymap ("C-c j" . jabber-global-keymap) - :bind (("C-c C-SPC" . jabber-activity-switch-to)) - :config - (setq jabber-account-list '(("acdw@hmm.st")) - jabber-auto-reconnect t - jabber-biboumi-server "irc.hmm.st" - jabber-biboumi-irc-servers '("irc.libera.chat" - "irc.oftc.net" - "irc.tilde.chat" - "tilde.town" - "m455.casa" - "irc.twitch.tv") - jabber-biboumi-default-nick "acdw" - jabber-last-read-marker (make-string fill-column ?.) - jabber-muc-decorate-presence-patterns - '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$" . nil) - ("Mode #.*" . jabber-muc-presence-dim) - ("." . jabber-muc-presence-dim)) - jabber-activity-make-strings #'jabber-activity-make-strings-shorten - jabber-rare-time-format " - - - - - - %H:%M %F" - jabber-chat-header-line-format - '("" (jabber-chat-buffer-show-avatar - (:eval - (let ((buddy (jabber-jid-symbol jabber-chatting-with))) - (jabber-propertize " " - 'display (get buddy 'avatar))))) - (:eval (replace-regexp-in-string "%" "%%" - (jabber-jid-displayname - jabber-chatting-with))) - "\t" (:eval (let ((buddy (jabber-jid-symbol jabber-chatting-with))) - (propertize - (or - (cdr (assoc (get buddy 'show) jabber-presence-strings)) - (get buddy 'show)) - 'face - (or (cdr (assoc (get buddy 'show) jabber-presence-faces)) - 'jabber-roster-user-online)))) - "\t" (:eval (jabber-fix-status (get (jabber-jid-symbol jabber-chatting-with) 'status))) - "\t" jabber-events-message - "\t" jabber-chatstates-message) - jabber-muc-header-line-format - '(" " (:eval (replace-regexp-in-string "%" "%%" - (jabber-jid-displayname - jabber-group))) - " / " jabber-muc-topic) - ;; buffer name formats - jabber-chat-buffer-format "*xmpp* %n" - jabber-browse-buffer-format "*xmpp-browse* %n" - jabber-groupchat-buffer-format "*xmpp-muc* %n" - jabber-muc-private-buffer-format "*xmpp-muc-private* %n" - ;; "prompt" (speaker) formats - jabber-groupchat-prompt-format (format "%%>%dn . " jabber-prefix-width) - jabber-chat-local-prompt-format (format "%%>%dn . " jabber-prefix-width) - jabber-chat-foreign-prompt-format (format "%%>%dn . " jabber-prefix-width) - jabber-muc-private-foreign-prompt-format "\n%g/%n . ") - ;; jabber muc nick coloring - ;; wgreenhous | I found 1.5 ok for saturation and 2.0 for value (modus) - ;; (setopt jabber-muc-nick-value 1.0 - ;; jabber-muc-nick-saturation 1.0 - ;; jabber-muc-colorize-local t - ;; jabber-muc-colorize-foreign t) - ;; When changing the above values, make sure to - ;; (setq jabber-muc-participant-colors nil) - (add-hook 'jabber-chat-mode-hook #'jabber-ui-setup) - (keymap-global-set "C-x C-j" #'dired-jump) ; Extremely annoying fix - ;; For each binding in `jabber-global-keymap', also bind the non-control - ;; character (lowercase) - (map-keymap (lambda (key command) - (define-key jabber-global-keymap (vector (+ key #x60)) command)) - jabber-global-keymap) - (define-key jabber-global-keymap "c" #'jabber-connect-all*) - (require 'jabber-httpupload nil t) - (add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons) - (remove-hook 'jabber-alert-muc-hooks 'jabber-muc-echo) - (remove-hook 'jabber-alert-presence-hooks 'jabber-presence-echo) - (add-hook 'jabber-alert-muc-hooks - (defun jabber@highlight-acdw (&optional _ _ buf _ _) - (when buf - (with-current-buffer buf - (let ((regexp (rx word-boundary - "acdw" ; maybe get from the config? - word-boundary))) - (hi-lock-unface-buffer regexp) - (highlight-regexp regexp 'jabber-chat-prompt-local)))))) - (add-hook 'jabber-chat-mode-hook - (defun jabber-chat@leave-when-kill () - (add-hook 'kill-buffer-hook - (defun @jabber-leave@kill () - (ignore-errors - (apply #'jabber-muc-leave (jabber-muc-argument-list)))) - nil :local))) - (when (fboundp 'jabber-chat-update-focus) - (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus)) - (with-eval-after-load 'consult - (defvar jabber-chat-buffer-source - `( :name "Jabber" - :hidden nil - :narrow ?j - :category buffer - :state ,#'consult--buffer-state - :items ,(lambda () - (mapcar #'buffer-name - (seq-filter (lambda (buf) - (with-current-buffer buf - (eq major-mode 'jabber-chat-mode))) - (buffer-list)))))) - (add-to-list 'consult-buffer-sources 'jabber-chat-buffer-source :append) - (consult-customize - consult-buffer :preview-key "M-."))) - -(provide 'acdw-chat) -;;; acdw-chat.el ends here diff --git a/lisp/acdw-mail.el b/lisp/acdw-mail.el deleted file mode 100644 index bf20c9b..0000000 --- a/lisp/acdw-mail.el +++ /dev/null @@ -1,439 +0,0 @@ -;;; acdw-mail.el --- My email configuration -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) -(require 'message) - -;;; Variables - -(defcustom +message-send-dispatch-rules nil - "Alist to set variables based on the current from address." - :group 'message - :type '(alist :key-type (string :tag "From address") - :value-type (alist :tag "Rules" - :key-type (symbol :tag "Variable") - :value-type (sexp :tag "Value")))) - -(defcustom +notmuch-spam-tags '("+spam -inbox -unread") - "List of tag changes to apply when marking a thread as spam." - :group 'notmuch - :type '(repeat string)) - -;;; Functions - -(defun +message-send-set-variables () - "Set variables for `message-send' depending on the From: header. -Useful in `message-send-hook'." - (unless +message-send-dispatch-rules - (load notmuch-init-file) - (or +message-send-dispatch-rules - (error "`+message-send-dispatch-rules' isn't set!"))) - (let ((from (message-fetch-field "from"))) - (cl-loop for (var . val) in (cl-loop for (address . bindings) - in +message-send-dispatch-rules - if (string-match-p address from) - return bindings) - do (set (make-local-variable var) val)))) - -;; Thanks to Alex Schroeder! -;; https://www.emacswiki.org/emacs/Change_Signature_Dynamically -(defun +message-check-for-signature-change (&rest ignore) - "Check for a change in the To: or Cc: fields" - (when (and (message--in-tocc-p) - (not (buffer-narrowed-p))) - (save-excursion - (goto-char (point-max)) - (let ((end (point))) - (when (re-search-backward message-signature-separator nil t) - (delete-region (1- (match-beginning 0)) end))) - (message-insert-signature)))) - -(defun +message-signature-setup () - (make-local-variable 'after-change-functions) - (push '+message-check-for-signature-change after-change-functions)) - -(defun +notmuch-field-match-p (field regexp) - "Return whether message FIELD matches REGEXP." - (string-match-p regexp (or (message-fetch-field field) ""))) - -(defun +notmuch-query-concat (&rest queries) - "Concatenate `notmuch' QUERIES with AND." - (mapconcat #'identity queries " AND ")) - -;;;###autoload -(defun +notmuch-goto (&optional prefix) - "Perform a saved `notmuch' search. -Without a PREFIX argument, perform the first search in -`notmuch-saved-searches'. With a single PREFIX argument -(\\[universal-argument]), prompt the user as to which saved -search to perform. With two PREFIX arguments, prompt the user -for a free-form search. With any other PREFIX argument, open -`notmuch-hello'." - (interactive "P") - (pcase prefix - ('nil (notmuch-search (plist-get (car notmuch-saved-searches) :query))) - ('(4) (notmuch-search - (plist-get (cl-find (completing-read "Saved search: " - (mapcar (lambda (elt) - (plist-get elt :name)) - notmuch-saved-searches)) - notmuch-saved-searches - :key (lambda (elt) (plist-get elt :name)) - :test #'equal) - :query))) - ('(16) (notmuch-search)) - (_ (notmuch-hello)))) - -(defun +notmuch-search-mark-spam (&optional ham start end) - "Mark the current thread or region as spam. -That is, add the tags in `+notmuch-spam-tags' to the message. -With an optional HAM argument (interactively, -\\[universal-argument]), mark the message as not-spam, or ham, by -reversing the tag changes." - (interactive (cons current-prefix-arg (notmuch-interactive-region))) - (when +notmuch-spam-tags - (notmuch-search-tag (notmuch-tag-change-list +notmuch-spam-tags ham) - start end)) - (when (eq start end) - (notmuch-search-next-thread))) - -(defun +notmuch-tree-mark-spam (&optional ham _ _) - "Mark the current message as spam. -That is, add the tags in `+notmuch-spam-tags' to the message. -With an optional HAM argument (interactively, -\\[universal-argument]), mark the message as not-spam, or ham, by -reversing the tag changes." - (interactive (cons current-prefix-arg (notmuch-interactive-region))) - (when +notmuch-spam-tags - (notmuch-tree-tag (notmuch-tag-change-list +notmuch-spam-tags ham))) - (notmuch-tree-next-matching-message)) - -(defun +notmuch-define-saved-search (name key search-type &rest queries) - "Wrapper to ease `notmuch-saved-searches' defining. -NAME, KEY, and SEARCH-TYPE are paired with the corresponding keywords in -`notmuch-saved-searches', which see. QUERIES are all concatenated together with -AND. If QUERIES is prepended with more keyword arguments, those are added to -the saved search as well." - (declare (indent 3)) - (let (extra-keywords) - (while (keywordp (car queries)) - (push (cadr queries) extra-keywords) - (push (car queries) extra-keywords) - (setf queries (cddr queries))) - (add-to-list 'notmuch-saved-searches - (append (list :name name - :key key - :search-type search-type - :query (apply #'+notmuch-query-concat queries)) - (reverse extra-keywords)) - :append - (lambda (a b) - (equal (plist-get a :name) - (plist-get b :name)))))) - -(defun notmuch-async-poll () - "Run `notmuch-poll' in an async process." - (interactive) - (if (require 'async nil t) - (progn - (message "Polling mail (async)...") - (async-start - (lambda () - (ignore-errors - (push "~/usr/share/emacs/site-lisp/" load-path) - (require 'notmuch-lib) - (notmuch-poll))) - (lambda (_) - (message "Polling mail (async)...done")))) - (user-error "Feature `async' not found!") - (notmuch-poll))) - -;;; https://kitchingroup.cheme.cmu.edu/blog/2015/09/04/Checking-for-email-attachments-before-you-send-email/ - -(defun email-says-attach-p () - "Return t if email suggests there could be an attachment." - (save-excursion - (goto-char (point-min)) - (re-search-forward "attach" nil t))) - -(defun email-has-attachment-p () - "Return t if the currently open email has an attachment." - (save-excursion - (goto-char (point-min)) - (re-search-forward "<#part" nil t))) - -(defun email-pre-send-check-attachment () - (when (and (email-says-attach-p) - (not (email-has-attachment-p))) - (unless - (y-or-n-p - "Your email suggests an attachment, but none was found. Send anyway?") - (error "No attachment. Aborting send.")))) - -;;; Process ical attachments -;; https://www.reddit.com/r/emacs/comments/8s1ion/comment/e0x5kgd/ - -(defun ical2org (&optional replace output-buffer) - "Run ical2org on contents of this buffer. -If REPLACE (interactive prefix argument), replace contents of the -buffer. If no REPLACE nor OUTPUT-BUFFER, output goes to -minibuffer." - (interactive "P") - (shell-command-on-region (point-min) (point-max) - "ical2org.awk" - output-buffer - replace - "*ical2org errors*" - 'display-errors)) - -(defun ical2org-capture () - "Run `ical2org' on this buffer, then `org-capture' the result. -Leaves current buffer as-was afterwards." - (interactive) - (let ((buf (current-buffer)) - (ics (buffer-string))) - (ical2org 'replace buf) - (mark-whole-buffer) - (org-capture nil "a") - (mark-whole-buffer) - (delete-region (point-min) (point-max)) - (insert ics))) - -(defun notmuch-ics-refile (filename header) - "Refile the current ICS buffer to FILENAME, under HEADER." - (org-refile nil nil - (list header - filename - nil - (with-current-buffer (find-file-noselect filename) - (org-find-exact-headline-in-buffer header)))) - (notmuch-ics-kill)) - -(defun notmuch-ics-kill () - "Kill the current ICS buffer and delete its file." - (let ((kill-buffer-hook nil) - (kill-buffer-query-functions nil) - (file (buffer-file-name))) - (set-buffer-modified-p nil) - (kill-buffer-and-window) - (delete-file file))) - -(defun notmuch-ics-cancel () - "Cancel saving ICS buffer." - (interactive) - (notmuch-ics-kill)) - -(define-derived-mode notmuch-save-ics-mode org-mode - "Org-mode but with a different keymap.") - -(defun notmuch-save-ics () - ;; XXX: this is hacky as hell - "Save a .ics file in a message." - (interactive) - (with-current-notmuch-show-message - (notmuch-foreach-mime-part - (lambda (part) - (when (and (listp part) - (or (equal "application/ics" (caadr part)) - ;; (equal "text/calendar" (caadr part)) - )) - (let* ((filename (format "/dev/shm/notmuch-%s.ics" - (time-convert (current-time) 'integer)))) - (mm-save-part-to-file part filename) - (message "Converting ICS to org ...") - (with-current-buffer (find-file-other-window filename) - (ical2org 'replace (current-buffer)) - (deactivate-mark) - (let ((org-mode-hook nil)) - (notmuch-save-ics-mode)) - (local-set-key (kbd "C-c C-c") - (lambda () (interactive) - (notmuch-ics-refile (sync/ "org/diary.org") "Appointments"))) - (local-set-key (kbd "C-c C-k") #'notmuch-ics-cancel) - (setq-local header-line-format - (concat "ICAL buffer. " - "Finish: `C-c C-c'. " - "Abort: `C-c C-k'.")))))) - (mm-dissect-buffer t t)))) - -(add-hook 'notmuch-show-hook #'notmuch-save-ics) - - -;;; Fixes - -;; https://nmbug.notmuchmail.org/nmweb/show/87bklhricc.fsf%40tethera.net - -(defun notmuch--indent-rigidly (start end count) - (cond - ((zerop count) t) - ((< count 0) (indent-rigidly start end count)) - (t - (save-excursion - (let ((startpt (progn (goto-char start) (line-beginning-position))) - (endpt (progn (goto-char end) (line-end-position))) - (spaces (spaces-string count))) - (goto-char startpt) - (while - (progn - (insert spaces) - (cl-incf endpt count) - (and (zerop (forward-line 1)) (bolp) - (<= (point) endpt))))))))) - -(with-eval-after-load 'notmuch-show - ;; Redefine `notmuch-show-lazy-part' --- XXX: this is the most braindead way - ;; of doing this - (defun notmuch-show-lazy-part (part-args button) - ;; Insert the lazy part after the button for the part. We would just - ;; move to the start of the new line following the button and insert - ;; the part but that point might have text properties (eg colours - ;; from a message header etc) so instead we start from the last - ;; character of the button by adding a newline and finish by - ;; removing the extra newline from the end of the part. - (save-excursion - (goto-char (button-end button)) - (insert "\n") - (let* ((inhibit-read-only t) - ;; We need to use markers for the start and end of the part - ;; because the part insertion functions do not guarantee - ;; to leave point at the end of the part. - (part-beg (copy-marker (point) nil)) - (part-end (copy-marker (point) t)) - ;; We have to save the depth as we can't find the depth - ;; when narrowed. - (depth (notmuch-show-get-depth))) - (save-restriction - (narrow-to-region part-beg part-end) - (delete-region part-beg part-end) - (apply #'notmuch-show-insert-bodypart-internal part-args) - (notmuch--indent-rigidly part-beg - part-end - (* notmuch-show-indent-messages-width depth))) - (goto-char part-end) - (delete-char 1) - (notmuch-show-record-part-information (cadr part-args) - (button-start button) - part-end) - ;; Create the overlay. If the lazy-part turned out to be empty/not - ;; showable this returns nil. - (notmuch-show-create-part-overlays button part-beg part-end)))) - ) - - -;;; Packages - -(use-package bbdb - :ensure t - :config - (setopt bbdb-complete-mail-allow-cycling t - bbdb-file (private/ "bbdb")) - (add-hook 'custom-allowed-after-load-hook - (defun bbdb@after-custom () - (require 'bbdb) - (require 'bbdb-message) - (bbdb-initialize 'message)))) - -(use-package bbdb-vcard - :ensure t - :after bbdb) - -(use-package notmuch - :when (executable-find "notmuch") - :load-path "~/usr/share/emacs/site-lisp/" - :defer 30 - :commands (notmuch-mua-new-mail - notmuch-search - notmuch-hello) - :preface (defdir notmuch/ (sync/ "emacs/notmuch/") - "Notmuch configuration directory." - :makedir) - :config - ;; Options - (setopt notmuch-init-file (notmuch/ "notmuch-init.el" t) - notmuch-address-save-filename (notmuch/ "addresses" t) - notmuch-address-use-company (featurep 'company) - notmuch-search-oldest-first nil - notmuch-archive-tags '("-inbox" "-unread") - notmuch-draft-tags '("+draft" "-inbox" "-unread") - +notmuch-spam-tags '("+spam") - mail-user-agent 'notmuch-user-agent - message-mail-user-agent t - notmuch-show-indent-content nil - message-kill-buffer-on-exit t - message-auto-save-directory nil - message-signature "Case Duckworth\nhttps://www.acdw.net" - send-mail-function #'sendmail-send-it - mail-specify-envelope-from t - message-sendmail-envelope-from 'header - message-envelope-from 'header - notmuch-saved-searches nil - notmuch-poll-script "~/usr/scripts/syncmail" ; XXX: Deprecated option - ) - (load notmuch-init-file) - ;; Key bindings - (keymap-set notmuch-search-mode-map "!" #'+notmuch-search-mark-spam) - (keymap-set notmuch-search-mode-map "RET" #'notmuch-search-show-thread) - (keymap-set notmuch-search-mode-map "M-RET" #'notmuch-tree-from-search-thread) - (keymap-set notmuch-tree-mode-map "!" #'+notmuch-tree-mark-spam) - ;; Saved searches - (+notmuch-define-saved-search "inbox+unread" "m" 'tree - "tag:inbox" "tag:unread" "NOT tag:Spam") - (+notmuch-define-saved-search "inbox" "i" 'tree - "tag:inbox" "NOT tag:Spam") - (+notmuch-define-saved-search "lists+unread" "l" 'tree - "tag:/List/" "tag:unread") - (+notmuch-define-saved-search "lists" "L" 'tree - "tag:/List/") - (+notmuch-define-saved-search "unread" "u" 'tree - "tag:unread" "NOT tag:Spam") - (+notmuch-define-saved-search "flagged" "f" 'tree - "tag:flagged") - (+notmuch-define-saved-search "sent" "t" 'tree - "tag:sent") - (+notmuch-define-saved-search "drafts" "d" 'tree - "tag:draft") - (+notmuch-define-saved-search "all mail" "a" 'tree "*") - ;; Hooks and advice - (add-hook 'message-send-hook #'+message-send-set-variables) - (add-hook 'message-send-hook #'email-pre-send-check-attachment) - (add-hook 'message-setup-hook #'+message-signature-setup) - (autoload 'visual-fill-column-mode "visual-fill-column" nil t) - (add-hook 'notmuch-message-mode-hook #'visual-fill-column-mode) - (add-hook 'notmuch-show-mode-hook #'visual-fill-column-mode) - - (define-advice notmuch-bury-or-kill-this-buffer (:after (&rest _) poll-async) - (call-process "swaymail")) - - (define-advice notmuch-address-selection-function - (:override (prompt collection _) no-initial-input) - "Call `completing-read' with `notmuch-address-history'. -This version doesn't add any initial-input." - (completing-read prompt collection nil nil nil 'notmuch-address-history)) - - (add-to-list 'notmuch-message-headers "List-Post" :append #'equal) - (define-advice notmuch-mua-new-reply (:around (orig &rest r) list-aware) - "Make `notmuch-mua-new-reply' list-aware." - (let ((ml (notmuch-show-get-header :List-Post))) - (apply orig r) - (require 'message) - (when ml - (with-buffer-modified-unmodified - (message-remove-header "To") - (message-add-header - (format "To: %s" (replace-regexp-in-string "" "\\1" - ml))) - (message-goto-body))))) - - (define-advice notmuch-tag (:filter-args (args) trim) - "Trim whitespace from ends of tags." - (list (car args) (mapcar #'string-trim (cadr args)))) - ;; Load init file - (load notmuch-init-file :noerror)) - -(use-package notmuch-tags - :load-path "~/src/emacs/notmuch-tags.el/" - :commands (notmuch-tags-mode)) - -(provide 'acdw-mail) -;;; acdw-mail.el ends here diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el deleted file mode 100644 index 2ec3339..0000000 --- a/lisp/acdw-org.el +++ /dev/null @@ -1,548 +0,0 @@ -;;; acdw-org.el --- My org customizations -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) - -;;; Variables - -(defcustom org-agenda-skip-file-regexp nil - "Files matching this regexp are removed from `org-agenda-files'." - :group 'org-agenda - :type 'regexp) - -;;; Functions - - -;;; DWIM - -;; https://github.com/alphapapa/unpackaged.el, -;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/ -(defun +org-return-dwim (&optional arg) - "A helpful replacement for `org-return'. -When called interactively with \\[universal-argument], call `org-return' -itself. Other values of ARG will call `newline' with that ARG." - (interactive "P") - ;; Auto-fill if enabled - (when auto-fill-function - (dolist (func (ensure-list auto-fill-function)) - (funcall func))) - (cl-letf* ((el (org-element-at-point)) - ((symbol-function 'el-child-of) - (lambda (&rest types) - (org-element-lineage el types t)))) - (cond ; Figure out what we're going to do - (arg ; Handle prefix ARG - (pcase arg - ('(4) (org-return t nil t)) - (_ (newline arg t)))) - ((and org-return-follows-link ; Open a link - (el-child-of 'link)) - (org-open-at-point-global)) - ((org-at-heading-p) ; Open a paragraph after a heading - (let ((heading-start (org-entry-beginning-position))) - (goto-char (org-entry-end-position)) - (cond ((and (org-at-heading-p) ; Entry is only a heading - (= heading-start (org-entry-beginning-position))) - (end-of-line) - (newline 2)) - (:else ; Entry is more than a heading - (forward-line -1) - (end-of-line) - (when (org-at-heading-p) - ;; Open a paragraph - (forward-line) - (newline) - (forward-line -1)) - (while (not (looking-back "\\(?:[[:blank:]]?\n\\)\\{3\\}" nil)) - (newline)) - (forward-line -1))))) - ((org-at-item-checkbox-p) ; Insert a new checkbox item - (end-of-line) - (org-insert-todo-heading nil)) - ((org-in-item-p) ; Insert a new list item - (let* ((context (org-element-context el)) - (first-item-p (eq 'plain-list (car context))) - (itemp (eq 'item (car context))) - (emptyp (or - ;; This (regular) list item is empty - (eq (org-element-property :contents-begin context) - (org-element-property :contents-end context)) - ;; This (definition) list item is empty - (looking-at " *::"))) - (item-child-p (el-child-of 'item))) - (cond ((and itemp emptyp) - ;; This test has to be here even though it's the same as the - ;; :else clause, because an item that's empty will also satisfy - ;; the next clause. - (delete-region (line-beginning-position) (line-end-position)) - (newline)) - ((or first-item-p - (and itemp (not emptyp)) - item-child-p) - (org-end-of-item) - (org-insert-item)) - (:else - (delete-region (line-beginning-position) (line-end-position)) - (newline))))) - ((and (fboundp 'org-inlinetask-in-task-p) ; Just return for inline tasks - (org-inlinetask-in-task-p)) - (org-return)) - ((org-at-table-p) ; Insert a new table row - (cond ((save-excursion ; Empty row: end the table - (beginning-of-line) - (cl-loop with end = (line-end-position) - for cell = (org-element-table-cell-parser) - always (eq (org-element-property :contents-begin cell) - (org-element-property :contents-end cell)) - while (re-search-forward "|" end t))) - (delete-region (line-beginning-position) (line-end-position)) - (org-return)) - (:else ; Non-empty row - (org-return)))) - (:else ; Something else - (org-return))))) - -(defun +org-table-copy-down|+org-return-dwim (&optional n) - "Call `org-table-copy-down' or `+org-return' depending on context." - (interactive "P") - (if (org-table-check-inside-data-field 'noerror) - (org-table-copy-down (or n 1)) - (+org-return-dwim n))) - - -;;; Buffer view cleanup - -(defun +org-hide-drawers-except-point () - "Hide all drawers except for the one point is in." - ;; Most of this bit is taken from `org-fold--hide-drawers'. - (let ((pt (point)) - (begin (point-min)) - (end (point-max))) - (save-excursion - (goto-char begin) - (while (and (< (point) end) - (re-search-forward org-drawer-regexp end t)) - (if (org-fold-folded-p nil 'drawer) - (goto-char (org-fold-next-folding-state-change 'drawer nil end)) - (let* ((drawer (org-element-at-point)) - (type (org-element-type drawer)) - (el-begin (org-element-property :begin drawer)) - (el-end (org-element-property :end drawer))) - (when (memq type '(drawer property-drawer)) - (org-fold-hide-drawer-toggle - (if (< el-begin pt el-end) 'off 'on) - nil drawer) - (goto-char el-end)))))))) - - -;;; Copy rich text to the keyboard - -;; Thanks to Oleh Krehel: -;; https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard -;; So. Emacs can't do this itself because it doesn't support sending clipboard -;; or selection contents as text/html. We have to use xclip instead. -;; (defun org-to-html-to-clipboard (&rest org-export-args) -;; "Export current org buffer to HTML, then copy it to the clipboard. -;; ORG-EXPORT-ARGS are passed to `org-export-to-file'." -;; (let ((f (make-temp-file "org-html-export"))) -;; (apply #'org-export-to-file 'html f org-export-args) -;; (start-process "xclip" " *xclip*" -;; "xclip" "-verbose" "-i" f -;; "-t" "text/html" "-selection" "clipboard") -;; (message "HTML pasted to clipboard."))) - -;; Wayland version.. TODO: make it work for both -(defun org-to-html-to-clipboard (&rest org-export-args) - "Export current org buffer to HTML, then copy it to the clipboard. -ORG-EXPORT-ARGS are passed to `org-export-to-file'." - (let ((buf (generate-new-buffer "*org-html-clipboard*" t))) - (apply #'org-export-to-buffer 'html buf org-export-args) - (with-current-buffer buf - (call-process-region (point-min) (point-max) - "wl-copy" nil nil nil - "-t" "text/html") - (kill-buffer-and-window)) - (message "HTML copied to clipboard."))) - -(defun org-subtree-to-html-to-clipboard () - "Export current subtree to HTML." - (interactive) - (org-to-html-to-clipboard nil :subtree)) - - -;;; Prompting - -(defun +org-prompt-for-property (property &optional clipboardp insert list) - "Prompt for PROPERTY and return a properly-formatted string. -Pre-fill the input with clipboard contents if they match CLIPBOARDP. If -CLIPBOARDP is nil or missing, don't pre-fill. - -If INSERT is non-nil, insert the property into the property -drawer of the current org tree. - -If LIST is non-nil, return the result as a list instead of a string." - (let* ((kill (current-kill 0)) - (value (read-string (concat property ": ") - (when (and clipboardp - (or (eq clipboardp t) - (funcall clipboardp kill))) - kill)))) - (when insert - (org-set-property property value)) - (if list - (list property value) - (format ":%s: %s" property value)))) - -(defun +org-prompt-tags (&optional prompt global) - (let* ((buffer (org-capture-get :buffer)) - (file (buffer-file-name (or (buffer-base-buffer buffer) buffer))) - (org-last-tags-completion-table - (org-global-tags-completion-table - (if global (org-agenda-files) (list file)))) - (org-add-colon-after-tag-completion t) - (ins (mapconcat - #'identity - (let ((crm-separator "[ \t]*:[ \t]*")) - (completing-read-multiple - (or prompt "Tags: ") - org-last-tags-completion-table nil nil nil - 'org-tags-history)) - ":"))) - (when (org-string-nw-p ins) - (prog1 (concat - (unless (eq (char-before) ?:) ":") - ins - (unless (eq (char-after) ?:) ":")) - (when (org-at-heading-p) (org-align-tags)))))) - - -;;; Navigating headings - -(defun org-next-visible-heading-unfolding (arg) - (interactive "p") - (when (let ((pt (org-next-visible-heading arg))) - (and (buffer-narrowed-p) - (or (= (point) (point-min)) - (and pt - (= pt (point-max)))))) - (widen) - (org-next-visible-heading arg) - (org-narrow-to-subtree))) - -(defun org-previous-visible-heading-unfolding (arg) - (interactive "p") - (org-next-visible-heading-unfolding (- arg))) - -(defun org-up-heading-unfolding (arg) - (interactive "p") - (when (let ((pt (outline-up-heading arg))) - (and (buffer-narrowed-p) - (= (point) (point-min)))) - (widen) - (org-up-heading-unfolding arg) - (org-narrow-to-subtree))) - - -;;; Misc. - -(defun org-clock-in-or-out (prefix) - "If clocked in, clock out. Otherwise, clock in." - (interactive "P") - (if (org-clocking-p) - (org-clock-out prefix) - (org-clock-in prefix))) - - -;;; Faces - -(defface org-bold '((t (:weight bold))) - "Bold face in `org-mode' documents.") - -(defface org-italic '((t (:slant italic))) - "Italic face in `org-mode' documents.") - -(defface org-underline '((t (:underline t))) - "Underline face in `org-mode' documents.") - -(defface org-strikethrough '((t (:strike-through t))) - "Strike-through face for `org-mode' documents.") - - -;;; Packages - -(use-package org - :defer t - :custom-face - (org-level-1 ((t :inherit fixed-pitch - :weight bold - :slant italic - :height 1.0))) - (org-level-2 ((t :inherit fixed-pitch - :weight bold - :slant italic - :height 1.0))) - (org-level-3 ((t :inherit fixed-pitch - :weight bold - :height 1.0))) - (org-level-4 ((t :inherit org-level-3))) - (org-level-5 ((t :inherit org-level-4))) - (org-level-6 ((t :inherit org-level-5))) - (org-level-7 ((t :inherit org-level-6))) - (org-level-8 ((t :inherit org-level-7))) - (org-drawer ((t :inherit fixed-pitch))) - (org-property-value ((t :inherit fixed-pitch))) - (org-special-keyword ((t :inherit fixed-pitch))) - (org-indent ((t :inherit fixed-pitch))) - (org-table ((t :inherit fixed-pitch))) - :config - ;; Options - (setopt org-adapt-indentation nil - org-auto-align-tags t - org-archive-mark-done t - org-fold-catch-invisible-edits 'show-and-error - org-clock-clocked-in-display 'mode-line - org-clock-string-limit 0 - org-clock-persist nil - org-confirm-babel-evaluate nil - org-cycle-separator-lines 0 - org-deadline-warning-days 0 - org-directory (sync/ "org/" t) - org-ellipsis (or (bound-and-true-p truncate-string-ellipsis) "…") - org-emphasis-alist - '(("*" org-bold) - ("/" org-italic) - ("_" org-underline) - ("=" org-verbatim) - ("~" org-code) - ("+" org-strikethrough)) - org-fontify-done-headline t - org-fontify-quote-and-verse-blocks t - org-fontify-whole-heading-line t - org-hide-emphasis-markers t - org-html-coding-system 'utf-8-unix - org-image-actual-width (list (* (window-font-width) - (- fill-column 8))) - org-imenu-depth 3 - org-indent-indentation-per-level 0 - org-indent-mode-turns-on-hiding-stars nil - org-insert-heading-respect-content t - org-list-demote-modify-bullet '(("-" . "+") - ("+" . "-")) - org-log-done 'time - org-log-into-drawer t - org-num-skip-commented t - org-num-skip-unnumbered t - org-num-skip-footnotes t - org-outline-path-complete-in-steps nil - org-pretty-entities t - org-pretty-entities-include-sub-superscripts nil - org-refile-targets '((nil . (:maxlevel . 2)) - (org-agenda-files . (:maxlevel . 1))) - org-refile-use-outline-path 'file - org-special-ctrl-a/e t - org-special-ctrl-k t - org-src-fontify-natively t - org-src-tab-acts-natively t - org-src-window-setup 'current-window - org-startup-truncated nil - org-startup-with-inline-images t - org-tags-column 0 ;(- 0 fill-column -3) - org-todo-keywords '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)" - "|" "DONE(d!)" "ASSIGNED(a@/!)") - (sequence "|" "CANCELED(k@)") - (sequence "MEETING(m)")) - org-use-fast-todo-selection 'auto - org-use-speed-commands t - org-element-use-cache nil) - ;; Keys - (keymap-set org-mode-map "C-M-k" #'kill-paragraph) - (keymap-set org-mode-map "C-M-t" #'transpose-paragraphs) - (keymap-set org-mode-map "RET" #'+org-return-dwim) - (keymap-set org-mode-map "S-" #'+org-table-copy-down|+org-return-dwim) - (keymap-unset org-mode-map "C-'" t) - (keymap-unset org-mode-map "C-," t) - (keymap-set org-mode-map "C-c C-n" #'org-next-visible-heading-unfolding) - (keymap-set org-mode-map "C-c C-p" #'org-previous-visible-heading-unfolding) - (keymap-set org-mode-map "C-c C-u" #'org-up-heading-unfolding) - ;; Hooks - (add-hook 'org-mode-hook - (defun org-mode@setup () - (when (require 'visual-fill-column nil t) - (setq-local visual-fill-column-extra-text-width '(2 . 2)) - (visual-fill-column-mode)) - (variable-pitch-mode) - (turn-off-auto-fill) - (org-indent-mode) - (abbrev-mode) - (add-hook 'before-save-hook - (defun before-save@org-mode@before-save () - (org-align-tags 'all) - (+org-hide-drawers-except-point) - ) - nil :local))) - ;; Extra font-lock keywords - (font-lock-add-keywords - 'org-mode - `(;; List markers => org-indent - (,(concat - "^[ ]*\\(\\(?:[-+]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)" - "\\(?:[ ]+\\|$\\)\\)" - "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\]" - "[ ]*\\)?" - "\\(?:\\(\\[[ X-]\\]\\)" - "\\(?:[ ]+\\|$\\)\\)?") - 0 'org-indent)))) - -(use-package org-clock - :bind (:map org-mode-map - ("" . org-clock-in-or-out)) - :config - (setopt org-clock-clocked-in-display 'mode-line - ;; global-mode-string - ;; '((t jabber-activity-mode-string) - ;; (:eval (when (org-clocking-p) org-mode-line-string)) - ;; (display-time-mode display-time-string)) - ) - ;; (add-hook 'org-clock-in-hook (defun org-clock@remove-from-global-mode-string () - ;; (setq global-mode-string - ;; (delq 'org-mode-line-string global-mode-string)))) - ) - -(use-package org-agenda - :bind (("C-c a" . org-agenda)) - :config - (setopt org-agenda-skip-deadline-if-done t - org-agenda-skip-scheduled-if-done t - org-agenda-span 10 - org-agenda-block-separator ?─ - org-agenda-time-grid '((daily today require-timed) - (800 1000 1200 1400 1600 1800 2000) - " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄") - org-agenda-current-time-string "← now ───────────────" - org-agenda-include-diary nil ; I use the org-diary features - org-agenda-todo-ignore-deadlines 'near - org-agenda-todo-ignore-scheduled 'future - org-agenda-include-deadlines t - org-deadline-warning-days 0 - org-agenda-show-future-repeats 'next - org-agenda-window-setup 'current-window - org-agenda-skip-file-regexp "sync-conflict" - org-agenda-inhibit-startup t - org-agenda-sticky t - org-agenda-follow-indirect t - org-stuck-projects '("TODO=\"WAIT\"" - ("TODO" "NEXT") - nil - "") - org-agenda-custom-commands - `(("c" "Click Here Digital To-do" - ((agenda "" ((org-agenda-overriding-header "Tasks") - (org-agenda-span 'fortnight) - (org-agenda-start-day "+0") - (org-agenda-skip-function - '(org-agenda-skip-subtree-if 'todo - '("WAIT" "MCKENZIE" "RACHEL"))))) - (stuck "" ((org-agenda-overriding-header "Waiting")))) - ((org-agenda-files ',(list (progn (require 'chd) - (chd/ "inbox-chd.org")) - (sync/ "org/diary.org"))))))) - ;; Speedup agenda generation - ;; https://orgmode.org/manual/Speeding-Up-Your-Agendas.html - ;; https://orgmode.org/worg/agenda-optimization.html - (setopt org-agenda-dim-blocked-tasks nil - org-agenda-inhibit-startup t - org-agenda-use-tag-inheritance nil - org-agenda-ignore-properties '(effort appt stats category)) - ;; Hooks and advice - (add-hook 'org-agenda-mode-hook #'truncate-lines-local-mode) - (add-hook 'org-agenda-mode-hook #'hl-line-mode) - (add-hook 'org-agenda-after-show-hook #'org-narrow-to-subtree) - ;; (add-hook 'org-agenda-after-show-hook #'+org-hide-drawers-except-point) - (define-advice org-agenda-files (:filter-return (files) skip-regexp) - "Filter some files from `org-agenda'." - (when org-agenda-skip-file-regexp - (setq files - (cl-remove-if (lambda (file) - (string-match-p org-agenda-skip-file-regexp - file)) - files))) - files) - (define-advice org-agenda (:around (orig &rest r) inhibit-hooks) - (dlet ((org-mode-hook nil)) - (apply orig r))) - (define-advice org-agenda-skip (:around (orig &rest r) fix-looking-at) - (dlet ((comment-start-skip "^\\s-*#\\(?: \\|$\\)")) - (apply orig r))) - ;; (advice-remove 'org-agenda 'org-agenda@inhibit-hooks) - (define-advice org-agenda-switch-to (:after (&rest _) do-hooks) - (run-hooks 'org-mode-hook)) - (progress@around org-agenda-list "Building agenda") - (with-eval-after-load 'org-agenda - (add-to-list 'org-agenda-files (sync/ "org/diary.org")))) - -(use-package org-capture - :bind (("C-c c" . org-capture))) - -(use-package ol ; org-link - :after org - :preface - (defmacro +org-link-define-type (type args &rest body) - "Define an org link TYPE. -A function named `+org-link-TYPE-open' will be created, with ARGS -as its arguments and BODY as its body. BODY can be blank, in -which case the user will be messaged (This is a good do-nothing -effect for exporting link types)." - (declare (indent 2) - (doc-string 3) - (debug (sexp sexp def-body))) - (let ((fn (intern (format "+org-link-%s-open" type))) - (body (or body `((message ,(format "%S: %%S" type) - ,(car args))))) - (type-string (format "%S" type))) - `(prog1 - (defun ,fn ,args ,@body) - (org-link-set-parameters ,type-string :follow #',fn)))) - :config - (+org-link-define-type sms (number _)) - (+org-link-define-type tel (number _))) - -(use-package ox ; org-export - :after org - :config - (require 'ox-md) - (setopt org-export-coding-system 'utf-8-unix - org-export-headline-levels 8 - org-export-with-drawers nil - org-export-with-section-numbers nil - org-export-with-smart-quotes t - org-export-with-sub-superscripts t - org-export-with-toc nil)) - -(use-package org-word-count - :load-path "~/src/org-word-count.el/" - :hook org-mode-hook) - -(use-package org-modern - :ensure t - :custom-face - (org-modern-label ((t :inherit fixed-pitch - :height 1.0))) - :hook (org-mode-hook) - :config - (setopt org-modern-star nil - org-modern-list '((43 . "◦") - (45 . "•") - (42 . "‣")) - org-hide-leading-stars nil - org-modern-hide-stars nil - org-tags-column 0 - org-modern-keyword nil - org-modern-table nil)) - -(use-package org-taskwise - :after org - :load-path "~/src/org-taskwise.el/") - -(provide 'acdw-org) -;;; acdw-org.el ends here diff --git a/lisp/acdw-shell.el b/lisp/acdw-shell.el deleted file mode 100644 index ce63bdc..0000000 --- a/lisp/acdw-shell.el +++ /dev/null @@ -1,141 +0,0 @@ -;;; acdw-shell.el ---Shell config -*- lexical-binding: t; -*- - -;;; Code: - -(defvar eshell-buffer-format "*eshell:%s*" - "Format for eshell buffer names.") - -(defun eshell-rename-pwd () - (rename-buffer (format eshell-buffer-format default-directory) t)) - -(defun eshell-last-dir () - (goto-char (point-max)) - (insert "cd -") - (eshell-send-input)) - -(defun eshellp (buffer-or-name) - (with-current-buffer buffer-or-name - (derived-mode-p 'eshell-mode))) - -(defun +eshell (&optional new) - (interactive "P") - (let ((dir default-directory) - (bname (format eshell-buffer-format default-directory)) - (display-comint-buffer-action 'pop-to-buffer)) - (if-let ((buf (and (not new) - (or (get-buffer bname) - (seq-find #'eshellp - (reverse (buffer-list))))))) - (pop-to-buffer buf) - (eshell new)) - (eshell-rename-pwd) - (unless (equal default-directory dir) - (eshell/cd dir) - (eshell-send-input) - (goto-char (point-max))))) - -(defun +eshell-quit (&optional choose) - (interactive "P") - (if choose - (let* ((bufs (mapcar #'buffer-name - (seq-filter #'eshellp - (buffer-list)))) - (buf (get-buffer - (completing-read "Eshell: " - bufs nil t nil nil (car bufs))))) - (quit-window) - (pop-to-buffer buf)) - (quit-window))) - -(defun acdw/eshell-prompt () - "My custom eshell prompt." - (concat (if (= 0 eshell-last-command-status) - "^_^ " - ";_; ") - (abbreviate-file-name (eshell/pwd)) - (if (= (user-uid) 0) " # " " $ "))) - - -;;; Packages - -(use-package eshell - :init - (add-hook 'eshell-post-command-hook #'eshell-rename-pwd) - (setopt eshell-modules-list - '(eshell-alias - eshell-basic - eshell-cmpl - eshell-dirs - eshell-elecslash - eshell-hist - eshell-ls - eshell-prompt - eshell-smart - eshell-extpipe - eshell-glob - eshell-hist - eshell-ls - eshell-pred - eshell-prompt - eshell-script - eshell-term - eshell-unix)) - :commands eshell - :bind (("C-z" . +eshell) - :map eshell-mode-map - ("C-z" . +eshell-quit) - ("C-o" . eshell-last-dir)) - :config - (require 'esh-module) - (require 'em-smart) - (require 'em-tramp) - (setq eshell-destroy-buffer-when-process-dies t - eshell-error-if-no-glob t - eshell-hist-ignoredups t - eshell-kill-on-exit t - eshell-prefer-lisp-functions t - eshell-prefer-lisp-variables t - eshell-scroll-to-bottom-on-input 'this - eshell-banner-message "" - eshell-hist-ignoredups 'erase - eshell-history-size 512 - eshell-input-filter (lambda (input) - (or (eshell-input-filter-default input) - (eshell-input-filter-initial-space input))) - eshell-prompt-function #'acdw/eshell-prompt) - (add-hook 'eshell-mode-hook - (defun eshell-setup () - (hungry-delete-mode -1) - (setq-local outline-regexp eshell-prompt-regexp - page-delimiter eshell-prompt-regexp - imenu-generic-expression - '(("Prompt" " $ \\(.*\\)" 1)) - truncate-lines t) - (setenv "PAGER" "cat")))) - -(use-package eat - :ensure t - :hook (eshell-load-hook . eat-eshell-mode)) - -(use-package exec-path-from-shell - :when (eq system-type 'gnu/linux) - :ensure t - :config - (add-to-list 'exec-path-from-shell-variables "SSH_AUTH_SOCK") - (add-to-list 'exec-path-from-shell-variables "SSH_AGENT_PID") - (add-to-list 'exec-path-from-shell-variables "GPG_AGENT_INFO") - (add-to-list 'exec-path-from-shell-variables "LANG") - (add-to-list 'exec-path-from-shell-variables "LC_CTYPE") - (add-to-list 'exec-path-from-shell-variables "XDG_CONFIG_HOME") - (add-to-list 'exec-path-from-shell-variables "XDG_CONFIG_DIRS") - (add-to-list 'exec-path-from-shell-variables "XDG_DATA_HOME") - (add-to-list 'exec-path-from-shell-variables "XDG_DATA_DIRS") - (add-to-list 'exec-path-from-shell-variables "XDG_CACHE_HOME") - (exec-path-from-shell-initialize)) - -(use-package eshell-bookmark - :ensure t - :hook (eshell-mode-hook . eshell-bookmark-setup)) - -(provide 'acdw-shell) -;;; acdw-shell.el ends here diff --git a/lisp/acdw-web.el b/lisp/acdw-web.el deleted file mode 100644 index 3b78e4d..0000000 --- a/lisp/acdw-web.el +++ /dev/null @@ -1,374 +0,0 @@ -;;; acdw.web.el --- Web browsing and such -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) - -(defcustom +browse-url-other-safe-browser-functions nil - "Other safe browser functions." - :type '(repeat function)) - -(defun +browse-url-browser-function-safe-p (f) - "Return t if F is a safe browser function." - (memq f (append +browse-url-other-safe-browser-functions - (mapcar (lambda (i) - (plist-get (cdr i) :value)) - (seq-filter (lambda (i) - (eq (car i) 'function-item)) - (cdr (get 'browse-url-browser-function - 'custom-type))))))) - -;;; URL matcher generators - -(defun +browse-url-matches (&rest regexps) - "Return a lambda that will determine if a url matches REGEXPS. -Each regexp will be tested in turn. The first one that matches -is returned by the lambda. - -This is a good function to use in key positions in `browse-url-handlers'." - `(lambda (url &optional new-window) - (cl-loop for regexp in ',regexps - if (string-match-p regexp url) - return regexp))) - -;;; External URL handlers - -(cl-defmacro +browse-url-make-external-viewer-handler - (viewer - &key - args - (prompt "URL: ") - (program (executable-find (format "%s" viewer))) - (name (intern (format "+browse-url-with-%s" viewer))) - doc - (var (intern (format "%s-args" name))) - vardoc - (custom-group '+browse-url) - (fallback '(function browse-url-generic))) - "Create a `browse-url' handler function calling PROGRAM on the URL. -This macro also creates a `customize' setting in CUSTOM-GROUP for -PROGRAM's command-line arguments. ARGS specifies the -default arguments for this user option. - -PROGRAM defaults to the result of calling `executable-find' on VIEWER. - -PROMPT is shown to the user in the function's `interactive' spec, as an argument -to `browse-url-interactive-arg'. - -The resulting function is named NAME, which defaults to -`+browse-url-with-VIEWER'. The custom variable is named VAR, which defaults -to `NAME-args'. If DOC or VARDOC are provided, they'll be the documentation of -the function and variable respectively; otherwise a basic default doc-string is -used. - -If FALLBACK is non-nil (the default is `browse-url-generic'), the -generated function will call FALLBACK if unable to start PROGRAM -for some reason." - (declare (indent 1)) - `(progn - (defcustom ,var ,args - ,(or vardoc (format "Arguments to pass to %s in `%s'." - viewer name)) - :type '(repeat :tag "Command-line argument" string) - :group ',custom-group) - (defun ,name (url &optional new-window) - ,(or doc (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) - (unless (ignore-errors (apply #'start-process - (format "%s %s" ',viewer url) - nil - ,program - (append ,var (list url)))) - ,@(cond - (fallback `((funcall ,fallback url new-window))) - (:else `((message "Can't find viewer: %s" ,viewer) - nil)))))))) - -;; Some default handlers - -(+browse-url-make-external-viewer-handler mpv - :args '("--cache-pause-wait=15" - "--cache-pause-initial=yes") - :prompt "Video URL: ") - -(+browse-url-make-external-viewer-handler miv - :program (executable-find "miv") - :prompt "Image URL: ") - -;;; External domains -;; Some domains just don't open well in `eww'. The following function and user -;; option define an easy way to automatically open those. - -(defcustom +browse-url-external-domains nil - "Domains to open in `browse-url-secondary-browser-function'. -This is just a list of strings. They'll be regexp-escaped and -passed to `+browse-url-external-url-p', which is a good function -to put in `browse-url-handlers'. - -If an item in this list is a list itself, it should contain one string, a valid -regexp that will not be regexp-quoted when matching against a url." - :type '(repeat (choice - (list :tag "Regexp" regexp) - (string :tag "Literal string")))) - -(with-eval-after-load 'custom-allowed - (add-to-list 'custom-allowed-variables '+browse-url-external-domains)) - -(defun +browse-url-external-url-p (url) - "Return t if URL is a member of `+browse-url-external-domains'. -This function only tests URL's domain." - (let ((host (url-host (url-generic-parse-url url)))) - (cl-loop for domain in +browse-url-external-domains - if (string-match-p (if (stringp domain) - (regexp-quote domain) - (car domain)) - host) - return t))) - -(defun +browse-url-external-domain-add (domain &optional regexp?) - "Add DOMAIN to `+browse-url-external-domains'. -If REGEXP? is non-nil, it will note that the domain is a regexp. -This function will also save `custom-file' with the updated value." - (interactive (pcase current-prefix-arg - (`nil - (list (read-from-minibuffer "Domain: ") - nil)) - (`(4) - (list (read-from-minibuffer "Domain regex: ") - t)) - (_ - (list (read-from-minibuffer "Domain: ") - (y-or-n-p "Regex? "))))) - (let ((new (funcall (if regexp? #'list #'identity) - domain))) - (custom-set-variables - `(+browse-url-external-domains - ',(add-to-list '+browse-url-external-domains new))) - (with-current-buffer (find-file-noselect custom-file) - (custom-save-variables)) - (message "%s added to `+browse-url-external-domains'." - domain))) - -;;; Downloading - -(defcustom +browse-url-download-open t - "Whether to open downloaded files after downloading." - :type 'boolean) - -(defun +browse-url-download (url &rest _) - "Download URL to `eww-download-directory'." - (interactive "sDownload URL: ") - (let ((dir eww-download-directory)) - (when (functionp dir) (setq dir (funcall dir))) - (make-directory dir :parents) - (url-retrieve url - (lambda (s u d) - (let ((file (+browse-url-download-callback s u d))) - (when +browse-url-download-open - (browse-url-xdg-open file)))) - (list url dir)))) - -(defun +browse-url-download-callback (status url dir) - ;; A slight change to `eww-download-callback' that returns the downloaded - ;; filename. - (unless (plist-get status :error) - (let* ((obj (url-generic-parse-url url)) - (path (directory-file-name (car (url-path-and-query obj)))) - (file (eww-make-unique-file-name - (eww-decode-url-file-name (file-name-nondirectory path)) - dir))) - (goto-char (point-min)) - (re-search-forward "\r?\n\r?\n") - (let ((coding-system-for-write 'no-conversion)) - (write-region (point) (point-max) file)) - (message "Saved %s" file) - file))) - -;;; Unfucking the internet - -(defun eww-archiveis-url (url) - "Run URL through archive.is and browse the result." - (interactive (list (plist-get eww-data :url))) - (letrec ((nonce (lambda () - (unwind-protect (eww-readable) - (remove-hook 'eww-after-render-hook nonce))))) - (add-hook 'eww-after-render-hook nonce) - (eww (format "https://archive.is/submit/?url=%s" url)))) - - -;;; Packages - -(use-package eww - :preface - (defun bookmark-eww--make () - "Make eww bookmark record." - `((filename . ,(plist-get eww-data :url)) - (title . ,(plist-get eww-data :title)) - (time . ,(current-time-string)) - (handler . ,#'bookmark-eww-handler) - (defaults . (,(concat - ;; url without the https and path - (replace-regexp-in-string - "/.*" "" - (replace-regexp-in-string - "\\`https?://" "" - (plist-get eww-data :url))) - " - " - ;; page title - (replace-regexp-in-string - "\\` +\\| +\\'" "" - (replace-regexp-in-string - "[\n\t\r ]+" " " - (plist-get eww-data :title)))))))) - (defun bookmark-eww-handler (bm) - "Handler for eww bookmarks." - (eww-browse-url (alist-get 'filename bm))) - (defun bookmark-eww--setup () - "Setup eww bookmark integration." - (setq-local bookmark-make-record-function #'bookmark-eww--make)) - :commands (eww eww-browse-url) - :config - (setopt eww-use-browse-url ".") - (add-hook 'eww-mode-hook - (defun eww-mode@setup () - (add-hook 'visual-fill-column-mode-hook - (defun visual-fill-column@eww-reload () - (eww-reload :local)))) - nil :local) - (keymap-set eww-mode-map "&" - (defun eww-browse-url-external (&optional url) - (interactive nil eww-mode) - (condition-case e - (funcall - browse-url-secondary-browser-function - (or url (plist-get eww-data :url))) - (:success (when (null url) (quit-window))) ; Interactive use - (t (signal (car e) (cdr e)))))) - (add-hook 'eww-mode-hook #'bookmark-eww--setup) - (define-key eww-mode-map "b" #'bookmark-set) - (define-key eww-mode-map "B" #'bookmark-jump) - (define-key eww-mode-map (kbd "M-n") nil) - (define-key eww-mode-map (kbd "M-p") nil) - (define-key eww-mode-map (kbd "*") #'eww-archiveis-url)) - -(use-package browse-url - :demand t - :config - (put 'browse-url-browser-function 'safe-local-variable - '+browse-url-browser-function-safe-p) - (setopt browse-url-browser-function #'eww-browse-url - browse-url-secondary-browser-function #'browse-url-firefox - browse-url-firefox-program (executable-find "firefox") - browse-url-firefox-arguments '("--new-tab") - ;; Dispatch browser based on URL - browse-url-handlers - `(;; Videos - (,(+browse-url-matches "youtube\\.com" "youtu\\.be" - "invidious" "yewtu\\.be" - "twitch\\.tv" - (rx "." (or "mp4" "gif" "mov" "MOV" "webm") - eos)) - . +browse-url-with-mpv) - ;; Music - (,(+browse-url-matches "soundcloud\\.com" "bandcamp\\.com" - (rx "." (or "ogg" "mp3" "opus" "m4a") eos)) - . +browse-url-with-mpv) - ;; Images - (,(+browse-url-matches "pbs\\.twimg\\.com" - (rx "." (or "jpeg" "jpg" "png" "pn" - "bmp" "webp") - eos)) - . +browse-url-with-miv) - ;; Blobs - (,(+browse-url-matches (rx "." (or ".tar.gz" ".pdf") eos)) - . +browse-url-download) - ;; External URLs --- see `+browse-url-external-domains' - (+browse-url-external-url-p - . ,browse-url-secondary-browser-function)) - ;; External domains - ;; +browse-url-external-domains - ;; '("github.com" "gitlab.com" "codeberg.org" - ;; "tildegit.org" "git.tilde.town" - ;; "google.com" "imgur.com" "twitch.tv" - ;; "pixelfed" "instagram.com" - ;; "bibliogram.art" "reddit.com" - ;; "teddit.net" "libreddit.de" - ;; "streamable.com" "spotify.com" - ;; "hetzner.cloud" "melpa.org" - ;; "twitter.com" ("^t\\.co$") - ;; "nitter.snopyta.org" "nitter.net") - ) - ;; External browsers: firefox > chromium > chrome - (when-let ((firefox (choose-executable "firefox" - "firefox-esr"))) - (setopt browse-url-firefox-program firefox - browse-url-firefox-new-window-is-tab t - browse-url-firefox-arguments '("--new-tab") - browse-url-generic-program firefox - browse-url-generic-args browse-url-firefox-arguments)) - (when-let ((chromium (choose-executable "chromium" - "chromium-browser"))) - (setopt browse-url-chromium-program chromium - browse-url-generic-program chromium)) - (when-let ((chrome (choose-executable "chrome" - "google-chrome-stable"))) - (setopt browse-url-chrome-program chrome - browse-url-generic-program chrome))) - -(use-package browse-url-transform - :after browse-url - :load-path "~/src/browse-url-transform.el/" - :config - (setopt browse-url-transform-alist - `(;; Privacy-respecting alternatives - ("twitter\\.com" . "nitter.snopyta.org") - ("\\(?:\\(?:old\\.\\)?reddit\\.com\\)" . "libreddit.de") - ("medium\\.com" . "scribe.rip") - (".*substack\\.com.*" . ,substack-proxy) - ;; Text-mode of non-text-mode sites - ("www\\.npr\\.org" . "text.npr.org") - ;; Ask for raw versions of paste sites - ("^.*dpaste\\.com.*$" . "\\&.txt") - ("bpa\\.st/\\(.*\\)" . "bpa.st/raw/\\1") - ("\\(paste\\.debian\\.net\\)/\\(.*\\)" . "\\1/plain/\\2") - ("\\(pastebin\\.com\\)/\\\(.*\\)" . "\\1/raw/\\2") - ("\\(paste\\.centos\\.org/view\\)/\\(.*\\)" . "\\1/raw/\\2"))) - (browse-url-transform-mode)) - -;;; Link hint - -(use-package link-hint - :ensure t :demand t - :preface (keymap-global-unset "M-l") - :bind - (("M-l M-l" . +link-hint-open-link) - ("M-l l" . +link-hint-open-link) - ("M-l M-o" . +link-hint-open:secondary) - ("M-l o" . +link-hint-open:secondary) - ("M-l M-m" . +link-hint-open-multiple-links) - ("M-l m" . +link-hint-open-multiple-links) - ("M-l M-w" . link-hint-copy-link) - ("M-l w" . link-hint-copy-link) - ("M-l M-c" . +link-hint-open:chrome) - ("M-l c" . +link-hint-open:chrome) - ("M-l M-d" . +link-hint-open:download) - ("M-l d" . +link-hint-open:download)) - :config - (require '+link-hint) - (setopt link-hint-avy-style 'at-full - link-hint-avy-all-windows t) - ;; For some reason, `link-hint-completion-list-candidate' freezes Emacs. - ;; Removing it fixes the problem, so ... that's what I've done. It's quite - ;; possible this problem isn't caused by `link-hint' at all, but rather by - ;; another package's configuration, but I don't care enough to fix it. - (setq link-hint-types - (delq 'link-hint-completion-list-candidate link-hint-types)) - ;; (+link-hint-open-secondary-setup) - ;; (+link-hint-open-chrome-setup) - ) - -(provide 'acdw-web) -;;; acdw-web.el ends here diff --git a/lisp/acdw.el b/lisp/acdw.el deleted file mode 100644 index b76b947..0000000 --- a/lisp/acdw.el +++ /dev/null @@ -1,384 +0,0 @@ -;;; acdw.el --- My Emacs extras -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) -(require 'seq) - -(defmacro defdir (name directory &optional docstring makedir) - "Define a variable and a function NAME expanding to DIRECTORY. -DOCSTRING is applied to the variable; its default is DIRECTORY's -path. If MAKEDIR is non-nil, the directory and its parents will -be created." - (declare (indent 2) (doc-string 3)) - `(progn - (defvar ,name (expand-file-name ,directory) - ,(concat (or docstring (format "%s" directory)) "\n" - "Defined by `defdir'.")) - (defun ,name (file &optional mkdir) - ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n" - "If MKDIR is non-nil, parent directories are created.\n" - "Defined by `defdir'.") - (let ((file-name (expand-file-name - (convert-standard-filename file) ,name))) - (when mkdir - (make-directory (file-name-directory file-name) :parents)) - file-name)) - ,(if makedir - `(make-directory ,directory :parents) - `(unless (file-exists-p ,directory) - (warn "Directory `%s' doesn't exist." ,directory))))) - -(defun choose-executable (&rest programs) - "Return the first of PROGRAMS that exists in the system's $PATH. -Each of PROGRAMS can be a single string, or a list. If it's a list then its car -will be tested with `executable-find', and the entire list returned. This -enables passing arguments to a calling function." - (catch 'found - (dolist (prog programs) - (let ((exec (executable-find (car (ensure-list prog)))) - (args (cdr-safe prog))) - (when exec - (throw 'found (if args (cons exec args) exec))))))) - -(defun file-string (file) - "Return the contents of FILE as a string." - (with-current-buffer (find-file-noselect file) - (buffer-string))) - -(defun unsmartify-region (begin end) - "Replace \"smart\" punctuation with \"dumb\" counterparts." - (interactive "*r") - (save-excursion - (goto-char begin) - (while (re-search-forward "[“”‘’–—]" end t) - (let ((replace (pcase (match-string 0) - ((or "“" "”") "\"") - ((or "‘" "’") "'") - ("–" "--") - ("—" "---")))) - (replace-match replace nil nil))))) - -(defun unsmartify-dwim () - "Unsmartify the current region or the entire buffer." - (interactive) - (if (region-active-p) - (unsmartify-region (region-beginning) (region-end)) - (unsmartify-region (point-min) (point-max)))) - -(defun ++concat (func strings) - "Concat STRINGS processed by FUNC. -Each of STRINGS can be a bare string or a list. Strings are -passed through as-is, but lists are passed to FUNC first as -arguments. Finally, all the resulting strings are `mapconcat'-ed -together. - -As a special case, if `:separator' is the first of STRINGS, the -string following will be used as a separator. Otherwise, a -newline will be used." - (let (separator) - (when (eq (car strings) :separator) - (setq separator (cadr strings) - strings (cddr strings))) - (mapconcat (lambda (s) - (cond - ((listp s) (apply func s)) - ((stringp s) s) - (t (user-error "Bad argument: %S" s)))) - strings - (or separator "\n")))) - -(defun format-concat (&rest strings) - "Concatenate formatted STRINGS. -Each of STRINGS can be a bare string or a list. Bare strings are passed as-is -to `mapconcat' for concatenation and separation. Lists, however, are passed to -`format' first. - -If `:separator' is the first of STRINGS, the next string will be -used as a separator." - (++concat #'format strings)) - -(defun list-append-removing-duplicates (&rest lists) - "Append LISTS, removing duplicates from the result. -Any keyword arguments to `cl-remove-duplicates' should come -before the LISTS." - (let (cl-remove-duplicates-args) - (while (keywordp (car lists)) - (push (pop lists) cl-remove-duplicates-args) - (push (pop lists) cl-remove-duplicates-args)) - (apply #'cl-remove-duplicates (apply #'append lists) - (nreverse cl-remove-duplicates-args)))) - -(defun mapc-buffers (func &optional predicate) - "Map FUNC over buffers matching PREDICATE. -Both FUNC and PREDICATE will be executed with no arguments and in -the context of each buffer. - -If PREDICATE is nil or not given, map FUNC over all buffers." - (cl-loop for buf being the buffers - do (with-current-buffer buf - (when (and predicate - (funcall predicate)) - (funcall func))))) - -(defun mapc-buffers-modes (func &rest modes) - "Map FUNC over buffers derived from MODES. -FUNC will be executed with no arguments and in the context of -each buffer." - (mapc-buffers func - (lambda () - (apply #'derived-mode-p modes)))) - -(defun find-font (&rest fonts) - "Return the first font of FONTS that is installed." - (cl-loop with ffl = (font-family-list) - for font in fonts - if (member font ffl) - return font)) - -(defmacro progress@around (fn message &optional name) - "Define :around advice for functions adding a simple progress reporter." - (let ((orig (gensym)) - (args (gensym)) - (prog (gensym))) - `(define-advice ,fn (:around (,orig &rest ,args) ,(or name 'progress)) - ,(format "Add a simple progress reporter to %s." fn) - (let ((,prog (make-progress-reporter - ,(format "%s..." (string-remove-suffix "..." message))))) - (apply ,orig ,args) - (progress-reporter-done ,prog))))) - - - -;;; Ispell in .dir-locals - -;; Let Emacs know a list of strings is safe -(defun +ispell-safe-local-p (list) - (and (listp list) - (seq-every-p #'stringp list))) - -;; Can I instruct ispell to insert LocalWords in a different file? -;; https://emacs.stackexchange.com/q/31396/2264 - -;; How can I move all my file-local LocalWords to .dir-locals.el? -;; https://emacs.stackexchange.com/q/31419 - -;; Adapted from ispell.el:ispell-buffer-local-words -(defun +ispell-buffer-local-words-list () - (let (words) - (or ispell-buffer-local-name - (setf ispell-buffer-local-name (buffer-name))) - (save-excursion - (goto-char (point-min)) - (while (search-forward ispell-words-keyword nil t) - (let ((end (point-at-eol)) - (ispell-casechars (ispell-get-casechars)) - string) - (while (re-search-forward " *\\([^ ]+\\)" end t) - (setf string (match-string-no-properties 1)) - (if (and (< 1 (length string)) - (equal 0 (string-match ispell-casechars string))) - (push string words)))))) - words)) - -;;;###autoload -(defun +ispell-move-buffer-words-to-dir-locals (&optional arg) - "Move the current buffer-local words to .dir-locals.el. -This function prompts the user to save .dir-locals.el, unless -prefix ARG is non-nil; then it just saves them." - (interactive "P") - (unless (buffer-file-name) - (user-error "Buffer not attached to file")) - (hack-dir-local-variables) - (let ((print-level nil) - (print-length nil) - (before-save-hook nil) - (after-save-hook nil)) - (when-let ((new-words (cl-remove-if - (lambda (el) (eq el '\.\.\.)) ; XXX: NO IDEA - ; where this came from - (list-append-removing-duplicates - :test #'string= - ispell-buffer-session-localwords - (alist-get 'ispell-buffer-session-localwords - dir-local-variables-alist) - (alist-get 'ispell-buffer-session-localwords - file-local-variables-alist) - (+ispell-buffer-local-words-list))))) - (save-excursion - (add-dir-local-variable - major-mode - 'ispell-buffer-session-localwords - (setf ispell-buffer-session-localwords - new-words)) - (when (or arg - (y-or-n-p "Save .dir-locals.el?")) - (save-buffer)) - (bury-buffer)) - (or ispell-buffer-local-name - (setf ispell-buffer-local-name (buffer-name))) - (save-excursion - (goto-char (point-min)) - (while (search-forward ispell-words-keyword nil t) - (delete-region (point-at-bol) (1+ (point-at-eol)))))))) - -;;;###autoload -(defun +ispell-move-buffer-words-to-dir-locals-hook () - "Convenience function for binding to a hook." - (+ispell-move-buffer-words-to-dir-locals t)) - - -;;; Comment-or-uncomment-sexp -;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html - -(defun +lisp-uncomment-sexp (&optional n) - "Uncomment N sexps around point." - (interactive "P") - (let* ((initial-point (point-marker)) - (inhibit-field-text-motion t) - (p) - (end (save-excursion - (when (elt (syntax-ppss) 4) - (re-search-backward comment-start-skip - (line-beginning-position) - t)) - (setq p (point-marker)) - (comment-forward (point-max)) - (point-marker))) - (beg (save-excursion - (forward-line 0) - (while (and (not (bobp)) - (= end (save-excursion - (comment-forward (point-max)) - (point)))) - (forward-line -1)) - (goto-char (line-end-position)) - (re-search-backward comment-start-skip - (line-beginning-position) - t) - (ignore-errors - (while (looking-at-p comment-start-skip) - (forward-char -1))) - (point-marker)))) - (unless (= beg end) - (uncomment-region beg end) - (goto-char p) - ;; Indentify the "top-level" sexp inside the comment. - (while (and (ignore-errors (backward-up-list) t) - (>= (point) beg)) - (skip-chars-backward (rx (syntax expression-prefix))) - (setq p (point-marker))) - ;; Re-comment everything before it. - (ignore-errors - (comment-region beg p)) - ;; And everything after it. - (goto-char p) - (forward-sexp (or n 1)) - (skip-chars-forward "\r\n[:blank:]") - (if (< (point) end) - (ignore-errors - (comment-region (point) end)) - ;; If this is a closing delimiter, pull it up. - (goto-char end) - (skip-chars-forward "\r\n[:blank:]") - (when (eq 5 (car (syntax-after (point)))) - (delete-indentation)))) - ;; Without a prefix, it's more useful to leave point where - ;; it was. - (unless n - (goto-char initial-point)))) - -(defun +lisp-comment-sexp--raw () - "Comment the sexp at point or ahead of point." - (pcase (or (bounds-of-thing-at-point 'sexp) - (save-excursion - (skip-chars-forward "\r\n[:blank:]") - (bounds-of-thing-at-point 'sexp))) - (`(,l . ,r) - (goto-char r) - (skip-chars-forward "\r\n[:blank:]") - (save-excursion - (comment-region l r)) - (skip-chars-forward "\r\n[:blank:]")))) - -(defun +lisp-comment-or-uncomment-sexp (&optional n) - "Comment the sexp at point and move past it. -If already inside (or before) a comment, uncomment instead. -With a prefix argument N, (un)comment that many sexps." - (interactive "P") - (if (or (elt (syntax-ppss) 4) - (< (save-excursion - (skip-chars-forward "\r\n[:blank:]") - (point)) - (save-excursion - (comment-forward 1) - (point)))) - (+lisp-uncomment-sexp n) - (dotimes (_ (or n 1)) - (+lisp-comment-sexp--raw)))) - - -;;; Random shit - -(defun insert-iso-date (&optional arg) - "Insert current date formatted ISO-8601 style. -When called with \\[universal-argument] \\[insert-iso-date], -include the time. When called with \\[universal-argument] -\\[universal-argument] \\[insert-iso-date], prompt the user for the -`format-time-string' format to use." - (interactive "P") - (insert (format-time-string (pcase arg - ('nil "%F") - ('(4) "%FT%T%z") - (_ (read-string "Time format: ")))))) - -(defun unfill-paragraph () - "Unfill the current paragraph." - (interactive) - (let ((fill-column most-positive-fixnum) - (fill-paragraph-function nil)) - (fill-paragraph))) - -(defun fill-with-double-spaced-sentences-dwim (&optional start end) - "Fill paragraph or region, double-spacing sentences." - (interactive) - (let ((sentence-end-double-space t)) - (unless (region-active-p) - (mark-paragraph)) - (repunctuate-sentences :no-query - (region-beginning) - (region-end)) - (fill-region (region-beginning) - (region-end)))) - -(defun fill-with-double-spaced-sentences-dwim (&optional start end) - "Fill from START to END, double-spacing sentences. -If START to END aren't given, or if a region isn't in use, fill -the current paragraph." - (interactive "*r") - (let ((sentence-end-double-space t)) - (save-mark-and-excursion - (save-restriction - (unless (region-active-p) - (setq start (progn (start-of-paragraph-text) - (point)) - end (progn (end-of-paragraph-text) - (point)))) - (narrow-to-region start end) - (goto-char (point-min)) - (repunctuate-sentences :no-query) - (fill-region (point-min) - (point-max)))))) - -(defun acdw-elisp-package-prepare (&optional file) - "Do all the elisp-package-preparing stuff on FILE. -If FILE is nil or not given, do it on the current buffer." - (with-current-buffer (if file (find-file-noselect file) (current-buffer)) - (check-parens) - (checkdoc) - (package-lint-buffer) - ;; TODO: use `lm-commentary' to write to README.org - )) - -(provide 'acdw) -;;; acdw.el ends here diff --git a/lisp/ical2org.el b/lisp/ical2org.el deleted file mode 100644 index 2716787..0000000 --- a/lisp/ical2org.el +++ /dev/null @@ -1,56 +0,0 @@ -;;; ical2org.el --- Run ical2org in Emacs -*- lexical-binding: t; -*- - -;;; Commentary: - -;; based on code from this reddit thread: -;; https://www.reddit.com/r/emacs/comments/8s1ion/ical2org_integrations/ -;; -;; see also: icalendar.org (converts to diary format, might be all I need) -;; -;; XXX: This code currently imports into gnus, which isn't what I want. - -;;; Code: - -(defun ical2org (&optional replace output-buffer) - "Run ical2org on contents of this buffer. -If REPLACE (interactive prefix argument), replace contents of the -buffer. If no REPLACE nor OUTPUT-BUFFER, output goes to -minibuffer." - (interactive "P") - (shell-command-on-region (point-min) (point-max) - "ical2org" - output-buffer - replace - "*ical2org errors*" - 'display-errors)) - -(defun ical2org-capture () - "Run `ical2org' on this buffer, then `org-capture' the result. -Leaves current buffer as-was afterwards." - (interactive) - (let ((buf (current-buffer)) - (ics (buffer-string))) - (ical2org 'replace) - (mark-whole-buffer) - (call-interactively #'org-capture) - (with-current-buffer buf - (delete-region (point-min) (point-max)) - (insert ics)))) - -(defun my-gnus-org-capture-icalendar () - "Capture any text/calendar invites with org." - (interactive) - (with-current-buffer gnus-article-buffer ;;; XXX - (save-excursion - (dolist (part gnus-article-mime-handle-alist) - (when (and (>= (length part) 3) - (listp (caddr part)) - (or (equal "application/ics" (caaddr part)) - (equal "text/calendar" (caaddr part)))) - (save-window-excursion - (gnus-mime-copy-part (cdr part)) - (ical2org-capture))))))) -(add-hook 'gnus-article-prepare-hook #'my-gnus-org-capture-icalendar) - -(provide 'ical2org) -;;; ical2org.el ends here -- cgit 1.4.1-21-gabe81