opal/opalfiles
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

yeet

Browse Source
This commit is contained in:
ry
2022-01-11 18:05:13 -08:00
parent 2046befee2
commit 8e7b654716
846 changed files with 71287 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

152
.config/emacs/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)))))

85
.config/emacs/modules/lang/org/autoload/contrib-present.el Normal file
View File

@@ -0,0 +1,85 @@
;;; 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
'local)))
;;
;;; Hooks
;;;###autoload
(defun +org-present-hide-blocks-h ()
"Hide org #+ constructs."
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^[[:space:]]*\\(#\\+\\)\\(\\(?:BEGIN\\|END\\|ATTR\\)[^[:space:]]+\\).*" nil t)
(org-flag-region (match-beginning 1)
(match-end 0)
org-tree-slide-mode
t))))
;;;###autoload
(defun +org-present-hide-leading-stars-h ()
"Hide leading stars in headings."
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^\\(\\*+\\)" nil t)
(org-flag-region (match-beginning 1)
(match-end 1)
org-tree-slide-mode
t))))
;;;###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)
(defvar +org-present--last-wconf nil)
;;;###autoload
(defun +org-present-prettify-slide-h ()
"Set up the org window for presentation."
(let ((arg (if org-tree-slide-mode +1 -1)))
(if (not org-tree-slide-mode)
(when +org-present--last-wconf
(set-window-configuration +org-present--last-wconf))
(setq +org-present--last-wconf (current-window-configuration))
(doom/window-maximize-buffer))
(when (fboundp 'centered-window-mode)
(setq-local cwm-use-vertical-padding t)
(setq-local cwm-frame-internal-border 100)
(setq-local cwm-left-fringe-ratio -10)
(setq-local cwm-centered-window-width 300)
(centered-window-mode arg))
(hide-mode-line-mode arg)
(+org-pretty-mode arg)
(cond (org-tree-slide-mode
(set-window-fringes nil 0 0)
(when (bound-and-true-p flyspell-mode)
(flyspell-mode -1))
(add-hook 'kill-buffer-hook #'+org-present--cleanup-org-tree-slides-mode
nil 'local)
(text-scale-set +org-present-text-scale)
(ignore-errors (org-latex-preview '(4))))
(t
(text-scale-set 0)
(set-window-fringes nil fringe-mode fringe-mode)
(org-clear-latex-preview)
(org-remove-inline-images)
(org-mode)))
(redraw-display)))

58
.config/emacs/modules/lang/org/autoload/contrib-roam2.el Normal file
View File

@@ -0,0 +1,58 @@
;;; lang/org/autoload/contrib-roam2.el -*- lexical-binding: t; -*-
;;;###if (featurep! +roam2)
;;; Custom node accessors
;;;###autoload (autoload 'org-roam-node-doom-filetitle "lang/org/autoload/contrib-roam2" nil t)
(cl-defmethod org-roam-node-doom-filetitle ((node org-roam-node))
"Return the value of \"#+title:\" (if any) from file that NODE resides in.
If there's no file-level title in the file, return empty string."
(or (if (= (org-roam-node-level node) 0)
(org-roam-node-title node)
(org-roam-get-keyword "TITLE" (org-roam-node-file node)))
""))
;;;###autoload (autoload 'org-roam-node-doom-hierarchy "lang/org/autoload/contrib-roam2" nil t)
(cl-defmethod org-roam-node-doom-hierarchy ((node org-roam-node))
"Return hierarchy for NODE, constructed of its file title, OLP and direct title.
If some elements are missing, they will be stripped out."
(let ((title (org-roam-node-title node))
(olp (org-roam-node-olp node))
(level (org-roam-node-level node))
(filetitle (org-roam-node-doom-filetitle node))
(separator (propertize " > " 'face 'shadow)))
(cl-case level
;; node is a top-level file
(0 filetitle)
;; node is a level 1 heading
(1 (concat (propertize filetitle 'face '(shadow italic))
separator title))
;; node is a heading with an arbitrary outline path
(t (concat (propertize filetitle 'face '(shadow italic))
separator (propertize (string-join olp " > ") 'face '(shadow italic))
separator title)))))
;;;###autoload (autoload 'org-roam-node-doom-subdirs "lang/org/autoload/contrib-roam2" nil t)
(cl-defmethod org-roam-node-doom-subdirs ((node org-roam-node))
"Return subdirectories of `org-roam-directory' in which NODE resides in.
If there's none, return an empty string."
(if-let ((dirs (thread-first node
(org-roam-node-file)
(file-relative-name org-roam-directory)
(file-name-directory))))
dirs
""))
;;;###autoload (autoload 'org-roam-node-doom-tags "lang/org/autoload/contrib-roam2" nil t)
(cl-defmethod org-roam-node-doom-tags ((node org-roam-node))
"Return tags formatted in the same way how they appear in org files.
Treat subdirectories as tags too. If there's no elements to build
the tags of, return an empty string."
(let ((tags (org-roam-node-tags node))
(subdirs (org-roam-node-doom-subdirs node)))
(when tags
(setq tags (propertize (concat (mapconcat (lambda (s) (concat ":" s)) tags nil) ":")
'face 'shadow)))
(unless (string-empty-p subdirs)
(setq subdirs (propertize (concat ":" (replace-regexp-in-string "/\\|\\\\" ":" subdirs))
'face '(shadow italic))))
(replace-regexp-in-string ":+" (propertize ":" 'face 'shadow) (concat subdirs tags))))

59
.config/emacs/modules/lang/org/autoload/org-attach.el Normal file
View File

@@ -0,0 +1,59 @@
;;; lang/org/autoload/org-attach.el -*- lexical-binding: t; -*-
;;;###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/open-gallery-from-attachments ()
"TODO"
(interactive)
(require 'org-attach)
(if-let (dir (org-attach-dir))
(pop-to-buffer
;; Rather than opening dired *and* image-dired windows, suppress them
;; both and open only the image-dired window.
(save-window-excursion
(image-dired dir)
(current-buffer)))
(user-error "No attachments for this node")))
;;;###autoload
(defun +org/find-file-in-attachments ()
"Open a file from `org-attach-id-dir'."
(interactive)
(doom-project-browse org-attach-id-dir))
;;;###autoload
(defun +org/attach-file-and-insert-link (path)
"Downloads the file at PATH and insert an org link at point.
PATH (a string) can be an url, a local file path, or a base64 encoded datauri."
(interactive "sUri/file: ")
(unless (eq major-mode 'org-mode)
(user-error "Not in an org buffer"))
(require 'org-download)
(condition-case-unless-debug e
(let ((raw-uri (url-unhex-string path)))
(cond ((string-match-p "^data:image/png;base64," path)
(org-download-dnd-base64 path nil))
((image-type-from-file-name raw-uri)
(org-download-image raw-uri))
((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")) ":/") path)
(url-copy-file raw-uri new-path)
(copy-file path new-path))
;; insert the link
(org-download-insert-link raw-uri new-path)))))
(error
(user-error "Failed to attach file: %s" (error-message-string e)))))

20
.config/emacs/modules/lang/org/autoload/org-avy.el Normal file
View File

@@ -0,0 +1,20 @@
;;; lang/org/autoload/org-avy.el -*- lexical-binding: t; -*-
;;;###autoload
(defun +org-headline-avy ()
"TODO"
(require 'avy)
(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)))

78
.config/emacs/modules/lang/org/autoload/org-babel.el Normal file
View File

@@ -0,0 +1,78 @@
;;; lang/org/autoload/org-babel.el -*- lexical-binding: t; -*-
;;;###autoload
(defun +org-eval-handler (beg end)
"TODO"
(save-excursion
(if (not (cl-loop for pos in (list beg (point) end)
if (save-excursion (goto-char pos) (org-in-src-block-p t))
return (goto-char pos)))
(message "Nothing to evaluate at point")
(let* ((element (org-element-at-point))
(block-beg (save-excursion
(goto-char (org-babel-where-is-src-block-head element))
(line-beginning-position 2)))
(block-end (save-excursion
(goto-char (org-element-property :end element))
(skip-chars-backward " \t\n")
(line-beginning-position)))
(beg (if beg (max beg block-beg) block-beg))
(end (if end (min end block-end) block-end))
(lang (or (org-eldoc-get-src-lang)
(user-error "No lang specified for this src block"))))
(cond ((and (string-prefix-p "jupyter-" lang)
(require 'jupyter nil t))
(jupyter-eval-region beg end))
((let ((major-mode (org-src-get-lang-mode lang)))
(+eval/region beg end))))))))
;;;###autoload
(defun +org-lookup-definition-handler (identifier)
"TODO"
(when (org-in-src-block-p t)
(let ((mode (org-src-get-lang-mode
(or (org-eldoc-get-src-lang)
(user-error "No lang specified for this src block")))))
(cond ((and (eq mode 'emacs-lisp-mode)
(fboundp '+emacs-lisp-lookup-definition))
(+emacs-lisp-lookup-definition identifier)
'deferred)
((user-error "Definition lookup in SRC blocks isn't supported yet"))))))
;;;###autoload
(defun +org-lookup-references-handler (identifier)
"TODO"
(when (org-in-src-block-p t)
(user-error "References lookup in SRC blocks isn't supported yet")))
;;;###autoload
(defun +org-lookup-documentation-handler (identifier)
"TODO"
(when (org-in-src-block-p t)
(let ((mode (org-src-get-lang-mode
(or (org-eldoc-get-src-lang)
(user-error "No lang specified for this src block"))))
(info (org-babel-get-src-block-info t)))
(cond ((string-prefix-p "jupyter-" (car info))
(and (require 'jupyter nil t)
(call-interactively #'jupyter-inspect-at-point)
(display-buffer (help-buffer))
'deferred))
((and (eq mode 'emacs-lisp-mode)
(fboundp '+emacs-lisp-lookup-documentation))
(+emacs-lisp-lookup-documentation identifier)
'deferred)
((user-error "Documentation lookup in SRC blocks isn't supported yet"))))))
;;
;;; Hooks
;;;###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))

161
.config/emacs/modules/lang/org/autoload/org-capture.el Normal file
View File

@@ -0,0 +1,161 @@
;;; lang/org/autoload/org-capture.el -*- lexical-binding: t; -*-
(defvar org-capture-initial)
;;
;;; External frame
(defvar +org-capture-fn #'org-capture
"Command to use to initiate org-capture.")
;;;###autoload
(defvar +org-capture-frame-parameters
`((name . "doom-capture")
(width . 70)
(height . 25)
(transient . t)
,@(when IS-LINUX
`((window-system . ,(if (boundp 'pgtk-initialized) 'pgtk 'x))
(display . ,(or (getenv "DISPLAY") ":0"))))
,(if IS-MAC '(menu-bar-lines . 1)))
"TODO")
;;;###autoload
(defun +org-capture-cleanup-frame-h ()
"Closes the org-capture frame once done adding an entry."
(when (and (+org-capture-frame-p)
(not org-capture-is-refiling))
(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 (alist-get 'name +org-capture-frame-parameters)
(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
(letf! ((#'pop-to-buffer #'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)))
(funcall +org-capture-fn)))
('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-projects-file (projectile-project-name)))
;;;###autoload
(defun +org-capture-central-project-notes-file ()
"TODO"
(+org--capture-central-file
+org-capture-projects-file (projectile-project-name)))
;;;###autoload
(defun +org-capture-central-project-changelog-file ()
"TODO"
(+org--capture-central-file
+org-capture-projects-file (projectile-project-name)))

53
.config/emacs/modules/lang/org/autoload/org-export.el Normal file
View File

@@ -0,0 +1,53 @@
;;; 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: " (progn (require 'ox) org-export-backends)))))
(require 'ox)
(let* ((org-export-show-temporary-export-buffer nil)
(buffer (org-export-to-buffer backend "*Formatted Copy*" nil nil t t)))
(unwind-protect
(with-current-buffer buffer
(kill-new (buffer-string)))
(kill-buffer 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)))
(_
;; Omit after/before-string overlay properties in htmlized regions, so we
;; don't get fringe characters for things like flycheck or git-gutter.
(letf! (defun htmlize-add-before-after-strings (_beg _end text) text)
(ox-clip-formatted-copy beg end)))))

248
.config/emacs/modules/lang/org/autoload/org-link.el Normal file
View File

@@ -0,0 +1,248 @@
;;; lang/org/autoload/org-link.el -*- lexical-binding: t; -*-
(defun +org--relative-path (path root)
(if (and buffer-file-name (file-in-directory-p buffer-file-name root))
(file-relative-name path)
path))
(defun +org--read-link-path (key dir &optional fn)
(let ((file (funcall (or fn #'read-file-name) (format "%s: " (capitalize key)) dir)))
(format "%s:%s" key (file-relative-name file dir))))
;;;###autoload
(defun +org-read-link-description-at-point (&optional default context)
"TODO"
(if (and (stringp default) (not (string-empty-p default)))
(string-trim default)
(if-let* ((context (or context (org-element-context)))
(context (org-element-lineage context '(link) t))
(beg (org-element-property :contents-begin context))
(end (org-element-property :contents-end context)))
(unless (= beg end)
(replace-regexp-in-string
"[ \n]+" " " (string-trim (buffer-substring-no-properties beg end)))))))
;;;###autoload
(defun +org-define-basic-link (key dir-var &rest plist)
"Define a link with some basic completion & fontification.
KEY is the name of the link type. DIR-VAR is the directory variable to resolve
links relative to. PLIST is passed to `org-link-set-parameters' verbatim.
Links defined with this will be rendered in the `error' face if the file doesn't
exist, and `org-link' otherwise."
(declare (indent 2))
(let ((requires (plist-get plist :requires))
(dir-fn (if (functionp dir-var)
dir-var
(lambda () (symbol-value dir-var)))))
(apply #'org-link-set-parameters
key
:complete (lambda ()
(if requires (mapc #'require (doom-enlist requires)))
(+org--relative-path (+org--read-link-path key (funcall dir-fn))
(funcall dir-fn)))
:follow (lambda (link)
(org-link-open-as-file (expand-file-name link (funcall dir-fn)) nil))
:face (lambda (link)
(let* ((path (expand-file-name link (funcall dir-fn)))
(option-index (string-match-p "::\\(.*\\)\\'" path))
(file-name (substring path 0 option-index)))
(if (file-exists-p file-name)
'org-link
'error)))
(doom-plist-delete plist :requires))))
;;
;;; Image data functions (for custom inline images)
;;;###autoload
(defun +org-image-file-data-fn (protocol link _description)
"Intepret LINK as an image file path and return its data."
(setq
link (expand-file-name
link (pcase protocol
("download"
(or (if (require 'org-download nil t) org-download-image-dir)
(if (require 'org-attach) org-attach-id-dir)
default-directory))
("attachment"
(require 'org-attach)
org-attach-id-dir)
(_ default-directory))))
(when (and (file-exists-p link)
(image-type-from-file-name link))
(with-temp-buffer
(set-buffer-multibyte nil)
(setq buffer-file-coding-system 'binary)
(insert-file-contents-literally link)
(buffer-substring-no-properties (point-min) (point-max)))))
;;;###autoload
(defun +org-inline-image-data-fn (_protocol link _description)
"Interpret LINK as base64-encoded image data."
(base64-decode-string link))
;;;###autoload
(defun +org-http-image-data-fn (protocol link _description)
"Interpret LINK as an URL to an image file."
(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)
(buffer-substring-no-properties (point) (point-max)))
(message "Download of image \"%s\" failed" link)
nil)))
(defvar +org--gif-timers nil)
;;;###autoload
(defun +org-play-gif-at-point-h ()
"Play the gif at point, while the cursor remains there (looping)."
(dolist (timer +org--gif-timers (setq +org--gif-timers nil))
(when (timerp (cdr timer))
(cancel-timer (cdr timer)))
(image-animate (car timer) nil 0))
(when-let* ((ov (cl-find-if
(lambda (it) (overlay-get it 'org-image-overlay))
(overlays-at (point))))
(dov (overlay-get ov 'display))
(pt (point)))
(when (image-animated-p dov)
(push (cons
dov (run-with-idle-timer
0.5 nil
(lambda (dov)
(when (equal
ov (cl-find-if
(lambda (it) (overlay-get it 'org-image-overlay))
(overlays-at (point))))
(message "playing gif")
(image-animate dov nil t)))
dov))
+org--gif-timers))))
;;;###autoload
(defun +org-play-all-gifs-h ()
"Continuously play all gifs in the visible buffer."
(dolist (ov (overlays-in (point-min) (point-max)))
(when-let* (((overlay-get ov 'org-image-overlay))
(dov (overlay-get ov 'display))
((image-animated-p dov))
(w (selected-window)))
(while-no-input
(run-with-idle-timer
0.3 nil
(lambda (dov)
(when (pos-visible-in-window-p (overlay-start ov) w nil)
(unless (plist-get (cdr dov) :animate-buffer)
(image-animate dov))))
dov)))))
;;
;;; 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))))
;;;###autoload
(defun +org/play-gif-at-point ()
"TODO"
(interactive)
(unless (eq 'org-mode major-mode)
(user-error "Not in org-mode"))
(or (+org-play-gif-at-point-h)
(user-error "No gif at point")))
;;
;;; Org-link parameters
;;; doom-module:
(defun +org-link--doom-module--read-link (link)
(cl-destructuring-bind (category &optional module flag)
(let ((desc (+org-read-link-description-at-point link)))
(if (string-prefix-p "+" (string-trim-left desc))
(list nil nil (intern desc))
(mapcar #'intern (split-string desc " " nil))))
(list :category category
:module module
:flag flag)))
;;;###autoload
(defun +org-link--doom-module-follow-fn (link)
(cl-destructuring-bind (&key category module flag)
(+org-link--doom-module--read-link link)
(when category
(let ((doom-modules-dirs (list doom-modules-dir)))
(if-let* ((path (doom-module-locate-path category module))
(path (or (car (doom-glob path "README.org"))
path)))
(find-file path)
(user-error "Can't find Doom module '%s'" link))))
(when flag
(goto-char (point-min))
(and (re-search-forward "^\\*+ \\(?:TODO \\)?Module Flags")
(re-search-forward (format "^\\s-*- %s :: "
(regexp-quote (symbol-name flag)))
(save-excursion (org-get-next-sibling)
(point)))
(recenter)))))
;;;###autoload
(defun +org-link--doom-module-face-fn (link)
(cl-destructuring-bind (&key category module flag)
(+org-link--doom-module--read-link link)
(if (doom-module-locate-path category module)
`(:inherit org-priority
:weight bold)
'error)))
;;; doom-package:
;;;###autoload
(defun +org-link--doom-package-follow-fn (link)
"TODO"
(doom/describe-package
(intern-soft
(+org-read-link-description-at-point link))))
;;; kbd:
(defun +org--describe-kbd (keystr)
(dolist (key `(("<leader>" . ,doom-leader-key)
("<localleader>" . ,doom-localleader-key)
("<prefix>" . ,(if (bound-and-true-p evil-mode)
(concat doom-leader-key " u")
"C-u"))
("<help>" . ,(if (bound-and-true-p evil-mode)
(concat doom-leader-key " h")
"C-h"))
("\\<M-" . "alt-")
("\\<S-" . "shift-")
("\\<s-" . "super-")
("\\<C-" . "ctrl-")))
(setq keystr
(replace-regexp-in-string (car key) (cdr key)
keystr t t)))
keystr)
;;;###autoload
(defun +org-read-kbd-at-point (&optional default context)
"TODO"
(+org--describe-kbd
(+org-read-link-description-at-point default context)))

101
.config/emacs/modules/lang/org/autoload/org-refile.el Normal file
View File

@@ -0,0 +1,101 @@
;;; 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 &optional file)
"Refile current heading to elsewhere in the current buffer.
If prefix ARG, copy instead of move."
(interactive "P")
(let ((org-refile-targets `((,file :maxlevel . 10)))
(org-refile-use-outline-path t)
(org-refile-keep arg)
current-prefix-arg)
(call-interactively #'org-refile)))
;;;###autoload
(defun +org/refile-to-file (arg file)
"Refile current heading to a particular org file.
If prefix ARG, copy instead of move."
(interactive
(list current-prefix-arg
(read-file-name "Select file to refile to: "
default-directory
(buffer-file-name (buffer-base-buffer))
t nil
(lambda (f) (string-match-p "\\.org$" f)))))
(+org/refile-to-current-file arg file))
;;;###autoload
(defun +org/refile-to-other-window (arg)
"Refile current heading to an org buffer visible in another window.
If prefix ARG, copy instead of move."
(interactive "P")
(let ((org-refile-keep arg)
org-refile-targets
current-prefix-arg)
(dolist (win (delq (selected-window) (window-list)))
(with-selected-window win
(let ((file (buffer-file-name (buffer-base-buffer))))
(and (eq major-mode 'org-mode)
file
(cl-pushnew (cons file (cons :maxlevel 10))
org-refile-targets)))))
(call-interactively #'org-refile)))
;;;###autoload
(defun +org/refile-to-other-buffer (arg)
"Refile current heading to another, living org buffer.
If prefix ARG, copy instead of move."
(interactive "P")
(let ((org-refile-keep arg)
org-refile-targets
current-prefix-arg)
(dolist (buf (delq (current-buffer) (doom-buffers-in-mode 'org-mode)))
(when-let (file (buffer-file-name (buffer-base-buffer buf)))
(cl-pushnew (cons file (cons :maxlevel 10))
org-refile-targets)))
(call-interactively #'org-refile)))
;;;###autoload
(defun +org/refile-to-running-clock (arg)
"Refile current heading to the currently clocked in task.
If prefix ARG, copy instead of move."
(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)
"Refile current heading to the last node you refiled to.
If prefix ARG, copy instead of move."
(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))))

96
.config/emacs/modules/lang/org/autoload/org-tables.el Normal file
View File

@@ -0,0 +1,96 @@
;;; 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."
(when (and (org-at-table-p) org-table-may-need-update)
(let ((pt (point))
(inhibit-message t))
(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)))

487
.config/emacs/modules/lang/org/autoload/org.el Normal file
View File

@@ -0,0 +1,487 @@
;;; lang/org/autoload/org.el -*- lexical-binding: t; -*-
;;
;;; Helpers
(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 (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)))
;; 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))))
;; 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))
(when (and (bound-and-true-p evil-local-mode)
(not (evil-emacs-state-p)))
(evil-insert 1))))
;;;###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 (&optional arg)
"Do-what-I-mean at point.
If on a:
- checkbox list item or todo heading: toggle it.
- clock: update its time.
- 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
- 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 "P")
(if (button-at (point))
(call-interactively #'push-button)
(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
((or `citation `citation-reference)
(org-cite-follow context arg))
(`headline
(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)))
(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))))
;; Update any metadata or inline previews in this subtree
(org-update-checkbox-count)
(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))
(`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 arg)
(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 arg)))
((or `src-block `inline-src-block)
(org-babel-execute-src-block arg))
((or `latex-fragment `latex-environment)
(org-latex-preview arg))
(`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--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)))
(let ((match (and (org-at-item-checkbox-p) (match-string 1))))
(org-toggle-checkbox (if (equal match "[ ]") '(16)))))
(_
(if (or (org-in-regexp org-ts-regexp-both nil t)
(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--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 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."
(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/toggle-last-clock (arg)
"Toggles last clocked item.
Clock out if an active clock is running (or cancel it if prefix ARG is non-nil).
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")
(require 'org-clock)
(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
;;;###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)
;;;###autoload
(defun +org/close-all-folds (&optional level)
"Close all folds in the buffer (or below LEVEL)."
(interactive "p")
(outline-hide-sublevels (or level 1)))
;;;###autoload
(defun +org/open-all-folds (&optional level)
"Open all folds in the buffer (or up to LEVEL)."
(interactive "P")
(if (integerp level)
(outline-hide-sublevels level)
(outline-show-all)))
(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 (&optional count)
"Decrease the fold-level of the visible area of the buffer. This unfolds
another level of headings on each invocation."
(interactive "p")
(let ((new-level (+ (+org--get-foldlevel) (or count 1))))
(outline-hide-sublevels new-level)
(message "Folded to level %s" new-level)))
;;;###autoload
(defun +org/hide-next-fold-level (&optional count)
"Increase the global fold-level of the visible area of the buffer. This folds
another level of headings on each invocation."
(interactive "p")
(let ((new-level (max 1 (- (+org--get-foldlevel) (or count 1)))))
(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)
((and (bound-and-true-p org-cdlatex-mode)
(or (org-inside-LaTeX-fragment-p)
(org-inside-latex-macro-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)
((and (save-excursion
(skip-chars-backward " \t")
(bolp))
(org-in-subtree-not-table-p))
(call-interactively #'tab-to-tab-stop)
t)))
;;;###autoload
(defun +org-yas-expand-maybe-h ()
"Expand a yasnippet snippet, if trigger exists at point or region is active.
Made for `org-tab-first-hook'."
(when (and (featurep! :editor snippets)
(require 'yasnippet nil t)
(bound-and-true-p yas-minor-mode))
(and (let ((major-mode (cond ((org-in-src-block-p t)
(org-src-get-lang-mode (org-eldoc-get-src-lang)))
((org-inside-LaTeX-fragment-p)
'latex-mode)
(major-mode)))
(org-src-tab-acts-natively nil) ; causes breakages
;; Smart indentation doesn't work with yasnippet, and painfully slow
;; in the few cases where it does.
(yas-indent-line 'fixed))
(cond ((and (or (not (bound-and-true-p evil-local-mode))
(evil-insert-state-p)
(evil-emacs-state-p))
(or (and (bound-and-true-p yas--tables)
(gethash major-mode yas--tables))
(progn (yas-reload-all) t))
(yas--templates-for-key-at-point))
(yas-expand)
t)
((use-region-p)
(yas-insert-snippet)
t)))
;; HACK Yasnippet breaks org-superstar-mode because yasnippets is
;; overzealous about cleaning up overlays.
(when (bound-and-true-p org-superstar-mode)
(org-superstar-restart)))))
;;;###autoload
(defun +org-cycle-only-current-subtree-h (&optional arg)
"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 (or (eq this-command 'org-shifttab)
(and (bound-and-true-p org-cdlatex-mode)
(or (org-inside-LaTeX-fragment-p)
(org-inside-latex-macro-p))))
(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-make-last-point-visible-h ()
"Unfold subtree around point if saveplace places us in a folded region."
(and (not org-inhibit-startup)
(not org-inhibit-startup-visibility-stuff)
;; Must be done on a timer because `org-show-set-visibility' (used by
;; `org-reveal') relies on overlays that aren't immediately available
;; when `org-mode' first initializes.
(run-at-time 0.1 nil #'org-reveal '(4))))
;;;###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-parent-todo-statistics nil t))
(add-hook 'before-save-hook #'org-update-parent-todo-statistics nil t))