From df207947bae8f29dce49815587436cde9f49ebed Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Thu, 23 Sep 2021 17:11:30 -0500 Subject: blehhaheoi --- lisp/acdw.el | 132 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 128 insertions(+), 4 deletions(-) (limited to 'lisp/acdw.el') diff --git a/lisp/acdw.el b/lisp/acdw.el index dcf7b19..b146f58 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el @@ -323,6 +323,43 @@ with `string<' starting with the key determined by KEY-FN." (insert-before-markers real) (delete-region (point) (marker-position end))))))))) +(defun acdw/sort-setups () + "Sort `setup' forms in the current buffer. +Actually sorts all forms, but based on the logic of `setup'. +In short, DO NOT USE THIS FUNCTION!!!" + (save-excursion + (sort-sexps + (point-min) (point-max) + (lambda (sexp) + (format "%S" (cadr sexp))) + (lambda (s1 s2) ; oh god, this is worse. + (let* ((s1 (cdr s1)) (s2 (cdr s2)) ; for the strings themselves + (s1-require (string-match ":require" s1)) + (s2-require (string-match ":require" s2)) + (s1-straight (string-match ":straight" s1)) + (s2-straight (string-match ":straight" s2)) + (s1-bare (not (or s1-require s1-straight))) + (s2-bare (not (or s2-require s2-straight)))) + (cond + ;; if both are the same, sort regular style + ((or (and s1-require s2-require) + (and s1-bare s2-bare)) + (string< s1 s2)) + ((and s1-straight s2-straight) + (let* ((r (rx ":straight" (? "-if") (* space) (? "("))) + (s1 (replace-regexp-in-string r "" s1)) + (s2 (replace-regexp-in-string r "" s2))) + (message "'%S' '%S'" s1 s2) + (string< s1 s2))) + ;; requires should go first + ((and s1-require (not s2-require)) t) + ((and (not s1-require) s2-require) nil) + ;; straights should go last + ((and s1-straight (not s2-straight)) nil) + ((and (not s1-straight) s2-straight) t) + ;; else, just sort em. + (t (string< s1 s2)))))))) + ;;; Emacs configuration functions @@ -402,6 +439,59 @@ first." (setq deactivate-mark t) nil) +;; https://emacs.stackexchange.com/questions/36366/ +(defun html-body-id-filter (output backend info) + "Remove random ID attributes generated by Org." + (when (eq backend 'html) + (replace-regexp-in-string + " id=\"[[:alpha:]-]*org[[:alnum:]]\\{7\\}\"" + "" + output t))) + +(defun html-body-div-filter (output backend info) + "Remove wrapping divs generated by Org." + (when (eq backend 'html) + (replace-regexp-in-string + "]*>\n*" "" + output t))) + +(defun org-demote-headings (backend) + (while (/= (point) (point-max)) + (org-next-visible-heading 1) + (org-demote-subtree))) + +(defun acdw/org-export-copy-html () + "Copy a tree as HTML." + (interactive) + (require 'ox-html) + (org-export-with-buffer-copy + ;; (add-hook 'org-export-before-parsing-hook #'org-demote-headings nil t) + (let ((extracted-heading (acdw/org-extract-heading-text)) + (org-export-show-temporary-export-buffer nil) + (org-export-filter-final-output-functions + '(html-body-id-filter html-body-div-filter)) + (org-export-with-smart-quotes nil) + (org-export-smart-quotes-alist nil)) + (insert "* ORG IS STUPID SOMETIMES\n") + (goto-char (point-min)) + (org-html-export-as-html nil t nil t) + (with-current-buffer "*Org HTML Export*" + (goto-char (point-min)) + (replace-regexp "

.*

" "") + (insert "

" extracted-heading "

") + (flush-lines "^$" (point-min) (point-max)) + (let ((sentence-end-double-space nil)) + (unfill-region (point-min) (point-max))) + (replace-regexp " +" "

" nil (point-min) (point-max)) + (replace-regexp " +

" "

" nil (point-min) (point-max)) + (copy-region-as-kill (point-min) (point-max))))) + (when (called-interactively-p 'interactive) + (indicate-copied-region)) + (setq deactivate-mark t) + nil) + (defun acdw/org-export-copy () "copy a tree" (interactive) @@ -409,14 +499,17 @@ first." (let ((extracted-heading (acdw/org-extract-heading-text))) ;; Export to ASCII - not async, subtree only, visible-only, body-only (let ((org-export-show-temporary-export-buffer nil)) - (org-ascii-export-as-ascii nil t t t)) + (org-ascii-export-as-ascii nil t nil t)) (with-current-buffer "*Org ASCII Export*" (goto-char (point-min)) (insert extracted-heading) - (newline) - (newline) + (newline 2) - (unfill-region (point-min) (point-max)) + (replace-regexp org-list-full-item-re " +\4") + + (let ((sentence-end-double-space nil)) + (unfill-region (point-min) (point-max))) (flush-lines "^$" (point-min) (point-max)) (copy-region-as-kill (point-min) (point-max))) @@ -435,6 +528,19 @@ first." (match-string-no-properties 2 match)) heading)))) +(defun acdw/sync-dir (&optional file make-directory) + "Return FILE from ~/Sync. +Optional argument MAKE-DIRECTORY makes the directory. +Logic is as in `acdw/dir', which see." + (let ((dir (expand-file-name (convert-standard-filename "~/Sync/")))) + (if file + (let ((file-name (expand-file-name (convert-standard-filename file) + dir))) + (when make-directory + (make-directory (file-name-directory file-name) 'parents)) + file-name) + dir))) + (defun acdw/dir (&optional file make-directory) "Place Emacs files in one place. @@ -695,6 +801,24 @@ When called with PREFIX, just kill Emacs without confirmation." (ignore-errors (delete-frame)))) +(defun acdw/disabled-command-function (&optional cmd keys) + (let ((cmd (or cmd this-command)) + (keys (or keys (this-command-keys)))) + ;; this logic stolen from original `disabled-command-function' + (if (or (eq (aref keys 0) (if (stringp keys) + (aref "\M-x" 0) + ?\M-x)) + (and (>= (length keys) 2) + (eq (aref keys 0) meta-prefix-char) + (eq (aref keys 1) ?x))) + ;; it's been run as an M-x command, we want to do it + (call-interactively cmd) + ;; else, tell the user it's disabled. + (message (substitute-command-keys + (concat "Command `%s' has been disabled. " + "Run with \\[execute-extended-command].")) + cmd)))) + ;;; cribbed -- cgit 1.4.1-21-gabe81