diff options
author | Case Duckworth | 2021-09-23 17:11:30 -0500 |
---|---|---|
committer | Case Duckworth | 2021-09-23 17:11:30 -0500 |
commit | df207947bae8f29dce49815587436cde9f49ebed (patch) | |
tree | 5a04990f32ea5058ad3f084c9928af9eb8bc6d09 /lisp | |
parent | Add TODO (diff) | |
download | emacs-df207947bae8f29dce49815587436cde9f49ebed.tar.gz emacs-df207947bae8f29dce49815587436cde9f49ebed.zip |
blehhaheoi
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/acdw.el | 132 |
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. | ||
328 | Actually sorts all forms, but based on the logic of `setup'. | ||
329 | In 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. | ||
533 | Optional argument MAKE-DIRECTORY makes the directory. | ||
534 | Logic 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 | ||