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

Moving to Doom Emacs!

Browse Source
This commit is contained in:
Derek Taylor
2019-12-16 20:21:19 -06:00
parent d9f2f456f1
commit d4b4c33550
683 changed files with 51877 additions and 100 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
.emacs.d/modules/lang/org/autoload/contrib-dragndrop.el Normal file
View File

@@ -0,0 +1,12 @@
;;; lang/org/autoload/contrib-dragndrop.el -*- lexical-binding: t; -*-
;;;###if (featurep! +dragndrop)
;;;###autoload
(defun +org-dragndrop-download-dnd-fn (uri action)
"Handle file links and base64 data uris."
(if (eq major-mode 'org-mode)
(+org-attach/uri uri)
(let ((dnd-protocol-alist
(rassq-delete-all '+org-attach-download-dnd
(copy-alist dnd-protocol-alist))))
(dnd-handle-one-url nil action uri))))

152
.emacs.d/modules/lang/org/autoload/contrib-ipython.el Normal file
View File

@@ -0,0 +1,152 @@
;;; lang/org/autoload/contrib-ipython.el -*- lexical-binding: t; -*-
;;;###if (featurep! +ipython)
;;;###autoload
(defun +org-ob-ipython-initiate-session-a (&optional session params)
"Create a session named SESSION according to PARAMS."
(if (string= session "none")
(error
"ob-ipython currently only supports evaluation using a session.
Make sure your src block has a :session param.")
(when (not (string-suffix-p ".json" session t))
(ob-ipython--create-kernel
(ob-ipython--normalize-session
session)
(cdr (assoc :kernel params))))
(ob-ipython--create-repl
(ob-ipython--normalize-session
session)
params)))
(defun +org--ob-ipython-generate-local-path-from-remote (session host params)
"Given a remote SESSION with PARAMS and corresponding HOST, copy remote config to local, start a jupyter console to generate a new one."
(let* ((runtime-dir
(cdr
(doom-call-process "ssh " host "jupyter" "--runtime-dir")))
(runtime-file (concat runtime-dir "/" "kernel-" session ".json"))
(tramp-path (concat "/ssh:" host ":" runtime-file))
(tramp-copy (concat (or +ob-ipython-local-runtime-dir
(cdr (doom-call-process "jupyter" "--runtime-dir")))
"/remote-" host "-kernel-" session ".json"))
(local-path
(concat
"Python:ob-ipython-"
(file-name-sans-extension (file-name-nondirectory tramp-copy))
"-ssh.json")))
;; scp remote file to local
(copy-file tramp-path tramp-copy t)
;; connect to remote use new config
(let* ((python-shell-interpreter-interactive-arg " console --simple-prompt")
(python-shell-prompt-detect-enabled nil)
(python-shell-completion-native-enable nil)
(buf (python-shell-make-comint
(concat ob-ipython-command
" console --simple-prompt --existing "
tramp-copy " --ssh " host)
(concat "" local-path)
t))
(proc (get-buffer-process buf))
(dir (cdr (assoc :pydir params))))
(sleep-for 3)
(when dir
(with-current-buffer buf
(setq-local default-directory dir)))
(format "*%s*" proc))))
;;;###autoload
(defun +org-ob-ipython-create-repl-a (name &optional params)
"Create repl based on NAME and PARAMS.
If PARAMS specifies remote kernel, copy the kernel config from remote server and
create a repl connecting to remote session."
(let ((cmd (string-join (ob-ipython--kernel-repl-cmd name) " ")))
(cond ((string= "default" name)
(run-python cmd nil nil)
(format "*%s*" python-shell-buffer-name))
((string-match "^remote-.*ssh.json" name)
(when (not (ignore-errors
(process-live-p
(get-process
(format
"Python:ob-ipython-%s"
name)))))
(let* ((remote (s-split "-" name))
(remote-host (nth 1 remote))
(remote-session (nth 3 remote)))
(+org--ob-ipython-generate-local-path-from-remote
remote-session
remote-host
params))))
((let* ((process-name (format "Python:ob-ipython-%s" name))
(python-shell-prompt-detect-enabled nil)
(python-shell-completion-native-enable nil)
(buf (python-shell-make-comint cmd process-name t))
(dir (cdr (assoc :pydir params))))
(if dir
(with-current-buffer buf
(setq-local default-directory dir)))
(sleep-for 1)
(format "*%s*" process-name))))))
;;;###autoload
(defun +org-babel-execute:ipython-a (body params)
"Execute a BODY of IPython code with PARAMS in org-babel.
This function is called by `org-babel-execute-src-block'."
(message default-directory)
(org-babel-ipython-initiate-session (cdr (assoc :session params))
params))
;;
;; * org-src-edit
;;;###autoload
(defun +org-babel-edit-prep:ipython-a (info)
(let* ((params (nth 2 info))
(session (cdr (assoc :session params))))
(org-babel-ipython-initiate-session session params))
;; Support for python.el's "send-code" commands within edit buffers.
(setq-local python-shell-buffer-name
(format "Python:ob-ipython-%s"
(ob-ipython--normalize-session
(cdr (assoc :session (nth 2 info))))))
(setq-local default-directory
(format "%s"
(ob-ipython--normalize-session
(cdr (assoc :pydir (nth 2 info))))))
(ob-ipython-mode 1)
;; hack on company mode to use company-capf rather than company-anaconda
(when (featurep! :completion company)
(setq-local company-backends
'(company-capf
company-dabbrev
company-files
company-yasnippet))
(setq-local company-idle-delay nil))
(when (featurep 'lpy)
(setq lispy-python-proc
(format "Python:ob-ipython-%s"
(ob-ipython--normalize-session
(cdr (assoc :session (nth 2 info)))))
lispy--python-middleware-loaded-p nil)
(lispy--python-middleware-load)))
;;
;; * retina
(defun +org--ob-ipython-mac-2x-image-file-name (filename &optional scale)
"Return the name of high-resolution image file for FILENAME.
The optional arg SCALE is scale factor, and defaults to 2."
(let ((pos (or (string-match "\\.[^./]*\\'" filename) (length filename))))
(format "%s@%dx%s"
(substring filename 0 pos)
(or scale 2)
(substring filename pos))))
;;;###autoload
(defun +org-ob-ipython-write-base64-string-a (oldfunc &rest args)
(let ((file (car args))
(b64-string (cdr args)))
(let ((file2x (+org--ob-ipython-mac-2x-image-file-name file)))
(apply oldfunc file2x b64-string)
(shell-command (concat "convert " file2x " -resize 50% " file)))))

97
.emacs.d/modules/lang/org/autoload/contrib-present.el Normal file
View File

@@ -0,0 +1,97 @@
;;; lang/org/autoload/contrib-present.el -*- lexical-binding: t; -*-
;;;###if (featurep! +present)
;;
;;; Helpers
(defun +org-present--cleanup-org-tree-slides-mode ()
(unless (cl-loop for buf in (doom-buffers-in-mode 'org-mode)
if (buffer-local-value 'org-tree-slide-mode buf)
return t)
(org-tree-slide-mode -1)
(remove-hook 'kill-buffer-hook #'+org-present--cleanup-org-tree-slides-mode)))
(defun +org-present--make-invisible (beg end)
(let ((overlay (make-overlay beg end)))
(push overlay +org-present--overlays)
(overlay-put overlay 'invisible '+org-present)))
;;
;;; Hooks
;;;###autoload
(defun +org-present-add-overlays-h ()
"TODO"
(add-to-invisibility-spec '(+org-present))
(save-excursion
;; hide org-mode options starting with #+
(goto-char (point-min))
(while (re-search-forward "^[[:space:]]*\\(#\\+\\)\\(\\(?:BEGIN\\|END\\|ATTR\\)[^[:space:]]+\\).*" nil t)
(+org-present--make-invisible
(match-beginning 1)
(match-end 0)))
;; hide stars in headings
(goto-char (point-min))
(while (re-search-forward "^\\(\\*+\\s-\\)" nil t)
(+org-present--make-invisible (match-beginning 1) (match-end 1)))))
;;;###autoload
(defun +org-present-remove-overlays-h ()
"TODO"
(mapc #'delete-overlay +org-present--overlays)
(remove-from-invisibility-spec '(+org-present)))
;;;###autoload
(defun +org-present-detect-slide-h ()
"TODO"
(outline-show-all)
(if (member "title" (org-get-tags))
(text-scale-set 10)
(text-scale-set +org-present-text-scale)))
(defvar cwm-use-vertical-padding)
(defvar cwm-frame-internal-border)
(defvar cwm-left-fringe-ratio)
(defvar cwm-centered-window-width)
;;;###autoload
(defun +org-present-init-org-tree-window-h ()
"TODO"
"Set up the org window for presentation."
(doom/window-maximize-buffer)
(let ((arg (if org-tree-slide-mode +1 -1)))
(when (fboundp 'centered-window-mode)
(let ((cwm-use-vertical-padding t)
(cwm-frame-internal-border 110)
(cwm-left-fringe-ratio -10)
(cwm-centered-window-width 240))
(centered-window-mode arg)))
(window-divider-mode (* arg -1))
(hide-mode-line-mode arg)
(+org-pretty-mode arg)
(cond (org-tree-slide-mode
(org-indent-mode -1)
(text-scale-set +org-present-text-scale)
(ignore-errors (org-latex-preview '(4)))
(set-face-attribute 'org-level-2 nil :height 1.4))
(t
(org-indent-mode +1)
(text-scale-set 0)
(org-clear-latex-preview)
(set-face-attribute 'org-level-2 nil :height 1.0)
(+org-present-remove-overlays-h)
(org-remove-inline-images)))))
;;
;;; Commands
(defvar +org-present--overlays nil)
;;;###autoload
(defun +org-present/start ()
"TODO"
(interactive)
(unless (derived-mode-p 'org-mode)
(error "Not in an org buffer"))
(call-interactively #'org-tree-slide-mode)
(add-hook 'kill-buffer-hook #'+org-present--cleanup-org-tree-slides-mode))

101
.emacs.d/modules/lang/org/autoload/org-attach.el Normal file
View File

@@ -0,0 +1,101 @@
;;; lang/org/autoload/org-attach.el -*- lexical-binding: t; -*-
;;
(defvar +org-attachments nil
"A list of all indexed attachments in `org-directory'.")
(defvar +org-attachments-files nil
"A list of all attachments in `org-attach-id-dir'.")
(defun +org-list-attachments (&optional beg end)
"Return a list of all attachment file names in the current buffer between BEG
and END (defaults to `point-min' and `point-max')."
(let ((case-fold-search t)
attachments)
(or end (setq end (point-max)))
(org-save-outline-visibility nil
(org-with-wide-buffer
(goto-char (or beg (point-min)))
(while (search-forward "[[attach:" end t)
(let* ((context (save-match-data (org-element-context)))
(link (expand-file-name (org-link-unescape (org-element-property :path context))
org-attach-id-dir)))
(when (and (equal "file" (org-element-property :type context))
(file-in-directory-p link org-attach-id-dir))
(push (file-name-nondirectory link) attachments))))))
(cl-delete-duplicates attachments :test #'string=)))
;;;###autoload
(defun +org-attach-icon-for (path)
(char-to-string
(pcase (downcase (file-name-extension path))
((or "jpg" "jpeg" "png" "gif") ?)
("pdf" ?)
((or "ppt" "pptx") ?)
((or "xls" "xlsx") ?)
((or "doc" "docx") ?)
((or "ogg" "mp3" "wav" "aiff" "flac") ?)
((or "mp4" "mov" "avi") ?)
((or "zip" "gz" "tar" "7z" "rar") ?)
(_ ?))))
;;;###autoload
(defun +org-attach/sync (arg)
"Reindex all attachments in `org-directory' and delete orphaned attachments in
`org-attach-id-dir'. If ARG (universal arg), conduct a dry run."
(declare (interactive-only t))
(interactive "P")
(message "Reloading")
(setq +org-attachments-files (directory-files org-attach-id-dir nil "^[^.]" t))
(with-temp-buffer
(delay-mode-hooks (org-mode))
(dolist (org-file (directory-files-recursively org-directory "\\.org$"))
(insert-file-contents-literally org-file))
(setq +org-attachments (+org-list-attachments)))
;; clean up
(let ((deleted 0))
(dolist (file (cl-set-difference +org-attachments-files +org-attachments
:test #'string=))
(message "Deleting orphaned attachment: %s" file)
(cl-incf deleted)
(unless arg
(delete-file (expand-file-name file org-attach-id-dir))))
(message "Buffer's attachments synced (%d deleted)" deleted)))
;;;###autoload
(defun +org-attach/find-file ()
"Open a file from `org-attach-id-dir'."
(interactive)
(doom-project-browse org-attach-id-dir))
;;;###autoload
(defun +org-attach/file (path)
"Copies the file at PATH to `+org-attach-dir' and places an org link to it at
the cursor."
(interactive "fAttach file: ")
(+org-attach/uri path))
;;;###autoload
(defun +org-attach/uri (uri)
"Downloads the file at URL and place an org link to it at the cursor."
(interactive "sUri/file: ")
(unless (eq major-mode 'org-mode)
(user-error "Not in an org buffer"))
(require 'org-download)
(let ((raw-uri (url-unhex-string uri)))
(condition-case ex
(cond ((string-match-p "^data:image/png;base64," uri)
(org-download-dnd-base64 uri nil))
((image-type-from-file-name raw-uri)
(org-download-image raw-uri))
(t
(let ((new-path (expand-file-name (org-download--fullname raw-uri))))
;; Download the file
(if (string-match-p (concat "^" (regexp-opt '("http" "https" "nfs" "ftp" "file")) ":/") uri)
(url-copy-file raw-uri new-path)
(copy-file uri new-path))
;; insert the link
(org-download-insert-link raw-uri new-path))))
(error
(user-error "Failed to attach file: %s" (error-message-string ex))))))

19
.emacs.d/modules/lang/org/autoload/org-avy.el Normal file
View File

@@ -0,0 +1,19 @@
;;; lang/org/autoload/org-avy.el -*- lexical-binding: t; -*-
;;;###autoload
(defun +org-headline-avy ()
"TODO"
(save-excursion
(when-let* ((org-reverse-note-order t)
(pos (avy-with avy-goto-line (avy-jump (rx bol (1+ "*") (1+ blank))))))
(when (integerp (car pos))
;; If avy is aborted with "C-g", it returns `t', so we know it was NOT
;; aborted when it returns an int. If it doesn't return an int, we
;; return nil.
(copy-marker (car pos))))))
;;;###autoload
(defun +org/goto-visible ()
"TODO"
(interactive)
(goto-char (+org-headline-avy)))

163
.emacs.d/modules/lang/org/autoload/org-capture.el Normal file
View File

@@ -0,0 +1,163 @@
;;; lang/org/autoload/org-capture.el -*- lexical-binding: t; -*-
(defvar org-capture-initial)
;;
;;; External frame
;;;###autoload
(defvar +org-capture-frame-parameters
`((name . "org-capture")
(width . 70)
(height . 25)
(transient . t)
,(if IS-LINUX '(display . ":0")))
"TODO")
;;;###autoload
(defun +org-capture-cleanup-frame-h ()
"Closes the org-capture frame once done adding an entry."
(when (+org-capture-frame-p)
(delete-frame nil t)))
;;;###autoload
(defun +org-capture-frame-p (&rest _)
"Return t if the current frame is an org-capture frame opened by
`+org-capture/open-frame'."
(and (equal "org-capture" (frame-parameter nil 'name))
(frame-parameter nil 'transient)))
;;;###autoload
(defun +org-capture/open-frame (&optional initial-input key)
"Opens the org-capture window in a floating frame that cleans itself up once
you're done. This can be called from an external shell script."
(interactive)
(when (and initial-input (string-empty-p initial-input))
(setq initial-input nil))
(when (and key (string-empty-p key))
(setq key nil))
(let* ((frame-title-format "")
(frame (if (+org-capture-frame-p)
(selected-frame)
(make-frame +org-capture-frame-parameters))))
(select-frame-set-input-focus frame) ; fix MacOS not focusing new frames
(with-selected-frame frame
(require 'org-capture)
(condition-case ex
(cl-letf (((symbol-function #'pop-to-buffer)
(symbol-function #'switch-to-buffer)))
(switch-to-buffer (doom-fallback-buffer))
(let ((org-capture-initial initial-input)
org-capture-entry)
(when (and key (not (string-empty-p key)))
(setq org-capture-entry (org-capture-select-template key)))
(if (or org-capture-entry
(not (fboundp 'counsel-org-capture)))
(org-capture)
(unwind-protect
(counsel-org-capture)
(if-let (buf (cl-find-if (doom-partial #'buffer-local-value 'org-capture-mode)
(buffer-list)))
(with-current-buffer buf
(add-hook 'kill-buffer-hook #'+org-capture-cleanup-frame-h nil t))
(delete-frame frame))))))
('error
(message "org-capture: %s" (error-message-string ex))
(delete-frame frame))))))
;;;###autoload
(defun +org-capture-available-keys ()
"TODO"
(string-join (mapcar #'car org-capture-templates) ""))
;;
;;; Capture targets
;;;###autoload
(defun +org-capture-todo-file ()
"Expand `+org-capture-todo-file' from `org-directory'.
If it is an absolute path return `+org-capture-todo-file' verbatim."
(expand-file-name +org-capture-todo-file org-directory))
;;;###autoload
(defun +org-capture-notes-file ()
"Expand `+org-capture-notes-file' from `org-directory'.
If it is an absolute path return `+org-capture-todo-file' verbatim."
(expand-file-name +org-capture-notes-file org-directory))
(defun +org--capture-local-root (path)
(let ((filename (file-name-nondirectory path)))
(expand-file-name
filename
(or (locate-dominating-file (file-truename default-directory)
filename)
(doom-project-root)
(user-error "Couldn't detect a project")))))
;;;###autoload
(defun +org-capture-project-todo-file ()
"Find the nearest `+org-capture-todo-file' in a parent directory, otherwise,
opens a blank one at the project root. Throws an error if not in a project."
(+org--capture-local-root +org-capture-todo-file))
;;;###autoload
(defun +org-capture-project-notes-file ()
"Find the nearest `+org-capture-notes-file' in a parent directory, otherwise,
opens a blank one at the project root. Throws an error if not in a project."
(+org--capture-local-root +org-capture-notes-file))
;;;###autoload
(defun +org-capture-project-changelog-file ()
"Find the nearest `+org-capture-changelog-file' in a parent directory,
otherwise, opens a blank one at the project root. Throws an error if not in a
project."
(+org--capture-local-root +org-capture-changelog-file))
(defun +org--capture-ensure-heading (headings &optional initial-level)
(if (not headings)
(widen)
(let ((initial-level (or initial-level 1)))
(if (and (re-search-forward (format org-complex-heading-regexp-format
(regexp-quote (car headings)))
nil t)
(= (org-current-level) initial-level))
(progn
(beginning-of-line)
(org-narrow-to-subtree))
(goto-char (point-max))
(unless (and (bolp) (eolp)) (insert "\n"))
(insert (make-string initial-level ?*)
" " (car headings) "\n")
(beginning-of-line 0))
(+org--capture-ensure-heading (cdr headings) (1+ initial-level)))))
(defun +org--capture-central-file (file project)
(let ((file (expand-file-name file org-directory)))
(set-buffer (org-capture-target-buffer file))
(org-capture-put-target-region-and-position)
(widen)
(goto-char (point-min))
;; Find or create the project headling
(+org--capture-ensure-heading
(append (org-capture-get :parents)
(list project (org-capture-get :heading))))))
;;;###autoload
(defun +org-capture-central-project-todo-file ()
"TODO"
(+org--capture-central-file
+org-capture-todo-file (projectile-project-name)))
;;;###autoload
(defun +org-capture-central-project-notes-file ()
"TODO"
(+org--capture-central-file
+org-capture-notes-file (projectile-project-name)))
;;;###autoload
(defun +org-capture-central-project-changelog-file ()
"TODO"
(+org--capture-central-file
+org-capture-changelog-file (projectile-project-name)))

47
.emacs.d/modules/lang/org/autoload/org-export.el Normal file
View File

@@ -0,0 +1,47 @@
;;; lang/org/autoload/org-export.el -*- lexical-binding: t; -*-
(defun +org--yank-html-buffer (buffer)
(with-current-buffer buffer
(require 'ox-clip)
(cond ((or IS-WINDOWS IS-MAC)
(shell-command-on-region
(point-min)
(point-max)
(cond (IS-WINDOWS ox-clip-w32-cmd)
(IS-MAC ox-clip-osx-cmd))))
(IS-LINUX
(let ((html (buffer-string)))
(with-temp-file (make-temp-file "ox-clip-md" nil ".html")
(insert html))
(apply #'start-process "ox-clip" "*ox-clip*"
(split-string ox-clip-linux-cmd " ")))))))
;;
;;; Commands
;;;###autoload
(defun +org/export-to-clipboard (backend)
"Exports the current buffer/selection to the clipboard.
Prompts for what BACKEND to use. See `org-export-backends' for options."
(interactive
(list (intern (completing-read "Export to: " org-export-backends))))
(let ((buffer (org-export-to-buffer backend "*Formatted Copy*" nil nil t t)))
(unwind-protect
(with-current-buffer buffer
(kill-new (buffer-string)))
(kill-buffer (current-buffer)))))
;;;###autoload
(defun +org/export-to-clipboard-as-rich-text (beg end)
"Export the current buffer to HTML then copies it to clipboard as rich text.
Supports org-mode, markdown-mode, and gfm-mode buffers. In any other mode,
htmlize is used (takes what you see in Emacs and converts it to html, text
properties and font-locking et all)."
(interactive "r")
(pcase major-mode
((or `markdown-mode `gfm-mode)
(+org--yank-html-buffer (markdown)))
(_ (ox-clip-formatted-copy beg end))))

49
.emacs.d/modules/lang/org/autoload/org-link.el Normal file
View File

@@ -0,0 +1,49 @@
;;; lang/org/autoload/org-link.el -*- lexical-binding: t; -*-
;;;###autoload
(defun +org-link-read-file (key dir)
(let ((file (read-file-name (format "%s: " (capitalize key)) dir)))
(format "%s:%s"
key
(file-relative-name file dir))))
;;;###autoload
(defun +org-link-read-directory (key dir)
(let ((file (read-directory-name (format "%s: " (capitalize key)) dir)))
(format "%s:%s"
key
(file-relative-name file dir))))
;;;###autoload
(defun +org-inline-data-image (_protocol link _description)
"Interpret LINK as base64-encoded image data."
(base64-decode-string link))
;;;###autoload
(defun +org-image-link (protocol link _description)
"Interpret LINK as base64-encoded image data."
(when (image-type-from-file-name link)
(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)
(buffer-substring-no-properties (point) (point-max)))
(message "Download of image \"%s\" failed" link)
nil)))
;;
;;; Commands
;;;###autoload
(defun +org/remove-link ()
"Unlink the text at point."
(interactive)
(unless (org-in-regexp org-link-bracket-re 1)
(user-error "No link at point"))
(save-excursion
(let ((label (if (match-end 2)
(match-string-no-properties 2)
(org-link-unescape (match-string-no-properties 1)))))
(delete-region (match-beginning 0) (match-end 0))
(insert label))))

83
.emacs.d/modules/lang/org/autoload/org-refile.el Normal file
View File

@@ -0,0 +1,83 @@
;;; lang/org/autoload/org-refile.el -*- lexical-binding: t; -*-
;; REVIEW These are all proof-of-concept. Refactor me!
;;;###autoload
(defun +org/refile-to-current-file (arg)
"TODO"
(interactive "P")
(let ((org-refile-targets `((nil :maxlevel . 10)))
(org-refile-use-outline-path nil)
(org-refile-keep arg)
current-prefix-arg)
(call-interactively #'org-refile)))
;;;###autoload
(defun +org/refile-to-other-window (arg)
"TODO"
(interactive "P")
(let ((org-refile-keep arg)
org-refile-targets
current-prefix-arg)
(dolist (win (delq (selected-window) (window-list)))
(with-selected-window win
(and (eq major-mode 'org-mode)
buffer-file-name
(cl-pushnew (cons buffer-file-name (cons :maxlevel 10))
org-refile-targets))))
(call-interactively #'org-refile)))
;;;###autoload
(defun +org/refile-to-other-buffer (arg)
"TODO"
(interactive "P")
(let ((org-refile-keep arg)
org-refile-targets
current-prefix-arg)
(dolist (buf (delq (current-buffer) (doom-buffers-in-mode 'org-mode)))
(with-current-buffer buf
(and buffer-file-name
(cl-pushnew (cons buffer-file-name (cons :maxlevel 10))
org-refile-targets))))
(call-interactively #'org-refile)))
;;;###autoload
(defun +org/refile-to-running-clock (arg)
"TODO"
(interactive "P")
(unless (bound-and-true-p org-clock-current-task)
(user-error "No active clock to refile to"))
(let ((org-refile-keep arg))
(org-refile 2)))
;;;###autoload
(defun +org/refile-to-last-location (arg)
"TODO"
(interactive "P")
(or (assoc (plist-get org-bookmark-names-plist :last-refile)
bookmark-alist)
(user-error "No saved location to refile to"))
(let ((org-refile-keep arg)
(completing-read-function
(lambda (_p _coll _pred _rm _ii _h default &rest _)
default)))
(org-refile)))
(defvar org-after-refile-insert-hook)
;; Inspired by org-teleport and alphapapa/alpha-org
;;;###autoload
(defun +org/refile-to-visible ()
"Refile current heading as first child of visible heading selected with Avy."
(interactive)
(when-let (marker (+org-headline-avy))
(let* ((buffer (marker-buffer marker))
(filename
(buffer-file-name (or (buffer-base-buffer buffer)
buffer)))
(heading
(org-with-point-at marker
(org-get-heading 'no-tags 'no-todo)))
;; Won't work with target buffers whose filename is nil
(rfloc (list heading filename nil marker))
(org-after-refile-insert-hook (cons #'org-reveal org-after-refile-insert-hook)))
(org-refile nil nil rfloc))))

97
.emacs.d/modules/lang/org/autoload/org-tables.el Normal file
View File

@@ -0,0 +1,97 @@
;;; lang/org/autoload/org-tables.el -*- lexical-binding: t; -*-
;;
;;; Row/Column traversal
;;;###autoload
(defun +org/table-previous-row ()
"Go to the previous row (same column) in the current table. Before doing so,
re-align the table if necessary. (Necessary because org-mode has a
`org-table-next-row', but not `org-table-previous-row')"
(interactive)
(org-table-maybe-eval-formula)
(org-table-maybe-recalculate-line)
(if (and org-table-automatic-realign
org-table-may-need-update)
(org-table-align))
(let ((col (org-table-current-column)))
(beginning-of-line 0)
(when (or (not (org-at-table-p)) (org-at-table-hline-p))
(beginning-of-line))
(org-table-goto-column col)
(skip-chars-backward "^|\n\r")
(when (org-looking-at-p " ")
(forward-char))))
;;
;;; Row/Column insertion
;;;###autoload
(defun +org/table-insert-column-left ()
"Insert a new column left of the current column."
(interactive)
(org-table-insert-column)
(org-table-move-column-left))
;;;###autoload
(defun +org/table-insert-row-below ()
"Insert a new row below the current row."
(interactive)
(org-table-insert-row 'below))
;;
;;; Hooks
;;;###autoload
(defun +org-realign-table-maybe-h ()
"Auto-align table under cursor and re-calculate formulas."
(when (and (org-at-table-p) org-table-may-need-update)
(let ((pt (point))
(inhibit-message t))
(org-table-recalculate)
(if org-table-may-need-update (org-table-align))
(goto-char pt))))
;;;###autoload
(defun +org-enable-auto-reformat-tables-h ()
"Realign tables & update formulas when exiting insert mode (`evil-mode').
Meant for `org-mode-hook'."
(when (featurep 'evil)
(add-hook 'evil-insert-state-exit-hook #'+org-realign-table-maybe-h nil t)
(add-hook 'evil-replace-state-exit-hook #'+org-realign-table-maybe-h nil t)
(advice-add #'evil-replace :after #'+org-realign-table-maybe-a)))
;;;###autoload
(defun +org-delete-backward-char-and-realign-table-maybe-h ()
"Ensure deleting characters with backspace doesn't deform the table cell."
(when (eq major-mode 'org-mode)
(org-check-before-invisible-edit 'delete-backward)
(save-match-data
(when (and (org-at-table-p)
(not (org-region-active-p))
(string-match-p "|" (buffer-substring (point-at-bol) (point)))
(looking-at-p ".*?|"))
(let ((pos (point))
(noalign (looking-at-p "[^|\n\r]* |"))
(c org-table-may-need-update))
(delete-char -1)
(unless overwrite-mode
(skip-chars-forward "^|")
(insert " ")
(goto-char (1- pos)))
;; noalign: if there were two spaces at the end, this field
;; does not determine the width of the column.
(when noalign (setq org-table-may-need-update c)))
t))))
;;
;;; Advice
;;;###autoload
(defun +org-realign-table-maybe-a (&rest _)
"Auto-align table under cursor and re-calculate formulas."
(when (eq major-mode 'org-mode)
(+org-realign-table-maybe-h)))

440
.emacs.d/modules/lang/org/autoload/org.el Normal file
View File

@@ -0,0 +1,440 @@
;;; lang/org/autoload/org.el -*- lexical-binding: t; -*-
;;
;;; 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--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 "[ ] ")))
((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))))
((memq type '(headline inlinetask))
(let ((level (if (eq (org-element-type context) 'headline)
(org-element-property :level context)
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))))))
((user-error "Not a valid list, heading or table")))
(when (org-invisible-p)
(org-show-hidden-entry))
(when (bound-and-true-p evil-local-mode)
(evil-insert 1))))
(defun +org--get-property (name &optional bound)
(save-excursion
(let ((re (format "^#\\+%s:[ \t]*\\([^\n]+\\)" (upcase name))))
(goto-char (point-min))
(when (re-search-forward re bound t)
(buffer-substring-no-properties (match-beginning 1) (match-end 1))))))
;;;###autoload
(defun +org-get-global-property (name &optional file bound)
"Get a document property named NAME (string) from an org FILE (defaults to
current file). Only scans first 2048 bytes of the document."
(unless bound
(setq bound 256))
(if file
(with-temp-buffer
(insert-file-contents-literally file nil 0 bound)
(+org--get-property name))
(+org--get-property name bound)))
;;;###autoload
(defun +org-get-todo-keywords-for (&optional keyword)
"Returns the list of todo keywords that KEYWORD belongs to."
(when keyword
(cl-loop for (type . keyword-spec)
in (cl-remove-if-not #'listp org-todo-keywords)
for keywords =
(mapcar (lambda (x) (if (string-match "^\\([^(]+\\)(" x)
(match-string 1 x)
x))
keyword-spec)
if (eq type 'sequence)
if (member keyword keywords)
return keywords)))
;;
;;; Modes
;;;###autoload
(define-minor-mode +org-pretty-mode
"Hides emphasis markers and toggles pretty entities."
:init-value nil
:lighter " *"
:group 'evil-org
(setq org-hide-emphasis-markers +org-pretty-mode)
(org-toggle-pretty-entities)
(with-silent-modifications
;; In case the above un-align tables
(org-table-map-tables 'org-table-align t)))
;;
;;; Commands
;;;###autoload
(defun +org/dwim-at-point ()
"Do-what-I-mean at point.
If on a:
- checkbox list item or todo heading: toggle it.
- clock: update its time.
- headline: toggle latex fragments and inline images underneath.
- 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
- table-cell: clear it and go into insert mode. If this is a formula cell,
recaluclate it instead.
- babel-call: execute the source block
- statistics-cookie: update it.
- latex fragment: toggle it.
- link: follow it
- otherwise, refresh all inline images in current tree."
(interactive)
(let* ((context (org-element-context))
(type (org-element-type context)))
;; skip over unimportant contexts
(while (and context (memq type '(verbatim code bold italic underline strike-through subscript superscript)))
(setq context (org-element-property :parent context)
type (org-element-type context)))
(pcase type
(`headline
(cond ((and (fboundp 'toc-org-insert-toc)
(member "TOC" (org-get-tags)))
(toc-org-insert-toc)
(message "Updating table of contents"))
((string= "ARCHIVE" (car-safe (org-get-tags)))
(org-force-cycle-archived))
((or (org-element-property :todo-type context)
(org-element-property :scheduled context))
(org-todo
(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)))))
(`clock (org-clock-update-time-maybe))
(`footnote-reference
(org-footnote-goto-definition (org-element-property :label context)))
(`footnote-definition
(org-footnote-goto-previous-reference (org-element-property :label context)))
((or `planning `timestamp)
(org-follow-timestamp-link))
((or `table `table-row)
(if (org-at-TBLFM-p)
(org-table-calc-current-TBLFM)
(ignore-errors
(save-excursion
(goto-char (org-element-property :contents-begin context))
(org-call-with-arg 'org-table-recalculate (or arg t))))))
(`table-cell
(org-table-blank-field)
(org-table-recalculate)
(when (and (string-empty-p (string-trim (org-table-get-field)))
(bound-and-true-p evil-local-mode))
(evil-change-state 'insert)))
(`babel-call
(org-babel-lob-execute-maybe))
(`statistics-cookie
(save-excursion (org-update-statistics-cookies nil)))
((or `src-block `inline-src-block)
(org-babel-execute-src-block))
((or `latex-fragment `latex-environment)
(org-latex-preview))
(`link
(let* ((lineage (org-element-lineage context '(link) t))
(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-open-at-point))))
((guard (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)))))
(_ (+org--refresh-inline-images-in-subtree)))))
;; 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).
;;;###autoload
(defun +org/insert-item-below (count)
"Inserts a new heading, table cell or item below the current one."
(interactive "p")
(dotimes (_ count) (+org--insert-item 'below)))
;;;###autoload
(defun +org/insert-item-above (count)
"Inserts a new heading, table cell or item above the current one."
(interactive "p")
(dotimes (_ count) (+org--insert-item 'above)))
;;;###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))))
;;;###autoload
(defun +org/toggle-clock (arg)
"Toggles clock on the last clocked item.
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."
(interactive "P")
(if (org-clocking-p)
(if arg
(org-clock-cancel)
(org-clock-out))
(org-clock-in-last arg)))
;;; Folds
;;;###autoload
(defalias #'+org/toggle-fold #'+org-cycle-only-current-subtree-h)
;;;###autoload
(defun +org/open-fold ()
"Open the current fold (not but its children)."
(interactive)
(+org/toggle-fold t))
;;;###autoload
(defalias #'+org/close-fold #'outline-hide-subtree)
(defun +org--get-foldlevel ()
(let ((max 1))
(save-restriction
(narrow-to-region (window-start) (window-end))
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(org-next-visible-heading 1)
(when (outline-invisible-p (line-end-position))
(let ((level (org-outline-level)))
(when (> level max)
(setq max level))))))
max)))
;;;###autoload
(defun +org/show-next-fold-level ()
"Decrease the fold-level of the visible area of the buffer. This unfolds
another level of headings on each invocation."
(interactive)
(let* ((current-level (+org--get-foldlevel))
(new-level (1+ current-level)))
(outline-hide-sublevels new-level)
(message "Folded to level %s" new-level)))
;;;###autoload
(defun +org/hide-next-fold-level ()
"Increase the global fold-level of the visible area of the buffer. This folds
another level of headings on each invocation."
(interactive)
(let* ((current-level (+org--get-foldlevel))
(new-level (max 1 (1- current-level))))
(outline-hide-sublevels new-level)
(message "Folded to level %s" new-level)))
;;
;;; Hooks
;;;###autoload
(defun +org-indent-maybe-h ()
"Indent the current item (header or item), if possible.
Made for `org-tab-first-hook' in evil-mode."
(interactive)
(cond ((not (and (bound-and-true-p evil-local-mode)
(evil-insert-state-p)))
nil)
((org-at-item-p)
(if (eq this-command 'org-shifttab)
(org-outdent-item-tree)
(org-indent-item-tree))
t)
((org-at-heading-p)
(ignore-errors
(if (eq this-command 'org-shifttab)
(org-promote)
(org-demote)))
t)
((org-in-src-block-p t)
(org-babel-do-in-edit-buffer
(call-interactively #'indent-for-tab-command))
t)))
;;;###autoload
(defun +org-update-cookies-h ()
"Update counts in headlines (aka \"cookies\")."
(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'."
(when (bound-and-true-p yas-minor-mode)
(cond ((and (or (not (bound-and-true-p evil-local-mode))
(evil-insert-state-p))
(yas--templates-for-key-at-point))
(call-interactively #'yas-expand)
t)
((use-region-p)
;; Triggering mode-specific indentation is expensive in src blocks
;; (if `org-src-tab-acts-natively' is non-nil), and can cause errors,
;; so we avoid smart indentation in this case.
(let ((yas-indent-line 'fixed))
(call-interactively #'yas-insert-snippet))
t))))
;;;###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')."
(interactive "P")
(unless (eq this-command 'org-shifttab)
(save-excursion
(org-beginning-of-line)
(let (invisible-p)
(when (and (org-at-heading-p)
(or org-cycle-open-archived-trees
(not (member org-archive-tag (org-get-tags))))
(or (not arg)
(setq invisible-p (outline-invisible-p (line-end-position)))))
(unless invisible-p
(setq org-cycle-subtree-status 'subtree))
(org-cycle-internal-local)
t)))))
;;;###autoload
(defun +org-unfold-to-2nd-level-or-point-h ()
"My version of the 'overview' #+STARTUP option: expand first-level headings.
Expands the first level, but no further. If point was left somewhere deeper,
unfold to point on startup."
(unless org-agenda-inhibit-startup
(when (eq org-startup-folded t)
(outline-hide-sublevels +org-initial-fold-level))
(when (outline-invisible-p)
(ignore-errors
(save-excursion
(outline-previous-visible-heading 1)
(org-show-subtree))))))
;;;###autoload
(defun +org-remove-occur-highlights-h ()
"Remove org occur highlights on ESC in normal mode."
(when org-occur-highlights
(org-remove-occur-highlights)
t))
;;;###autoload
(defun +org-enable-auto-update-cookies-h ()
"Update statistics cookies when saving or exiting insert mode (`evil-mode')."
(when (bound-and-true-p evil-local-mode)
(add-hook 'evil-insert-state-exit-hook #'+org-update-cookies-h nil t))
(add-hook 'before-save-hook #'+org-update-cookies-h nil t))