(defgroup ews ()
"Emacs Writing Studio."
:group 'files
:link '(url-link :tag "Homepage" "https://lucidmanager.org/tags/emacs/"))
(defcustom ews-bibtex-directory
(concat (file-name-as-directory (getenv "HOME")) "library")
"Location of BibTeX files and attachments."
:group 'ews
:type 'directory)
(defcustom ews-denote-para-keywords
'("projects" "areas" "resources" "archives")
"List of keywords to use for implementing the PARA method with Denote."
:group 'ews
:type 'list)
(defcustom ews-hunspell-dictionaries "en_US"
"Comma-separated list of Hunspell dictionaries."
:group 'ews
:type 'list)
(defcustom ews-org-heading-level-capitalise nil
"Minimum level of Org headings to be capitalised
Nil implies all levels are capitalised."
:group 'ews
:type '(choice (const :tag "All headings" nil)
(integer :tag "Highest level" 1)))
(defun ews-missing-executables (prog-list)
"Identify missing executables in PROG-LIST.
Sublists indicate that one of the entries is required."
(let ((missing '()))
(dolist (exec prog-list)
(if (listp exec)
(unless (cl-some #'executable-find exec)
(push (format "(%s)" (mapconcat 'identity exec " or ")) missing))
(unless (executable-find exec)
(push exec missing))))
(if missing
(message "Missing executable files(s): %s"
(mapconcat 'identity missing ", "))
(message "No missing executable files."))))
(defvar ews-bibtex-files
(when (file-exists-p ews-bibtex-directory)
(directory-files ews-bibtex-directory t "^[A-Z|a-z|0-9].+.bib$"))
"List of BibTeX files. Use `ews-bibtex-register' to configure.")
(defun ews-bibtex-register ()
"Register the contents of the `ews-bibtex-directory' with `ews-bibtex-files`.
Use when adding or removing a BibTeX file from or to `ews-bibtex-directory'."
(interactive)
(when (file-exists-p ews-bibtex-directory)
(let ((bib-files (directory-files ews-bibtex-directory t
"^[A-Z|a-z|0-9].+.bib$")))
(setq ews-bibtex-files bib-files
org-cite-global-bibliography bib-files
citar-bibliography bib-files)))
(message "Registered:\n%s" (mapconcat #'identity ews-bibtex-files "\n")))
(defun ews--bibtex-combined-biblio-lookup ()
"Combines `biblio-lookup' and `biblio-doi-insert-bibtex'."
(require 'biblio)
(let* ((dbs (biblio--named-backends))
(db-list (append dbs '(("DOI" . biblio-doi-backend))))
(db-selected (biblio-completing-read-alist
"Backend:"
db-list)))
(if (eq db-selected 'biblio-doi-backend)
(let ((doi (read-string "DOI: ")))
(biblio-doi-insert-bibtex doi))
(biblio-lookup db-selected))))
(defun ews-bibtex-biblio-lookup ()
"Insert Biblio search results into current buffer or select BibTeX file."
(interactive)
(if-let ((current-mode major-mode)
ews-bibtex-files
(bibfiles (length ews-bibtex-files))
(bibfile (cond ((eq bibfiles 1) (car ews-bibtex-files))
((equal major-mode 'bibtex-mode)
(buffer-file-name))
(t (completing-read
"Select BibTeX file:" ews-bibtex-files)))))
(progn (find-file bibfile)
(goto-char (point-max))
(ews--bibtex-combined-biblio-lookup)
(save-buffer))
(message "No BibTeX file(s) defined.")))
(defun ews--bibtex-extract-attachments ()
"Extract attachment file names from BibTeX files in `ews-bibtex-directory'."
(ews-bibtex-register)
(let ((attachments '()))
(dolist (bibtex-file ews-bibtex-files)
(with-temp-buffer
(insert-file-contents bibtex-file)
(goto-char (point-min))
(while (re-search-forward "file.*=.*{\\([^}]+\\)}" nil t)
(let ((file-paths (split-string (match-string 1)
"[[:space:]]*;[[:space:]]*")))
(dolist (file-path file-paths)
(push (expand-file-name (string-trim file-path)
ews-bibtex-directory)
attachments))))))
attachments))
(defun ews--bibtex-extract-files ()
"List files recursively in `ews-bibtex-directory', excluding `.bib' and `.csl'."
(seq-remove (lambda (file)
(or (string-suffix-p ".bib" file)
(string-suffix-p ".csl" file)))
(mapcar 'expand-file-name
(directory-files-recursively ews-bibtex-directory ""))))
(defun ews-bibtex-missing-files ()
"List BibTeX attachments not listed in a BibTeX file entry."
(interactive)
(let* ((files (ews--bibtex-extract-files))
(attachments (ews--bibtex-extract-attachments))
(missing (cl-remove-if
(lambda (f) (member f attachments)) files)))
(message "%s files not registered in bibliography" (length missing))
(dolist (file missing)
(message file))))
(defun ews-bibtex-missing-attachments ()
"List BibTeX file entries with missing attachment(s)."
(interactive)
(let* ((files (ews--bibtex-extract-files))
(attachments (ews--bibtex-extract-attachments))
(missing (cl-remove-if
(lambda (f) (member f files)) attachments)))
(message "%s BibTeX files without matching attachment." (length missing))
(dolist (file missing)
(message file))))
(defun ews-denote-assign-para ()
"Move your note to either Project, Area, Reource or Archive (PARA).
Configure the PARA names with `ews-denote-para-keywords'."
(interactive)
(if-let* ((file (buffer-file-name))
((denote-filename-is-note-p file))
(all-keywords (string-split (denote-retrieve-filename-keywords file) "_"))
(keywords (seq-remove (lambda (keyword)
(member keyword ews-denote-para-keywords))
all-keywords))
(para (completing-read "Select category: " ews-denote-para-keywords))
(new-keywords (push para keywords)))
(denote-rename-file
file
(denote-retrieve-title-or-filename file (denote-filetype-heuristics file))
new-keywords
(denote-retrieve-filename-signature file))
(message "Current buffer is not a Denote file.")))
(defvar ews-olivetti-point nil
"Stores the point position before enabling Olivetti mode.")
(defun ews-olivetti ()
"Distraction-free writing environment enhancing Olivetti mode.
Stores the window configuration when enabling Olivetti mode.
Restores the previous configuration when existing Olivetti mode
and moves point to the last location."
(interactive)
(if olivetti-mode
(progn
(if (eq (length (window-list)) 1)
(progn
(jump-to-register 1)
(goto-char ews-olivetti-point)))
(olivetti-mode 0)
(text-scale-set 0))
(progn
(setq ews-olivetti-point (point))
(window-configuration-to-register 1)
(delete-other-windows)
(text-scale-set 1)
(olivetti-mode t))))
(defun ews-org-insert-notes-drawer ()
"Generate or open a NOTES drawer under the current heading.
If a drawer exists for this section, a new line is created at the end of the
current note."
(interactive)
(push-mark)
(org-previous-visible-heading 1)
(forward-line)
(if (looking-at-p "^[ \t]*:NOTES:")
(progn
(org-fold-hide-drawer-toggle 'off)
(re-search-forward "^[ \t]*:END:" nil t)
(forward-line -1)
(org-end-of-line)
(org-return))
(org-insert-drawer nil "NOTES"))
(org-unlogged-message "Press <C-u C-SPACE> to return to the previous position."))
(defun ews-org-count-words ()
"Add word count to each heading property drawer in an Org mode buffer."
(interactive)
(org-map-entries
(lambda ()
(let* ((start (point))
(end (save-excursion (org-end-of-subtree)))
(word-count (count-words start end)))
(org-set-property "WORDCOUNT" (number-to-string word-count))))))
(defun ews-org-insert-screenshot ()
"Take a screenshot with the maim program and insert as an Org mode link."
(interactive)
(let ((filename (read-file-name "Enter filename for screenshot: " default-directory)))
(unless (string-equal "png" (file-name-extension filename))
(setq filename (concat (file-name-sans-extension filename) ".png")))
(call-process-shell-command (format "maim --select %s" filename))
(insert (format "#+caption: %s\n" (read-from-minibuffer "Caption: ")))
(insert (format "[[file:%s]]" filename))
(org-redisplay-inline-images)))
(defun ews-org-headings-titlecase (&optional arg)
"Cycle through all headings in an Org buffer and convert them to title case.
When used with universal argument (ARG) converts to sentence case.
Customise `titlecase-style' for styling."
(interactive "P")
(require 'titlecase)
(let ((style (if arg 'sentence titlecase-style)))
(message "Converting headings to '%s' style" style)
(org-map-entries
(lambda ()
(let* ((heading (substring-no-properties (org-get-heading t t t t)))
(level (org-current-level))
(heading-lower (downcase heading))
(new-heading (titlecase--string heading-lower style)))
(when (<= level (or ews-org-heading-level-capitalise 999))
(org-edit-headline new-heading)))))))
(defun ews-denote-link-description-title-case (file)
"Return link description for FILE.
If the region is active, use it as the description.
The title is formatted with the `titlecase' package.
This function is useful as the value of `denote-link-description-function' to
generate links in titlecase for attachments."
(require 'titlecase)
(let* ((file-type (denote-filetype-heuristics file))
(title (denote-retrieve-title-or-filename file file-type))
(clean-title (if (string-match-p " " title)
title
(replace-regexp-in-string "\\([a-zA-Z0-9]\\)-\\([a-zA-Z0-9]\\)" "\\1 \\2" title)))
(region-text (denote--get-active-region-content)))
(cond
(region-text region-text)
(title (format "%s" (titlecase--string clean-title titlecase-style)))
(t ""))))
(defun my-smart-copy-dwim (arg)
"Smart copy behavior combining `scimax-copy-dwim` and `xah-copy-line-or-region`.
Copies the active region, rectangle, paragraph, sentence, line, or word at point.
With a prefix ARG, copies the whole buffer.
Repeated calls append subsequent lines."
(interactive "P")
(cond
(arg
(copy-region-as-kill (point-min) (point-max)))
((and (boundp 'rectangle-mark-mode) rectangle-mark-mode)
(copy-region-as-kill (region-beginning) (region-end) t))
((region-active-p)
(copy-region-as-kill (region-beginning) (region-end)))
((eq last-command this-command)
(unless (eobp)
(kill-append "\n" nil)
(kill-append (buffer-substring (line-beginning-position) (line-end-position)) nil)
(end-of-line)
(forward-char)))
((let ((cp (point)))
(save-excursion
(forward-paragraph)
(backward-paragraph)
(when (looking-at "^$") (forward-line))
(= cp (point))))
(kill-ring-save (point) (save-excursion (forward-paragraph) (point))))
((let ((cp (point)))
(save-excursion
(forward-sentence)
(backward-sentence)
(= cp (point))))
(let* ((bounds (bounds-of-thing-at-point 'sentence))
(start (car bounds))
(end (cdr bounds)))
(kill-ring-save start end)))
((bolp)
(copy-region-as-kill (line-beginning-position) (line-end-position))
(end-of-line)
(forward-char))
(t
(let* ((bounds (bounds-of-thing-at-point 'word))
(start (car bounds))
(end (cdr bounds)))
(kill-ring-save start end)))))
(defvar my-smart-cut-dwim--last-point nil
"Stores point position for detecting repeated `my-smart-cut-dwim` calls.")
(defun my-smart-cut-dwim (arg)
"Smart cut function combining `scimax-kill-dwim` and `xah-cut-line-or-region`.
With region active, cuts region. At beginning of sentence/paragraph/line, cuts accordingly.
Defaults to cutting word at point. With prefix ARG, cuts entire buffer.
Repeated calls append the next line."
(interactive "P")
(cond
(arg
(setq my-smart-cut-dwim--last-point nil)
(kill-new (buffer-string))
(delete-region (point-min) (point-max)))
((region-active-p)
(setq my-smart-cut-dwim--last-point nil)
(kill-region (region-beginning) (region-end)))
((eq last-command this-command)
(setq my-smart-cut-dwim--last-point (point))
(unless (eobp)
(kill-append "\n" nil)
(kill-append (buffer-substring (line-beginning-position) (line-end-position)) nil)
(delete-region (line-beginning-position) (line-end-position))
(end-of-line)
(forward-char)))
((let ((cp (point)))
(save-excursion
(forward-paragraph)
(backward-paragraph)
(when (looking-at "^$") (forward-line))
(= cp (point))))
(setq my-smart-cut-dwim--last-point nil)
(kill-region (point) (save-excursion (forward-paragraph) (point))))
((let ((cp (point)))
(save-excursion
(forward-sentence)
(backward-sentence)
(= cp (point))))
(setq my-smart-cut-dwim--last-point nil)
(let* ((bounds (bounds-of-thing-at-point 'sentence))
(start (car bounds))
(end (cdr bounds)))
(kill-region start end)))
((bolp)
(setq my-smart-cut-dwim--last-point nil)
(kill-line))
(t
(setq my-smart-cut-dwim--last-point nil)
(let* ((bounds (bounds-of-thing-at-point 'word))
(start (car bounds))
(end (cdr bounds)))
(kill-region start end)))))
(defun xah-paste-or-paste-previous ()
"Paste. When called repeatedly, paste previous.
This command calls `yank', and if repeated, call `yank-pop'.
When `universal-argument' is called first with a number arg, paste that many times.
URL `http://xahlee.info/emacs/emacs/emacs_paste_or_paste_previous.html'
Version 2017-07-25 2020-09-08"
(interactive)
(progn
(when (and delete-selection-mode (region-active-p))
(delete-region (region-beginning) (region-end)))
(if current-prefix-arg
(progn
(dotimes (_ (prefix-numeric-value current-prefix-arg))
(yank)))
(if (eq real-last-command this-command)
(yank-pop 1)
(yank)))))
(defun xah-beginning-of-line-or-block ()
"Move cursor to beginning of indent or line, end of previous block, in that order.
If `visual-line-mode' is on, beginning of line means visual line.
URL `http://xahlee.info/emacs/emacs/emacs_move_by_paragraph.html'
Created: 2018-06-04
Version: 2024-10-30"
(interactive)
(let ((xp (point)))
(if (or (eq (point) (line-beginning-position))
(eq last-command this-command))
(when (re-search-backward "\n[\t\n ]*\n+" nil 1)
(skip-chars-backward "\n\t ")
)
(if visual-line-mode
(beginning-of-visual-line)
(if (eq major-mode 'eshell-mode)
(beginning-of-line)
(back-to-indentation)
(when (eq xp (point))
(beginning-of-line)))))))
(defun xah-end-of-line-or-block ()
"Move cursor to end of line or next block.
• When called first time, move cursor to end of line.
• When called again, move cursor forward by jumping over any sequence of whitespaces containing 2 blank lines.
• if `visual-line-mode' is on, end of line means visual line.
URL `http://xahlee.info/emacs/emacs/emacs_move_by_paragraph.html'
Created: 2018-06-04
Version: 2024-10-30"
(interactive)
(if (or (eq (point) (line-end-position))
(eq last-command this-command))
(re-search-forward "\n[\t\n ]*\n+" nil 1)
(if visual-line-mode
(end-of-visual-line)
(end-of-line))))
(defun org-export-output-file-name-modified (orig-fun extension &optional subtreep pub-dir)
(unless pub-dir
(setq pub-dir "~/Documents")
(unless (file-directory-p pub-dir)
(make-directory pub-dir)))
(apply orig-fun extension subtreep pub-dir nil))
(advice-add 'org-export-output-file-name :around #'org-export-output-file-name-modified)
(defun org-markup-region-or-point (type beginning-marker end-marker)
"Apply the markup TYPE with BEGINNING-MARKER and END-MARKER to region, word or point.
This is a generic function used to apply markups. It is mostly
the same for the markups, but there are some special cases for
subscripts and superscripts."
(cond
((region-active-p)
(let* ((bounds (list (region-beginning) (region-end)))
(start (apply 'min bounds))
(end (apply 'max bounds))
(lines))
(unless (memq type '(subscript superscript))
(save-excursion
(goto-char start)
(unless (looking-at " \\|\\<")
(backward-word)
(setq start (point)))
(goto-char end)
(unless (or (looking-at " \\|\\>")
(looking-back "\\>" 1))
(forward-word)
(setq end (point)))))
(setq lines
(s-join "\n" (mapcar
(lambda (s)
(if (not (string= (s-trim s) ""))
(concat beginning-marker
(s-trim s)
end-marker)
s))
(split-string
(buffer-substring start end) "\n"))))
(cl--set-buffer-substring start end lines)
(forward-char (length lines))))
((thing-at-point 'word)
(cond
((looking-back " " 1)
(insert beginning-marker)
(re-search-forward "\\>")
(insert end-marker))
((looking-back "\\>" 1)
(insert (concat beginning-marker end-marker))
(backward-char (length end-marker)))
((and (memq type '(subscript superscript))
(looking-back end-marker 1))
(delete-char -1)
(forward-char)
(insert end-marker))
((memq type '(subscript superscript))
(insert beginning-marker)
(forward-char (- (length beginning-marker) 1))
(insert end-marker))
(t
(re-search-backward "\\<")
(insert beginning-marker)
(re-search-forward "\\>")
(insert end-marker))))
((looking-back end-marker (length end-marker))
(delete-char (* -1 (length end-marker)))
(forward-word)
(insert end-marker))
(t
(insert (concat beginning-marker end-marker))
(backward-char (length end-marker)))))
(defun org-double-quote-region-or-point ()
"Double quote the region, word or character at point.
This function tries to do what you mean:
1. If you select a region, markup the region.
2. If in a word, markup the word.
3. Otherwise wrap the character at point in the markup.
Repeated use of the function slurps the next word into the markup."
(interactive)
(org-markup-region-or-point 'italics "\"" "\""))
(defun org-single-quote-region-or-point ()
"Single quote the region, word or character at point.
This function tries to do what you mean:
1. If you select a region, markup the region.
2. If in a word, markup the word.
3. Otherwise wrap the character at point in the markup.
Repeated use of the function slurps the next word into the markup."
(interactive)
(org-markup-region-or-point 'italics "'" "'"))
(defun org-italics-region-or-point ()
"Italicize the region, word or character at point.
This function tries to do what you mean:
1. If you select a region, markup the region.
2. If in a word, markup the word.
3. Otherwise wrap the character at point in the markup.
Repeated use of the function slurps the next word into the markup."
(interactive)
(org-markup-region-or-point 'italics "/" "/"))
(defun org-bold-region-or-point ()
"Bold the region, word or character at point.
This function tries to do what you mean:
1. If you select a region, markup the region.
2. If in a word, markup the word.
3. Otherwise wrap the character at point in the markup.
Repeated use of the function slurps the next word into the markup."
(interactive)
(org-markup-region-or-point 'bold "*" "*"))
(defun org-underline-region-or-point ()
"Underline the region, word or character at point.
This function tries to do what you mean:
1. If you select a region, markup the region.
2. If in a word, markup the word.
3. Otherwise wrap the character at point in the markup.
Repeated use of the function slurps the next word into the markup."
(interactive)
(org-markup-region-or-point 'underline "_" "_"))
(defun org-code-region-or-point ()
"Mark the region, word or character at point as code.
This function tries to do what you mean:
1. If you select a region, markup the region.
2. If in a word, markup the word.
3. Otherwise wrap the character at point in the markup.
Repeated use of the function slurps the next word into the markup."
(interactive)
(org-markup-region-or-point 'underline "~" "~"))
(defun org-verbatim-region-or-point ()
"Mark the region, word or character at point as verbatim.
This function tries to do what you mean:
1. If you select a region, markup the region.
2. If in a word, markup the word.
3. Otherwise wrap the character at point in the markup.
Repeated use of the function slurps the next word into the markup."
(interactive)
(org-markup-region-or-point 'underline "=" "="))
(defun org-strikethrough-region-or-point ()
"Mark the region, word or character at point as strikethrough.
This function tries to do what you mean:
1. If you select a region, markup the region.
2. If in a word, markup the word.
3. Otherwise wrap the character at point in the markup.
Repeated use of the function slurps the next word into the markup."
(interactive)
(org-markup-region-or-point 'strikethrough "+" "+"))
(defun org-subscript-region-or-point ()
"Mark the region, word or character at point as a subscript.
This function tries to do what you mean:
1. If you select a region, markup the region.
2. If in a word, markup the word.
3. Otherwise wrap the character at point in the markup.
Repeated use of the function slurps the next word into the markup."
(interactive)
(org-markup-region-or-point 'subscript "_{" "}"))
(defun org-superscript-region-or-point ()
"Mark the region, word or character at point as superscript.
This function tries to do what you mean:
1. If you select a region, markup the region.
2. If in a word, markup the word.
3. Otherwise wrap the character at point in the markup.
Repeated use of the function slurps the next word into the markup."
(interactive)
(org-markup-region-or-point 'superscript "^{" "}"))
(defun org-latex-math-region-or-point (&optional arg)
"Wrap the selected region in latex math markup.
\(\) or $$ (with prefix ARG) or @@latex:@@ with double prefix.
With no region selected, insert those and put point in the middle
to add an equation. Finally, if you are between these markers
then exit them."
(interactive "P")
(if (memq 'org-latex-and-related (get-char-property (point) 'face))
(goto-char (or (next-single-property-change (point) 'face) (line-end-position)))
(let ((chars
(cond
((null arg)
'("\\(" . "\\)"))
((equal arg '(4))
'("$" . "$"))
((equal arg '(16))
'("@@latex:" . "@@")))))
(if (region-active-p)
(progn
(goto-char (region-end))
(insert (cdr chars))
(goto-char (region-beginning))
(insert (car chars)))
(cond
((thing-at-point 'word)
(save-excursion
(end-of-thing 'word)
(insert (cdr chars)))
(save-excursion
(beginning-of-thing 'word)
(insert (car chars)))
(forward-char (length (car chars))))
((and (not (equal arg '(16))) (looking-back (regexp-quote (cdr chars)) (length (cdr chars))))
(delete-char (* -1 (length (cdr chars))))
(forward-word)
(insert (cdr chars)))
(t
(insert (concat (car chars) (cdr chars)))
(backward-char (length (cdr chars)))))))))
(defun cc/emphasize-bold ()
"Mark region bold for Org or Markdown modes."
(interactive)
(when (not (use-region-p))
(beginning-of-thing 'sexp)
(mark-sexp))
(cond ((derived-mode-p 'org-mode)
(org-emphasize ?*))
((derived-mode-p 'markdown-mode)
(markdown-insert-bold))
(t nil)))
(defun cc/emphasize-italic ()
"Mark region italic for Org or Markdown modes."
(interactive)
(when (not (use-region-p))
(beginning-of-thing 'sexp)
(mark-sexp))
(cond ((derived-mode-p 'org-mode)
(org-emphasize ?/))
((derived-mode-p 'markdown-mode)
(markdown-insert-italic))
(t nil)))
(defun cc/emphasize-code ()
"Mark region code for Org or Markdown modes."
(interactive)
(when (not (use-region-p))
(beginning-of-thing 'sexp)
(mark-sexp))
(cond ((derived-mode-p 'org-mode)
(org-emphasize ?~))
((derived-mode-p 'markdown-mode)
(markdown-insert-code))
(t nil)))
(defun cc/emphasize-underline ()
"Mark region underline for Org mode."
(interactive)
(when (not (use-region-p))
(beginning-of-thing 'sexp)
(mark-sexp))
(cond ((derived-mode-p 'org-mode)
(org-emphasize ?_))
(t nil)))
(defun cc/emphasize-verbatim ()
"Mark region verbatim for Org mode."
(interactive)
(when (not (use-region-p))
(beginning-of-thing 'sexp)
(mark-sexp))
(cond ((derived-mode-p 'org-mode)
(org-emphasize ?=))
(t nil)))
(defun cc/emphasize-strike-through ()
"Mark region strike-through for Org or Markdown modes."
(interactive)
(when (not (use-region-p))
(beginning-of-thing 'sexp)
(mark-sexp))
(cond ((derived-mode-p 'org-mode)
(org-emphasize ?+))
((derived-mode-p 'markdown-mode)
(markdown-insert-strike-through))
(t nil)))
(defun cc/emphasize-remove ()
"Remove marked region."
(interactive)
(when (not (use-region-p))
(beginning-of-thing 'sexp)
(mark-sexp))
(cond ((derived-mode-p 'org-mode)
(org-emphasize ? ))
((derived-mode-p 'markdown-mode)
(message "unsupported."))
(t nil)))
(defun cc/emphasize-dwim ()
"DWIM emphasize text for Org or Markdown.
This command will appropriately style either a region or the text
the point is in depending on whether the current major mode is
Org or Markdown. Selection of the emphasis style is done by
mini-buffer command completion.
If no region is defined, then the text amount is considered to be
a balanced expression (sexp). A balanced expression is used as it
can cover most cases of applying the style to text that is
contiguous without spaces."
(interactive)
(let* ((styles (list "bold" "italic" "code"
"underline" "verbatim" "strike" "remove"))
(choice (car (completing-read-multiple "Style: " styles))))
(when (not (use-region-p))
(beginning-of-thing 'sexp)
(mark-sexp))
(cond
((string= choice "bold") (cc/emphasize-bold))
((string= choice "italic") (cc/emphasize-italic))
((string= choice "code") (cc/emphasize-code))
((string= choice "verbatim") (cc/emphasize-verbatim))
((string= choice "underline") (cc/emphasize-underline))
((string= choice "strike") (cc/emphasize-strike-through))
((string= choice "remove")
(if (derived-mode-p 'org-mode)
(org-emphasize ? )
(message "remove not supported for Markdown.")))
(t (message "ERROR: undefined choice: %s" choice)))))
(defun scimax/org-return (&optional arg)
"Add new list item, heading or table row with RET.
A double return on an empty element deletes it.
Use a prefix arg to get regular RET.
A prefix arg of 4 opens link in new window.
A prefix arg of 5 opens link in new frame."
(interactive "P")
(cond
((and arg (listp arg) (equal arg '(4)))
(org-return))
((null arg)
(cond
((eq 'line-break (car (org-element-context)))
(org-return t))
((and (eq 'link (car (org-element-context))) (not (eolp)))
(org-return))
((looking-at org-heading-regexp)
(org-return))
((and (bolp)
(save-excursion
(let ((p (point)))
(org-beginning-of-line)
(not (= p (point)))))
(save-excursion
(let ((p (point)))
(org-beginning-of-line)
(org-end-of-line)
(not (= p (point))))))
(org-show-entry)
(org-insert-heading))
((org-inlinetask-in-task-p)
(org-return))
((org-at-item-checkbox-p)
(cond
((and (eolp)
(not (eq 'item (car (org-element-context)))))
(org-insert-todo-heading nil))
((and (eolp) (eq 'item (car (org-element-context))))
(delete-region (line-beginning-position) (point)))
((eq 'paragraph (car (org-element-context)))
(goto-char (org-element-property :end (org-element-context)))
(org-insert-todo-heading nil))
(t
(org-return))))
((org-in-item-p)
(cond
((and (looking-at " ::")
(looking-back "- " 3))
(beginning-of-line)
(delete-region (line-beginning-position) (line-end-position)))
((and (looking-at "$")
(looking-back "- " 3))
(beginning-of-line)
(delete-region (line-beginning-position) (line-end-position)))
((and (looking-at "$")
(looking-back "[0-9]+. " (line-beginning-position)))
(beginning-of-line)
(delete-region (line-beginning-position) (line-end-position)))
((and (looking-at "$")
(looking-at "^"))
(org-return))
(t
(end-of-line)
(org-insert-item))))
((org-at-heading-p)
(if (not (string= "" (org-element-property :title (org-element-context))))
(progn
(org-end-of-subtree)
(org-insert-heading-respect-content)
(outline-show-entry))
(beginning-of-line)
(delete-region (line-beginning-position) (line-end-position))))
((org-at-table-p)
(if (-any?
(lambda (x) (not (string= "" x)))
(nth
(- (org-table-current-dline) 1)
(remove 'hline (org-table-to-lisp))))
(org-return)
(beginning-of-line)
(delete-region (line-beginning-position) (line-end-position))
(org-return)))
(t
(org-return))))
((= arg 4)
(clone-indirect-buffer-other-window (buffer-name) t)
(org-return))
((= arg 5)
(clone-frame)
(org-return))
(t
(org-return))))
(defun scimax-org-headline-to-inlinetask ()
"Convert the heading at point to an inlinetask."
(interactive)
(let* ((hl (org-element-context))
(body (buffer-substring-no-properties (org-element-property :contents-begin hl)
(org-element-property :contents-end hl)))
(title (org-element-property :title hl))
(tags (nth 5 (org-heading-components)))
(beg (org-element-property :begin hl))
(end (org-element-property :end hl))
(inlinetask (with-temp-buffer
(org-mode)
(org-inlinetask-insert-task)
(insert title " " tags "\n" body)
(concat (buffer-string) "\n\n"))))
(cl--set-buffer-substring beg end inlinetask)))
(defun xah-comment-dwim ()
"Toggle comment in programing language code.
Like `comment-dwim', but toggle comment if cursor is not at end of line.
If cursor is at end of line, either add comment at the line end or move cursor to start of line end comment. call again to comment out whole line.
URL `http://xahlee.info/emacs/emacs/emacs_toggle_comment_by_line.html'
Created: 2016-10-25
Version: 2023-07-10"
(interactive)
(if (region-active-p)
(comment-dwim nil)
(let ((xbegin (line-beginning-position))
(xend (line-end-position)))
(if (eq xbegin xend)
(progn
(comment-dwim nil))
(if (eq (point) xend)
(progn
(comment-dwim nil))
(progn
(comment-or-uncomment-region xbegin xend)
(forward-line )))))))
(defun xah-show-kill-ring ()
"Insert all `kill-ring' content in a new buffer named *copy history*.
URL `http://xahlee.info/emacs/emacs/emacs_show_kill_ring.html'
Created: 2019-12-02
Version: 2024-05-07"
(interactive)
(let ((xbuf (generate-new-buffer "*copy history*"))
(inhibit-read-only t))
(progn
(switch-to-buffer xbuf)
(funcall 'fundamental-mode)
(mapc
(lambda (x)
(insert x "\n\nsss97707------------------------------------------------\n\n" ))
kill-ring))
(goto-char (point-min))))
(defun xah-toggle-letter-case ()
"Toggle the letter case of current word or selection.
Always cycle in this order: Init Caps, ALL CAPS, all lower.
URL `http://xahlee.info/emacs/emacs/emacs_toggle_letter_case.html'
Version: 2020-06-26 2023-11-14"
(interactive)
(let ( (deactivate-mark nil) xp1 xp2)
(if (region-active-p)
(setq xp1 (region-beginning) xp2 (region-end))
(save-excursion
(skip-chars-backward "[:alpha:]")
(setq xp1 (point))
(skip-chars-forward "[:alpha:]")
(setq xp2 (point))))
(when (not (eq last-command this-command))
(put this-command 'state 0))
(cond
((equal 0 (get this-command 'state))
(upcase-initials-region xp1 xp2)
(put this-command 'state 1))
((equal 1 (get this-command 'state))
(upcase-region xp1 xp2)
(put this-command 'state 2))
((equal 2 (get this-command 'state))
(downcase-region xp1 xp2)
(put this-command 'state 0)))))
(defun xah-title-case-region-or-line (&optional Begin End)
"Title case text between nearest brackets, or current line or selection.
Capitalize first letter of each word, except words like {to, of, the, a, in, or, and}. If a word already contains cap letters such as HTTP, URL, they are left as is.
When called in a elisp program, Begin End are region boundaries.
URL `http://xahlee.info/emacs/emacs/elisp_title_case_text.html'
Version: 2017-01-11 2021-03-30 2021-09-19"
(interactive)
(let* ((xskipChars "^\"<>(){}[]“”‘’‹›«»「」『』【】〖〗《》〈〉〔〕")
(xp0 (point))
(xp1 (if Begin
Begin
(if (region-active-p)
(region-beginning)
(progn
(skip-chars-backward xskipChars (line-beginning-position)) (point)))))
(xp2 (if End
End
(if (region-active-p)
(region-end)
(progn (goto-char xp0)
(skip-chars-forward xskipChars (line-end-position)) (point)))))
(xstrPairs [
[" A " " a "]
[" An " " an "]
[" And " " and "]
[" At " " at "]
[" As " " as "]
[" By " " by "]
[" Be " " be "]
[" Into " " into "]
[" In " " in "]
[" Is " " is "]
[" It " " it "]
[" For " " for "]
[" Of " " of "]
[" Or " " or "]
[" On " " on "]
[" Via " " via "]
[" The " " the "]
[" That " " that "]
[" To " " to "]
[" Vs " " vs "]
[" With " " with "]
[" From " " from "]
["'S " "'s "]
["'T " "'t "]
]))
(save-excursion
(save-restriction
(narrow-to-region xp1 xp2)
(upcase-initials-region (point-min) (point-max))
(let ((case-fold-search nil))
(mapc
(lambda (xx)
(goto-char (point-min))
(while
(search-forward (aref xx 0) nil t)
(replace-match (aref xx 1) t t)))
xstrPairs))))))
(defun xah-upcase-sentence ()
"Upcase first letters of sentences of current block or selection.
URL `http://xahlee.info/emacs/emacs/emacs_upcase_sentence.html'
Created: 2020-12-08
Version: 2025-03-25"
(interactive)
(let (xbeg xend)
(seq-setq (xbeg xend) (if (region-active-p) (list (region-beginning) (region-end)) (list (save-excursion (if (re-search-backward "\n[ \t]*\n" nil 1) (match-end 0) (point))) (save-excursion (if (re-search-forward "\n[ \t]*\n" nil 1) (match-beginning 0) (point))))))
(save-restriction
(narrow-to-region xbeg xend)
(let ((case-fold-search nil))
(goto-char (point-min))
(while (re-search-forward "\\(\\.\\|\\?\\|!\\)[ \n]+ *\\([a-z]\\)" nil 1)
(upcase-region (match-beginning 2) (match-end 2))
(overlay-put (make-overlay (match-beginning 2) (match-end 2)) 'face 'highlight))
(goto-char (point-min))
(while (re-search-forward "\\(\\`\\|• \\|\n\n\\)\\([a-z]\\)" nil 1)
(upcase-region (match-beginning 2) (match-end 2))
(overlay-put (make-overlay (match-beginning 2) (match-end 2)) 'face 'highlight))
(when
(or
(eq major-mode 'xah-html-mode)
(eq major-mode 'html-mode)
(eq major-mode 'sgml-mode)
(eq major-mode 'nxml-mode)
(eq major-mode 'xml-mode)
(eq major-mode 'mhtml-mode))
(goto-char (point-min))
(while
(re-search-forward "\\(<title>[ \n]?\\|<h[1-6]>[ \n]?\\|<p>[ \n]?\\|<li>[ \n]?\\|<dd>[ \n]?\\|<td>[ \n]?\\|<br ?/?>[ \n]?\\|<figcaption>[ \n]?\\)\\([a-z]\\)" nil 1)
(upcase-region (match-beginning 2) (match-end 2))
(overlay-put (make-overlay (match-beginning 2) (match-end 2)) 'face 'highlight))))
(goto-char (point-max)))
(skip-chars-forward " \n\t")))
(defun xah-add-period-to-line-end ()
"Add a period to each end of line that does not have one.
Work on current paragraph if there is no selection.
URL `http://xahlee.info/emacs/emacs/emacs_period_to_line_end.html'
Created: 2020-11-25
Version: 2025-03-26"
(interactive)
(let (xbeg xend)
(seq-setq (xbeg xend) (if (region-active-p) (list (region-beginning) (region-end)) (list (save-excursion (if (re-search-backward "\n[ \t]*\n" nil 1) (match-end 0) (point))) (save-excursion (if (re-search-forward "\n[ \t]*\n" nil 1) (match-beginning 0) (point))))))
(save-restriction
(narrow-to-region xbeg xend)
(goto-char (point-max))
(insert "\n")
(goto-char (point-min))
(while (search-forward "\n" nil 1)
(backward-char)
(let ((charX (char-before)))
(if (or (eq charX ?\.) (eq charX ?!) (eq charX ??) (eq charX ?\n) (eq charX ?>))
nil
(insert ".")))
(forward-char))
(goto-char (point-max))
(when (eq (char-before) ?\n) (delete-char -1)))))
(defun xah-reformat-to-sentence-lines ()
"Reformat current block or selection into multiple lines by ending period.
Move cursor to the beginning of next text block.
After this command is called, press `xah-repeat-key' to repeat it.
URL `http://xahlee.info/emacs/emacs/elisp_reformat_to_sentence_lines.html'
Created: 2020-12-02
Version: 2025-03-25"
(interactive)
(let (xbeg xend)
(seq-setq (xbeg xend) (if (region-active-p) (list (region-beginning) (region-end)) (list (save-excursion (if (re-search-backward "\n[ \t]*\n" nil 1) (match-end 0) (point))) (save-excursion (if (re-search-forward "\n[ \t]*\n" nil 1) (match-beginning 0) (point))))))
(save-restriction
(narrow-to-region xbeg xend)
(goto-char (point-min)) (while (search-forward "。" nil t) (replace-match "。\n"))
(goto-char (point-min))
(while (re-search-forward "\\([A-Za-z0-9]+\\)[ \t]*\n[ \t]*\\([A-Za-z0-9]+\\)" nil t)
(replace-match "\\1 \\2"))
(goto-char (point-min))
(while (re-search-forward "\\([,]\\)[ \t]*\n[ \t]*\\([A-Za-z0-9]+\\)" nil t)
(replace-match "\\1 \\2"))
(goto-char (point-min))
(while (re-search-forward " +" nil t) (replace-match " "))
(goto-char (point-min))
(while (re-search-forward "\\([.?!]\\) +\\([(0-9A-Za-z]+\\)" nil t) (replace-match "\\1\n\\2"))
(goto-char (point-max))
(while (eq (char-before) 32) (delete-char -1))))
(re-search-forward "\n+" nil 1)
(set-transient-map (let ((xkmap (make-sparse-keymap))) (define-key xkmap (kbd (if (boundp 'xah-repeat-key) xah-repeat-key "m")) this-command) xkmap))
(set-transient-map (let ((xkmap (make-sparse-keymap))) (define-key xkmap (kbd "DEL") this-command) xkmap)))
(defun xah-convert-english-chinese-punctuation (&optional Begin End ToDirection)
"Convert punctuation from/to English/Chinese characters.
When called interactively, do current line or selection. The conversion direction is automatically determined.
If `universal-argument' is called, ask user for change direction.
When called in lisp code, Begin End are region begin/end positions. ToDirection must be any of the following string values:
chinese
english
auto
URL `http://xahlee.info/emacs/emacs/elisp_convert_chinese_punctuation.html'
Version: 2012-12-10 2022-05-18 2023-08-26 2023-11-25"
(interactive)
(let (xp1 xp2 xinputStr xcontainChinese
(xengToChinesePairs
[
[". " "。"]
[".\n" "。\n"]
[", " "，"]
[",\n" "，\n"]
[": " "："]
["; " "；"]
["? " "？"] ["! " "！"]
["& " "＆"]
[" (" "（"]
[") " "）"]
[".</" "。</"]
["?</" "？</"]
[":</" "：</"]
[" " " "]
]
))
(if (and Begin End)
(setq xp1 Begin xp2 End)
(if (region-active-p)
(setq xp1 (region-beginning) xp2 (region-end))
(setq xp1 (line-beginning-position) xp2 (line-end-position))))
(setq xinputStr (buffer-substring-no-properties xp1 xp2))
(when (not ToDirection)
(setq ToDirection (if current-prefix-arg
(completing-read
"Change to: "
'("english" "chinese")
nil
t)
"auto"
)))
(setq xcontainChinese
(seq-some
(lambda (x) (string-match (aref x 1) xinputStr))
xengToChinesePairs))
(when (string-equal ToDirection "auto")
(setq
ToDirection
(if xcontainChinese
"english"
"chinese")))
(save-restriction
(narrow-to-region xp1 xp2)
(mapc
(lambda (xx)
(progn
(goto-char (point-min))
(while (search-forward (aref xx 0) nil t)
(replace-match (aref xx 1)))))
(cond
((string-equal ToDirection "chinese") xengToChinesePairs)
((string-equal ToDirection "english") (mapcar (lambda (x) (vector (elt x 1) (elt x 0))) xengToChinesePairs))
(t (user-error "Your 3rd argument 「%s」 isn't valid" ToDirection))))
(goto-char (point-max)))))
(defun xah-twitterfy ()
"Shorten words for Twitter 280 char limit on current line or selection.
If `universal-argument' is called first, ask for conversion direction (shorten/lenthen).
Note: calling this function twice in opposite direction does not necessarily return the origial, because the map is not one-to-one.
URL `http://xahlee.info/emacs/emacs/elisp_twitterfy.html'
Created: 2019-03-02
Version: 2025-03-25"
(interactive)
(let (xbeg xend xdirection
(xabbrevMap
[
["\\bare\\b" "r"]
["\\byou\\b" "u"]
["e.g. " "eg "]
["\bto\b" "2"]
[" your" " ur "]
["\\band\\b" "＆"]
["\\bbecause\\b" "∵"]
["\\bcuz\\b" "∵"]
["therefore " "∴"]
[" at " " @ "]
[" love " " ♥ "]
[" one " " 1 "]
[" two " " 2 "]
[" three " " 3 "]
[" four " " 4 "]
[" zero " " 0 "]
["hexadecimal " "hex "]
["Emacs: " "#emacs "]
["JavaScript: " "#JavaScript "]
["Python: " "#python "]
["Ruby: " "#ruby "]
["Perl: " "#perl "]
["Emacs Lisp: " "#emacs #lisp "]
["Elisp: " "#emacs #lisp "]
[", " "，"]
["\\.\\.\\." "…"]
["\\. " "。"]
["\\? " "？"]
[": " "："]
["! " "！"]]
)
(xreverseMap
[
["\\bu\\b" "you"]
["\\br\\b" "are"]
["eg " "e.g. "]
[" 2 " " to "]
["\\bur\\b" "your"]
["\\b＆\\b" "and"]
["\\bcuz\\b" "because"]
["\\b∴\\b" "therefore "]
[" @ " " at "]
[" ♥ " " love "]
[" 1 " " one "]
[" 2 " " two "]
[" 3 " " three "]
[" 4 " " four "]
[" 0 " " zero "]
["hex " "hexadecimal "]
["，" ", "]
["…" "..."]
["。" ". "]
["？" "? "]
["：" ": "]
["！" "! "]
]
))
(seq-setq (xbeg xend) (if (region-active-p) (list (region-beginning) (region-end)) (list (save-excursion (if (re-search-backward "\n[ \t]*\n" nil 1) (match-end 0) (point))) (save-excursion (if (re-search-forward "\n[ \t]*\n" nil 1) (match-beginning 0) (point))))))
(setq xdirection
(if current-prefix-arg
(completing-read "Direction: " '("shorten" "lengthen") nil t)
"auto"
))
(save-restriction
(narrow-to-region xbeg xend)
(when (string-equal xdirection "auto")
(goto-char (point-min))
(setq xdirection
(if (re-search-forward "。\\|，\\|？\\|！" nil t)
"lengthen" "shorten"
)))
(let ((case-fold-search nil))
(mapc
(lambda (xx)
(goto-char (point-min))
(while (re-search-forward (elt xx 0) nil t)
(replace-match (elt xx 1) t t)))
(if (string-equal xdirection "shorten")
xabbrevMap
xreverseMap))
(goto-char (point-min))
(while (re-search-forward " +" nil t)
(replace-match " " t t)))
(goto-char (+ (point-min) 280)))))
(defun xah-html-percent-decode-url (&optional Begin End)
"Decode percent encoded URL of current line or selection.
Example:
%28D%C3%BCrer%29
becomes
(Dürer)
Example:
%E6%96%87%E6%9C%AC%E7%BC%96%E8%BE%91%E5%99%A8
becomes
文本编辑器
URL `http://xahlee.info/emacs/emacs/emacs_url_percent_decode.html'
Created: 2022-04-08
Version: 2023-09-24"
(interactive)
(let (xbeg xend xinput xnewStr)
(if (and Begin End)
(setq xbeg Begin xend End)
(if (region-active-p)
(setq xbeg (region-beginning) xend (region-end))
(setq xbeg (line-beginning-position) xend (line-end-position))))
(setq xinput (buffer-substring-no-properties xbeg xend))
(require 'url-util)
(setq xnewStr (url-unhex-string xinput))
(if (string-equal xnewStr xinput)
(message "percent-decode no change")
(progn
(delete-region xbeg xend)
(insert (decode-coding-string xnewStr 'utf-8))))))
(defcustom xah-recently-closed-buffers-max 40 "The maximum length for `xah-recently-closed-buffers'."
:type 'integer)
(defvar xah-recently-closed-buffers nil "A Alist of recently closed buffers.
Each element is (bufferName . filePath).
The max number to track is controlled by the variable `xah-recently-closed-buffers-max'.")
(defun xah-add-to-recently-closed (&optional BufferName BufferFileName)
"Add to `xah-recently-closed-buffers'.
Version: 2023-03-02"
(let ((xbn (if BufferName BufferName (buffer-name)))
(xbfn (if BufferFileName BufferFileName buffer-file-name)))
(setq xah-recently-closed-buffers (cons (cons xbn xbfn) xah-recently-closed-buffers)))
(when (> (length xah-recently-closed-buffers) xah-recently-closed-buffers-max)
(setq xah-recently-closed-buffers (butlast xah-recently-closed-buffers 1))))
(defvar xah-create-buffer-backup nil "If true, `xah-close-current-buffer' creates a backup file when closing non-file buffer. Version: 2024-11-09")
(setq xah-create-buffer-backup t)
(defvar xah-temp-dir-path nil "Path to temp dir used by xah commands.
by default, the value is dir named temp at `user-emacs-directory'.
Version: 2023-03-21")
(setq xah-temp-dir-path (concat user-emacs-directory "temp/"))
(defun xah-open-last-closed ()
"Open the last closed file.
URL `http://xahlee.info/emacs/emacs/elisp_close_buffer_open_last_closed.html'
Created: 2016-06-19
Version: 2022-03-22"
(interactive)
(if (> (length xah-recently-closed-buffers) 0)
(find-file (cdr (pop xah-recently-closed-buffers)))
(progn (message "No recently close buffer in this session."))))
(defun xah-open-recently-closed ()
"Open recently closed file.
Prompt for a choice.
URL `http://xahlee.info/emacs/emacs/elisp_close_buffer_open_last_closed.html'
Created: 2016-06-19
Version: 2023-09-19"
(interactive)
(find-file
(let ((completion-ignore-case t))
(completing-read
"Open:"
(mapcar (lambda (f) (cdr f)) xah-recently-closed-buffers)
nil t
))))
(defun xah-list-recently-closed ()
"List recently closed file.
URL `http://xahlee.info/emacs/emacs/elisp_close_buffer_open_last_closed.html'
Version: 2016-06-19"
(interactive)
(let ((xbuf (generate-new-buffer "*recently closed*")))
(switch-to-buffer xbuf)
(mapc (lambda (xf) (insert (cdr xf) "\n"))
xah-recently-closed-buffers)))
(defun xah-close-current-buffer ()
"Close the current buffer with possible backup.
• If the buffer is a file and not modified, kill it. If is modified, do nothing. Print a message.
• If the buffer is not a file, and variable `xah-create-buffer-backup' is true, then save a backup to `xah-temp-dir-path' named untitled_‹datetime›_‹randomhex›.txt.
If `universal-argument' is called first, call `kill-buffer'. (this is useful to force kill.)
If the buffer is a file, add the path to the list `xah-recently-closed-buffers'.
URL `http://xahlee.info/emacs/emacs/elisp_close_buffer_open_last_closed.html'
Created: 2016-06-19
Version: 2025-04-13"
(interactive)
(widen)
(cond
(current-prefix-arg (kill-buffer))
((minibufferp (current-buffer)) (minibuffer-keyboard-quit))
((eq major-mode 'dired-mode)
(xah-add-to-recently-closed (buffer-name) default-directory)
(kill-buffer))
((and buffer-file-name (not (buffer-modified-p)))
(xah-add-to-recently-closed (buffer-name) buffer-file-name)
(kill-buffer))
((and buffer-file-name (buffer-modified-p))
(message "buffer file modified. Save it first.\n%s" buffer-file-name))
((and xah-create-buffer-backup (not buffer-file-name) (xah-user-buffer-p) (not (eq (point-max) 1)))
(let ((xnewName (format "%suntitled_%s_%x.txt"
xah-temp-dir-path
(format-time-string "%Y-%m-%d_%H%M%S")
(random #xfffff))))
(when (not (file-exists-p xah-temp-dir-path)) (make-directory xah-temp-dir-path))
(write-region (point-min) (point-max) xnewName)
(xah-add-to-recently-closed (buffer-name) xnewName)
(kill-buffer)))
(t (kill-buffer))))
(defun xah-copy-file-path (&optional DirPathOnlyQ)
"Copy current buffer file path or dired path.
Result is full path.
If `universal-argument' is called first, copy only the dir path.
If in dired, copy the current or marked files.
If a buffer is not file and not dired, copy value of `default-directory'.
URL `http://xahlee.info/emacs/emacs/emacs_copy_file_path.html'
Created: 2018-06-18
Version: 2021-09-30"
(interactive "P")
(let ((xfpath
(if (eq major-mode 'dired-mode)
(progn
(let ((xresult (mapconcat #'identity
(dired-get-marked-files) "\n")))
(if (equal (length xresult) 0)
(progn default-directory )
(progn xresult))))
(if buffer-file-name
buffer-file-name
(expand-file-name default-directory)))))
(kill-new
(if DirPathOnlyQ
(progn
(message "Directory copied: %s" (file-name-directory xfpath))
(file-name-directory xfpath))
(progn
(message "File path copied: %s" xfpath)
xfpath )))))
(when (and (eq system-type 'darwin) (display-graphic-p))
(defun org-export-to-devonthink (arg)
"Export current Org buffer to HTML and send to DEVONthink 3 as a new record.
If ARG is non-nil, pass it to the exporter (e.g., for subtree export)."
(interactive "P")
(require 'org)
(require 'ox-html)
(let* ((org-export-show-temporary-export-buffer nil)
(html-content (org-export-as 'html arg nil t nil))
(escaped-content (replace-regexp-in-string "\"" "\\\\\"" html-content t t))
(title (or (nth 4 (org-heading-components)) (buffer-name)))
(escaped-title (replace-regexp-in-string "\"" "\\\\\"" title t t))
(file-path (or (buffer-file-name) "")))
(do-applescript
(format "tell application id \"com.devon-technologies.think3\"
create record with {name:\"%s\", type:html, source:\"%s\", url:\"%s\"} in current group
end tell"
escaped-title escaped-content file-path))))
)
(defun gen-env-file-based-on-system-name ()
"Generate an env file in user-emacs-directory named after the system."
(let* ((file-name (concat system-name "-env.el"))
(path (expand-file-name file-name user-emacs-directory))
(dirname (file-name-directory path)))
(make-directory dirname t)
(with-temp-file path
(setq-local coding-system-for-write 'utf-8-unix)
(insert
";; -*- mode: emacs-lisp -*-\n"
";; This file was automatically generated and will be overwritten.\n")
(insert (pp-to-string process-environment)))))
(defun load-env-file-based-on-system-name ()
"Load envvars from a system-name-based file in user-emacs-directory."
(let* ((file-name (concat system-name "-env.el"))
(file (expand-file-name file-name user-emacs-directory)))
(if (not (file-exists-p file))
(signal 'file-error
(list "No envvar file exists." file))
(with-temp-buffer
(insert-file-contents file)
(when-let (env (read (current-buffer)))
(let ((tz (getenv-internal "TZ")))
(setq-default
process-environment
(append env (default-value 'process-environment))
exec-path
(append (split-string (getenv "PATH") path-separator t)
(list exec-directory))
shell-file-name
(or (getenv "SHELL")
(default-value 'shell-file-name)))
(when-let (newtz (getenv-internal "TZ"))
(unless (equal tz newtz)
(set-time-zone-rule newtz))))
env)))))
(defun maybe-refresh-env-file-based-on-system-name ()
"Regenerate and load env file if it's missing or older than 30 days."
(let* ((file-name (concat system-name "-env.el"))
(file-path (expand-file-name file-name user-emacs-directory)))
(if (or (not (file-readable-p file-path))
(let* ((attributes (file-attributes file-path))
(mod-time (float-time (nth 5 attributes)))
(now (float-time (current-time)))
(age-days (/ (- now mod-time) 86400.0)))
(>= age-days 30)))
(progn
(message "Generating new env file for system: %s" system-name)
(gen-env-file-based-on-system-name))
(message "Using existing env file for system: %s" system-name))
(load-env-file-based-on-system-name)))
(add-to-list 'ispell-skip-region-alist '("^\s*:PROPERTIES\:$" . "^\s*:END\:$"))
(defun endless/simple-get-word ()
(car-safe (save-excursion (ispell-get-word nil)))
)
(defun endless/ispell-word-then-abbrev (p)
"Call `ispell-word', then create an abbrev for it.
With prefix P, create local abbrev. Otherwise it will
be global.
If there's nothing wrong with the word at point, keep
looking for a typo until the beginning of buffer. You can
skip typos you don't want to fix with `SPC', and you can
abort completely with `C-g'."
(interactive "P")
(let (bef aft)
(save-excursion
(while (if (setq bef (endless/simple-get-word))
(if (ispell-word nil 'quiet)
nil (not (bobp)))
(not (bobp)))
(backward-word)
(backward-char))
(setq aft (endless/simple-get-word)))
(if (and aft bef (not (equal aft bef)))
(let ((aft (downcase aft))
(bef (downcase bef)))
(define-abbrev
(if p local-abbrev-table global-abbrev-table)
bef aft)
(message "\"%s\" now expands to \"%s\" %sally"
bef aft (if p "loc" "glob")))
(user-error "No typo at or before point")))
)
(defun narrow-or-widen-dwim (p)
"Widen if buffer is narrowed, narrow-dwim otherwise.
Dwim means: region, org-src-block, org-fixed-width-region,
org-table-field, org-subtree, or defun, whichever applies
first. Narrowing to:
- org-src-block calls `org-edit-src-code'
- org-fixed-width-region calls `org-edit-fixed-width-region'
- org-table-field calls `org-table-edit-field'
With prefix P, don't widen, just narrow even if buffer is already
narrowed. If called with a prefix on a table field, just make the
full field visible so that it can be edited in place."
(interactive "P")
(declare (interactive-only))
(cond
((and (not p) (buffer-narrowed-p))
(widen))
((and (not p) (org-src-edit-buffer-p))
(org-edit-src-exit))
((and (not p) (equal (buffer-name) "*Org Table Edit Field*"))
(orgtbl-ctrl-c-ctrl-c nil))
((and (not p) (separedit-in-edit-buffer-p))
(separedit-commit))
((region-active-p)
(narrow-to-region (region-beginning) (region-end)))
((derived-mode-p 'org-mode)
(cond ((ignore-errors (org-edit-src-code) t))
((ignore-errors (org-edit-fixed-width-region) t))
((org-at-table-p) (call-interactively 'org-table-edit-field) t)
((ignore-errors (org-narrow-to-block) t))
((ignore-errors (org-narrow-to-element) t))
(t (org-narrow-to-subtree))))
((derived-mode-p 'latex-mode)
(LaTeX-narrow-to-environment))
((ignore-errors (separedit) t))
(t (narrow-to-defun))))
(defun dm/copy-as-rtf ()
"Export region to RTF and copy it to the clipboard."
(interactive)
(save-window-excursion
(let* ((buf (org-export-to-buffer 'html "*Formatted Copy*" nil nil t t))
(html (with-current-buffer buf (buffer-string))))
(with-current-buffer buf
(shell-command-on-region
(point-min)
(point-max)
"textutil -stdin -format html -convert rtf -stdout | pbcopy"))
(kill-buffer buf))))
(defun er-keyboard-quit ()
"Smater version of the built-in `keyboard-quit'.
The generic `keyboard-quit' does not do the expected thing when
the minibuffer is open. Whereas we want it to close the
minibuffer, even without explicitly focusing it.
URL `https://emacsredux.com/blog/2025/06/01/let-s-make-keyboard-quit-smarter/'
Created: 2025-06-04
Version: 2025-06-04"
(interactive)
(if (active-minibuffer-window)
(if (minibufferp)
(minibuffer-keyboard-quit)
(abort-recursive-edit))
(keyboard-quit)))
(defun mac-open-file-using-panel ()
"A quick way to open files with your system file picker,
URL `https://christiantietze.de/posts/2022/12/use-file-open-dialog-for-file-actions/'
Created: 2025-06-04
Version: 2025-06-04"
(interactive)
(let ((last-nonmenu-event nil)
(use-dialog-box t)
(use-file-dialog t))
(call-interactively #'find-file))
)
(defun casual-dired-context-menu-addons (menu click)
"Customize context MENU with CLICK event."
(easy-menu-add-item menu nil casual-dired-sort-menu)
menu)
(defun casual-bookmark-context-menu-addons (menu click)
"Customize context MENU with CLICK event."
(easy-menu-add-item global-map '(menu-bar)
casual-bookmarks-main-menu
"Tools")
menu)
(defun embark-which-key-indicator ()
"An embark indicator that displays keymaps using which-key.
The which-key help message will show the type and value of the
current target followed by an ellipsis if there are further
targets."
(lambda (&optional keymap targets prefix)
(if (null keymap)
(which-key--hide-popup-ignore-command)
(which-key--show-keymap
(if (eq (plist-get (car targets) :type) 'embark-become)
"Become"
(format "Act on %s '%s'%s"
(plist-get (car targets) :type)
(embark--truncate-target (plist-get (car targets) :target))
(if (cdr targets) "…" "")))
(if prefix
(pcase (lookup-key keymap prefix 'accept-default)
((and (pred keymapp) km) km)
(_ (key-binding prefix 'accept-default)))
keymap)
nil nil t (lambda (binding)
(not (string-suffix-p "-argument" (cdr binding))))))))
(defun embark-hide-which-key-indicator (fn &rest args)
"Hide the which-key indicator immediately when using the completing-read prompter."
(which-key--hide-popup-ignore-command)
(let ((embark-indicators
(remq #'embark-which-key-indicator embark-indicators)))
(apply fn args)))
(defun resize-embark-collect-window (&rest _)
(when (memq embark-collect--kind '(:live :completions))
(fit-window-to-buffer (get-buffer-window)
(floor (frame-height) 2) 1)))
(defun my/dwim-shell-command-convert-to-gif ()
"Convert all marked videos to optimized gif(s)."
(interactive)
(dwim-shell-command-on-marked-files
"Convert to gif"
"ffmpeg -loglevel quiet -stats -y -i '<<f>>' -pix_fmt rgb24 -r 15 '<<fne>>.gif'"
:utils "ffmpeg"))
(defun my/casual-update-location-from-journelly ()
"Set casual calendar latitude and longitude from journelly-get-location."
(interactive)
(let ((location (journelly-get-location)))
(when location
(let ((lat (cdr (assoc 'lat location)))
(lon (cdr (assoc 'lon location))))
(when lat
(setq casual-calendar--customize-calendar-latitude lat))
(when lon
(setq casual-calendar--customize-calendar-longitude lon))
(message "casual-calendar location set to: %s, %s" lat lon)))))
(defun xah-html-htmlize-string (pinput-str pmajor-mode-name)
"Take pinput-str and return a htmlized version using pmajor-mode-name.
The purpose is to syntax color source code in HTML.
If pmajor-mode-name is string. It'll be converted to symbol and if is not in `obarray', `fundamental-mode' is used.
This function requires the `htmlize-buffer' from htmlize.el by Hrvoje Niksic.
Version 2018-09-28"
(interactive)
(let (xoutputbuff
xresultStr
(xmajorModeSym (intern-soft pmajor-mode-name)))
(with-temp-buffer
(insert pinput-str)
(if (fboundp xmajorModeSym)
(funcall xmajorModeSym)
(fundamental-mode))
(font-lock-ensure)
(setq xoutputbuff (htmlize-buffer)))
(with-current-buffer xoutputbuff
(let (xp1 xp2 )
(setq xp1 (search-forward "<pre>"))
(setq xp2 (search-forward "</pre>"))
(setq xresultStr (buffer-substring-no-properties (+ xp1 1) (- xp2 6)))))
(kill-buffer xoutputbuff)
xresultStr ))
(defvar xah-html-lang-name-map nil "a alist that maps lang name. Each element has this form
(‹lang code› . [‹emacs major mode name› ‹file extension›])
For example:
(\"emacs-lisp\" . [\"xah-elisp-mode\" \"el\"])")
(setq xah-html-lang-name-map
'(
("ahk" . ["ahk-mode" "ahk"])
("code" . ["fundamental-mode" "txt"])
("output" . ["fundamental-mode" "txt"])
("bash" . ["sh-mode" "sh"])
("unix-config" . ["conf-space-mode" "conf"])
("cmd" . ["dos-mode" "bat"])
("bbcode" . ["xbbcode-mode" "bbcode"])
("markdown" . ["markdown-mode" "md"])
("c" . ["c-mode" "c"])
("cpp" . ["c++-mode" "cpp"])
("common-lisp" . ["lisp-mode" "lisp"])
("org-mode" . ["org-mode" "org"])
("clojure" . ["xah-clojure-mode" "clj"])
("typescript" . ["typescript-mode" "ts"])
("css" . ["xah-css-mode" "css"])
("emacs-lisp" . ["xah-elisp-mode" "el"])
("dart" . ["dart-mode" "dart"])
("haskell" . ["haskell-mode" "hs"])
("golang" . ["go-mode" "go"])
("html" . ["xah-html-mode" "html"])
("mysql" . ["sql-mode" "sql"])
("xml" . ["sgml-mode" "xml"])
("html6" . ["xah-html6-mode" "html6"])
("java" . ["java-mode" "java"])
("js" . ["xah-js-mode" "js"])
("nodejs" . ["xah-js-mode" "js"])
("lsl" . ["xlsl-mode" "lsl"])
("latex" . ["latex-mode" "txt"])
("ocaml" . ["tuareg-mode" "ml"])
("perl" . ["perl-mode" "pl"])
("php" . ["xah-php-mode" "php"])
("povray" . ["pov-mode" "pov"])
("powershell" . ["powershell-mode" "ps1"])
("python" . ["python-mode" "py"])
("python3" . ["python-mode" "py3"])
("qi" . ["shen-mode" "qi"])
("ruby" . ["ruby-mode" "rb"])
("scala" . ["scala-mode" "scala"])
("apl" . ["gnu-apl-mode" "apl"])
("scheme" . ["scheme-mode" "scm"])
("racket" . ["racket-mode" "rkt"])
("prolog" . ["prolog-mode" "prolog"])
("yasnippet" . ["snippet-mode" "yasnippet"])
("vbs" . ["visual-basic-mode" "vbs"])
("visualbasic" . ["visual-basic-mode" "vbs"])
("mathematica" . ["fundamental-mode" "m"])
("math" . ["fundamental-mode" "txt"])
("slim" . ["slim-mode" "slim"])
("yaml" . ["yaml-mode" "yaml"])
("haml" . ["haml-mode" "haml"])
("sass" . ["sass-mode" "sass"])
("scss" . ["xah-css-mode" "css"])
("vimrc" . ["vimrc-mode" "vim"])))
(defvar xah-html-lang-mode-list nil "List of supported language mode names.")
(defun xah-html-langcode-to-major-mode-name (P-lang-code P-lang-code-map)
"get the `major-mode' name associated with P-lang-code.
return major-mode name as string. If none found, return nil.
Version 2017-01-10"
(interactive)
(elt (cdr (assoc P-lang-code P-lang-code-map)) 0))
(defun xah-html-htmlize-region (pp1 pp2 pmode-name )
"Htmlized region pp1 pp2 using `major-mode' pmode-name.
This function requires the `htmlize-buffer' from htmlize.el by Hrvoje Niksic.
Version 2016-12-18 (2022-06-20)"
(interactive
(list (region-beginning)
(region-end)
(completing-read "Chose mode for coloring:" xah-html-lang-mode-list)))
(let* (
(xinputStr (buffer-substring-no-properties pp1 pp2))
(xoutStr (xah-html-htmlize-string xinputStr pmode-name)))
(if (string-equal xinputStr xoutStr)
nil
(progn
(delete-region pp1 pp2)
(insert xoutStr)))))
(defun xah-html-get-precode-langCode ()
"Get the langCode and position boundary of current HTML pre block.
A pre block is text of this form
<pre class=\"‹langCode›\">…▮…</pre>.
Your cursor must be between the tags.
Returns a vector [langCode pos1 pos2], where pos1 pos2 are the boundary of the text content.
Version 2018-09-28"
(interactive)
(let (xlangCode xp1 xp2)
(save-excursion
(re-search-backward "<pre class=\"\\([-A-Za-z0-9]+\\)\"") (setq xlangCode (match-string 1))
(setq xp1 (search-forward ">")) (backward-char 1)
(xah-html-skip-tag-forward)
(setq xp2 (search-backward "</pre>")) (vector xlangCode xp1 xp2))))
(defun xah-html-htmlize-precode (plang-code-map)
"Replace text enclosed by “pre” tag to htmlized code.
For example, if the cursor is inside the pre tags <pre class=\"‹langCode›\">…▮…</pre>, then after calling, the text inside the pre tag will be htmlized. That is, wrapped with many span tags for syntax coloring.
The opening tag must be of the form <pre class=\"‹langCode›\">. The ‹langCode› determines what emacs mode is used to colorize the text. See `xah-html-lang-name-map' for possible ‹langCode›.
Cursor will end up right before </pre>.
See also: `xah-html-dehtmlize-precode', `xah-html-toggle-syntax-coloring-markup'.
This function requires the `htmlize-buffer' from htmlize.el by Hrvoje Niksic.
Version 2018-09-28"
(interactive (list xah-html-lang-name-map))
(let* (
(xprecodeData (xah-html-get-precode-langCode))
(xlangCode (elt xprecodeData 0))
(xp1 (elt xprecodeData 1))
(xp2 (elt xprecodeData 2))
(xmodeName (xah-html-langcode-to-major-mode-name xlangCode plang-code-map)))
(xah-html-htmlize-region xp1 xp2 xmodeName t)))