doomemacs/modules/lang/org/autoload/org.el

215 lines
7.3 KiB
EmacsLisp
Raw Normal View History

;;; lang/org/autoload/org.el
2017-02-19 19:01:47 -05:00
;;;###autoload
(defun +org/indent ()
"Indent the current item (header or item). Otherwise, forward to
`self-insert-command'."
(interactive)
(cond ((org-at-item-p)
(org-indent-item-tree))
((org-at-heading-p)
(ignore-errors (org-demote)))
((org-in-src-block-p t)
(doom/dumb-indent))
2017-05-19 03:29:00 +02:00
(t
(call-interactively #'self-insert-command))))
2017-02-19 19:01:47 -05:00
;;;###autoload
(defun +org/indent-or-next-field-or-yas-expand ()
"Depending on the context either a) indent the current line, b) go the next
table field or c) run `yas-expand'."
2017-02-19 19:01:47 -05:00
(interactive)
(call-interactively
(cond ((and (bound-and-true-p yas-minor-mode)
(yas--templates-for-key-at-point))
2017-05-19 03:29:00 +02:00
#'yas-expand)
((org-at-table-p)
2017-05-19 03:29:00 +02:00
#'org-table-next-field)
(t
2017-05-19 03:29:00 +02:00
#'+org/indent))))
2017-02-19 19:01:47 -05:00
;;;###autoload
(defun +org/dedent ()
"Dedent the current item (header or item). Otherwise, forward to
`self-insert-command'."
(interactive)
(cond ((org-at-item-p)
2017-05-19 03:29:00 +02:00
(org-list-indent-item-generic
-1 nil
(save-excursion
(when (org-region-active-p)
(goto-char (region-beginning)))
(org-list-struct))))
2017-02-19 19:01:47 -05:00
((org-at-heading-p)
(ignore-errors (org-promote)))
2017-05-19 03:29:00 +02:00
(t
(call-interactively #'self-insert-command))))
2017-02-19 19:01:47 -05:00
;;;###autoload
(defun +org/dedent-or-prev-field ()
"Depending on the context either dedent the current item or go the previous
table field."
(interactive)
2017-05-19 03:29:00 +02:00
(call-interactively
(if (org-at-table-p)
#'org-table-previous-field
#'+org/dedent)))
2017-02-19 19:01:47 -05:00
;;;###autoload
(defun +org/insert-item (direction)
"Inserts a new heading, table cell or item, depending on the context.
DIRECTION can be 'above or 'below.
I use this instead of `org-insert-item' or `org-insert-heading' which are too
opinionated and perform this simple task incorrectly (e.g. whitespace in the
wrong places)."
(interactive)
2017-03-08 14:39:55 -05:00
(let* ((context (org-element-lineage
(org-element-context)
'(table table-row headline inlinetask item plain-list)
t))
2017-02-19 19:01:47 -05:00
(type (org-element-type context)))
2017-03-08 14:39:55 -05:00
(cond ((eq type 'item)
2017-02-19 19:01:47 -05:00
(let ((marker (org-element-property :bullet context)))
(pcase direction
2017-02-19 19:01:47 -05:00
('below
(goto-char (line-end-position))
(insert (concat "\n" marker)))
('above
(goto-char (line-beginning-position))
(insert marker)
(save-excursion (insert "\n")))))
(when (org-element-property :checkbox context)
(insert "[ ] ")))
2017-05-19 03:29:00 +02:00
2017-02-19 19:01:47 -05:00
((memq type '(table table-row))
(cl-case direction
('below (org-table-insert-row t))
('above (+org/table-prepend-row-or-shift-up))))
2017-05-19 03:29:00 +02:00
((memq type '(headline inlinetask plain-list))
(let* ((subcontext (org-element-context))
(level (save-excursion
(org-back-to-heading)
(org-element-property
:level
(if (eq (org-element-type subcontext) 'headline)
subcontext
1)))))
2017-02-19 19:01:47 -05:00
(cl-case direction
('below
(let ((at-eol (= (point) (1- (line-end-position)))))
(goto-char (line-end-position))
(org-end-of-subtree)
(insert (concat "\n"
(when (= level 1)
(if at-eol
(ignore (cl-incf level))
"\n"))
(make-string level ?*)
" "))))
('above
(org-back-to-heading)
(org-insert-heading)
(when (= level 1)
(save-excursion (evil-open-above 1))
(save-excursion (insert "\n")))))
(when (org-element-property :todo-type context)
(org-todo 'todo))))
2017-02-19 19:01:47 -05:00
(t (user-error "Not a valid list, heading or table")))
(when (bound-and-true-p evil-mode)
(evil-append-line 1))))
2017-02-19 19:01:47 -05:00
;;;###autoload
(defun +org/toggle-fold ()
"Toggle the local fold at the point (as opposed to cycling through all levels
with `org-cycle'). Also removes babel result blocks, if run from a code block."
2017-02-19 19:01:47 -05:00
(interactive)
(save-excursion
(org-beginning-of-line)
(cond ((org-in-src-block-p)
(org-babel-remove-result))
((org-at-heading-p)
(outline-toggle-children))
((org-at-item-p)
(let ((window-beg (window-start)))
(org-cycle)
(set-window-start nil window-beg))))))
2017-02-19 19:01:47 -05:00
;;;###autoload
(defun +org/toggle-checkbox ()
"Toggle the presence of a checkbox in the current item."
(interactive)
(org-toggle-checkbox '(4)))
2017-02-19 19:01:47 -05:00
;;;###autoload
(defun +org/dwim-at-point ()
"Do-what-I-mean at point. This includes following timestamp links, aligning
tables, toggling checkboxes/todos, executing babel blocks, previewing latex
fragments, opening links, or refreshing images."
(interactive)
(let* ((scroll-pt (window-start))
(context (org-element-context))
(type (org-element-type context))
(value (org-element-property :value context)))
(cond
((memq type '(planning timestamp))
(org-follow-timestamp-link))
((memq type '(table table-row))
(if (org-element-property :tblfm (org-element-property :parent context))
(org-table-recalculate t)
(org-table-align)))
2017-03-08 14:39:55 -05:00
((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)))))
2017-02-19 19:01:47 -05:00
((and (eq type 'headline)
2017-02-19 19:01:47 -05:00
(org-element-property :todo-type context))
(org-todo
(if (eq (org-element-property :todo-type context) 'done) 'todo 'done)))
((and (eq type 'headline)
2017-02-19 19:01:47 -05:00
(string= "ARCHIVE" (car-safe (org-get-tags))))
(org-force-cycle-archived))
((eq type 'headline)
2017-02-19 19:01:47 -05:00
(org-remove-latex-fragment-image-overlays)
2017-04-17 02:19:20 -04:00
(org-toggle-latex-fragment '(4)))
2017-02-19 19:01:47 -05:00
((eq type 'babel-call)
2017-02-19 19:01:47 -05:00
(org-babel-lob-execute-maybe))
((memq type '(src-block inline-src-block))
(org-babel-execute-src-block))
((memq type '(latex-fragment latex-environment))
2017-04-17 02:19:20 -04:00
(org-toggle-latex-fragment))
2017-02-19 19:01:47 -05:00
((eq type 'link)
2017-03-08 14:39:55 -05:00
(let ((path (org-element-property :path (org-element-lineage context '(link) t))))
2017-02-19 19:01:47 -05:00
(if (and path (image-type-from-file-name path))
(+org/refresh-inline-images)
(org-open-at-point))))
(t (+org/refresh-inline-images)))
(set-window-start nil scroll-pt)))
;;;###autoload
(defun +org/refresh-inline-images ()
"Refresh image previews in the current heading/tree."
(interactive)
(if (> (length org-inline-image-overlays) 0)
(org-remove-inline-images)
(org-display-inline-images
t t
(if (org-before-first-heading-p)
(line-beginning-position)
(save-excursion (org-back-to-heading) (point)))
(if (org-before-first-heading-p)
(line-end-position)
(save-excursion (org-end-of-subtree) (point))))))