embark-org.el (15679B)
1 ;;; embark-org.el --- Embark targets and actions for Org Mode -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2022 Free Software Foundation, Inc. 4 5 ;; This program is free software; you can redistribute it and/or modify 6 ;; it under the terms of the GNU General Public License as published by 7 ;; the Free Software Foundation, either version 3 of the License, or 8 ;; (at your option) any later version. 9 10 ;; This program is distributed in the hope that it will be useful, 11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ;; GNU General Public License for more details. 14 15 ;; You should have received a copy of the GNU General Public License 16 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 17 18 ;;; Commentary: 19 20 ;; This package configures the Embark package for use in Org Mode 21 ;; buffers. It teaches Embark a number of Org related targets and 22 ;; appropriate actions. Currently it has table cells, whole tables, 23 ;; source blocks and links. Targets to add: headings (Embark already 24 ;; has generic support for outlines, so we just nee to add Org 25 ;; specific actions), timestamps, etc. 26 27 ;;; Code: 28 29 (require 'embark) 30 (require 'org) 31 (require 'org-element) 32 33 ;;; Basic target finder for Org 34 35 ;; There are very many org element and objects types, we'll only 36 ;; recognize those for which there are specific actions we can put in 37 ;; a keymap, or for even if there aren't any specific actions, if it's 38 ;; import to be able to kill, delete or duplicate (embark-insert) them 39 ;; conveniently. I'll start conservatively and we can add more later 40 41 (defconst embark-org--types 42 '( 43 babel-call 44 ;; bold 45 ;; center-block 46 ;; citation 47 ;; citation-reference 48 ;; clock 49 ;; code 50 ;; comment 51 ;; comment-block 52 ;; diary-sexp 53 ;; drawer 54 ;; dynamic-block 55 ;; entity 56 ;; example-block 57 ;; export-block 58 ;; export-snippet 59 ;; fixed-width 60 footnote-definition 61 footnote-reference 62 ;; headline ; the bounds include the entire subtree! 63 ;; horizontal-rule 64 ;; inline-babel-call 65 ;; inline-src-block 66 ;; inlinetask 67 ;; italic 68 item 69 ;; keyword 70 ;; latex-environment 71 ;; latex-fragment 72 ;; line-break 73 link 74 ;; macro 75 ;; node-property 76 ;; paragraph ; the existing general support seems fine 77 plain-list 78 ;; planning 79 ;; property-drawer 80 ;; quote-block 81 ;; radio-target 82 ;; section 83 ;; special-block 84 src-block 85 ;; statistics-cookie 86 ;; strike-through 87 ;; subscript 88 ;; superscript 89 table ; supported via a specific target finder 90 table-cell 91 ;; table-row ; we'll put row & column actions in the cell map 92 ;; target ; I think there are no useful actions for radio targets 93 timestamp 94 ;; underline 95 ;; verbatim 96 ;; verse-block 97 ) 98 "Supported Org object and element types.") 99 100 (defun embark-org-target-element-context () 101 "Target all Org elements or objects around point." 102 (when (derived-mode-p 'org-mode 'org-agenda-mode) 103 (cl-loop 104 for elt = (org-element-lineage (org-element-context) embark-org--types t) 105 then (org-element-lineage elt embark-org--types) 106 while elt 107 for begin = (org-element-property :begin elt) 108 for end = (org-element-property :end elt) 109 for target = (buffer-substring begin end) 110 ;; Adjust table-cell to exclude final |. (Why is that there?) 111 ;; Note: We are not doing this is an embark transformer because we 112 ;; want to adjust the bounds too. 113 ;; TODO? If more adjustments like this become necessary, add a 114 ;; nice mechanism for doing them. 115 when (and (eq (car elt) 'table-cell) (string-suffix-p "|" target)) 116 do (setq target (string-trim (string-remove-suffix "|" target)) 117 end (1- end)) 118 collect `(,(intern (format "org-%s" (car elt))) ,target ,begin . ,end)))) 119 120 (add-to-list 'embark-target-finders 'embark-org-target-element-context) 121 122 ;;; Custom Org actions 123 124 (defvar org-export-with-toc) 125 126 (defun embark-org-copy-as-markdown (start end) 127 "Export the region from START to END to markdown and save on the `kill-ring'." 128 (interactive "r") 129 (require 'ox) 130 (kill-new 131 (let (org-export-with-toc) 132 (string-trim 133 (org-export-string-as (buffer-substring-no-properties start end) 'md t)))) 134 (deactivate-mark)) 135 136 (add-to-list 'embark-pre-action-hooks 137 '(embark-org-copy-as-markdown embark--mark-target)) 138 139 (keymap-set embark-region-map "M" #'embark-org-copy-as-markdown) ; good idea? 140 141 ;;; Tables 142 143 (dolist (motion '(org-table-move-cell-up org-table-move-cell-down 144 org-table-move-cell-left org-table-move-cell-right)) 145 (add-to-list 'embark-repeat-actions motion)) 146 147 (push 'embark--ignore-target 148 (alist-get 'org-table-edit-field embark-target-injection-hooks)) 149 150 (defvar-keymap embark-org-table-cell-map 151 :doc "Keymap for actions the current cells, column or row of an Org table." 152 :parent embark-general-map 153 ;; TODO: default action? 154 "<up>" #'org-table-move-cell-up 155 "<down>" #'org-table-move-cell-down 156 "<left>" #'org-table-move-cell-left 157 "<right>" #'org-table-move-cell-right 158 "=" #'org-table-eval-formula 159 "e" #'org-table-edit-field 160 "g" #'org-table-recalculate) 161 162 (defvar-keymap embark-org-table-map 163 :doc "Keymap for actions on entire Org table." 164 :parent embark-general-map 165 ;; TODO: default action? 166 "=" #'org-table-edit-formulas 167 "s" #'org-table-sort-lines 168 "t" #'org-table-transpose-table-at-point 169 "c" #'org-table-convert 170 "f" #'org-table-follow-field-mode 171 "y" #'org-table-paste-rectangle 172 "d" #'org-table-toggle-formula-debugger 173 "i" #'org-table-iterate 174 "e" #'org-table-export) 175 176 (push 'embark--ignore-target ; prompts for file name 177 (alist-get 'org-table-export embark-target-injection-hooks)) 178 179 (add-to-list 'embark-keymap-alist '(org-table . embark-org-table-map)) 180 181 (add-to-list 'embark-keymap-alist '(org-table-cell . embark-org-table-cell-map)) 182 183 ;;; Links 184 185 ;; The link support has a slightly complicated design in order to 186 ;; achieve the following goals: 187 188 ;; 1. RET should simply be org-open-at-point 189 190 ;; 2. When the link is to a file, URL, email address or elisp 191 ;; expression or command, we want to offer the user actions for 192 ;; that underlying type. 193 194 ;; 3. Even in those cases, we still want some actions to apply to the 195 ;; entire link including description: actions to copy the link as 196 ;; markdown, or just the link description or target. 197 198 ;; So the strategy is as follows (illustrated with file links): 199 200 ;; - The target will be just the file, without the description and 201 ;; also without the "file:" prefix nor the "::line-number or search" 202 ;; suffix. That way, file actions will correctly apply to it. 203 204 ;; - The type will not be 'file, but 'org-file-link that way we can 205 ;; register a keymap for 'org-file-link that inherits from both 206 ;; embark-org-link-map (with RET bound to org-open-at-point and a 207 ;; few other generic link actions) and embark-file-map. 208 209 ;; - The commands to copy the link at point in some format will be 210 ;; written as commands that act on the Org link at point. This way 211 ;; they are independently (plausibly) useful, and we circumvent the 212 ;; problem that the whole Org link is not actually the target (just 213 ;; the inner file is!). 214 215 ;; Alternative design I considered: separate each target into two, a 216 ;; whole link target which includes the description and brackets and 217 ;; what not; and an "inner target" which is just the file or URL or 218 ;; whatever. Cons of this approach: much target cycling is required! 219 ;; First of all, an unadorned embark-dwim definitely should be 220 ;; org-open-at-point, which means the whole link target would need 221 ;; priority. That means that any file, URL, etc. actions would require 222 ;; you to cycle first. This sounds very inconvenient, the above 223 ;; slightly more complex design allows both whole-link and inner 224 ;; target actions to work without cycling. 225 226 (autoload 'org-attach-dir "org-attach") 227 228 (defun embark-org--refine-link-type (_type target) 229 "Refine type of link TARGET if we have more specific actions available." 230 (when (string-match org-link-any-re target) 231 (let ((target (or (match-string-no-properties 2 target) 232 (match-string-no-properties 0 target)))) 233 (cond 234 ((string-prefix-p "http" target) 235 (cons 'org-url-link target)) 236 ((string-prefix-p "mailto:" target) 237 (cons 'org-email-link (string-remove-prefix "mailto:" target))) 238 ((string-prefix-p "file:" target) 239 (cons 'org-file-link 240 (replace-regexp-in-string 241 "::.*" "" (string-remove-prefix "file:" target)))) 242 ((string-prefix-p "attachment:" target) 243 (cons 'org-file-link 244 (expand-file-name 245 (replace-regexp-in-string 246 "::.*" "" (string-remove-prefix "attachment:" target)) 247 (org-attach-dir)))) 248 ((string-match-p "^[./]" target) 249 (cons 'org-file-link (abbreviate-file-name (expand-file-name target)))) 250 ((string-prefix-p "elisp:(" target) 251 (cons 'org-expression-link (string-remove-prefix "elisp:" target))) 252 ((string-prefix-p "elisp:" target) 253 (cons 'command (string-remove-prefix "elisp:" target))) 254 (t (cons 'org-link target)))))) 255 256 (add-to-list 'embark-transformer-alist 257 '(org-link . embark-org--refine-link-type)) 258 259 (defmacro embark-org-define-link-copier (name formula description) 260 "Define a command that copies the Org link at point according to FORMULA. 261 The command's name is formed by appending NAME to 262 embark-org-copy-link. The docstring includes the DESCRIPTION of 263 what part or in what format the link is copied." 264 `(defun ,(intern (format "embark-org-copy-link-%s" name)) () 265 ,(format "Copy to the kill-ring the Org link at point%s." description) 266 (interactive) 267 (when (org-in-regexp org-link-any-re) 268 (let* ((full (match-string-no-properties 0)) 269 (target (or (match-string-no-properties 2) 270 (match-string-no-properties 0))) 271 (description (match-string-no-properties 3)) 272 (kill ,formula)) 273 (ignore full target description) 274 (when kill 275 (message "Saved '%s'" kill) 276 (kill-new kill)))))) 277 278 (embark-org-define-link-copier in-full full " in full") 279 (embark-org-define-link-copier description description "'s description") 280 (embark-org-define-link-copier target target "'s target") 281 282 (defalias 'embark-org-copy-link-inner-target #'kill-new 283 "Copy inner part of the Org link at point's target. 284 For mailto and elisp links, the inner part is the portion of the 285 target after `mailto:' or `elisp:'. 286 287 For file links the inner part is the file name, without the 288 `file:' prefix and without `::' suffix (used for line numbers, 289 IDs or search terms). 290 291 For URLs the inner part is the whole target including the `http:' 292 or `https:' prefix. For any other type of link the inner part is 293 also the whole target.") 294 295 (defvar-keymap embark-org-link-copy-map 296 :doc "Keymap for different ways to copy Org links to the kill-ring. 297 298 You should bind w in this map to your most frequently used link 299 copying function. The default is for w to copy the \"inner 300 target\" (see `embark-org-copy-link-inner-target'); which is also 301 bound to i." 302 :parent nil 303 "w" #'embark-org-copy-link-inner-target 304 "f" #'embark-org-copy-link-in-full 305 "d" #'embark-org-copy-link-description 306 "t" #'embark-org-copy-link-target 307 "i" #'embark-org-copy-link-inner-target 308 "m" #'embark-org-copy-as-markdown) 309 310 (fset 'embark-org-link-copy-map embark-org-link-copy-map) 311 312 (defvar-keymap embark-org-link-map 313 :doc "Keymap for actions on Org links." 314 :parent embark-general-map 315 "RET" #'org-open-at-point 316 "'" #'org-insert-link 317 "w" #'embark-org-link-copy-map) 318 319 ;; The reason for this is left as an exercise to the reader. 320 ;; Solution: Na ryvfc gnetrg znl cebzcg gur hfre sbe fbzrguvat! 321 (push 'embark--ignore-target 322 (alist-get 'org-open-at-point embark-target-injection-hooks)) 323 324 (push 'embark--ignore-target 325 (alist-get 'org-insert-link embark-target-injection-hooks)) 326 327 (add-to-list 'embark-keymap-alist 328 '(org-link embark-org-link-map)) 329 (add-to-list 'embark-keymap-alist 330 '(org-url-link embark-org-link-map embark-url-map)) 331 (add-to-list 'embark-keymap-alist 332 '(org-email-link embark-org-link-map embark-email-map)) 333 (add-to-list 'embark-keymap-alist 334 '(org-file-link embark-org-link-map embark-file-map)) 335 (add-to-list 'embark-keymap-alist 336 '(org-expression-link embark-org-link-map embark-expression-map)) 337 338 ;;; Source blocks and babel calls 339 340 (defvar-keymap embark-org-src-block-map 341 :doc "Keymap for actions on Org source blocks." 342 :parent embark-general-map 343 "RET" #'org-babel-execute-src-block 344 "c" #'org-babel-check-src-block 345 "k" #'org-babel-remove-result-one-or-many 346 "p" #'org-babel-previous-src-block 347 "n" #'org-babel-next-src-block 348 "t" #'org-babel-tangle 349 "s" #'org-babel-switch-to-session 350 "l" #'org-babel-load-in-session 351 "'" #'org-edit-special) 352 353 (dolist (motion '(org-babel-next-src-blockorg-babel-previous-src-block)) 354 (add-to-list 'embark-repeat-actions motion)) 355 356 (add-to-list 'embark-keymap-alist '(org-src-block . embark-org-src-block-map)) 357 358 ;;; List items 359 360 (defvar-keymap embark-org-item-map 361 :doc "Keymap for actions on Org list items." 362 :parent embark-general-map 363 "RET" #'org-toggle-checkbox 364 "c" #'org-toggle-checkbox 365 "t" #'org-toggle-item 366 "n" #'org-next-item 367 "p" #'org-previous-item 368 "<left>" #'org-outdent-item 369 "<right>" #'org-indent-item 370 "<up>" #'org-move-item-up 371 "<down>" #'org-move-item-down 372 ">" #'org-indent-item-tree 373 "<" #'org-outdent-item-tree) 374 375 (dolist (cmd '(org-toggle-checkbox 376 org-toggle-item 377 org-next-item 378 org-previous-item 379 org-outdent-item 380 org-indent-item 381 org-move-item-up 382 org-move-item-down 383 org-indent-item-tree 384 org-outdent-item-tree)) 385 (add-to-list 'embark-repeat-actions cmd)) 386 387 (add-to-list 'embark-keymap-alist '(org-item . embark-org-item-map)) 388 389 ;;; Org plain lists 390 391 (defvar-keymap embark-org-plain-list-map 392 :doc "Keymap for actions on plain Org lists." 393 :parent embark-general-map 394 "RET" #'org-list-repair 395 "r" #'org-list-repair 396 "s" #'org-sort-list 397 "b" #'org-cycle-list-bullet 398 "t" #'org-list-make-subtree 399 "c" #'org-toggle-checkbox) 400 401 (add-to-list 'embark-repeat-actions 'org-cycle-list-bullet) 402 403 (add-to-list 'embark-keymap-alist '(org-plain-list . embark-org-plain-list-map)) 404 405 (cl-defun embark-org--toggle-checkboxes 406 (&rest rest &key run type &allow-other-keys) 407 "Around action hook for `org-toggle-checkbox'. 408 See `embark-around-action-hooks' for the keyword arguments RUN and TYPE. 409 REST are the remaining arguments." 410 (apply (if (eq type 'org-plain-list) #'embark--mark-target run) 411 :type type 412 rest)) 413 414 (cl-pushnew #'embark-org--toggle-checkboxes 415 (alist-get 'org-toggle-checkbox embark-around-action-hooks)) 416 417 ;;; "Encode" region using Org export in place 418 419 (defvar-keymap embark-org-export-in-place-map 420 :doc "Keymap for actions which replace the region by an exported version." 421 :parent embark-general-map 422 "m" #'org-md-convert-region-to-md 423 "h" #'org-html-convert-region-to-html 424 "a" #'org-ascii-convert-region-to-ascii 425 "l" #'org-latex-convert-region-to-latex) 426 427 (fset 'embark-org-export-in-place-map embark-org-export-in-place-map) 428 429 (keymap-set embark-encode-map "o" 'embark-org-export-in-place-map) 430 431 (provide 'embark-org) 432 ;;; embark-org.el ends here