1 files changed, 155 insertions, 113 deletions

@@ -1,7 +1,13 @@
-;;; +org.el --- -*- lexical-binding: t -*-
+;;; +org.el  -*- lexical-binding: t; -*-
 
-;;; Org Return DWIM
-;; [[https://github.com/alphapapa/unpackaged.el][unpackaged]] and [[http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/][kitchin]]
+;;; Code:
+
+(require 'cl-lib)
+(require 'seq)
+
+;;; Org-return DWIM
+;; https://github.com/alphapapa/unpackaged.el,
+;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/
 
 (defun +org-element-descendant-of (type element)
   "Return non-nil if ELEMENT is a descendant of TYPE.
@@ -94,53 +100,13 @@ With PREFIX, call `org-return'."
    (t                                   ; Otherwise---just call `org-return'.
     (org-return))))
 
-(defun +org-table-copy-down|+org-return (&optional n)
+(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)))
 
-;;; 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)))))
 
 ;;; A ... different ... `org-open-at-point-dwim'
 ;; I honestly don't remember what the difference is between this and the
@@ -177,20 +143,7 @@ and POST-PROCESS are passed to `org-export-to-file'."
           (org-up-heading-all 1))
         (org-open-at-point arg)))))
 
-;;; Skip invisible shit when moving around
-(defun +org-ignore-invisible (fn &rest r)
-  ":around ADVICE to ignore invisible text in `org-mode' buffers."
-  ;; TODO: generalize to all modes
-  (cond ((and (derived-mode-p #'org-mode)
-              (org-invisible-p))
-         (while (org-invisible-p)
-           (forward-char))
-         (apply fn r))
-        (t (apply fn r))))
-
 ;;; Faces
-
-;;; Better org faces
 ;; see `org-emphasis-alist'
 
 (defface org-bold '((t (:weight bold)))
@@ -205,63 +158,152 @@ and POST-PROCESS are passed to `org-export-to-file'."
 (defface org-strikethrough '((t (:strike-through t)))
   "Strike-through face for `org-mode' documents.")
 
-;; `org-verbatim' and `org-code' are apparently already things, so we skip them
-;; here.
-
-;;; Inhibit hooks on `org-agenda'
-;; It's really annoying when I call `org-agenda' and five hundred Ispell
-;; processes are created because I have `flyspell-mode' in the hook.  This mode
-;; inhibits those hooks when entering the agenda, but runs them when opening the
-;; actual buffer.
-
-(defun +org-agenda-inhibit-hooks (fn &rest r)
-  "Advice to inhibit hooks when entering `org-agenda'."
-  (let ((org-mode-hook nil))
-    (apply fn r)))
-
-(defvar-local +org-hook-has-run-p nil
-  "Whether `org-mode-hook' has run in the current buffer.")
-
-(defun +org-agenda-switch-run-hooks (&rest _)
-  "Advice to run `org-mode-hook' when entering org-mode.
-This should only fire when switching to a buffer from `org-agenda'."
-  (unless +org-hook-has-run-p
-    (run-hooks 'org-mode-hook)
-    (setq +org-hook-has-run-p t)))
-
-(define-minor-mode +org-agenda-inhibit-hooks-mode
-  "Inhibit `org-mode-hook' when opening `org-agenda'."
-  :lighter " A/h"
-  :global t
-  (cond (+org-agenda-inhibit-hooks-mode
-         (advice-add 'org-agenda :around #'+org-agenda-inhibit-hooks)
-         (advice-add 'org-agenda-switch-to :after #'+org-agenda-switch-run-hooks))
-        (:else
-         (advice-remove 'org-agenda #'+org-agenda-inhibit-hooks)
-         (advice-remove 'org-agenda-switch-to #'+org-agenda-switch-run-hooks))))
-
-;;; Drawers
+;;; Unsmartify
+
+(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)))))
+
+;;; Copy org trees as HTML
+;; Thanks to Oleh Krehel:
+;; https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard
+
+(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)
+    ;; XXX: figure out which clipboard to use, or use something in Emacs
+    (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))
+
+;;; Hide drawers on save, except the currently-expanded one
+
 (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))))))))
+  "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))))))))
+
+;;; Define `ol' link types
+
+(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))))
+
+;;; Skip some files in `org-agenda'
+
+(defcustom org-agenda-file-skip-regexp nil
+  "Files matching this regexp are removed from `org-agenda-files'."
+  :group 'org-agenda)
+
+(defun org-agenda-files@skip-regexp (files)
+  "`:filter-return' advice to filter files in `org-agenda-file-skip-regexp'."
+  (when org-agenda-file-skip-regexp
+    (setq files
+          (seq-remove (lambda (file)
+                        (string-match-p
+                         org-agenda-file-skip-regexp file))
+                      files)))
+  files)
+
+;;; Prompt for stuff
+
+(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))))))
 
 (provide '+org)
+;;; +org.el ends here