From 43bed1f97e6f1a229553d7a25dc437741326772e Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 10 May 2023 13:08:35 -0500 Subject: Bankruptcy 10 --- lisp/acdw.el | 384 ----------------------------------------------------------- 1 file changed, 384 deletions(-) delete mode 100644 lisp/acdw.el (limited to 'lisp/acdw.el') diff --git a/lisp/acdw.el b/lisp/acdw.el deleted file mode 100644 index b76b947..0000000 --- a/lisp/acdw.el +++ /dev/null @@ -1,384 +0,0 @@ -;;; acdw.el --- My Emacs extras -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) -(require 'seq) - -(defmacro defdir (name directory &optional docstring makedir) - "Define a variable and a function NAME expanding to DIRECTORY. -DOCSTRING is applied to the variable; its default is DIRECTORY's -path. If MAKEDIR is non-nil, the directory and its parents will -be created." - (declare (indent 2) (doc-string 3)) - `(progn - (defvar ,name (expand-file-name ,directory) - ,(concat (or docstring (format "%s" directory)) "\n" - "Defined by `defdir'.")) - (defun ,name (file &optional mkdir) - ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n" - "If MKDIR is non-nil, parent directories are created.\n" - "Defined by `defdir'.") - (let ((file-name (expand-file-name - (convert-standard-filename file) ,name))) - (when mkdir - (make-directory (file-name-directory file-name) :parents)) - file-name)) - ,(if makedir - `(make-directory ,directory :parents) - `(unless (file-exists-p ,directory) - (warn "Directory `%s' doesn't exist." ,directory))))) - -(defun choose-executable (&rest programs) - "Return the first of PROGRAMS that exists in the system's $PATH. -Each of PROGRAMS can be a single string, or a list. If it's a list then its car -will be tested with `executable-find', and the entire list returned. This -enables passing arguments to a calling function." - (catch 'found - (dolist (prog programs) - (let ((exec (executable-find (car (ensure-list prog)))) - (args (cdr-safe prog))) - (when exec - (throw 'found (if args (cons exec args) exec))))))) - -(defun file-string (file) - "Return the contents of FILE as a string." - (with-current-buffer (find-file-noselect file) - (buffer-string))) - -(defun unsmartify-region (begin end) - "Replace \"smart\" punctuation with \"dumb\" counterparts." - (interactive "*r") - (save-excursion - (goto-char begin) - (while (re-search-forward "[“”‘’–—]" end t) - (let ((replace (pcase (match-string 0) - ((or "“" "”") "\"") - ((or "‘" "’") "'") - ("–" "--") - ("—" "---")))) - (replace-match replace nil nil))))) - -(defun unsmartify-dwim () - "Unsmartify the current region or the entire buffer." - (interactive) - (if (region-active-p) - (unsmartify-region (region-beginning) (region-end)) - (unsmartify-region (point-min) (point-max)))) - -(defun ++concat (func strings) - "Concat STRINGS processed by FUNC. -Each of STRINGS can be a bare string or a list. Strings are -passed through as-is, but lists are passed to FUNC first as -arguments. Finally, all the resulting strings are `mapconcat'-ed -together. - -As a special case, if `:separator' is the first of STRINGS, the -string following will be used as a separator. Otherwise, a -newline will be used." - (let (separator) - (when (eq (car strings) :separator) - (setq separator (cadr strings) - strings (cddr strings))) - (mapconcat (lambda (s) - (cond - ((listp s) (apply func s)) - ((stringp s) s) - (t (user-error "Bad argument: %S" s)))) - strings - (or separator "\n")))) - -(defun format-concat (&rest strings) - "Concatenate formatted STRINGS. -Each of STRINGS can be a bare string or a list. Bare strings are passed as-is -to `mapconcat' for concatenation and separation. Lists, however, are passed to -`format' first. - -If `:separator' is the first of STRINGS, the next string will be -used as a separator." - (++concat #'format strings)) - -(defun list-append-removing-duplicates (&rest lists) - "Append LISTS, removing duplicates from the result. -Any keyword arguments to `cl-remove-duplicates' should come -before the LISTS." - (let (cl-remove-duplicates-args) - (while (keywordp (car lists)) - (push (pop lists) cl-remove-duplicates-args) - (push (pop lists) cl-remove-duplicates-args)) - (apply #'cl-remove-duplicates (apply #'append lists) - (nreverse cl-remove-duplicates-args)))) - -(defun mapc-buffers (func &optional predicate) - "Map FUNC over buffers matching PREDICATE. -Both FUNC and PREDICATE will be executed with no arguments and in -the context of each buffer. - -If PREDICATE is nil or not given, map FUNC over all buffers." - (cl-loop for buf being the buffers - do (with-current-buffer buf - (when (and predicate - (funcall predicate)) - (funcall func))))) - -(defun mapc-buffers-modes (func &rest modes) - "Map FUNC over buffers derived from MODES. -FUNC will be executed with no arguments and in the context of -each buffer." - (mapc-buffers func - (lambda () - (apply #'derived-mode-p modes)))) - -(defun find-font (&rest fonts) - "Return the first font of FONTS that is installed." - (cl-loop with ffl = (font-family-list) - for font in fonts - if (member font ffl) - return font)) - -(defmacro progress@around (fn message &optional name) - "Define :around advice for functions adding a simple progress reporter." - (let ((orig (gensym)) - (args (gensym)) - (prog (gensym))) - `(define-advice ,fn (:around (,orig &rest ,args) ,(or name 'progress)) - ,(format "Add a simple progress reporter to %s." fn) - (let ((,prog (make-progress-reporter - ,(format "%s..." (string-remove-suffix "..." message))))) - (apply ,orig ,args) - (progress-reporter-done ,prog))))) - - - -;;; Ispell in .dir-locals - -;; Let Emacs know a list of strings is safe -(defun +ispell-safe-local-p (list) - (and (listp list) - (seq-every-p #'stringp list))) - -;; Can I instruct ispell to insert LocalWords in a different file? -;; https://emacs.stackexchange.com/q/31396/2264 - -;; How can I move all my file-local LocalWords to .dir-locals.el? -;; https://emacs.stackexchange.com/q/31419 - -;; Adapted from ispell.el:ispell-buffer-local-words -(defun +ispell-buffer-local-words-list () - (let (words) - (or ispell-buffer-local-name - (setf ispell-buffer-local-name (buffer-name))) - (save-excursion - (goto-char (point-min)) - (while (search-forward ispell-words-keyword nil t) - (let ((end (point-at-eol)) - (ispell-casechars (ispell-get-casechars)) - string) - (while (re-search-forward " *\\([^ ]+\\)" end t) - (setf string (match-string-no-properties 1)) - (if (and (< 1 (length string)) - (equal 0 (string-match ispell-casechars string))) - (push string words)))))) - words)) - -;;;###autoload -(defun +ispell-move-buffer-words-to-dir-locals (&optional arg) - "Move the current buffer-local words to .dir-locals.el. -This function prompts the user to save .dir-locals.el, unless -prefix ARG is non-nil; then it just saves them." - (interactive "P") - (unless (buffer-file-name) - (user-error "Buffer not attached to file")) - (hack-dir-local-variables) - (let ((print-level nil) - (print-length nil) - (before-save-hook nil) - (after-save-hook nil)) - (when-let ((new-words (cl-remove-if - (lambda (el) (eq el '\.\.\.)) ; XXX: NO IDEA - ; where this came from - (list-append-removing-duplicates - :test #'string= - ispell-buffer-session-localwords - (alist-get 'ispell-buffer-session-localwords - dir-local-variables-alist) - (alist-get 'ispell-buffer-session-localwords - file-local-variables-alist) - (+ispell-buffer-local-words-list))))) - (save-excursion - (add-dir-local-variable - major-mode - 'ispell-buffer-session-localwords - (setf ispell-buffer-session-localwords - new-words)) - (when (or arg - (y-or-n-p "Save .dir-locals.el?")) - (save-buffer)) - (bury-buffer)) - (or ispell-buffer-local-name - (setf ispell-buffer-local-name (buffer-name))) - (save-excursion - (goto-char (point-min)) - (while (search-forward ispell-words-keyword nil t) - (delete-region (point-at-bol) (1+ (point-at-eol)))))))) - -;;;###autoload -(defun +ispell-move-buffer-words-to-dir-locals-hook () - "Convenience function for binding to a hook." - (+ispell-move-buffer-words-to-dir-locals t)) - - -;;; Comment-or-uncomment-sexp -;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html - -(defun +lisp-uncomment-sexp (&optional n) - "Uncomment N sexps around point." - (interactive "P") - (let* ((initial-point (point-marker)) - (inhibit-field-text-motion t) - (p) - (end (save-excursion - (when (elt (syntax-ppss) 4) - (re-search-backward comment-start-skip - (line-beginning-position) - t)) - (setq p (point-marker)) - (comment-forward (point-max)) - (point-marker))) - (beg (save-excursion - (forward-line 0) - (while (and (not (bobp)) - (= end (save-excursion - (comment-forward (point-max)) - (point)))) - (forward-line -1)) - (goto-char (line-end-position)) - (re-search-backward comment-start-skip - (line-beginning-position) - t) - (ignore-errors - (while (looking-at-p comment-start-skip) - (forward-char -1))) - (point-marker)))) - (unless (= beg end) - (uncomment-region beg end) - (goto-char p) - ;; Indentify the "top-level" sexp inside the comment. - (while (and (ignore-errors (backward-up-list) t) - (>= (point) beg)) - (skip-chars-backward (rx (syntax expression-prefix))) - (setq p (point-marker))) - ;; Re-comment everything before it. - (ignore-errors - (comment-region beg p)) - ;; And everything after it. - (goto-char p) - (forward-sexp (or n 1)) - (skip-chars-forward "\r\n[:blank:]") - (if (< (point) end) - (ignore-errors - (comment-region (point) end)) - ;; If this is a closing delimiter, pull it up. - (goto-char end) - (skip-chars-forward "\r\n[:blank:]") - (when (eq 5 (car (syntax-after (point)))) - (delete-indentation)))) - ;; Without a prefix, it's more useful to leave point where - ;; it was. - (unless n - (goto-char initial-point)))) - -(defun +lisp-comment-sexp--raw () - "Comment the sexp at point or ahead of point." - (pcase (or (bounds-of-thing-at-point 'sexp) - (save-excursion - (skip-chars-forward "\r\n[:blank:]") - (bounds-of-thing-at-point 'sexp))) - (`(,l . ,r) - (goto-char r) - (skip-chars-forward "\r\n[:blank:]") - (save-excursion - (comment-region l r)) - (skip-chars-forward "\r\n[:blank:]")))) - -(defun +lisp-comment-or-uncomment-sexp (&optional n) - "Comment the sexp at point and move past it. -If already inside (or before) a comment, uncomment instead. -With a prefix argument N, (un)comment that many sexps." - (interactive "P") - (if (or (elt (syntax-ppss) 4) - (< (save-excursion - (skip-chars-forward "\r\n[:blank:]") - (point)) - (save-excursion - (comment-forward 1) - (point)))) - (+lisp-uncomment-sexp n) - (dotimes (_ (or n 1)) - (+lisp-comment-sexp--raw)))) - - -;;; Random shit - -(defun insert-iso-date (&optional arg) - "Insert current date formatted ISO-8601 style. -When called with \\[universal-argument] \\[insert-iso-date], -include the time. When called with \\[universal-argument] -\\[universal-argument] \\[insert-iso-date], prompt the user for the -`format-time-string' format to use." - (interactive "P") - (insert (format-time-string (pcase arg - ('nil "%F") - ('(4) "%FT%T%z") - (_ (read-string "Time format: ")))))) - -(defun unfill-paragraph () - "Unfill the current paragraph." - (interactive) - (let ((fill-column most-positive-fixnum) - (fill-paragraph-function nil)) - (fill-paragraph))) - -(defun fill-with-double-spaced-sentences-dwim (&optional start end) - "Fill paragraph or region, double-spacing sentences." - (interactive) - (let ((sentence-end-double-space t)) - (unless (region-active-p) - (mark-paragraph)) - (repunctuate-sentences :no-query - (region-beginning) - (region-end)) - (fill-region (region-beginning) - (region-end)))) - -(defun fill-with-double-spaced-sentences-dwim (&optional start end) - "Fill from START to END, double-spacing sentences. -If START to END aren't given, or if a region isn't in use, fill -the current paragraph." - (interactive "*r") - (let ((sentence-end-double-space t)) - (save-mark-and-excursion - (save-restriction - (unless (region-active-p) - (setq start (progn (start-of-paragraph-text) - (point)) - end (progn (end-of-paragraph-text) - (point)))) - (narrow-to-region start end) - (goto-char (point-min)) - (repunctuate-sentences :no-query) - (fill-region (point-min) - (point-max)))))) - -(defun acdw-elisp-package-prepare (&optional file) - "Do all the elisp-package-preparing stuff on FILE. -If FILE is nil or not given, do it on the current buffer." - (with-current-buffer (if file (find-file-noselect file) (current-buffer)) - (check-parens) - (checkdoc) - (package-lint-buffer) - ;; TODO: use `lm-commentary' to write to README.org - )) - -(provide 'acdw) -;;; acdw.el ends here -- cgit 1.4.1-21-gabe81