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

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

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

   ;; updating and reverting

   ;; wconfig undo/redo

   (kbd "C-r")        'wg-revert-workgroup

   (kbd "r")          'wg-revert-workgroup

   (kbd "C-S-r")      'wg-revert-all-workgroups

   (kbd "R")          'wg-revert-all-workgroups

   (kbd "<left>")     'wg-undo-wconfig-change

   (kbd "<right>")    'wg-redo-wconfig-change

   (kbd "[")          'wg-undo-wconfig-change

   (kbd "]")          'wg-redo-wconfig-change

   (kbd "{")          'wg-undo-once-all-workgroups

   (kbd "}")          'wg-redo-once-all-workgroups

   ;; wconfig save/restore

   (kbd "C-d C-s")    'wg-save-wconfig

   (kbd "C-d C-'")    'wg-restore-saved-wconfig

   (kbd "C-d C-k")    'wg-kill-saved-wconfig

   ;; workgroup movement

   (kbd "C-x")        'wg-swap-workgroups

   (kbd "C-,")        'wg-offset-workgroup-left

   (kbd "C-.")        'wg-offset-workgroup-right

   ;; window moving and frame reversal

   (kbd "|")          'wg-reverse-frame-horizontally

   (kbd "\\")         'wg-reverse-frame-vertically

   (kbd "/")          'wg-reverse-frame-horizontally-and-vertically

   ;; toggling

   (kbd "C-t C-m")    'wg-toggle-mode-line-display

   (kbd "C-t C-b")    'wg-toggle-buffer-list-filtration

   (kbd "C-t C-d")    'wg-toggle-window-dedicated-p

   ;; misc

   (kbd "!")          'wg-reset

   (kbd "?")          'wg-help

   )

  "The keymap that sits on `wg-prefix-key'.")

  "Return t if BUFFER-OR-NAME is the current buffer, nil otherwise."

  (eq (wg-get-buffer buffer-or-name) (current-buffer)))

(defmacro wg-buffer-local-setq (buffer var value)

  "`setq' VAR to VALUE while BUFFER is current.

Note that this won't make VAR buffer-local if it isn't already."

  `(with-current-buffer ,buffer (setq ,var ,value)))

(defun wg-interesting-buffers ()

  "Return a list of only the interesting buffers in `buffer-list'."

  (cl-remove-if (lambda (bname) (string-match "^ " bname))

                (wg-buffer-list-emacs) :key 'buffer-name))

(defun wg-get-first-buffer-matching-regexp (regexp &optional buffer-list)

  "Return the first buffer in BUFFER-LIST with a name matching REGEXP.

BUFFER-LIST should contain buffer objects and/or buffer names."

  (cl-find regexp (or buffer-list (wg-buffer-list-emacs))

           :test 'string-match :key 'wg-buffer-name))

;;; files

(defun wg-write-sexp-to-file (sexp file)

  "Write the printable representation of SEXP to FILE."

  (with-temp-buffer

    (let ((print-level nil)  (print-length nil))

      (insert (format "%S" sexp)))

    (write-file file)))

(defun wg-read-sexp-from-file (file)

  "Return a Lisp object from FILE."

  (with-temp-buffer

    (insert-file-contents file)

    (goto-char (point-min))

    (read (current-buffer))))

(defalias 'wg-lisp-object-from-file 'wg-read-sexp-from-file)

(defun wg-file-under-root-path-p (root-path file-path)

  "Return t when FILE-PATH is under ROOT-PATH, nil otherwise."

  (string-match (concat "^" (regexp-quote (expand-file-name root-path)))

                (expand-file-name file-path)))

;;; frames

(defun wg-cyclic-nth-from-frame (&optional n frame)

  "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."

              (when (require ',,pkg nil 'noerror)

                (wg-dbind (this-function variables) (wg-buf-special-data buffer)

                  (let ((default-directory (car variables))

                        (df (cdr (assoc 'deserialize ',,params)))

                        (user-vars (car (cdr variables))))

                    (if df

                        (funcall df buffer user-vars)

                      (get-buffer-create wg-default-buffer))

                    )))))

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

              "Serialization function created with `wg-support'.

Saves some variables to restore a BUFFER later."

              (when (get-buffer buffer)

                (with-current-buffer buffer

                  (when (eq major-mode ',,mode)

                    (let ((sf (cdr (assoc 'serialize ',,params)))

                          (save (cdr (assoc 'save ',,params))))

                      (list ',(intern (format "wg-deserialize-%s-buffer" mode-str))

                            (list default-directory

                                  (if sf (funcall sf buffer)

                                    (if save (mapcar 'wg-get-value save)))

                                  ))))))))

     ;; Maybe change a docstring for functions

     ;;(put (intern (format "wg-serialize-%s-buffer" (symbol-name mode)))

     ;;     'function-documentation

     ;;     (format "A function created by `wg-support'."))

     ;; Add function to `wg-special-buffer-serdes-functions' variable

     (eval `(add-to-list 'wg-special-buffer-serdes-functions

                         ',(intern (format "wg-serialize-%s-buffer" mode-str)) t))

     ))

(defvar wg-current-session nil "Current session object.")

(defun wg-current-session (&optional noerror)

  "Return `wg-current-session' or scream unless NOERROR."

  (or wg-current-session

      (unless noerror

        (error "No session is defined"))))

(defun wg-read-buffer-mode ()

  "Return the buffer switching package (ido or iswitchb) to use, or nil."

  (if (eq wg-current-buffer-list-filter-id 'fallback) 'fallback

    (cl-case (let (workgroups-mode) (command-remapping 'switch-to-buffer))

      (ido-switch-buffer 'ido)

      (otherwise 'fallback))))