8 files changed, 349 insertions, 19 deletions

@@ -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
@@ -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
@@ -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
@@ -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)
@@ -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
@@ -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
@@ -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)))))))
@@ -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