about summary refs log tree commit diff stats
path: root/lisp
diff options
context:
space:
mode:
authorCase Duckworth2021-09-23 17:11:30 -0500
committerCase Duckworth2021-09-23 17:11:30 -0500
commitdf207947bae8f29dce49815587436cde9f49ebed (patch)
tree5a04990f32ea5058ad3f084c9928af9eb8bc6d09 /lisp
parentAdd TODO (diff)
downloademacs-df207947bae8f29dce49815587436cde9f49ebed.tar.gz
emacs-df207947bae8f29dce49815587436cde9f49ebed.zip
blehhaheoi
Diffstat (limited to 'lisp')
-rw-r--r--lisp/acdw.el132
1 files changed, 128 insertions, 4 deletions
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."
323 (insert-before-markers real) 323 (insert-before-markers real)
324 (delete-region (point) (marker-position end))))))))) 324 (delete-region (point) (marker-position end)))))))))
325 325
326(defun acdw/sort-setups ()
327 "Sort `setup' forms in the current buffer.
328Actually sorts all forms, but based on the logic of `setup'.
329In short, DO NOT USE THIS FUNCTION!!!"
330 (save-excursion
331 (sort-sexps
332 (point-min) (point-max)
333 (lambda (sexp)
334 (format "%S" (cadr sexp)))
335 (lambda (s1 s2) ; oh god, this is worse.
336 (let* ((s1 (cdr s1)) (s2 (cdr s2)) ; for the strings themselves
337 (s1-require (string-match ":require" s1))
338 (s2-require (string-match ":require" s2))
339 (s1-straight (string-match ":straight" s1))
340 (s2-straight (string-match ":straight" s2))
341 (s1-bare (not (or s1-require s1-straight)))
342 (s2-bare (not (or s2-require s2-straight))))
343 (cond
344 ;; if both are the same, sort regular style
345 ((or (and s1-require s2-require)
346 (and s1-bare s2-bare))
347 (string< s1 s2))
348 ((and s1-straight s2-straight)
349 (let* ((r (rx ":straight" (? "-if") (* space) (? "(")))
350 (s1 (replace-regexp-in-string r "" s1))
351 (s2 (replace-regexp-in-string r "" s2)))
352 (message "'%S' '%S'" s1 s2)
353 (string< s1 s2)))
354 ;; requires should go first
355 ((and s1-require (not s2-require)) t)
356 ((and (not s1-require) s2-require) nil)
357 ;; straights should go last
358 ((and s1-straight (not s2-straight)) nil)
359 ((and (not s1-straight) s2-straight) t)
360 ;; else, just sort em.
361 (t (string< s1 s2))))))))
362
326 363
327;;; Emacs configuration functions 364;;; Emacs configuration functions
328 365
@@ -402,6 +439,59 @@ first."
402 (setq deactivate-mark t) 439 (setq deactivate-mark t)
403 nil) 440 nil)
404 441
442;; https://emacs.stackexchange.com/questions/36366/
443(defun html-body-id-filter (output backend info)
444 "Remove random ID attributes generated by Org."
445 (when (eq backend 'html)
446 (replace-regexp-in-string
447 " id=\"[[:alpha:]-]*org[[:alnum:]]\\{7\\}\""
448 ""
449 output t)))
450
451(defun html-body-div-filter (output backend info)
452 "Remove wrapping divs generated by Org."
453 (when (eq backend 'html)
454 (replace-regexp-in-string
455 "</?div[^>]*>\n*" ""
456 output t)))
457
458(defun org-demote-headings (backend)
459 (while (/= (point) (point-max))
460 (org-next-visible-heading 1)
461 (org-demote-subtree)))
462
463(defun acdw/org-export-copy-html ()
464 "Copy a tree as HTML."
465 (interactive)
466 (require 'ox-html)
467 (org-export-with-buffer-copy
468 ;; (add-hook 'org-export-before-parsing-hook #'org-demote-headings nil t)
469 (let ((extracted-heading (acdw/org-extract-heading-text))
470 (org-export-show-temporary-export-buffer nil)
471 (org-export-filter-final-output-functions
472 '(html-body-id-filter html-body-div-filter))
473 (org-export-with-smart-quotes nil)
474 (org-export-smart-quotes-alist nil))
475 (insert "* ORG IS STUPID SOMETIMES\n")
476 (goto-char (point-min))
477 (org-html-export-as-html nil t nil t)
478 (with-current-buffer "*Org HTML Export*"
479 (goto-char (point-min))
480 (replace-regexp "<h2>.*</h2>" "")
481 (insert "<h2>" extracted-heading "</h2>")
482 (flush-lines "^$" (point-min) (point-max))
483 (let ((sentence-end-double-space nil))
484 (unfill-region (point-min) (point-max)))
485 (replace-regexp "<h" "\n<h" nil (1+ (point-min)) (point-max))
486 (replace-regexp "<p" "\n<p" nil (point-min) (point-max))
487 (replace-regexp "<p> +" "<p>" nil (point-min) (point-max))
488 (replace-regexp " +</p>" "</p>" nil (point-min) (point-max))
489 (copy-region-as-kill (point-min) (point-max)))))
490 (when (called-interactively-p 'interactive)
491 (indicate-copied-region))
492 (setq deactivate-mark t)
493 nil)
494
405(defun acdw/org-export-copy () 495(defun acdw/org-export-copy ()
406 "copy a tree" 496 "copy a tree"
407 (interactive) 497 (interactive)
@@ -409,14 +499,17 @@ first."
409 (let ((extracted-heading (acdw/org-extract-heading-text))) 499 (let ((extracted-heading (acdw/org-extract-heading-text)))
410 ;; Export to ASCII - not async, subtree only, visible-only, body-only 500 ;; Export to ASCII - not async, subtree only, visible-only, body-only
411 (let ((org-export-show-temporary-export-buffer nil)) 501 (let ((org-export-show-temporary-export-buffer nil))
412 (org-ascii-export-as-ascii nil t t t)) 502 (org-ascii-export-as-ascii nil t nil t))
413 (with-current-buffer "*Org ASCII Export*" 503 (with-current-buffer "*Org ASCII Export*"
414 (goto-char (point-min)) 504 (goto-char (point-min))
415 (insert extracted-heading) 505 (insert extracted-heading)
416 (newline) 506 (newline 2)
417 (newline)
418 507
419 (unfill-region (point-min) (point-max)) 508 (replace-regexp org-list-full-item-re "
509\4")
510
511 (let ((sentence-end-double-space nil))
512 (unfill-region (point-min) (point-max)))
420 (flush-lines "^$" (point-min) (point-max)) 513 (flush-lines "^$" (point-min) (point-max))
421 514
422 (copy-region-as-kill (point-min) (point-max))) 515 (copy-region-as-kill (point-min) (point-max)))
@@ -435,6 +528,19 @@ first."
435 (match-string-no-properties 2 match)) 528 (match-string-no-properties 2 match))
436 heading)))) 529 heading))))
437 530
531(defun acdw/sync-dir (&optional file make-directory)
532 "Return FILE from ~/Sync.
533Optional argument MAKE-DIRECTORY makes the directory.
534Logic is as in `acdw/dir', which see."
535 (let ((dir (expand-file-name (convert-standard-filename "~/Sync/"))))
536 (if file
537 (let ((file-name (expand-file-name (convert-standard-filename file)
538 dir)))
539 (when make-directory
540 (make-directory (file-name-directory file-name) 'parents))
541 file-name)
542 dir)))
543
438(defun acdw/dir (&optional file make-directory) 544(defun acdw/dir (&optional file make-directory)
439 "Place Emacs files in one place. 545 "Place Emacs files in one place.
440 546
@@ -695,6 +801,24 @@ When called with PREFIX, just kill Emacs without confirmation."
695 (ignore-errors 801 (ignore-errors
696 (delete-frame)))) 802 (delete-frame))))
697 803
804(defun acdw/disabled-command-function (&optional cmd keys)
805 (let ((cmd (or cmd this-command))
806 (keys (or keys (this-command-keys))))
807 ;; this logic stolen from original `disabled-command-function'
808 (if (or (eq (aref keys 0) (if (stringp keys)
809 (aref "\M-x" 0)
810 ?\M-x))
811 (and (>= (length keys) 2)
812 (eq (aref keys 0) meta-prefix-char)
813 (eq (aref keys 1) ?x)))
814 ;; it's been run as an M-x command, we want to do it
815 (call-interactively cmd)
816 ;; else, tell the user it's disabled.
817 (message (substitute-command-keys
818 (concat "Command `%s' has been disabled. "
819 "Run with \\[execute-extended-command]."))
820 cmd))))
821
698 822
699;;; cribbed 823;;; cribbed
700 824