Snoooopy/dtos-dotfiles
1
0
Fork 0
mirror of https://gitlab.com/dwt1/dotfiles.git synced 2026-04-24 12:00:24 +10:00
Code Issues Packages Projects Releases Wiki Activity

Minor updates.

Browse Source
This commit is contained in:
Derek Taylor
2020-08-11 17:27:59 -05:00
parent c00618a23a
commit 367af05623
154 changed files with 2484 additions and 1801 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
.emacs.d/modules/lang/org/autoload/org-link.el
View File

@@ -74,8 +74,9 @@ exist, and `org-link' otherwise."
;;;###autoload
(defun +org-http-image-data-fn (protocol link _description)
"Interpret LINK as an URL to an image file."
(when (image-type-from-file-name link)
(if-let* ((buf (url-retrieve-synchronously (concat protocol ":" link))))
(when (and (image-type-from-file-name link)
(not (eq org-display-remote-inline-images 'skip)))
(if-let (buf (url-retrieve-synchronously (concat protocol ":" link)))
(with-current-buffer buf
(goto-char (point-min))
(re-search-forward "\r?\n\r?\n" nil t)

280
.emacs.d/modules/lang/org/autoload/org.el
View File

@@ -3,82 +3,82 @@
;;
;;; Helpers
(defun +org--refresh-inline-images-in-subtree ()
"Refresh image previews in the current heading/tree."
(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))))))
(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
(save-excursion
(when (bolp)
(back-to-indentation)
(forward-char))
(org-element-lineage
(org-element-context)
'(table table-row headline inlinetask item plain-list)
t)))
(type (org-element-type context)))
(cond ((memq type '(item plain-list))
(let ((marker (org-element-property :bullet context))
(pad (save-excursion
(org-beginning-of-item)
(back-to-indentation)
(- (point) (line-beginning-position)))))
(save-match-data
(pcase direction
(`below
(org-end-of-item)
(backward-char)
(end-of-line)
(if (and marker (string-match "\\([0-9]+\\)\\([).] *\\)" marker))
(let ((l (line-number-at-pos)))
(org-insert-item)
(when (= l (line-number-at-pos))
(org-next-item)
(org-end-of-line)))
(insert "\n" (make-string pad 32) (or marker ""))))
(`above
(org-beginning-of-item)
(if (and marker (string-match-p "[0-9]+[).]" marker))
(org-insert-item)
(insert (make-string pad 32) (or marker ""))
(save-excursion (insert "\n")))))))
(when (org-element-property :checkbox context)
(insert "[ ] ")))
(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)))
((memq type '(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))))
;; 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))))
((let ((level (or (org-current-level) 1)))
(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)
(car (+org-get-todo-keywords-for todo-keyword)))
(todo-keyword)
('todo)))))))
;; 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))
@@ -147,7 +147,8 @@ current file). Only scans first 2048 bytes of the document."
If on a:
- checkbox list item or todo heading: toggle it.
- clock: update its time.
- headline: toggle latex fragments and inline images underneath.
- 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
@@ -167,7 +168,8 @@ If on a:
type (org-element-type context)))
(pcase type
(`headline
(cond ((memq (bound-and-true-p org-goto-map) (current-active-maps))
(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)))
@@ -181,11 +183,32 @@ If on a:
(if (eq (org-element-property :todo-type context) 'done)
(or (car (+org-get-todo-keywords-for (org-element-property :todo-keyword context)))
'todo)
'done)))
(t
(+org--refresh-inline-images-in-subtree)
(org-clear-latex-preview)
(org-latex-preview '(4)))))
'done))))
;; Update any metadata or inline previews in this subtree
(org-update-checkbox-count)
(let (org-hierarchical-todo-statistics)
(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))
@@ -230,7 +253,9 @@ If on a:
(path (org-element-property :path lineage)))
(if (or (equal (org-element-property :type lineage) "img")
(and path (image-type-from-file-name path)))
(+org--refresh-inline-images-in-subtree)
(+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)))
@@ -242,12 +267,23 @@ If on a:
(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--refresh-inline-images-in-subtree))))))
(+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 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).
;; 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."
@@ -262,37 +298,24 @@ If on a:
;;;###autoload
(defun +org/dedent ()
"TODO"
(interactive)
(cond ((org-at-item-p)
(org-list-indent-item-generic
-1 nil
(save-excursion
(when (org-region-active-p)
(goto-char (region-beginning)))
(org-list-struct))))
((org-at-heading-p)
(ignore-errors (org-promote)))
((call-interactively #'self-insert-command))))
(defun +org/toggle-last-clock (arg)
"Toggles last clocked item.
;;;###autoload
(defun +org/toggle-clock (arg)
"Toggles clock on the last clocked item.
Clock out if an active clock is running (or cancel it if prefix ARG is non-nil).
Clock out if an active clock is running. Clock in otherwise.
If in an org file, clock in on the item at point. Otherwise clock into the last
task you clocked into.
See `org-clock-out', `org-clock-in' and `org-clock-in-last' for details on how
the prefix ARG changes this command's behavior."
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")
(if (org-clocking-p)
(if arg
(org-clock-cancel)
(org-clock-out))
(org-clock-in-last arg)))
(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
@@ -390,15 +413,15 @@ Made for `org-tab-first-hook' in evil-mode."
;;;###autoload
(defun +org-update-cookies-h ()
"Update counts in headlines (aka \"cookies\")."
"Update statistics cookies/todo statistics in headlines."
(when (and buffer-file-name (file-exists-p buffer-file-name))
(let (org-hierarchical-todo-statistics)
(org-update-parent-todo-statistics))))
;;;###autoload
(defun +org-yas-expand-maybe-h ()
"Tries to expand a yasnippet snippet, if one is available. Made for
`org-tab-first-hook'."
"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))
@@ -422,8 +445,14 @@ Made for `org-tab-first-hook' in evil-mode."
;;;###autoload
(defun +org-cycle-only-current-subtree-h (&optional arg)
"Toggle the local fold at the point (as opposed to cycling through all levels
with `org-cycle')."
"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
@@ -439,19 +468,14 @@ with `org-cycle')."
(org-cycle-internal-local)
t)))))
;;;###autoload
(defun +org-clear-babel-results-h ()
"Remove the results block for the org babel block at point."
(when (and (org-in-src-block-p t)
(org-babel-where-is-src-block-result))
(org-babel-remove-result)
t))
;;;###autoload
(defun +org-make-last-point-visible-h ()
"Unfold subtree around point if saveplace places it to a folded region."
(and (not org-agenda-inhibit-startup)
(outline-invisible-p)
"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)