1 files changed, 0 insertions, 309 deletions

@@ -1,309 +0,0 @@
-;;; +org.el  -*- lexical-binding: t; -*-
-
-;;; 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.
-TYPE should be an element type, like `item' or `paragraph'.
-ELEMENT should be a list like that returned by `org-element-context'."
-  ;; MAYBE: Use `org-element-lineage'.
-  (when-let* ((parent (org-element-property :parent element)))
-    (or (eq type (car parent))
-        (+org-element-descendant-of type parent))))
-
-(defun +org-return-dwim (&optional prefix)
-  "A helpful replacement for `org-return'.
-With PREFIX, call `org-return'."
-  (interactive "P")
-  ;; Auto-fill if enabled
-  (when auto-fill-function
-    (dolist (func (ensure-list auto-fill-function))
-      (funcall func)))
-  (cond
-   (prefix                              ; Handle prefix
-    (pcase prefix
-      ('(4) (newline))
-      ('(16) (newline 2))
-      (_ (newline prefix))))
-   ((and org-return-follows-link        ; Open link
-         (eq 'link (car (org-element-context))))
-    (org-open-at-point-global))
-   ((org-at-heading-p)                  ; Open a line after a heading
-    (let ((heading-start (org-entry-beginning-position)))
-      (goto-char (org-entry-end-position))
-      (cond ((and (org-at-heading-p)
-                  (= heading-start (org-entry-beginning-position)))
-             ;; Entry ends on its heading, so add 2 newlines
-             (end-of-line)
-             (newline 2))
-            (t
-             ;; Entry ends after its heading, so back up
-             (forward-line -1)
-             (end-of-line)
-             (when (org-at-heading-p)
-               (forward-line)
-               (newline)
-               (forward-line -1))
-             (while (not (looking-back (rx (repeat 3 (seq (optional blank) "\n")))
-                                       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))
-           (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 (+org-element-descendant-of 'item context)))
-      (cond ((and itemp emptyp)
-             (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))
-            (t
-             (delete-region (line-beginning-position) (line-end-position))
-             (newline)))))
-   ((and (fboundp 'org-inlinetask-in-task-p) ; Don't insert a new heading with
-         (org-inlinetask-in-task-p))         ; inline tasks
-    (org-return))
-   ((org-at-table-p)                    ; Insert a new org-table row
-    (cond ((save-excursion
-             (beginning-of-line)
-             (cl-loop with end = (line-end-position)
-                      for cell = (org-element-table-cell-parser)
-                      always (equal (org-element-property :contents-begin cell)
-                                    (org-element-property :contents-end cell))
-                      while (re-search-forward "|" end t)))
-           ;; Empty row: end the table
-           (delete-region (line-beginning-position) (line-end-position))
-           (org-return))
-          (t
-           ;; Non-empty row
-           (org-return))))
-   (t                                   ; Otherwise---just call `org-return'.
-    (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)))
-
-
-;;; A ... different ... `org-open-at-point-dwim'
-;; I honestly don't remember what the difference is between this and the
-;; O.G. one is.. hopefully this one fixes annoying stupid problems.
-
-(defun +org-open-at-point-dwim (&optional arg)
-  "Open thing at point, or if there isn't something, list things."
-  (interactive "P")
-  (save-excursion
-    (let* ((this-char-type (org-element-type (org-element-context)))
-           (prev-char-type (ignore-errors
-                             (save-excursion
-                               (backward-char)
-                               (org-element-type (org-element-context)))))
-           (types '(citation citation-reference clock comment comment-block
-                             footnote-definition footnote-reference headline
-                             inline-src-block inlinetask keyword link
-                             node-property planning src-block timestamp))
-           (type this-char-type))
-      (when (and (memq this-char-type types) (memq prev-char-type types))
-        (backward-char)
-        (setq type prev-char-type))                  ; what the fuckckckckck
-      ;; Okay, so this ^ is pretty janky and doesn't /really/ work that well,
-      ;; especially on DEADLINE (and probably SCHEDULED) lines.  However, since
-      ;; I really just want to open the list of URLs /most of the time/, I'm
-      ;; fixing it like this instead.
-      (unless (and (memq type types)
-                   (ignore-errors (org-open-at-point arg)
-                                  t))
-        (while (not
-                (progn
-                  (org-back-to-heading)
-                  (car (org-offer-links-in-entry (current-buffer) (point) 1))))
-          (org-up-heading-all 1))
-        (org-open-at-point arg)))))
-
-;;; Faces
-;; see `org-emphasis-alist'
-
-(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.")
-
-;;; 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))))))))
-
-;;; 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