;;; workgroups.keys.el --- Set default workgroups keys

;;; Commentary:

;;

;;; Code:

(require 'workgroups-variables)

(require 'workgroups-utils-basic)

(defcustom wg-prefix-key (kbd "C-c z")

  "Workgroups' prefix key.

Setting this variable requires that `workgroups-mode' be turned

off and then on again to take effect."

  :type 'string

  :group 'workgroups)

(defvar workgroups-mode-map nil

  "Workgroups Mode's keymap.")

(defvar wg-prefixed-map

  (wg-fill-keymap

   (make-sparse-keymap)

   ;; workgroups

   (kbd "C-c")        'wg-create-workgroup

   (kbd "c")          'wg-create-workgroup

   (kbd "C")          'wg-clone-workgroup

   (kbd "A")          'wg-rename-workgroup

   (kbd "C-'")        'wg-switch-to-workgroup

   (kbd "'")          'wg-switch-to-workgroup

   (kbd "C-v")        'wg-switch-to-workgroup

   (kbd "v")          'wg-switch-to-workgroup

   ;; session

   (kbd "C-s")        'wg-save-session

   (kbd "C-w")        'wg-save-session-as

   (kbd "C-f")        'wg-open-session

   ;; killing and yanking

   (kbd "C-k")        'wg-kill-workgroup

   (kbd "k")          'wg-kill-workgroup

   (kbd "M-W")        'wg-kill-ring-save-base-wconfig

   (kbd "M-w")        'wg-kill-ring-save-working-wconfig

   (kbd "C-y")        'wg-yank-wconfig

   (kbd "y")          'wg-yank-wconfig

   (kbd "M-k")        'wg-kill-workgroup-and-buffers

   (kbd "K")          'wg-delete-other-workgroups

   ;; workgroup switching

   (kbd "M-v")        'wg-switch-to-workgroup-other-frame

   (kbd "C-j")        'wg-switch-to-workgroup-at-index

   (kbd "j")          'wg-switch-to-workgroup-at-index

   (kbd "0")          'wg-switch-to-workgroup-at-index-0

   (kbd "1")          'wg-switch-to-workgroup-at-index-1

   (kbd "2")          'wg-switch-to-workgroup-at-index-2

   (kbd "3")          'wg-switch-to-workgroup-at-index-3

   (kbd "4")          'wg-switch-to-workgroup-at-index-4

   (kbd "5")          'wg-switch-to-workgroup-at-index-5

   (kbd "6")          'wg-switch-to-workgroup-at-index-6

   (kbd "7")          'wg-switch-to-workgroup-at-index-7

   (kbd "8")          'wg-switch-to-workgroup-at-index-8

   (kbd "9")          'wg-switch-to-workgroup-at-index-9

   (kbd "C-p")        'wg-switch-to-workgroup-left

   (kbd "p")          'wg-switch-to-workgroup-left

   (kbd "C-n")        'wg-switch-to-workgroup-right

   (kbd "n")          'wg-switch-to-workgroup-right

  "Return the frame N places away from FRAME in `frame-list' cyclically.

N defaults to 1, and FRAME defaults to `selected-frame'."

  (wg-cyclic-nth-from-elt

   (or frame (selected-frame)) (frame-list) (or n 1)))

;;; namespace-prefixed defstruct

(defmacro wg-defstruct (prefix name-form &rest slot-defs)

  "`defstruct' wrapper that namespace-prefixes all generated functions.

Note: this doesn't yet work with :conc-name, and possibly other

options."

  (declare (indent 2))

  (let* ((name (if (consp name-form) (car name-form) name-form))

         (prefixed-name (wg-symcat prefix "-" name)))

    (cl-labels ((rebind (opstr)

                      (let ((oldfnsym (wg-symcat opstr "-" prefix "-" name)))

                        `((fset ',(wg-symcat prefix "-" opstr "-" name)

                                (symbol-function ',oldfnsym))

                          (fmakunbound ',oldfnsym)))))

      ;; `eval-and-compile' gets rid of byte-comp warnings ("function `foo' not

      ;; known to be defined").  We can accomplish this with `declare-function'

      ;; too, but it annoyingly requires inclusion of the function's arglist,

      ;; which gets ugly.

      `(eval-and-compile

         (cl-defstruct ,(if (symbolp name-form) prefixed-name

                       `(,prefixed-name ,@(cdr name-form)))

           ,@slot-defs)

         ,@(rebind "make")

         ,@(rebind "copy")

         ',prefixed-name))))

(defmacro wg-with-slots (obj slot-bindings &rest body)

  "Bind OBJ's slot values to symbols in BINDS, then eval BODY.

The car of each element of SLOT-BINDINGS is the bound symbol, and

the cadr as the accessor function."

  (declare (indent 2))

  (wg-with-gensyms (objsym)

    `(let* ((,objsym ,obj)

            ,@(wg-docar (slot slot-bindings)

                `(,(car slot) (,(cadr slot) ,objsym))))

       ,@body)))

;;; misc

(defun wg-add-or-remove-hooks (remove &rest pairs)

  "Add FUNCTION to or remove it from HOOK, depending on REMOVE."

  (dolist (pair (wg-partition pairs 2))

    (funcall (if remove 'remove-hook 'add-hook)

             (car pair) (cadr pair))))

(defmacro wg-set-parameter (place parameter value)

  "Set PARAMETER to VALUE at PLACE.

This needs to be a macro to allow specification of a setf'able place."

  (wg-with-gensyms (p v)

    `(let ((,p ,parameter) (,v ,value))

       (wg-pickelable-or-error ,p)

       (wg-pickelable-or-error ,v)

       (setf ,place (wg-aput ,place ,p ,v))

       ,v)))

;;; uid utils

(defun wg-time-to-b36 ()

  "Convert `current-time' into a b36 string."

  (apply 'concat (wg-docar (time (current-time))

                   (wg-int-to-b36 time 4))))

(defun wg-b36-to-time (b36)

  "Parse the time in B36 string from UID."

  (cl-loop for i from 0 to 8 by 4

           collect (wg-b36-to-int (cl-subseq b36 i (+ i 4)))))

(defalias 'wg-uid-to-time 'wg-b36-to-time)

(defun wg-generate-uid (&optional prefix)

  "Return a new uid, optionally prefixed by PREFIX."

  (concat prefix (wg-time-to-b36) "-" (wg-int-to-b36 string-chars-consed)))

(defun wg-uid-to-seconds (uid)

  "Return the `float-time' parsed from UID with `wg-uid-to-time'."

  (float-time (wg-uid-to-time uid)))

(defun wg-get-value (arg)

  "Get a value of ARG if it exists."

  (if (boundp `,arg) (eval arg)))

(defmacro wg-support (mode pkg params)

  "Macro to create (de)serialization functions for a buffer.

You need to save/restore a specific MODE which is loaded from a

package PKG.  In PARAMS you give local variables to save and a

deserialization function."

  `(let ((mode-str (symbol-name ,mode))

         (args ,params))

     (eval `(defun ,(intern (format "wg-deserialize-%s-buffer" mode-str)) (buffer)

              "DeSerialization function created with `wg-support'.

Gets saved variables and runs code to restore a BUFFER."