;;; acdw.el -- bits and bobs  -*- lexical-binding: t; -*-
;; by C. Duckworth <acdw@acdw.net>
(provide 'acdw)

(require 'cl-lib)

;;; Define both a directory and a function expanding to a file in that directory

(defmacro +define-dir (name directory &optional docstring inhibit-mkdir)
  "Define a variable and function NAME expanding to DIRECTORY.
DOCSTRING is applied to the variable.  Ensure DIRECTORY exists in
the filesystem, unless INHIBIT-MKDIR is non-nil."
  (declare (indent 2)
           (doc-string 3))
  (unless inhibit-mkdir
    (make-directory (eval directory) :parents))
  `(progn
     (defvar ,name ,directory
       ,(concat docstring (when docstring "\n")
                "Defined by `/define-dir'."))
     (defun ,name (file &optional mkdir)
       ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n"
                "If MKDIR is non-nil, the directory is created.\n"
                "Defined by `/define-dir'.")
       (let ((file-name (expand-file-name (convert-standard-filename file)
                                          ,name)))
         (when mkdir
           (make-directory (file-name-directory file-name) :parents))
         file-name))))

;;; Convenience functions

(defun define-key* (maps &rest keydefs)
  "Define KEYDEFS in MAPS.
Convenience wrapper around `define-key'."
  (unless (zerop (mod (length keydefs) 2))
    (user-error "Wrong number of arguments: %S" (length keydefs)))
  (dolist (map (if (or (atom maps) (eq (car maps) 'keymap))
                   (list maps)
                 maps))
    (cl-loop for (key def) on keydefs by #'cddr
             do (let ((key (if (stringp key) (kbd key) key)))
                  (define-key (if (symbolp map)
                                  (symbol-value map)
                                map)
                    key def)))))

(unless (fboundp 'ensure-list)
  ;; Just in case we're using an old version of Emacs.
  (defun ensure-list (object)
  "Return OBJECT as a list.
If OBJECT is already a list, return OBJECT itself.  If it's
not a list, return a one-element list containing OBJECT."
  (if (listp object)
      object
    (list object))))

(defun add-to-list* (lists &rest things)
  "Add THINGS to LISTS.
LISTS can be one list variable or a list.  Each thing of THINGS
can be either a variablel (the thing), or a list of the form
(ELEMENT &optional APPEND COMPARE-FN), which is passed to
`add-to-list'."
  (declare (indent 1))
  (dolist (l (ensure-list lists))
    (dolist (thing things)
      (apply #'add-to-list l (ensure-list thing)))))

(defun add-hook* (hooks &rest functions)
  "Add FUNCTIONS to HOOKS.
Each function in FUNCTIONS can be a singleton or a list of the
form (FUNCTION &optional DEPTH LOCAL)."
  (declare (indent 1))
  (dolist (hook (ensure-list hooks))
    (dolist (fn functions)
      (apply #'add-hook hook (ensure-list fn)))))

(defun +concat (&rest strings)
  "Concat STRINGS separated by SEPARATOR.
SEPARATOR is \"\\n\" unless the keyword argument `:separator' is
given, followed by the separator to use.  Each item in STRINGS is
either a string or a list or strings, which is concatenated
without any separator."
  (let (ret
        ;; I don't know why a `cl-defun' with
        ;; (&rest strings &key (separator "\n")) doesn't work
        (separator (or (cl-loop for i from 0 upto (length strings)
                                if (eq (nth i strings) :separator)
                                return (nth (1+ i) strings))
                       "\n")))
    (while strings
      (let ((string (pop strings)))
        (cond ((eq string :separator) (pop strings))
              ((listp string) (push (apply #'concat string) ret))
              ((stringp string) (push string ret)))))
    (mapconcat #'identity (nreverse ret) separator)))

(defun require* (&rest features)
  "Require FEATURES in order.
Each feature of FEATURES can also be a list of the arguments to
pass to `require', which see."
  (condition-case e
    (dolist (feature features)
      (apply #'require (ensure-list feature)))
    (:success (mapcar (lambda (f) (car (ensure-list f))) features))
    (t (signal (car e) (cdr e)))))

;;; Convenience macros

(defmacro define-local-before-save-hook (mode-or-hook &rest body)
  "Add a local `before-save-hook' to MODE-OR-HOOK."
  (declare (indent 1))
  (let* ((name (format "%s" mode-or-hook))
         (external-name (intern (format "%s@before-save" name)))
         (internal-name (intern (format "before-save@%s" name)))
         (hook (if (string-suffix-p "-hook" name)
                   mode-or-hook
                 (intern (format "%s-hook" name)))))
    `(progn
       (defun ,internal-name ()
         ,@body)
       (defun ,external-name ()
         (add-hook 'before-save-hook #',internal-name nil :local))
       (add-hook ',hook #',external-name))))

(defmacro setq-local-hook (hook &rest args)
  "Run `setq-local' on ARGS when running HOOK."
  (declare (indent 1))
  (let ((fn (intern (format "%s-setq-local" hook))))
    (when (and (fboundp fn)
               (functionp fn))
      (setf args (append (function-get fn 'setq-local-hook-settings) args)))
    (unless (and (< 0 (length args))
                 (zerop (mod (length args) 2)))
      (user-error "Wrong number of arguments: %S" (length args)))
    `(progn
       (defun ,fn ()
         ,(format "Set local variables after `%s'." hook)
         (setq-local ,@args))
       (function-put ',fn 'setq-local-hook-settings ',args)
       (add-hook ',hook #',fn))))

(defmacro with-message (message &rest body)
  "Execute BODY, with MESSAGE.
If body executes without errors, MESSAGE...Done will be displayed."
  (declare (indent 1))
  (let ((msg (gensym)))
    `(let ((,msg ,message))
       (condition-case e
           (progn (message "%s..." ,msg)
                  ,@body)
         (:success (message "%s...done" ,msg))
         (t (signal (car e) (cdr e)))))))

;; https://emacs.stackexchange.com/a/39324/37239
;; XXX: This shit don't work rn
(defun ignore-invisible-overlays (fn)
  "Execute FN, ignoring invisible overlays.
FN should return a point."
  (let ((overlay nil)
        (point nil))
   (setq point (and (funcall fn) (point)))
   (setq overlay (car (overlays-at (point))))
   (while (and overlay (member 'invisible (overlay-properties overlay)))
     (goto-char (overlay-end overlay))
     (setq point (and (funcall fn) (point)))
     (setq overlay (car (overlays-at (point)))))
   point))

;;; Extras
;; Trying to avoid a whole install of crux ...

(defun kill-and-join-forward (&optional arg)
  "Kill the line or, if at the end of a line, join with the next.
This command is `visual-line-mode'-aware.  If ARG is provided,
it's passed on to kill a line, but not to delete indentation.
When joining, this command deletes whitespace."
  (interactive "P")
  (if (and (eolp) (not (bolp)))
      (delete-indentation 1)
    (funcall (if visual-line-mode #'kill-visual-line #'kill-line) arg)))

(defun other-window|switch-buffer ()
  "Call `other-window' or `switch-buffer' depending on windows."
  (interactive)
  (if (one-window-p)
      (switch-to-buffer nil)
    (other-window 1)))