1 files changed, 128 insertions, 4 deletions

@@ -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
+     "</?div[^>]*>\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 "<h2>.*</h2>" "")
+       (insert "<h2>" extracted-heading "</h2>")
+       (flush-lines "^$" (point-min) (point-max))
+       (let ((sentence-end-double-space nil))
+         (unfill-region (point-min) (point-max)))
+       (replace-regexp "<h" "\n<h" nil (1+ (point-min)) (point-max))
+       (replace-regexp "<p" "\n<p" nil (point-min) (point-max))
+       (replace-regexp "<p> +" "<p>" nil (point-min) (point-max))
+       (replace-regexp " +</p>" "</p>" 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