From e5c025158ef6e383aa892ef88e63a2a32de3d7fb Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Tue, 18 Oct 2022 12:08:21 -0500 Subject: Add a bunch of other stuff or whatever --- lisp/+emacs.el | 4 +- lisp/+flyspell-correct.el | 24 +++++++ lisp/+org-capture.el | 164 ++++++++++++++++++++++++++++++++++++++++++++++ lisp/+org.el | 44 +++++++++++++ lisp/+ox.el | 29 ++++++++ lisp/+titlecase.el | 32 +++++++++ lisp/acdw.el | 48 +++++++++----- lisp/private.el | 23 +++++++ 8 files changed, 349 insertions(+), 19 deletions(-) create mode 100644 lisp/+flyspell-correct.el create mode 100644 lisp/+org-capture.el create mode 100644 lisp/+org.el create mode 100644 lisp/+ox.el create mode 100644 lisp/+titlecase.el create mode 100644 lisp/private.el (limited to 'lisp') diff --git a/lisp/+emacs.el b/lisp/+emacs.el index 6f37b83..6f40cf0 100644 --- a/lisp/+emacs.el +++ b/lisp/+emacs.el @@ -301,8 +301,8 @@ ARG is passed to `backward-kill-word'." (defun +yank@indent (&rest _) "Indent the current region." (indent-region (min (point) (mark)) (max (point) (mark)))) -(advice-add #'yank :after #'+yank@indent) -(advice-add #'yank-pop :after #'+yank@indent) +;; (advice-add #'yank :after #'+yank@indent) +;; (advice-add #'yank-pop :after #'+yank@indent) ;;; Extra functions diff --git a/lisp/+flyspell-correct.el b/lisp/+flyspell-correct.el new file mode 100644 index 0000000..f4fc956 --- /dev/null +++ b/lisp/+flyspell-correct.el @@ -0,0 +1,24 @@ +;;; +flyspell-correct.el --- -*- lexical-binding: t; -*- + +;;; Code: + +(require 'flyspell-correct) + +(defun +flyspell-correct-buffer (&optional prefix) + "Run `flyspell-correct-wrapper' on all misspelled words in the buffer. +With PREFIX, prompt to change the current dictionary." + (interactive "P") + (flyspell-buffer) + (when prefix + (let ((current-prefix-arg nil)) + (call-interactively #'ispell-change-dictionary))) + (+with-message "Checking spelling" + (flyspell-correct-move (point-min) :forward :rapid))) + +(defun +flyspell-correct-buffer-h (&rest _) + "Run `+flyspell-correct-buffer'. +This is suitable for placement in a hook." + (+flyspell-correct-buffer)) + +(provide '+flyspell-correct) +;;; +flyspell-correct.el ends here diff --git a/lisp/+org-capture.el b/lisp/+org-capture.el new file mode 100644 index 0000000..7ed4e00 --- /dev/null +++ b/lisp/+org-capture.el @@ -0,0 +1,164 @@ +;;; +org-capture.el -*- lexical-binding: t; -*- + +;;; Code: + +(require 'cl-lib) +(require 'acdw) +;; We don't require `org-capture' here because I'll have to require this library +;; to init.el /before/ org-capture is fully needed. But I do need to declare +;; `org-capture-templates'. +(defvar org-capture-templates nil) + +(defun +org-capture--get (key &optional list) + "Find KEY in LIST, or return nil. +LIST defaults to `org-capture-templates'." + (alist-get key (or list org-capture-templates) nil nil #'equal)) + +;; Set it up as a generic value. Based on the one for `alist-get'. +(gv-define-expander +org-capture--get + (lambda (do key &optional alist) + (setq alist (or alist org-capture-templates)) + (macroexp-let2 macroexp-copyable-p k key + (gv-letplace (getter setter) alist + (macroexp-let2 nil p `(assoc ,k ,getter 'equal) + (funcall do `(cdr ,p) + (lambda (v) + (macroexp-let2 nil v v + (let ((set-exp + `(if ,p (setcdr ,p ,v) + ,(funcall setter + `(cons (setq ,p (cons ,k ,v)) + ,getter))))) + `(progn + ,set-exp + ,v)))))))))) + +(defun +org-capture-sort (&optional list) + "Sort LIST by string keys. +LIST is a symbol and defaults to `org-capture-templates'." + (setq list (or list 'org-capture-templates)) + (set list (sort (symbol-value list) (lambda (a b) + (string< (car a) (car b)))))) + +(defun +org-capture-sort-after-init (&optional list) + "Sort LIST with `+org-capture-sort' after Emacs init." + (+ensure-after-init #'+org-capture-sort)) + +;;;###autoload +(defun +org-capture-templates-setf (key value &optional list sort-after) + "Add KEY to LIST, using `setf'. +LIST is a symbol and defaults to `org-capture-templates' -- so +this function sets values on a list that's structured as such. + +Thus, KEY is a string key. If it's longer than one character, +this function will search LIST for each successive run of +characters before the final, ensuring sub-lists exist of the +form (CHARS DESCRIPTION). + +For example, if KEY is \"abc\", first a LIST item of the form (a +DESCRIPTION), if non-existant, will be added to the list (with a +default description), then an item of the +form (\"ab\" DESCRIPTION), before adding (KEY VALUE) to the LIST. + +VALUE is the template or group header required for +`org-capture-templates', which see. + +SORT-AFTER, when set to t, will call +`+org-capture-templates-sort' after setting, to ensure org can +properly process the variable." + ;; LIST defaults to `org-capture-templates' + (declare (indent 2)) + (unless list (setq list 'org-capture-templates)) + ;; Ensure VALUE is a list to cons properly + (unless (listp value) (setq value (list value))) + (when (> (length key) 1) + ;; Check for existence of groups. + (let ((expected (cl-loop for i from 1 to (1- (length key)) + collect (substring key 0 i) into keys + finally return keys))) + (cl-loop for ek in expected + if (not (+org-capture--get ek (symbol-value list))) do + (setf (+org-capture--get ek (symbol-value list)) + (list (format "(Group %s)" ek)))))) + (prog1 ;; Set KEY to VALUE + (setf (+org-capture--get key (symbol-value list)) value) + ;; Sort after, maybe + (when sort-after (+org-capture-sort list)))) + +(defun +org-template--ensure-path (keys &optional list) + "Ensure path of keys exists in `org-capture-templates'." + (unless list (setq list 'org-capture-templates)) + (when (> (length key) 1) + ;; Check for existence of groups. + (let ((expected (cl-loop for i from 1 to (1- (length key)) + collect (substring key 0 i) into keys + finally return keys))) + (cl-loop for ek in expected + if (not (+org-capture--get ek (symbol-value list))) do + (setf (+org-capture--get ek (symbol-value list)) + (list (format "(Group %s)" ek))))))) + +(defcustom +org-capture-default-type 'entry + "Default template for `org-capture-templates'." + :type '(choice (const :tag "Entry" entry) + (const :tag "Item" item) + (const :tag "Check Item" checkitem) + (const :tag "Table Line" table-line) + (const :tag "Plain Text" plain))) + +(defcustom +org-capture-default-target "" + "Default target for `org-capture-templates'." + ;; TODO: type + ) + +(defcustom +org-capture-default-template nil + "Default template for `org-capture-templates'." + ;; TODO: type + ) + +(defun +org-define-capture-templates-group (keys description) + "Add a group title to `org-capture-templates'." + (setf (+org-capture--get keys org-capture-templates) + (list description))) + +;; [[https://github.com/cadadr/configuration/blob/39813a771286e542af3aa333172858532c3bb257/emacs.d/gk/gk-org.el#L1573][from cadadr]] +(defun +org-define-capture-template (keys description &rest args) + "Define a capture template and necessary antecedents. +ARGS is a plist, which in addition to the additional options +`org-capture-templates' accepts, takes the following and places +them accordingly: :type, :target, and :template. Each of these +corresponds to the same field in `org-capture-templates's +docstring, which see. Likewise with KEYS and DESCRIPTION, which +are passed separately to the function. + +This function will also create all the necessary intermediate +capture keys needed for `org-capture'; that is, if KEYS is +\"wcp\", entries for \"w\" and \"wc\" will both be ensured in +`org-capture-templates'." + (declare (indent 2)) + ;; Check for existence of parent groups + (when (> (length keys) 1) + (let ((expected (cl-loop for i from 1 to (1- (length keys)) + collect (substring 0 i) into keys + finally return keys))) + (cl-loop + for ek in expected + if (not (+org-capture--get ek org-capture-templates)) + do (+org-define-capture-templates-group ek (format "(Group %s)" ek))))) + (if (null args) + ;; Add the title + (+org-define-capture-templates-group keys description) + ;; Add the capture template. + (setf (+org-capture--get keys org-capture-templates) + (append (list (or (plist-get args :type) + +org-capture-default-type) + (or ( plist-get args :target) + +org-capture-default-target) + (or (plist-get args :template) + +org-capture-default-template)) + (cl-loop for (key val) on args by #'cddr + unless (member key '(:type :target :template)) + append (list key val)))))) + +(provide '+org-capture) +;;; +org-capture.el ends here diff --git a/lisp/+org.el b/lisp/+org.el new file mode 100644 index 0000000..b17a1fa --- /dev/null +++ b/lisp/+org.el @@ -0,0 +1,44 @@ +;;; +org.el --- -*- lexical-binding: t -*- + +;;; Copy org trees as HTML + +;; Thanks to Oleh Krehel, via [[https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard][this StackExchange question]]. +(defun +org-export-clip-to-html + (&optional async subtreep visible-only body-only ext-plist post-process) + "Export region to HTML, and copy it to the clipboard. +Arguments ASYNC, SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST, +and POST-PROCESS are passed to `org-export-to-file'." + (interactive) ; XXX: hould this be interactive? + (message "Exporting Org to HTML...") + (let ((org-tmp-file "/tmp/org.html")) + (org-export-to-file 'html org-tmp-file + async subtreep visible-only body-only ext-plist post-process) + (start-process "xclip" "*xclip*" + "xclip" "-verbose" + "-i" org-tmp-file + "-t" "text/html" + "-selection" "clipboard")) + (message "Exporting Org to HTML...done.")) + +;; Specialized functions +(defun +org-export-clip-subtree-to-html () + "Export current subtree to HTML." + (interactive) + (+org-export-clip-to-html nil :subtree)) + +;;; Unsmartify quotes and dashes and stuff. + +(defun +org-unsmartify () + "Replace \"smart\" punctuation with their \"dumb\" counterparts." + (interactive) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "[“”‘’–—]" nil t) + (let ((replace (pcase (match-string 0) + ((or "“" "”") "\"") + ((or "‘" "’") "'") + ("–" "--") + ("—" "---")))) + (replace-match replace nil nil))))) + +(provide '+org) diff --git a/lisp/+ox.el b/lisp/+ox.el new file mode 100644 index 0000000..8748a55 --- /dev/null +++ b/lisp/+ox.el @@ -0,0 +1,29 @@ +;;; +ox.el --- org-export helpers -*- lexical-binding: t; -*- + +;;; Commentary: + +;;; Code: + +(require 'ox) + +;;; Run hooks before doing any exporting at all + +(defcustom +org-export-pre-hook nil + "Functions to run /before/ `org-export-as' does anything. +These will run on the buffer about to be exported, NOT a copy." + :type 'hook) + +(defun +org-export-pre-run-hooks (&rest _) + "Run hooks in `+org-export-pre-hook'." + (run-hooks '+org-export-pre-hook)) + +(defun +org-export-pre-hooks-insinuate () + "Advise `org-export-as' to run `+org-export-pre-hook'." + (advice-add 'org-export-as :before #'+org-export-pre-run-hooks)) + +(defun +org-export-pre-hooks-remove () + "Remove pre-hook advice on `org-export-as'." + (advice-remove 'org-export-as #'+org-export-pre-run-hooks)) + +(provide '+ox) +;;; +ox.el ends here diff --git a/lisp/+titlecase.el b/lisp/+titlecase.el new file mode 100644 index 0000000..9266807 --- /dev/null +++ b/lisp/+titlecase.el @@ -0,0 +1,32 @@ +;;; +titlecase.el --- Titlecase extras -*- lexical-binding: t; -*- + +;;; Commentary: + +;;; Code: + +(require 'titlecase) + +(defun +titlecase-sentence-style-dwim (&optional arg) + "Titlecase a sentence. +With prefix ARG, toggle the value of +`titlecase-downcase-sentences' before sentence-casing." + (interactive "P") + (let ((titlecase-downcase-sentences (if arg (not titlecase-downcase-sentences) + titlecase-downcase-sentences))) + (titlecase-dwim 'sentence))) + +(defun +titlecase-org-headings () + (interactive) + (save-excursion + (goto-char (point-min)) + ;; See also `org-map-tree'. I'm not using that function because I want to + ;; skip the first headline. A better solution would be to patch + ;; `titlecase-line' to ignore org-mode metadata (TODO cookies, tags, etc). + (let ((level (funcall outline-level))) + (while (and (progn (outline-next-heading) + (> (funcall outline-level) level)) + (not (eobp))) + (titlecase-line))))) + +(provide '+titlecase) +;;; +titlecase.el ends here diff --git a/lisp/acdw.el b/lisp/acdw.el index f972d08..444f249 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el @@ -45,23 +45,6 @@ Convenience wrapper around `define-key'." map) key def))))) -(defmacro setq-local-hook (hook &rest args) - "Run `setq-local' on ARGS when running HOOK." - (declare (indent 1)) - (let ((fn (intern (format "%s-setq-local" hook)))) - (when (and (fboundp fn) - (functionp fn)) - (setq args (append (function-get fn 'setq-local-hook-settings) args))) - (unless (and (< 0 (length args)) - (zerop (mod (length args) 2))) - (user-error "Wrong number of arguments: %S" (length args))) - `(progn - (defun ,fn () - ,(format "Set local variables after `%s'." hook) - (setq-local ,@args)) - (function-put ',fn 'setq-local-hook-settings ',args) - (add-hook ',hook #',fn)))) - (unless (fboundp 'ensure-list) ;; Just in case we're using an old version of Emacs. (defun ensure-list (object) @@ -89,3 +72,34 @@ form (FUNCTION &optional DEPTH LOCAL)." (dolist (hook (ensure-list hooks)) (dolist (fn functions) (apply #'add-hook hook (ensure-list fn))))) + +;;; Convenience macros + +(defmacro setq-local-hook (hook &rest args) + "Run `setq-local' on ARGS when running HOOK." + (declare (indent 1)) + (let ((fn (intern (format "%s-setq-local" hook)))) + (when (and (fboundp fn) + (functionp fn)) + (setq args (append (function-get fn 'setq-local-hook-settings) args))) + (unless (and (< 0 (length args)) + (zerop (mod (length args) 2))) + (user-error "Wrong number of arguments: %S" (length args))) + `(progn + (defun ,fn () + ,(format "Set local variables after `%s'." hook) + (setq-local ,@args)) + (function-put ',fn 'setq-local-hook-settings ',args) + (add-hook ',hook #',fn)))) + +(defmacro with-message (message &rest body) + "Execute BODY, with MESSAGE. +If body executes without errors, MESSAGE...Done will be displayed." + (declare (indent 1)) + (let ((msg (gensym))) + `(let ((,msg ,message)) + (condition-case e + (progn (message "%s..." ,msg) + ,@body) + (:success (message "%s...done" ,msg)) + (t (signal (car e) (cdr e))))))) diff --git a/lisp/private.el b/lisp/private.el new file mode 100644 index 0000000..4f6115e --- /dev/null +++ b/lisp/private.el @@ -0,0 +1,23 @@ +;;; private.el -*- lexical-binding: t; -*- + +;;; Commentary: + +;;; Code: + +(require 'acdw) + +(defgroup private nil + "Private things are private. Shhhhh....") + +;; Private directory + +(+define-dir private/ (sync/ "emacs/private") + "Private secretive secrets inside.") +(add-to-list 'load-path private/) + +;; Load random private stuff + +(require '_acdw) + +(provide 'private) +;;; private.el ends here -- cgit 1.4.1-21-gabe81