1 files changed, 116 insertions, 3 deletions

@@ -2,6 +2,9 @@
 
 ;;; 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
@@ -22,9 +25,9 @@ be created."
            (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)))))
+          `(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.
@@ -85,6 +88,17 @@ 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
@@ -125,6 +139,83 @@ each buffer."
          (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))
+    (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
 
@@ -214,5 +305,27 @@ With a prefix argument N, (un)comment that many sexps."
     (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)))
+
 (provide 'acdw)
 ;;; acdw.el ends here