;;; lang/org/autoload/org.el -*- lexical-binding: t; -*- ;; ;;; Helpers (defun +org--toggle-inline-images-in-subtree (&optional beg end refresh) "Refresh inline image previews in the current heading/tree." (let ((beg (or beg (if (org-before-first-heading-p) (line-beginning-position) (save-excursion (org-back-to-heading) (point))))) (end (or end (if (org-before-first-heading-p) (line-end-position) (save-excursion (org-end-of-subtree) (point))))) (overlays (cl-remove-if-not (lambda (ov) (overlay-get ov 'org-image-overlay)) (ignore-errors (overlays-in beg end))))) (dolist (ov overlays nil) (delete-overlay ov) (setq org-inline-image-overlays (delete ov org-inline-image-overlays))) (when (or refresh (not overlays)) (org-display-inline-images t t beg end) t))) (defun +org--insert-item (direction) (let ((context (org-element-lineage (org-element-context) '(table table-row headline inlinetask item plain-list) t))) (pcase (org-element-type context) ;; Add a new list item (carrying over checkboxes if necessary) ((or `item `plain-list) ;; Position determines where org-insert-todo-heading and org-insert-item ;; insert the new list item. (if (eq direction 'above) (org-beginning-of-item) (org-end-of-item) (backward-char)) (org-insert-item (org-element-property :checkbox context)) ;; Handle edge case where current item is empty and bottom of list is ;; flush against a new heading. (when (and (eq direction 'below) (eq (org-element-property :contents-begin context) (org-element-property :contents-end context))) (org-end-of-item) (org-end-of-line))) ;; Add a new table row ((or `table `table-row) (pcase direction ('below (save-excursion (org-table-insert-row t)) (org-table-next-row)) ('above (save-excursion (org-shiftmetadown)) (+org/table-previous-row)))) ;; Otherwise, add a new heading, carrying over any todo state, if ;; necessary. (_ (let ((level (or (org-current-level) 1))) ;; I intentionally avoid `org-insert-heading' and the like because they ;; impose unpredictable whitespace rules depending on the cursor ;; position. It's simpler to express this command's responsibility at a ;; lower level than work around all the quirks in org's API. (pcase direction (`below (let (org-insert-heading-respect-content) (goto-char (line-end-position)) (org-end-of-subtree) (insert "\n" (make-string level ?*) " "))) (`above (org-back-to-heading) (insert (make-string level ?*) " ") (save-excursion (insert "\n")))) (when-let* ((todo-keyword (org-element-property :todo-keyword context)) (todo-type (org-element-property :todo-type context))) (org-todo (cond ((eq todo-type 'done) ;; Doesn't make sense to create more "DONE" headings (car (+org-get-todo-keywords-for todo-keyword))) (todo-keyword) ('todo))))))) (when (org-invisible-p) (org-show-hidden-entry)) (when (and (bound-and-true-p evil-local-mode) (not (evil-emacs-state-p))) (evil-insert 1)))) (defun +org--get-property (name &optional bound) (save-excursion (let ((re (format "^#\\+%s:[ \t]*\\([^\n]+\\)" (upcase name)))) (goto-char (point-min)) (when (re-search-forward re bound t) (buffer-substring-no-properties (match-beginning 1) (match-end 1)))))) ;;;###autoload (defun +org-get-global-property (name &optional file bound) "Get a document property named NAME (string) from an org FILE (defaults to current file). Only scans first 2048 bytes of the document." (unless bound (setq bound 256)) (if file (with-temp-buffer (insert-file-contents-literally file nil 0 bound) (+org--get-property name)) (+org--get-property name bound))) ;;;###autoload (defun +org-get-todo-keywords-for (&optional keyword) "Returns the list of todo keywords that KEYWORD belongs to." (when keyword (cl-loop for (type . keyword-spec) in (cl-remove-if-not #'listp org-todo-keywords) for keywords = (mapcar (lambda (x) (if (string-match "^\\([^(]+\\)(" x) (match-string 1 x) x)) keyword-spec) if (eq type 'sequence) if (member keyword keywords) return keywords))) ;; ;;; Modes ;;;###autoload (define-minor-mode +org-pretty-mode "Hides emphasis markers and toggles pretty entities." :init-value nil :lighter " *" :group 'evil-org (setq org-hide-emphasis-markers +org-pretty-mode) (org-toggle-pretty-entities) (with-silent-modifications ;; In case the above un-align tables (org-table-map-tables 'org-table-align t))) ;; ;;; Commands ;;;###autoload (defun +org/dwim-at-point (&optional arg) "Do-what-I-mean at point. If on a: - checkbox list item or todo heading: toggle it. - clock: update its time. - headline: cycle ARCHIVE subtrees, toggle latex fragments and inline images in subtree; update statistics cookies/checkboxes and ToCs. - footnote reference: jump to the footnote's definition - footnote definition: jump to the first reference of this footnote - table-row or a TBLFM: recalculate the table's formulas - table-cell: clear it and go into insert mode. If this is a formula cell, recaluclate it instead. - babel-call: execute the source block - statistics-cookie: update it. - latex fragment: toggle it. - link: follow it - otherwise, refresh all inline images in current tree." (interactive "P") (let* ((context (org-element-context)) (type (org-element-type context))) ;; skip over unimportant contexts (while (and context (memq type '(verbatim code bold italic underline strike-through subscript superscript))) (setq context (org-element-property :parent context) type (org-element-type context))) (pcase type (`headline (cond ((memq (bound-and-true-p org-goto-map) (current-active-maps)) (org-goto-ret)) ((and (fboundp 'toc-org-insert-toc) (member "TOC" (org-get-tags))) (toc-org-insert-toc) (message "Updating table of contents")) ((string= "ARCHIVE" (car-safe (org-get-tags))) (org-force-cycle-archived)) ((or (org-element-property :todo-type context) (org-element-property :scheduled context)) (org-todo (if (eq (org-element-property :todo-type context) 'done) (or (car (+org-get-todo-keywords-for (org-element-property :todo-keyword context))) 'todo) 'done)))) ;; Update any metadata or inline previews in this subtree (org-update-checkbox-count) (org-update-parent-todo-statistics) (when (and (fboundp 'toc-org-insert-toc) (member "TOC" (org-get-tags))) (toc-org-insert-toc) (message "Updating table of contents")) (let* ((beg (if (org-before-first-heading-p) (line-beginning-position) (save-excursion (org-back-to-heading) (point)))) (end (if (org-before-first-heading-p) (line-end-position) (save-excursion (org-end-of-subtree) (point)))) (overlays (ignore-errors (overlays-in beg end))) (latex-overlays (cl-find-if (lambda (o) (eq (overlay-get o 'org-overlay-type) 'org-latex-overlay)) overlays)) (image-overlays (cl-find-if (lambda (o) (overlay-get o 'org-image-overlay)) overlays))) (+org--toggle-inline-images-in-subtree beg end) (if (or image-overlays latex-overlays) (org-clear-latex-preview beg end) (org--latex-preview-region beg end)))) (`clock (org-clock-update-time-maybe)) (`footnote-reference (org-footnote-goto-definition (org-element-property :label context))) (`footnote-definition (org-footnote-goto-previous-reference (org-element-property :label context))) ((or `planning `timestamp) (org-follow-timestamp-link)) ((or `table `table-row) (if (org-at-TBLFM-p) (org-table-calc-current-TBLFM) (ignore-errors (save-excursion (goto-char (org-element-property :contents-begin context)) (org-call-with-arg 'org-table-recalculate (or arg t)))))) (`table-cell (org-table-blank-field) (org-table-recalculate arg) (when (and (string-empty-p (string-trim (org-table-get-field))) (bound-and-true-p evil-local-mode)) (evil-change-state 'insert))) (`babel-call (org-babel-lob-execute-maybe)) (`statistics-cookie (save-excursion (org-update-statistics-cookies arg))) ((or `src-block `inline-src-block) (org-babel-execute-src-block arg)) ((or `latex-fragment `latex-environment) (org-latex-preview arg)) (`link (let* ((lineage (org-element-lineage context '(link) t)) (path (org-element-property :path lineage))) (if (or (equal (org-element-property :type lineage) "img") (and path (image-type-from-file-name path))) (+org--toggle-inline-images-in-subtree (org-element-property :begin lineage) (org-element-property :end lineage)) (org-open-at-point arg)))) ((guard (org-element-property :checkbox (org-element-lineage context '(item) t))) (let ((match (and (org-at-item-checkbox-p) (match-string 1)))) (org-toggle-checkbox (if (equal match "[ ]") '(16))))) (_ (if (or (org-in-regexp org-ts-regexp-both nil t) (org-in-regexp org-tsr-regexp-both nil t) (org-in-regexp org-link-any-re nil t)) (call-interactively #'org-open-at-point) (+org--toggle-inline-images-in-subtree (org-element-property :begin context) (org-element-property :end context))))))) ;;;###autoload (defun +org/shift-return (&optional arg) "Insert a literal newline, or dwim in tables. Executes `org-table-copy-down' if in table." (interactive "p") (if (org-at-table-p) (org-table-copy-down arg) (org-return nil arg))) ;; I use these instead of `org-insert-item' or `org-insert-heading' because they ;; impose bizarre whitespace rules depending on cursor location and many ;; settings. These commands have a much simpler responsibility. ;;;###autoload (defun +org/insert-item-below (count) "Inserts a new heading, table cell or item below the current one." (interactive "p") (dotimes (_ count) (+org--insert-item 'below))) ;;;###autoload (defun +org/insert-item-above (count) "Inserts a new heading, table cell or item above the current one." (interactive "p") (dotimes (_ count) (+org--insert-item 'above))) ;;;###autoload (defun +org/toggle-last-clock (arg) "Toggles last clocked item. Clock out if an active clock is running (or cancel it if prefix ARG is non-nil). If no clock is active, then clock into the last item. See `org-clock-in-last' to see how ARG affects this command." (interactive "P") (cond ((org-clocking-p) (if arg (org-clock-cancel) (org-clock-out))) ((and (null org-clock-history) (or (org-on-heading-p) (org-at-item-p)) (y-or-n-p "No active clock. Clock in on current item?")) (org-clock-in)) ((org-clock-in-last arg)))) ;;; Folds ;;;###autoload (defalias #'+org/toggle-fold #'+org-cycle-only-current-subtree-h) ;;;###autoload (defun +org/open-fold () "Open the current fold (not but its children)." (interactive) (+org/toggle-fold t)) ;;;###autoload (defalias #'+org/close-fold #'outline-hide-subtree) ;;;###autoload (defun +org/close-all-folds (&optional level) "Close all folds in the buffer (or below LEVEL)." (interactive "p") (outline-hide-sublevels (or level 1))) ;;;###autoload (defun +org/open-all-folds (&optional level) "Open all folds in the buffer (or up to LEVEL)." (interactive "P") (if (integerp level) (outline-hide-sublevels level) (outline-show-all))) (defun +org--get-foldlevel () (let ((max 1)) (save-restriction (narrow-to-region (window-start) (window-end)) (save-excursion (goto-char (point-min)) (while (not (eobp)) (org-next-visible-heading 1) (when (outline-invisible-p (line-end-position)) (let ((level (org-outline-level))) (when (> level max) (setq max level)))))) max))) ;;;###autoload (defun +org/show-next-fold-level (&optional count) "Decrease the fold-level of the visible area of the buffer. This unfolds another level of headings on each invocation." (interactive "p") (let ((new-level (+ (+org--get-foldlevel) (or count 1)))) (outline-hide-sublevels new-level) (message "Folded to level %s" new-level))) ;;;###autoload (defun +org/hide-next-fold-level (&optional count) "Increase the global fold-level of the visible area of the buffer. This folds another level of headings on each invocation." (interactive "p") (let ((new-level (max 1 (- (+org--get-foldlevel) (or count 1))))) (outline-hide-sublevels new-level) (message "Folded to level %s" new-level))) ;; ;;; Hooks ;;;###autoload (defun +org-indent-maybe-h () "Indent the current item (header or item), if possible. Made for `org-tab-first-hook' in evil-mode." (interactive) (cond ((not (and (bound-and-true-p evil-local-mode) (evil-insert-state-p))) nil) ((org-at-item-p) (if (eq this-command 'org-shifttab) (org-outdent-item-tree) (org-indent-item-tree)) t) ((org-at-heading-p) (ignore-errors (if (eq this-command 'org-shifttab) (org-promote) (org-demote))) t) ((org-in-src-block-p t) (org-babel-do-in-edit-buffer (call-interactively #'indent-for-tab-command)) t) ((and (save-excursion (skip-chars-backward " \t") (bolp)) (org-in-subtree-not-table-p)) (call-interactively #'tab-to-tab-stop) t))) ;;;###autoload (defun +org-yas-expand-maybe-h () "Expand a yasnippet snippet, if trigger exists at point or region is active. Made for `org-tab-first-hook'." (when (bound-and-true-p yas-minor-mode) (and (let ((major-mode (if (org-in-src-block-p t) (org-src-get-lang-mode (org-eldoc-get-src-lang)) major-mode)) (org-src-tab-acts-natively nil) ; causes breakages ;; Smart indentation doesn't work with yasnippet, and painfully slow ;; in the few cases where it does. (yas-indent-line 'fixed)) (cond ((and (or (not (bound-and-true-p evil-local-mode)) (evil-insert-state-p)) (yas--templates-for-key-at-point)) (yas-expand) t) ((use-region-p) (yas-insert-snippet) t))) ;; HACK Yasnippet breaks org-superstar-mode because yasnippets is ;; overzealous about cleaning up overlays. (when (bound-and-true-p org-superstar-mode) (org-superstar-restart))))) ;;;###autoload (defun +org-cycle-only-current-subtree-h (&optional arg) "Toggle the local fold at the point, and no deeper. `org-cycle's standard behavior is to cycle between three levels: collapsed, subtree and whole document. This is slow, especially in larger org buffer. Most of the time I just want to peek into the current subtree -- at most, expand *only* the current subtree. All my (performant) foldings needs are met between this and `org-show-subtree' (on zO for evil users), and `org-cycle' on shift-TAB if I need it." (interactive "P") (unless (eq this-command 'org-shifttab) (save-excursion (org-beginning-of-line) (let (invisible-p) (when (and (org-at-heading-p) (or org-cycle-open-archived-trees (not (member org-archive-tag (org-get-tags)))) (or (not arg) (setq invisible-p (outline-invisible-p (line-end-position))))) (unless invisible-p (setq org-cycle-subtree-status 'subtree)) (org-cycle-internal-local) t))))) ;;;###autoload (defun +org-make-last-point-visible-h () "Unfold subtree around point if saveplace places us in a folded region." (and (not org-inhibit-startup) (not org-inhibit-startup-visibility-stuff) (org-invisible-p nil 'folding-only) (or (not (org-on-heading-p)) (not (member "ARCHIVE" (org-get-tags)))) (ignore-errors (save-excursion (outline-previous-visible-heading 1) (org-show-subtree))))) ;;;###autoload (defun +org-remove-occur-highlights-h () "Remove org occur highlights on ESC in normal mode." (when org-occur-highlights (org-remove-occur-highlights) t)) ;;;###autoload (defun +org-enable-auto-update-cookies-h () "Update statistics cookies when saving or exiting insert mode (`evil-mode')." (when (bound-and-true-p evil-local-mode) (add-hook 'evil-insert-state-exit-hook #'org-update-parent-todo-statistics nil t)) (add-hook 'before-save-hook #'org-update-parent-todo-statistics nil t))