;;; workgroups-utils.el --- Utilities used by Workgroups

;;; Commentary:

;;

;; A bunch of general purpose-ish utilities used by Workgroups.

;;

;;; Code:

;;; utils used in macros

(require 'cl-lib)

(require 'anaphora)

(require 'workgroups-faces)

(require 'workgroups-variables)

(defmacro wg-with-gensyms (syms &rest body)

  "Bind all symbols in SYMS to `gensym's, and eval BODY."

  (declare (indent 1))

  `(let (,@(mapcar (lambda (sym) `(,sym (cl-gensym))) syms)) ,@body))

(defmacro wg-dbind (args expr &rest body)

  "Bind the variables in ARGS to the result of EXPR and execute BODY.

Abbreviation of `destructuring-bind'."

  (declare (indent 2))

  `(cl-destructuring-bind ,args ,expr ,@body))

(defun wg-partition (list &optional n step)

  "Take LIST, return a list of N length sublists, offset by STEP.

N defaults to 2, and STEP defaults to N.

Iterative to prevent stack overflow."

  (let* ((n (or n 2)) (step (or step n)) acc)

    (while list

      (setq list (nthcdr step list)))

    (nreverse acc)))

;;; bindings

(defmacro wg-when-let (binds &rest body)

  "Like `let*' but when all BINDS are non-nil - eval BODY."

  (declare (indent 1))

  (wg-dbind (bind . binds) binds

    (when (consp bind)

      `(let (,bind)

         (when ,(car bind)

           ,(if (not binds) `(progn ,@body)

              `(wg-when-let ,binds ,@body)))))))

(defmacro wg-when-boundp (symbols &rest body)

  "When all SYMBOLS are bound, `eval' BODY."

  (declare (indent 1))

  `(when (and ,@(mapcar (lambda (sym) `(boundp ',sym)) symbols))

     ,@body))

;;; do-style wrappers

(defmacro wg-docar (spec &rest body)

  "do-style wrapper for `mapcar'.

\(fn (VAR LIST) BODY...)"

  (declare (indent 1))

  `(mapcar (lambda (,(car spec)) ,@body) ,(cadr spec)))

(defmacro wg-dohash (spec &rest body)

  "do-style wrapper for `maphash'.

\(fn (KEY VALUE TABLE [RESULT]) BODY...)"

  (declare (indent 1))

  (wg-dbind (key val table &optional result) spec

    `(progn (maphash (lambda (,key ,val) ,@body) ,table) ,result)))

(defmacro wg-doconcat (spec &rest body)

  "do-style wrapper for `mapconcat'.

\(fn (VAR SEQ [SEPARATOR]) BODY...)"

  (declare (indent 1))

  (wg-dbind (elt seq &optional sep) spec

    `(mapconcat (lambda (,elt) ,@body) ,seq (or ,sep ""))))

;;; anaphora

(defmacro wg-asetf (&rest places-and-values)

  "Anaphoric `setf'."

  `(progn ,@(mapcar (lambda (pv) `(let ((it ,(car pv))) (setf ,@pv)))

                    (wg-partition places-and-values 2))))

;;; other control structures

(defmacro wg-destructuring-dolist (spec &rest body)

  "Loop over a list.

Evaluate BODY, destructuring LIST into SPEC, then evaluate RESULT

to get a return value, defaulting to nil.  The only hitch is that

spec must end in dotted style, collecting the rest of the list

into a var, like so: (a (b c) . rest)

\(fn (SPEC LIST [RESULT]) BODY...)"

  (declare (indent 1))

  (wg-dbind (loopspec list &optional result) spec

    (let ((rest (cdr (last loopspec))))

      (wg-with-gensyms (list-sym)

        `(let ((,list-sym ,list))

           (while ,list-sym

             (wg-dbind ,loopspec ,list-sym

               ,@body

               (setq ,list-sym ,rest)))

           ,result)))))

;;; numbers

(defun wg-step-to (n m step)

  "Increment or decrement N toward M by STEP.

Return M when the difference between N and M is less than STEP."

  (cond ((= n m) n)

        ((< n m) (min (+ n step) m))

        ((> n m) (max (- n step) m))))

(defun wg-within (num lo hi &optional hi-inclusive)

  "Return t when NUM is within bounds LO and HI.

HI-INCLUSIVE non-nil means the HI bound is inclusive."

  (and (>= num lo) (if hi-inclusive (<= num hi) (< num hi))))

(defun wg-int-to-b36-one-digit (i)

  "Return a character in 0..9 or A..Z from I, and integer 0<=I<32.

Cribbed from `org-id-int-to-b36-one-digit'."

  (cond ((not (wg-within i 0 36))

         (error "%s out of range" i))

        ((< i 10) (+ ?0 i))

        ((< i 36) (+ ?A i -10))))

(defun wg-b36-to-int-one-digit (i)

  "Turn a character 0..9, A..Z, a..z into a number 0..61.

The input I may be a character, or a single-letter string.

Cribbed from `org-id-b36-to-int-one-digit'."

  (and (stringp i) (setq i (string-to-char i)))

  (cond ((and (>= i ?0) (<= i ?9)) (- i ?0))

        ((and (>= i ?A) (<= i ?Z)) (+ (- i ?A) 10))

        (t (error "Invalid b36 character"))))

(defun wg-int-to-b36 (i &optional length)

  "Return a base 36 string from I."

  (let ((base 36) b36)

    (cl-labels ((add-digit () (push (wg-int-to-b36-one-digit (mod i base)) b36)

                         (setq i (/ i base))))

      (add-digit)

      (while (> i 0) (add-digit))

      (setq b36 (cl-map 'string 'identity b36))

      (if (not length) b36

        (concat (make-string (max 0 (- length (length b36))) ?0) b36)))))

(defun wg-b36-to-int (str)

  "Convert STR, a base-36 string, into the corresponding integer.

Cribbed from `org-id-b36-to-int'."

  (let ((result 0))

    (mapc (lambda (i)

            (setq result (+ (* result 36)

                            (wg-b36-to-int-one-digit i))))

          str)

    result))

;;; lists

(defmacro wg-removef-p (item seq-place &rest keys)

  "If ITEM is a `member*' of SEQ-PLACE, remove it from SEQ-PLACE and return t.

Otherwise return nil.  KEYS can be any keywords accepted by `remove*'."

  `(> (length ,seq-place)

      (length (setf ,seq-place (cl-remove ,item ,seq-place ,@keys)))))

(defmacro wg-pushnew-p (item seq-place &rest keys)

  "If ITEM is not a `member' of SEQ-PLACE, push it to SEQ-PLACE and return t.

Otherwise return nil.  KEYS can be any keyword args accepted by `pushnew'."

  `(< (length ,seq-place)

      (length (cl-pushnew ,item ,seq-place ,@keys))))

(defun wg-range (start end)

  "Return a list of integers from START up to but not including END."

  (let (accum)

    (dotimes (i (- end start) (nreverse accum))

      (push (+ start i) accum))))

(defun wg-rotate-list (list &optional offset)

  "Rotate LIST by OFFSET.  Positive OFFSET rotates left, negative right."

  (when list

    (let ((split (mod (or offset 1) (length list))))

(defun wg-center-rotate-list (list)

  "Rotate LIST so it's first elt is in the center.  When LIST's

length is even, the first elt is left nearer the front."

  (wg-rotate-list list (- (/ (1- (length list)) 2))))

(defun wg-insert-after (elt list index)

  "Insert ELT into LIST after INDEX."

  (let ((new-list (cl-copy-list list)))

    (push elt (cdr (nthcdr index new-list)))

    new-list))

(defun wg-insert-before (elt list index)

  "Insert ELT into LIST before INDEX."

  (if (zerop index) (cons elt list)

    (wg-insert-after elt list (1- index))))

(defun wg-move-elt (elt list index &rest keys)

  "Move ELT before INDEX in LIST.

KEYS is passed to `remove*'."

  (wg-insert-before elt (apply 'cl-remove elt list keys) index))

(defun wg-cyclic-nth (list n)

  "Return the Nth element of LIST, modded by the length of list."

  (nth (mod n (length list)) list))

(defun wg-cyclic-offset-elt (elt list n)

  "Cyclically offset ELT's position in LIST by N."

  (wg-when-let ((pos (cl-position elt list)))

    (wg-move-elt elt list (mod (+ n pos) (length list)))))

(defun wg-cyclic-nth-from-elt (elt list n &rest keys)

  "Return the elt in LIST N places cyclically from ELT.

If ELT is not present is LIST, return nil.

KEYS is passed to `position'."

  (wg-when-let ((pos (apply 'cl-position elt list keys)))

    (wg-cyclic-nth list (+ pos n))))

(defun wg-util-swap (elt1 elt2 list)

  "Return a copy of LIST with ELT1 and ELT2 swapped.

Return nil when ELT1 and ELT2 aren't both present."

  (wg-when-let ((p1 (cl-position elt1 list))

                (p2 (cl-position elt2 list)))

    (wg-move-elt elt1 (wg-move-elt elt2 list p1) p2)))

(defun wg-dups-p (list &rest keys)

  "Return non-nil when LIST contains duplicate elements.

Keywords supported: :test :key

\(fn LIST [KEYWORD VALUE]...)"

  (let ((test (or (plist-get keys :test) 'eq))

        (key (or (plist-get keys :key) 'identity)))

    (cl-loop for (elt . rest) on list

             for elt = (funcall key elt)

             when (cl-find elt rest :test test :key key) return elt)))

(defun wg-string-list-union (&optional list1 list2)

  "Return the `union' of LIST1 and LIST2, using `string=' as the test.

This only exists to get rid of duplicate lambdas in a few reductions."

  (cl-union list1 list2 :test 'string=))

;;; alists

(defun wg-make-alist (&rest kvps)

  "Return a new alist from KVPS."

  (let (alist)

    (while kvps

      (push (cons (car kvps) (cadr kvps)) alist)

      (setq kvps (cddr kvps)))

    (nreverse alist)))

(defun wg-aget (alist key &optional default)

  "Return the value of KEY in ALIST. Uses `assq'.

If PARAM is not found, return DEFAULT which defaults to nil."

  (aif (assq key alist) (cdr it) default))

(defun wg-acopy (alist)

  "Return a copy of ALIST's toplevel list structure."

  (mapcar (lambda (kvp) (cons (car kvp) (cdr kvp))) alist))

(defun wg-aput (alist key value)

  "Return a new alist from ALIST with KEY's value set to VALUE."

  (let* ((found nil)

         (new (wg-docar (kvp alist)

                (if (not (eq key (car kvp))) kvp

                  (setq found (cons key value))))))

    (if found new (cons (cons key value) new))))

(defun wg-aremove (alist key)

  "`remove' KEY's key-value-pair from ALIST."

  (remove (assoc key alist) alist))