;;; config-org-behaviour.el --- Generated package (no.73) from my config -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2024 TEC ;; ;; Author: TEC <https://code.tecosaur.net/tec> ;; Maintainer: TEC <contact@tecosaur.net> ;; Created: April 20, 2024 ;; Modified: April 20, 2024 ;; Version: 2024.04.20 ;; Homepage: https://code.tecosaur.net/tec/emacs-config ;; Package-Requires: ((emacs "29.1")) ;; ;; This file is not part of GNU Emacs. ;; ;;; Commentary: ;; ;; Generated package (no.73) from my config. ;; ;; During generation, dependency on other aspects of my configuration and ;; packages is inferred via (regexp-based) static analysis. While this seems ;; to do a good job, this method is imperfect. This code likely depends on ;; utilities provided by Doom, and if you try to run it in isolation you may ;; discover the code makes more assumptions. ;; ;; That said, I've found pretty good results so far. ;; ;;; Code: (require 'org) (setq org-directory (expand-file-name "org" (xdg-data-home)) ; Let's put files here. org-agenda-files (list org-directory) ; Seems like the obvious place. org-use-property-inheritance t ; It's convenient to have properties inherited. org-log-done 'time ; Having the time a item is done sounds convenient. org-list-allow-alphabetical t ; Have a. A. a) A) list bullets. org-catch-invisible-edits 'smart ; Try not to accidently do weird stuff in invisible regions. org-export-with-sub-superscripts '{} ; Don't treat lone _ / ^ as sub/superscripts, require _{} / ^{}. org-export-allow-bind-keywords t ; Bind keywords can be handy org-image-actual-width '(0.9)) ; Make the in-buffer display closer to the exported result.. (setq org-babel-default-header-args '((:session . "none") (:results . "replace") (:exports . "code") (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no") (:comments . "link"))) (remove-hook 'text-mode-hook #'visual-line-mode) (add-hook 'text-mode-hook #'auto-fill-mode) (map! :map evil-org-mode-map :after evil-org :n "g <up>" #'org-backward-heading-same-level :n "g <down>" #'org-forward-heading-same-level :n "g <left>" #'org-up-element :n "g <right>" #'org-down-element) (map! :map org-mode-map :nie "M-SPC M-SPC" (cmd! (insert "\u200B"))) (setq org-list-demote-modify-bullet '(("+" . "-") ("-" . "+") ("*" . "+") ("1." . "a."))) (defun +org-insert-file-link () "Insert a file link. At the prompt, enter the filename." (interactive) (org-insert-link nil (org-link-complete-file))) (map! :after org :map org-mode-map :localleader "l f" #'+org-insert-file-link) (defadvice! +org-edit-latex-env-after-insert-a (&rest _) :after #'org-cdlatex-environment-indent (org-edit-latex-environment)) (cl-defmacro lsp-org-babel-enable (lang) "Support LANG in org source code block." (setq centaur-lsp 'lsp-mode) (cl-check-type lang string) (let* ((edit-pre (intern (format "org-babel-edit-prep:%s" lang))) (intern-pre (intern (format "lsp--%s" (symbol-name edit-pre))))) `(progn (defun ,intern-pre (info) (let ((file-name (->> info caddr (alist-get :file)))) (unless file-name (setq file-name (make-temp-file "babel-lsp-"))) (setq buffer-file-name file-name) (lsp-deferred))) (put ',intern-pre 'function-documentation (format "Enable lsp-mode in the buffer of org source block (%s)." (upcase ,lang))) (if (fboundp ',edit-pre) (advice-add ',edit-pre :after ',intern-pre) (progn (defun ,edit-pre (info) (,intern-pre info)) (put ',edit-pre 'function-documentation (format "Prepare local buffer environment for org source block (%s)." (upcase ,lang)))))))) (defvar org-babel-lang-list '("go" "python" "ipython" "bash" "sh")) (dolist (lang org-babel-lang-list) (eval `(lsp-org-babel-enable ,lang))) (map! :map org-mode-map :localleader :desc "View exported file" "v" #'org-view-output-file) (defun org-view-output-file (&optional org-file-path) "Visit buffer open on the first output file (if any) found, using `org-view-output-file-extensions'" (interactive) (let* ((org-file-path (or org-file-path (buffer-file-name) "")) (dir (file-name-directory org-file-path)) (basename (file-name-base org-file-path)) (output-file nil)) (dolist (ext org-view-output-file-extensions) (unless output-file (when (file-exists-p (concat dir basename "." ext)) (setq output-file (concat dir basename "." ext))))) (if output-file (if (member (file-name-extension output-file) org-view-external-file-extensions) (browse-url-xdg-open output-file) (pop-to-buffer (or (find-buffer-visiting output-file) (find-file-noselect output-file)))) (message "No exported file found")))) (defvar org-view-output-file-extensions '("pdf" "md" "rst" "txt" "tex" "html") "Search for output files with these extensions, in order, viewing the first that matches") (defvar org-view-external-file-extensions '("html") "File formats that should be opened externally.") (use-package! doct :commands doct) (after! org-capture (defun org-capture-select-template-prettier (&optional keys) "Select a capture template, in a prettier way than default Lisp programs can force the template by setting KEYS to a string." (let ((org-capture-templates (or (org-contextualize-keys (org-capture-upgrade-templates org-capture-templates) org-capture-templates-contexts) '(("t" "Task" entry (file+headline "" "Tasks") "* TODO %?\n %u\n %a"))))) (if keys (or (assoc keys org-capture-templates) (error "No capture template referred to by \"%s\" keys" keys)) (org-mks org-capture-templates "Select a capture template\n━━━━━━━━━━━━━━━━━━━━━━━━━" "Template key: " `(("q" ,(concat (nerd-icons-octicon "nf-oct-stop" :face 'nerd-icons-red :v-adjust 0.01) "\tAbort"))))))) (advice-add 'org-capture-select-template :override #'org-capture-select-template-prettier) (defun org-mks-pretty (table title &optional prompt specials) "Select a member of an alist with multiple keys. Prettified. TABLE is the alist which should contain entries where the car is a string. There should be two types of entries. 1. prefix descriptions like (\"a\" \"Description\") This indicates that `a' is a prefix key for multi-letter selection, and that there are entries following with keys like \"ab\", \"ax\"… 2. Select-able members must have more than two elements, with the first being the string of keys that lead to selecting it, and the second a short description string of the item. The command will then make a temporary buffer listing all entries that can be selected with a single key, and all the single key prefixes. When you press the key for a single-letter entry, it is selected. When you press a prefix key, the commands (and maybe further prefixes) under this key will be shown and offered for selection. TITLE will be placed over the selection in the temporary buffer, PROMPT will be used when prompting for a key. SPECIALS is an alist with (\"key\" \"description\") entries. When one of these is selected, only the bare key is returned." (save-window-excursion (let ((inhibit-quit t) (buffer (org-switch-to-buffer-other-window "*Org Select*")) (prompt (or prompt "Select: ")) case-fold-search current) (unwind-protect (catch 'exit (while t (setq-local evil-normal-state-cursor (list nil)) (erase-buffer) (insert title "\n\n") (let ((des-keys nil) (allowed-keys '("\C-g")) (tab-alternatives '("\s" "\t" "\r")) (cursor-type nil)) ;; Populate allowed keys and descriptions keys ;; available with CURRENT selector. (let ((re (format "\\`%s\\(.\\)\\'" (if current (regexp-quote current) ""))) (prefix (if current (concat current " ") ""))) (dolist (entry table) (pcase entry ;; Description. (`(,(and key (pred (string-match re))) ,desc) (let ((k (match-string 1 key))) (push k des-keys) ;; Keys ending in tab, space or RET are equivalent. (if (member k tab-alternatives) (push "\t" allowed-keys) (push k allowed-keys)) (insert (propertize prefix 'face 'font-lock-comment-face) (propertize k 'face 'bold) (propertize "›" 'face 'font-lock-comment-face) " " desc "…" "\n"))) ;; Usable entry. (`(,(and key (pred (string-match re))) ,desc . ,_) (let ((k (match-string 1 key))) (insert (propertize prefix 'face 'font-lock-comment-face) (propertize k 'face 'bold) " " desc "\n") (push k allowed-keys))) (_ nil)))) ;; Insert special entries, if any. (when specials (insert "─────────────────────────\n") (pcase-dolist (`(,key ,description) specials) (insert (format "%s %s\n" (propertize key 'face '(bold nerd-icons-red)) description)) (push key allowed-keys))) ;; Display UI and let user select an entry or ;; a sub-level prefix. (goto-char (point-min)) (unless (pos-visible-in-window-p (point-max)) (org-fit-window-to-buffer)) (let ((pressed (org--mks-read-key allowed-keys prompt (not (pos-visible-in-window-p (1- (point-max))))))) (setq current (concat current pressed)) (cond ((equal pressed "\C-g") (user-error "Abort")) ;; Selection is a prefix: open a new menu. ((member pressed des-keys)) ;; Selection matches an association: return it. ((let ((entry (assoc current table))) (and entry (throw 'exit entry)))) ;; Selection matches a special entry: return the ;; selection prefix. ((assoc current specials) (throw 'exit current)) (t (error "No entry available"))))))) (when buffer (kill-buffer buffer)))))) (advice-add 'org-mks :override #'org-mks-pretty) (defun +doct-icon-declaration-to-icon (declaration) "Convert :icon declaration to icon" (let ((name (pop declaration)) (set (intern (concat "nerd-icons-" (plist-get declaration :set)))) (face (intern (concat "nerd-icons-" (plist-get declaration :color)))) (v-adjust (or (plist-get declaration :v-adjust) 0.01))) (apply set `(,name :face ,face :v-adjust ,v-adjust)))) (defun +doct-iconify-capture-templates (groups) "Add declaration's :icon to each template group in GROUPS." (let ((templates (doct-flatten-lists-in groups))) (setq doct-templates (mapcar (lambda (template) (when-let* ((props (nthcdr (if (= (length template) 4) 2 5) template)) (spec (plist-get (plist-get props :doct) :icon))) (setf (nth 1 template) (concat (+doct-icon-declaration-to-icon spec) "\t" (nth 1 template)))) template) templates)))) (setq doct-after-conversion-functions '(+doct-iconify-capture-templates)) (defvar +org-capture-recipies "~/Desktop/TEC/Organisation/recipies.org") (defun set-org-capture-templates () (setq org-capture-templates (doct `(("Personal todo" :keys "t" :icon ("nf-oct-checklist" :set "octicon" :color "green") :file +org-capture-todo-file :prepend t :headline "Inbox" :type entry :template ("* TODO %?" "%i %a")) ("Personal note" :keys "n" :icon ("nf-fa-sticky_note_o" :set "faicon" :color "green") :file +org-capture-todo-file :prepend t :headline "Inbox" :type entry :template ("* %?" "%i %a")) ("Email" :keys "e" :icon ("nf-fa-envelope" :set "faicon" :color "blue") :file +org-capture-todo-file :prepend t :headline "Inbox" :type entry :template ("* TODO %^{type|reply to|contact} %\\3 %? :email:" "Send an email %^{urgancy|soon|ASAP|anon|at some point|eventually} to %^{recipiant}" "about %^{topic}" "%U %i %a")) ("Interesting" :keys "i" :icon ("nf-fa-eye" :set "faicon" :color "lcyan") :file +org-capture-todo-file :prepend t :headline "Interesting" :type entry :template ("* [ ] %{desc}%? :%{i-type}:" "%i %a") :children (("Webpage" :keys "w" :icon ("nf-fa-globe" :set "faicon" :color "green") :desc "%(org-cliplink-capture) " :i-type "read:web") ("Article" :keys "a" :icon ("nf-fa-file_text_o" :set "faicon" :color "yellow") :desc "" :i-type "read:reaserch") ("\tRecipie" :keys "r" :icon ("nf-fa-spoon" :set "faicon" :color "dorange") :file +org-capture-recipies :headline "Unsorted" :template "%(org-chef-get-recipe-from-url)") ("Information" :keys "i" :icon ("nf-fa-info_circle" :set "faicon" :color "blue") :desc "" :i-type "read:info") ("Idea" :keys "I" :icon ("nf-md-chart_bubble" :set "mdicon" :color "silver") :desc "" :i-type "idea"))) ("Tasks" :keys "k" :icon ("nf-oct-inbox" :set "octicon" :color "yellow") :file +org-capture-todo-file :prepend t :headline "Tasks" :type entry :template ("* TODO %? %^G%{extra}" "%i %a") :children (("General Task" :keys "k" :icon ("nf-oct-inbox" :set "octicon" :color "yellow") :extra "") ("Task with deadline" :keys "d" :icon ("nf-md-timer" :set "mdicon" :color "orange" :v-adjust -0.1) :extra "\nDEADLINE: %^{Deadline:}t") ("Scheduled Task" :keys "s" :icon ("nf-oct-calendar" :set "octicon" :color "orange") :extra "\nSCHEDULED: %^{Start time:}t"))) ("Project" :keys "p" :icon ("nf-oct-repo" :set "octicon" :color "silver") :prepend t :type entry :headline "Inbox" :template ("* %{time-or-todo} %?" "%i" "%a") :file "" :custom (:time-or-todo "") :children (("Project-local todo" :keys "t" :icon ("nf-oct-checklist" :set "octicon" :color "green") :time-or-todo "TODO" :file +org-capture-project-todo-file) ("Project-local note" :keys "n" :icon ("nf-fa-sticky_note" :set "faicon" :color "yellow") :time-or-todo "%U" :file +org-capture-project-notes-file) ("Project-local changelog" :keys "c" :icon ("nf-fa-list" :set "faicon" :color "blue") :time-or-todo "%U" :heading "Unreleased" :file +org-capture-project-changelog-file))) ("\tCentralised project templates" :keys "o" :type entry :prepend t :template ("* %{time-or-todo} %?" "%i" "%a") :children (("Project todo" :keys "t" :prepend nil :time-or-todo "TODO" :heading "Tasks" :file +org-capture-central-project-todo-file) ("Project note" :keys "n" :time-or-todo "%U" :heading "Notes" :file +org-capture-central-project-notes-file) ("Project changelog" :keys "c" :time-or-todo "%U" :heading "Unreleased" :file +org-capture-central-project-changelog-file))))))) (set-org-capture-templates) (unless (display-graphic-p) (add-hook 'server-after-make-frame-hook (defun org-capture-reinitialise-hook () (when (display-graphic-p) (set-org-capture-templates) (remove-hook 'server-after-make-frame-hook #'org-capture-reinitialise-hook)))))) (setf (alist-get 'height +org-capture-frame-parameters) 15) ;; (alist-get 'name +org-capture-frame-parameters) "❖ Capture") ;; ATM hardcoded in other places, so changing breaks stuff (setq +org-capture-fn (lambda () (interactive) (set-window-parameter nil 'mode-line-format 'none) (org-capture))) (defun unpackaged/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)) (unpackaged/org-element-descendant-of type parent)))) ;;;###autoload (defun unpackaged/org-return-dwim (&optional default) "A helpful replacement for `org-return-indent'. With prefix, call `org-return-indent'. 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." ;; Inspired by John Kitchin: http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/ (interactive "P") (if default (org-return t) (cond ;; Act depending on context around point. ;; NOTE: I prefer RET to not follow links, but by uncommenting this block, links will be ;; followed. ;; ((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 "\\(?:[[:blank:]]?\n\\)\\{3\\}" 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. Yes, this gets a little complicated... (let ((context (org-element-context))) (if (or (eq 'plain-list (car context)) ; First item in list (and (eq 'item (car context)) (not (eq (org-element-property :contents-begin context) (org-element-property :contents-end context)))) (unpackaged/org-element-descendant-of 'item context)) ; Element in list item, e.g. a link ;; Non-empty item: Add new item. (org-insert-item) ;; Empty item: Close the list. ;; TODO: Do this with org functions rather than operating on the text. Can't seem to find the right function. (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 t)) ((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)) (t ;; Non-empty row: call `org-return-indent'. (org-return t)))) (t ;; All other cases: call `org-return-indent'. (org-return t))))) (map! :after evil-org :map evil-org-mode-map :i [return] #'unpackaged/org-return-dwim) (defun +yas/org-src-header-p () "Determine whether `point' is within a src-block header or header-args." (pcase (org-element-type (org-element-context)) ('src-block (< (point) ; before code part of the src-block (save-excursion (goto-char (org-element-property :begin (org-element-context))) (forward-line 1) (point)))) ('inline-src-block (< (point) ; before code part of the inline-src-block (save-excursion (goto-char (org-element-property :begin (org-element-context))) (search-forward "]{") (point)))) ('keyword (string-match-p "^header-args" (org-element-property :value (org-element-context)))))) (defun +yas/org-prompt-header-arg (arg question values) "Prompt the user to set ARG header property to one of VALUES with QUESTION. The default value is identified and indicated. If either default is selected, or no selection is made: nil is returned." (let* ((src-block-p (not (looking-back "^#\\+property:[ \t]+header-args:.*" (line-beginning-position)))) (default (or (cdr (assoc arg (if src-block-p (nth 2 (org-babel-get-src-block-info t)) (org-babel-merge-params org-babel-default-header-args (let ((lang-headers (intern (concat "org-babel-default-header-args:" (+yas/org-src-lang))))) (when (boundp lang-headers) (eval lang-headers t))))))) "")) default-value) (setq values (mapcar (lambda (value) (if (string-match-p (regexp-quote value) default) (setq default-value (concat value " " (propertize "(default)" 'face 'font-lock-doc-face))) value)) values)) (let ((selection (consult--read values :prompt question :default default-value))) (unless (or (string-match-p "(default)$" selection) (string= "" selection)) selection)))) (defun +yas/org-src-lang () "Try to find the current language of the src/header at `point'. Return nil otherwise." (let ((context (org-element-context))) (pcase (org-element-type context) ('src-block (org-element-property :language context)) ('inline-src-block (org-element-property :language context)) ('keyword (when (string-match "^header-args:\\([^ ]+\\)" (org-element-property :value context)) (match-string 1 (org-element-property :value context))))))) (defun +yas/org-last-src-lang () "Return the language of the last src-block, if it exists." (save-excursion (beginning-of-line) (when (re-search-backward "^[ \t]*#\\+begin_src" nil t) (org-element-property :language (org-element-context))))) (defun +yas/org-most-common-no-property-lang () "Find the lang with the most source blocks that has no global header-args, else nil." (let (src-langs header-langs) (save-excursion (goto-char (point-min)) (while (re-search-forward "^[ \t]*#\\+begin_src" nil t) (push (+yas/org-src-lang) src-langs)) (goto-char (point-min)) (while (re-search-forward "^[ \t]*#\\+property: +header-args" nil t) (push (+yas/org-src-lang) header-langs))) (setq src-langs (mapcar #'car ;; sort alist by frequency (desc.) (sort ;; generate alist with form (value . frequency) (cl-loop for (n . m) in (seq-group-by #'identity src-langs) collect (cons n (length m))) (lambda (a b) (> (cdr a) (cdr b)))))) (car (cl-set-difference src-langs header-langs :test #'string=)))) (defun org-syntax-convert-keyword-case-to-lower () "Convert all #+KEYWORDS to #+keywords." (interactive) (save-excursion (goto-char (point-min)) (let ((count 0) (case-fold-search nil)) (while (re-search-forward "^[ \t]*#\\+[A-Z_]+" nil t) (unless (s-matches-p "RESULTS" (match-string 0)) (replace-match (downcase (match-string 0)) t) (setq count (1+ count)))) (message "Replaced %d occurances" count)))) (org-link-set-parameters "xkcd" :image-data-fun #'+org-xkcd-image-fn :follow #'+org-xkcd-open-fn :export #'+org-xkcd-export :complete #'+org-xkcd-complete) (defun +org-xkcd-open-fn (link) (+org-xkcd-image-fn nil link nil)) (defun +org-xkcd-image-fn (protocol link description) "Get image data for xkcd num LINK" (let* ((xkcd-info (+xkcd-fetch-info (string-to-number link))) (img (plist-get xkcd-info :img)) (alt (plist-get xkcd-info :alt))) (message alt) (+org-image-file-data-fn protocol (xkcd-download img (string-to-number link)) description))) (defun +org-xkcd-export (num desc backend _com) "Convert xkcd to html/LaTeX form" (let* ((xkcd-info (+xkcd-fetch-info (string-to-number num))) (img (plist-get xkcd-info :img)) (alt (plist-get xkcd-info :alt)) (title (plist-get xkcd-info :title)) (file (xkcd-download img (string-to-number num)))) (cond ((org-export-derived-backend-p backend 'html) (format "<img class='invertible' src='%s' title=\"%s\" alt='%s'>" img (subst-char-in-string ?\" ?“ alt) title)) ((org-export-derived-backend-p backend 'latex) (format "\\begin{figure}[!htb] \\centering \\includegraphics[scale=0.4]{%s}%s \\end{figure}" file (if (equal desc (format "xkcd:%s" num)) "" (format "\n \\caption*{\\label{xkcd:%s} %s}" num (or desc (format "\\textbf{%s} %s" title alt)))))) (t (format "https://xkcd.com/%s" num))))) (defun +org-xkcd-complete (&optional arg) "Complete xkcd using `+xkcd-stored-info'" (format "xkcd:%d" (+xkcd-select))) (org-link-set-parameters "yt" :export #'+org-export-yt) (defun +org-export-yt (path desc backend _com) (cond ((org-export-derived-backend-p backend 'html) (format "<iframe width='440' \ height='335' \ src='https://www.youtube.com/embed/%s' \ frameborder='0' \ allowfullscreen>%s</iframe>" path (or "" desc))) ((org-export-derived-backend-p backend 'latex) (format "\\href{https://youtu.be/%s}{%s}" path (or desc "youtube"))) (t (format "https://youtu.be/%s" path)))) (defadvice! shut-up-org-problematic-hooks (orig-fn &rest args) :around #'org-fancy-priorities-mode (ignore-errors (apply orig-fn args))) (provide 'config-org-behaviour) ;;; config-org-behaviour.el ends here