;;; +org.el -*- lexical-binding: t; -*- ;;; Code: (require 'el-patch) (require 'org) (require 'org-element) (require 'ox) ;;; 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]] (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'. On headings, move point to position after entry content. In lists, insert a new item or end the list, with checkbox if appropriate. In tables, insert a new row or end the table." (interactive "P") ;; Auto-fill if enabled (when auto-fill-function (if (listp auto-fill-function) (dolist (func auto-fill-function) (funcall func)) (funcall auto-fill-function))) (if prefix ;; Handle prefix args (pcase prefix ('(4) (newline)) ('(16) (newline 2)) ;; this is ... not ideal. but whatever. (_ (newline prefix))) (cond ;; Act depending on context around point. ((and org-return-follows-link (eq 'link (car (org-element-context)))) ;; Link: Open it. (org-open-at-point-global)) ((org-at-heading-p) ;; Heading: Move to position after entry content. ;; NOTE: This is probably the most interesting feature of this function. (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; add newline after (end-of-line) (insert "\n\n")) (t ;; Entry ends after its heading; back up (forward-line -1) (end-of-line) (when (org-at-heading-p) ;; At the same heading (forward-line) (insert "\n") (forward-line -1)) (while (not (looking-back (rx (repeat 3 (seq (optional blank) "\n"))) nil)) (insert "\n")) (forward-line -1))))) ((org-at-item-checkbox-p) ;; Checkbox: Insert new item with checkbox. (org-insert-todo-heading nil)) ((org-in-item-p) ;; Plain list (let* ((context (org-element-context)) (first-item-p (eq 'plain-list (car context))) (itemp (eq 'item (car context))) (emptyp (or ;; Empty list item (regular) (eq (org-element-property :contents-begin context) (org-element-property :contents-end context)) ;; Empty list item (definition) ;; This seems to work, with minimal testing. -- 2022-02-17 (looking-at " *::"))) (item-child-p (+org-element-descendant-of 'item context))) ;; The original function from unpackaged just tested the (or ...) test ;; in this cond, in an if. However, that doesn't auto-end nested ;; lists. So I made this form a cond and added the (and...) test in ;; the first position, which is clunky (the delete-region... stuff ;; comes twice) and might not be needed. More testing, obviously, but ;; for now, it works well enough. (cond ((and itemp emptyp) (delete-region (line-beginning-position) (line-end-position)) (insert "\n")) ((or first-item-p (and itemp (not emptyp)) item-child-p) (org-insert-item)) (t (delete-region (line-beginning-position) (line-end-position)) (insert "\n"))))) ((when (fboundp 'org-inlinetask-in-task-p) (org-inlinetask-in-task-p)) ;; Inline task: Don't insert a new heading. (org-return)) ((org-at-table-p) (cond ((save-excursion (beginning-of-line) ;; See `org-table-next-field'. (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: call `org-return'. (org-return)))) (t ;; All other cases: call `org-return'. (org-return))))) (defun +org-table-copy-down (n) "Call `org-table-copy-down', or `org-return' outside of a table. N is passed to the functions." (interactive "p") (if (org-table-check-inside-data-field 'noerror) (org-table-copy-down n) (+org-return-dwim n))) ;;; org-fix-blank-lines - unpackaged.el (defun +org-fix-blank-lines (&optional prefix) "Ensure blank lines around headings. Optional PREFIX argument operates on the entire buffer. Drawers are included with their headings." (interactive "P") (let ((org-element-use-cache nil)) (org-map-entries (lambda () (let ((beg (org-entry-beginning-position)) (end (org-entry-end-position))) (org-with-wide-buffer ;; `org-map-entries' narrows the buffer, which ;; prevents us from seeing newlines before the ;; current heading, so we do this part widened. (while (not (looking-back "\n\n" nil)) ;; Insert blank lines before heading. (insert "\n"))) ;; Insert blank lines before entry content (forward-line) (while (and (org-at-planning-p) (< (point) (point-max))) ;; Skip planning lines (forward-line)) (while (re-search-forward org-drawer-regexp end t) ;; Skip drawers. You might think that ;; `org-at-drawer-p' would suffice, but for ;; some reason it doesn't work correctly when ;; operating on hidden text. This works, taken ;; from `org-agenda-get-some-entry-text'. (re-search-forward "^[ \t]*:END:.*\n?" end t) (goto-char (match-end 0))) (unless (or (= (point) (point-max)) (org-at-heading-p) (looking-at-p "\n")) (insert "\n")))) t (if prefix nil 'tree)))) ;;; org-count-words (defun +org-count-words-stupidly (start end &optional limit) "Count words between START and END, ignoring a lot. Since this function is, for some reason, pricy, the optional parameter LIMIT sets a word limit at which to stop counting. Once the function hits that number, it'll return -LIMIT instead of the true count." (interactive (list nil nil)) (cond ((not (called-interactively-p 'any)) (let ((words 0) (continue t)) (save-excursion (save-restriction (narrow-to-region start end) (goto-char (point-min)) (while (and continue (< (point) (point-max))) (cond ;; Ignore comments ((or (org-at-comment-p) (org-in-commented-heading-p)) (forward-line)) ;; Ignore headings ((or (org-at-heading-p)) (forward-line)) ;; Ignore property and log drawers ((or (looking-at org-drawer-regexp) (looking-at org-clock-drawer-re)) (search-forward ":END:" nil :noerror) (forward-line)) ;; Ignore DEADLINE and SCHEDULED keywords ((or (looking-at org-deadline-regexp) (looking-at org-scheduled-regexp) (looking-at org-closed-time-regexp)) (forward-line)) ;; Ignore tables ((org-at-table-p) (forward-line)) ;; Ignore hyperlinks, but count the descriptions ((looking-at org-link-bracket-re) (when-let ((desc (match-string-no-properties 5))) (save-match-data (setq words (+ words (length (remove "" (org-split-string desc "\\W"))))))) (goto-char (match-end 0))) ;; Ignore source blocks ((org-in-src-block-p) (forward-line)) ;; Ignore blank lines ((looking-at "^$") (forward-line)) ;; Count everything else (t ;; ... unless it's in a few weird contexts (let ((contexts (org-context))) (cond ((or (assoc :todo-keyword contexts) (assoc :priority contexts) (assoc :keyword contexts) (assoc :checkbox contexts)) (forward-word-strictly)) (t (setq words (1+ words)) (if (and limit (> words limit)) (setq words (- limit) continue nil)) (forward-word-strictly))))))))) words)) ((use-region-p) (message "%d words in region" (+org-count-words-stupidly (region-beginning) (region-end)))) (t (message "%d words in buffer" (+org-count-words-stupidly (point-min) (point-max)))))) ;;; org-insert-link-dwim - https://xenodium.com/emacs-dwim-do-what-i-mean/ (defun +org-insert--get-title-and-headings (url) "Retrieve title and headings from URL. Return as a list." (with-current-buffer (url-retrieve-synchronously url) (let ((dom (libxml-parse-html-region (point-min) (point-max)))) (cl-remove-if (lambda (i) (string= i "")) (apply #'append (mapcar (lambda (tag) (mapcar #'dom-text (dom-by-tag dom tag))) '(title h1 h2 h3 h4 h5 h6))))))) (defun +org-insert-link-dwim (&optional interactivep) "Like `org-insert-link' but with personal dwim preferences." (interactive '(t)) (let* ((point-in-link (org-in-regexp org-link-any-re 1)) (clipboard-url (when (string-match-p (rx (sequence bos (or "http" "gemini" "gopher" "tel" "mailto"))) (current-kill 0)) (current-kill 0))) (region-content (when (region-active-p) (buffer-substring-no-properties (region-beginning) (region-end)))) (org-link (when (and clipboard-url (not point-in-link)) (org-link-make-string (string-trim clipboard-url) (or region-content (let ((clipboard-headings (+org-insert--get-title-and-headings clipboard-url))) (read-string "title (edit): " (completing-read "title: " clipboard-headings nil nil nil nil (car clipboard-headings))))))))) (if interactivep (cond ((and region-content clipboard-url (not point-in-link)) (delete-region (region-beginning) (region-end)) (insert org-link)) ((and clipboard-url (not point-in-link)) (insert org-link)) (t (call-interactively 'org-insert-link))) org-link))) ;;; Navigate headings with widening (defun +org-next-heading-widen (arg) "Find the ARGth next org heading, widening if necessary." (interactive "p") (let ((current-point (point)) (point-target (if (> arg 0) (point-max) (point-min)))) (org-next-visible-heading arg) (when (and (buffer-narrowed-p) (= (point) point-target) (or (and (> arg 0)) (and (< arg 0) (= (point) current-point)))) (widen) (org-next-visible-heading arg)))) (defun +org-previous-heading-widen (arg) "Find the ARGth previous org heading, widening if necessary." (interactive "p") (+org-next-heading-widen (- arg))) ;;; Hooks & Advice (defvar +org-before-save-prettify-buffer t "Prettify org buffers before saving.") (put '+org-before-save-prettify-buffer 'safe-local-variable #'booleanp) (defun +org-before-save@prettify-buffer () (when +org-before-save-prettify-buffer (save-mark-and-excursion (+org-unsmartify) (+org-fix-blank-lines t) (org-align-tags t) (when (buffer-narrowed-p) (goto-char (point-min)) (forward-line 1) (org-narrow-to-subtree))))) (defun +org-delete-backward-char (N) "Keep tables aligned while deleting N characters backward. When deleting backwards, in tables this function will insert whitespace in front of the next \"|\" separator, to keep the table aligned. The table will still be marked for re-alignment if the field did fill the entire column, because, in this case the deletion might narrow the column." (interactive "p") (save-match-data (org-check-before-invisible-edit 'delete-backward) (if (and (= N 1) (not overwrite-mode) (not (org-region-active-p)) (not (eq (char-before) ?|)) (save-excursion (skip-chars-backward " \t") (not (bolp))) (looking-at-p ".*?|") (org-at-table-p)) (progn (forward-char -1) (org-delete-char 1)) (backward-delete-char-untabify N) (org-fix-tags-on-the-fly)))) ;;; Smarter {super,sub}scripts ;; https://old.reddit.com/r/emacs/comments/qzlzm0/what_are_your_top_key_bindings_rebindings_minor/hmwyhm3/ ;; I don't use this currently because I found out about ;; `org-pretty-entities-include-sub-superscripts', which really does exactly ;; what I wanted. (defface +org-script-markers '((t (:inherit shadow))) "Face to be used for sub/superscripts markers i.e., ^, _, {, }.") ;; Hiding the super and subscript markers is extremely annoying ;; since any remotely complex equation becomes a chore. And leaving ;; it not raised is jarring to the eye. So this fontifies the ;; buffer just like how auctex does -- use a muted colour to ;; highlight the markup and raise the script. (defun +org-raise-scripts (limit) "Differences from `org-raise-scripts' are: - It doesn't actually hide the markup used for super and subscript. - It uses a custom face to highlight the markup: +org-script-markers. - It doesn't require `org-pretty-entities' to be t." (when (and org-pretty-entities-include-sub-superscripts (re-search-forward (if (eq org-use-sub-superscripts t) org-match-substring-regexp org-match-substring-with-braces-regexp) limit t)) (let* ((pos (point)) table-p comment-p (mpos (match-beginning 3)) (emph-p (get-text-property mpos 'org-emphasis)) (link-p (get-text-property mpos 'mouse-face)) (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face)))) (goto-char (point-at-bol)) (setq table-p (looking-at-p org-table-dataline-regexp) comment-p (looking-at-p "^[ \t]*#[ +]")) (goto-char pos) ;; Handle a_b^c (when (member (char-after) '(?_ ?^)) (goto-char (1- pos))) (unless (or comment-p emph-p link-p keyw-p) (put-text-property (match-beginning 3) (match-end 0) 'display (if (equal (char-after (match-beginning 2)) ?^) ;; (nth (if table-p 3 1) org-script-display) (nth 3 org-script-display) ;; (nth (if table-p 2 0) org-script-display) (nth 2 org-script-display))) (put-text-property (match-beginning 2) (match-end 2) 'face '+org-script-markers) (when (and (eq (char-after (match-beginning 3)) ?{) (eq (char-before (match-end 3)) ?})) (put-text-property (match-beginning 3) (1+ (match-beginning 3)) 'face '+org-script-markers) (put-text-property (1- (match-end 3)) (match-end 3) 'face '+org-script-markers))) t))) ;; Extra link types (defun +org-tel-open (number _) "Notify the user of what phone NUMBER to call." (message "Call: %s" number)) (defun +org-sms-open (number _) "Notify the user of what phone NUMBER to text." (message "SMS: %s" number)) ;; Make a horizontal rule! (defun +org-horizontal-rule () "Make a horizontal rule after the current line." (interactive nil org-mode) (unless (eq (line-beginning-position) (line-end-position)) (end-of-line) (newline)) (dotimes (_ fill-column) (insert "-"))) ;; Follow links, DWIM style (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))))) ;;; Open local HTML files with `browse-url' (defun +org-open-html (file-path link-string) "Open FILE-PATH with `browse-url'. This function is intended to use with `org-file-apps'. See the documentation of that function for a description of the two arguments here, FILE-PATH and LINK-STRING." (message "Opening %s (%s)..." file-path link-string) (browse-url file-path)) (defun +org-insert-horizontal-rule (prefix) "Insert a horizontal rule (-----) after the current line. With PREFIX, insert before the current line." (interactive "P") (if prefix (move-beginning-of-line nil) (move-end-of-line nil) (forward-line 1)) (insert "-----\n")) ;;; Make code snippets in org-mode easier to type ;; http://mbork.pl/2022-01-17_Making_code_snippets_in_Org-mode_easier_to_type (defun +org-insert-backtick () "Insert a backtick using `org-self-insert-command'." (interactive) (setq last-command-event ?`) (call-interactively #'org-self-insert-command)) (defvar-local +org-insert-tilde-language nil "Default language name in the current Org file. If nil, `org-insert-tilde' after 2 tildes inserts an \"example\" block. If a string, it inserts a \"src\" block with the given language name.") (defun +org-insert-tilde () "Insert a tilde using `org-self-insert-command'." (interactive) (if (string= (buffer-substring-no-properties (- (point) 3) (point)) "\n~~") (progn (delete-char -2) (if +org-insert-tilde-language (insert (format "#+begin_src %s\n#+end_src" +org-insert-tilde-language)) (insert "#+begin_example\n#+end_example")) (forward-line -1) (if (string= +org-insert-tilde-language "") (move-end-of-line nil) ;;(org-edit-special) ; Useful really only with splits. )) (setq last-command-event ?~) (call-interactively #'org-self-insert-command))) ;;; Better org 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.") ;; `org-verbatim' and `org-code' are apparently already things, so we skip them ;; here. ;;; 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))))) ;;; go forward and backward in the tree, ~ cleanly ~ ;; https://stackoverflow.com/a/25201697/10756297 (defun +org-show-next-heading-tidily () "Show next entry, keeping other entries closed." (interactive) (if (save-excursion (end-of-line) (outline-invisible-p)) (progn (org-show-entry) (show-children)) (outline-next-heading) (unless (and (bolp) (org-on-heading-p)) (org-up-heading-safe) (hide-subtree) (user-error "Boundary reached")) (org-overview) (org-reveal t) (org-show-entry) (recenter-top-bottom) (show-children) (recenter-top-bottom 1))) (defun +org-show-previous-heading-tidily () "Show previous entry, keeping other entries closed." (interactive) (let ((pos (point))) (outline-previous-heading) (unless (and (< (point) pos) (bolp) (org-on-heading-p)) (goto-char pos) (hide-subtree) (user-error "Boundary reached")) (org-overview) (org-reveal t) (org-show-entry) (recenter-top-bottom) (show-children) (recenter-top-bottom 1))) ;;; Make `org-flag-region' (which folds subtrees) recognize ;; [[https://teddit.net/r/orgmode/comments/u3du0v/how_to_make_orgcycle_respect_and_always_show_the/][from u/yantar92]] ;; (advice-add 'org-flag-region :around #'org-flag-region@unfold-page-breaks) (defun org-flag-region@unfold-page-breaks (oldfun from to flag &optional spec) "ADVICE to unfold all the page-break lines inside a folded region." (funcall oldfun from to flag spec) (when (and flag (not (eq 'visible spec))) (org-with-point-at from (while (re-search-forward "\n\u000c\n" to t) (org-flag-region (match-beginning 0) (match-end 0) t 'visible))))) ;;; Emacs 28+: wrap on hyphens ;; https://emacs.stackexchange.com/a/71342/37239 (defcustom +org-category-table (let ((table (copy-category-table))) (modify-category-entry ?- ?| table) table) "Character category table for `org-mode'." :type 'sexp) (defun +org-wrap-on-hyphens () "Soft-wrap `org-mode' buffers on spaces and hyphens." (set-category-table +org-category-table) (setq-local word-wrap-by-category t)) ;;; 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'." (dlet ((org-mode-hook nil)) ; I'm not sure if `dlet' is strictly needed (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-mode-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 "" :global t (if +org-agenda-inhibit-hooks-mode (progn ; Enable (advice-add 'org-agenda :around #'+org-agenda-inhibit-hooks) (advice-add 'org-agenda-switch-to :after #'+org-agenda-switch-run-hooks)) (progn ; Disable (advice-remove 'org-agenda #'+org-agenda-inhibit-hooks) (advice-remove 'org-agenda-switch-to #'+org-agenda-switch-run-hooks)))) ;;; "Fix" `org-align-tags' (el-patch-defun org-align-tags (&optional all) "Align tags in current entry. When optional argument ALL is non-nil, align all tags in the visible part of the buffer." (let ((get-indent-column (lambda () (let ((offset (el-patch-swap (if (bound-and-true-p org-indent-mode) (* (1- org-indent-indentation-per-level) (1- (org-current-level))) 0) 0))) (+ org-tags-column (if (> org-tags-column 0) (- offset) offset)))))) (if (and (not all) (org-at-heading-p)) (org--align-tags-here (funcall get-indent-column)) (save-excursion (if all (progn (goto-char (point-min)) (while (re-search-forward org-tag-line-re nil t) (org--align-tags-here (funcall get-indent-column)))) (org-back-to-heading t) (org--align-tags-here (funcall get-indent-column))))))) ;;; Meta-return (defun +org-meta-return (&optional arg) "Insert a new line, or wrap a region in a table. See `org-meta-return', but `+org-return-dwim' does most of the stuff I would want out of that function already. When called with a prefix ARG, will still unconditionally call `org-insert-heading'." (interactive "P") (org-fold-check-before-invisible-edit 'insert) (or (run-hook-with-args-until-success 'org-metareturn-hook) ; Allow customizations (call-interactively (cond (arg #'org-insert-heading) ((org-at-table-p) #'org-table-wrap-region) (t #'org-return))))) ;;; move org archives to a dedicated file (defun +org-archive-monthwise (archive-file) (if (file-exists-p archive-file) (with-current-buffer (find-file-noselect archive-file) (let ((dir (file-name-directory (file-truename archive-file))) (prog (make-progress-reporter (format "Archiving from %s..." archive-file))) (keep-going t)) (goto-char (point-min)) (while keep-going (when-let* ((time (or (org-entry-get (point) "ARCHIVE_TIME") (org-get-deadline-time (point)))) (parsed-time (and time (org-parse-time-string time))) (refile-target (format "%s%02d-%02d.org" dir (decoded-time-year parsed-time) (decoded-time-month parsed-time))) (title-str (format "#+title: Archive for %02d-%02d (%s)\n\n" (decoded-time-year parsed-time) (decoded-time-month parsed-time) (file-truename archive-file)))) (unless (file-exists-p refile-target) (with-current-buffer (find-file-noselect refile-target) (insert title-str) (save-buffer))) (org-refile nil nil (list "" refile-target nil 0))) (progress-reporter-update prog) (org-next-visible-heading 1) (when (>= (point) (point-max)) (setq keep-going nil))))) (message "Archive file %s does not exist!" archive-file))) ;;; el-patch (el-patch-defun org-format-outline-path (path &optional width prefix separator) "Format the outline path PATH for display. WIDTH is the maximum number of characters that is available. PREFIX is a prefix to be included in the returned string, such as the file name. SEPARATOR is inserted between the different parts of the path, the default is \"/\"." (setq width (or width 79)) (setq path (delq nil path)) (unless (> width 0) (user-error "Argument `width' must be positive")) (setq separator (or separator "/")) (let* ((org-odd-levels-only nil) (fpath (concat prefix (and prefix path separator) (mapconcat (lambda (s) (replace-regexp-in-string "[ \t]+\\'" "" s)) (cl-loop for head in path for n from 0 collect (el-patch-swap (org-add-props head nil 'face (nth (% n org-n-level-faces) org-level-faces)) head)) separator)))) (when (> (length fpath) width) (if (< width 7) ;; It's unlikely that `width' will be this small, but don't ;; waste characters by adding ".." if it is. (setq fpath (substring fpath 0 width)) (setf (substring fpath (- width 2)) ".."))) fpath)) (provide '+org) ;;; +org.el ends here