1 files changed, 0 insertions, 384 deletions

@@ -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