;;; workgroups-buf.el --- BUFFER class
;;; Commentary:
;;
;; Workgroups Data Structures:
;;   https://github.com/pashinin/workgroups2/wiki/Workgroups-data-structures
;;
;;
;; BUFFER is the most low level part Workgroups operates with (except
;; serializing Emacs objects functions).
;;
;; Different buffers we have:
;;  - live buffers     (just switch-to them)
;;  - files/dirs       (open them)
;;  - special buffers  (shells, unknown modes - write support for them)
;;
;; Another different types of "buffers":
;;  - standard Emacs buffer (as you know it)
;;  - Workgroups Buffer object (Elisp object, a representation of Emacs buffer)
;;; Code:

(require 'workgroups-pickel)
(require 'workgroups-specialbufs)
(require 'workgroups-structs)

;;; Variables

(defvar wg-buffer-workgroup nil
  "A workgroup in which this buffer most recently appeared.
Buffer-local.")
(make-variable-buffer-local 'wg-buffer-workgroup)

(defcustom wg-default-buffer "*scratch*"
  "Show this in case everything else fails.
When a buffer can't be restored, when creating a blank wg."
  :type 'string
  :group 'workgroups)


;;; Functions

(defmacro wg-buf-list ()
  "Setf'able `wg-current-session' buf-list slot accessor."
  `(wg-session-buf-list (wg-current-session)))

(defun wg-restore-default-buffer ()
  "Switch to `wg-default-buffer'."
  (switch-to-buffer wg-default-buffer t))

(defun wg-restore-existing-buffer (buf)
  "Just switch to and return existing buffer."
  (wg-awhen (wg-find-buf-in-buffer-list buf (buffer-list))
    (switch-to-buffer it t)
    (wg-set-buffer-uid-or-error (wg-buf-uid buf))
    it))

(defun wg-restore-file-buffer (buf)
  "Restore BUF by finding its file.  Return the created buffer.
If BUF's file doesn't exist, call `wg-restore-default-buffer'"
  (wg-when-let ((file-name (wg-buf-file-name buf)))
    (when (or wg-restore-remote-buffers
              (not (file-remote-p file-name)))
      (cond ((file-exists-p file-name)
             (find-file file-name)
             (rename-buffer (wg-buf-name buf) t)
             (wg-set-buffer-uid-or-error (wg-buf-uid buf))
             (when wg-restore-mark
               (set-mark (wg-buf-mark buf))
               (deactivate-mark))
             (wg-deserialize-buffer-local-variables buf)
             (current-buffer))
            (t
             ;; try directory
             (if (not (file-remote-p file-name))
                 (if (file-directory-p (file-name-directory file-name))
                     (progn
                       (dired (file-name-directory file-name))
                       (current-buffer))
                   (progn
                     (message "Attempt to restore nonexistent file: %S" file-name)
                     nil))
               nil)
             )))))

(defun wg-restore-special-buffer (buf)
  "Restore a buffer BUF with DESERIALIZER-FN."
  (wg-when-let
      ((special-data (wg-buf-special-data buf))
       (buffer (save-window-excursion
                 (condition-case err
                     (funcall (car special-data) buf)
                   (error (message "Error deserializing %S: %S"
                                   (wg-buf-name buf) err)
                          nil)))))
    (switch-to-buffer buffer t)
    (wg-set-buffer-uid-or-error (wg-buf-uid buf))
    buffer))

(defun wg-restore-buffer (buf)
  "Restore BUF and return it."
  (or (wg-restore-existing-buffer buf)
      (wg-restore-special-buffer buf)
      (wg-restore-file-buffer buf)
      (progn (wg-restore-default-buffer) nil)))


;;; buffer object utils

(defun wg-buffer-uid (buffer-or-name)
  "Return BUFFER-OR-NAME's buffer-local value of `wg-buffer-uid'."
  (buffer-local-value 'wg-buffer-uid (wg-get-buffer buffer-or-name)))

(defun wg-bufobj-uid (bufobj)
  "Return BUFOBJ's uid."
  (cl-etypecase bufobj
    (buffer (wg-buffer-uid bufobj))
    (wg-buf (wg-buf-uid bufobj))
    (string (wg-bufobj-uid (wg-get-buffer bufobj)))))

(defun wg-bufobj-name (bufobj)
  "Return BUFOBJ's buffer name."
  (cl-etypecase bufobj
    (buffer (buffer-name bufobj))
    (wg-buf (wg-buf-name bufobj))
    (string (wg-buffer-name bufobj))))

(defun wg-bufobj-file-name (bufobj)
  "Return BUFOBJ's filename."
  (cl-etypecase bufobj
    (buffer (buffer-file-name bufobj))
    (wg-buf (wg-buf-file-name bufobj))
    (string (wg-bufobj-file-name (wg-get-buffer bufobj)))))

(defun wg-buf-major-mode (buf)
  "Return BUF's `major-mode'.
It's stored in BUF's local-vars list, since it's a local variable."
  (wg-aget (wg-buf-local-vars buf) 'major-mode))

(defun wg-buffer-major-mode (bufobj)
  "Return BUFOBJ's `major-mode'.
It works with Emacs buffer, Workgroups buffer object and a simple string."
  (cl-etypecase bufobj
    (buffer (wg-buffer-major-mode bufobj))
    (wg-buf (wg-buf-major-mode bufobj))
    (string (wg-buffer-major-mode bufobj))))

;; `wg-equal-bufobjs' and `wg-find-bufobj' may need to be made a lot smarter
(defun wg-equal-bufobjs (bufobj1 bufobj2)
  "Return t if BUFOBJ1 is \"equal\" to BUFOBJ2."
  (let ((fname1 (wg-bufobj-file-name bufobj1))
        (fname2 (wg-bufobj-file-name bufobj2)))
    (cond ((and fname1 fname2) (string= fname1 fname2))
          ((or fname1 fname2) nil)
          ((string= (wg-bufobj-name bufobj1) (wg-bufobj-name bufobj2)) t))))

(defun wg-find-bufobj (bufobj bufobj-list)
  "Find BUFOBJ in BUFOBJ-LIST, testing with `wg-equal-bufobjs'."
  (cl-find bufobj bufobj-list :test 'wg-equal-bufobjs))

(defun wg-find-bufobj-by-uid (uid bufobj-list)
  "Find the bufobj in BUFOBJ-LIST with uid UID."
  (cl-find uid bufobj-list :test 'string= :key 'wg-bufobj-uid))

(defun wg-find-buf-in-buf-list (buf buf-list)
  "Find BUF in BUF-LIST.
This is only here for completeness."
  (cl-find buf buf-list))

(defun wg-find-buffer-in-buffer-list (buffer-or-name buffer-list)
  "Find BUFFER-OR-NAME in BUFFER-LIST."
  (cl-find (wg-get-buffer buffer-or-name) buffer-list :key 'wg-get-buffer))

(defun wg-find-buffer-in-buf-list (buffer-or-name buf-list)
  "Find BUFFER-OR-NAME in BUF-LIST."
  (wg-aif (wg-buffer-uid buffer-or-name)
      (wg-find-bufobj-by-uid it buf-list)
    (wg-find-bufobj buffer-or-name buf-list)))

(defun wg-find-buf-in-buffer-list (buf buffer-list)
  "Find BUF in BUFFER-LIST."
  (or (wg-find-bufobj-by-uid (wg-buf-uid buf) buffer-list)
      (wg-find-bufobj buf buffer-list)))

(defun wg-find-buf-by-uid (uid)
  "Find a buf in `wg-buf-list' by UID."
  (wg-find-bufobj-by-uid uid (wg-buf-list)))

(defun wg-set-buffer-uid-or-error (uid &optional buffer)
  "Set BUFFER's buffer local value of `wg-buffer-uid' to UID.
If BUFFER already has a buffer local value of `wg-buffer-uid',
and it's not equal to UID, error."
  (if wg-buffer-uid
      ;;(if (string= wg-buffer-uid uid) uid
      ;;  (error "uids don't match %S and %S" uid wg-buffer-uid))
      (setq wg-buffer-uid uid)))


(defun wg-buffer-special-data (buffer)
  "Return BUFFER's auxiliary serialization, or nil."
  (cl-some (lambda (fn) (funcall fn buffer)) wg-special-buffer-serdes-functions))


(defun wg-serialize-buffer-local-variables ()
  "Return an alist of buffer-local variable symbols and their values.
See `wg-buffer-local-variables-alist' for details."
  (wg-docar (entry wg-buffer-local-variables-alist)
    (wg-dbind (var ser des) entry
      (when (local-variable-p var)
        (cons var (if ser (funcall ser) (symbol-value var)))))))

(defun wg-buffer-to-buf (buffer)
  "Return the serialization (a wg-buf) of Emacs buffer BUFFER."
  (with-current-buffer buffer
    (wg-make-buf
     :name           (buffer-name)
     :file-name      (buffer-file-name)
     :point          (point)
     :mark           (mark)
     :local-vars     (wg-serialize-buffer-local-variables)
     :special-data   (wg-buffer-special-data buffer))))

(defun wg-add-buffer-to-buf-list (buffer)
  "Make a buf from BUFFER, and add it to `wg-buf-list' if necessary.
If there isn't already a buf corresponding to BUFFER in
`wg-buf-list', make one and add it.  Return BUFFER's uid
in either case."
  (with-current-buffer buffer
    (setq wg-buffer-uid
          (wg-aif (wg-find-buffer-in-buf-list buffer (wg-buf-list))
              (wg-buf-uid it)
            (let ((buf (wg-buffer-to-buf buffer)))
              (push buf (wg-buf-list))
              (wg-buf-uid buf))))))

(defun wg-buffer-uid-or-add (buffer)
  "Return BUFFER's uid.
If there isn't already a buf corresponding to BUFFER in
`wg-buf-list', make one and add it."
  (or (wg-buffer-uid buffer) (wg-add-buffer-to-buf-list buffer)))

(defun wg-bufobj-uid-or-add (bufobj)
  "If BUFOBJ is a wg-buf, return its uid.
If BUFOBJ is a buffer or a buffer name, see `wg-buffer-uid-or-add'."
  (cl-etypecase bufobj
    (wg-buf (wg-buf-uid bufobj)) ;; possibly also add to `wg-buf-list'
    (buffer (wg-buffer-uid-or-add bufobj))
    (string (wg-bufobj-uid-or-add (wg-get-buffer bufobj)))))


(defun wg-reset-buffer (buffer)
  "Return BUFFER.
Currently only sets BUFFER's `wg-buffer-uid' to nil."
  (with-current-buffer buffer (setq wg-buffer-uid nil)))



;;; buffer-list-filter commands

(defun wg-next-buffer-internal (buffer-list &optional prev noerror)
  "Switch to the next buffer in Workgroups' filtered buffer list."
  (when buffer-list
    (let* ((cur (current-buffer))
           (next (or (wg-cyclic-nth-from-elt cur buffer-list (if prev -1 1))
                     (car buffer-list))))
      (unless (eq cur next)
        (switch-to-buffer next)
        (unless prev (bury-buffer cur))
        next))))

(defun wg-next-buffer (&optional prev)
  "Switch to the next buffer in Workgroups' filtered buffer list.
In the post-command message the current buffer is rotated to the
middle of the list to more easily see where `wg-previous-buffer'
will take you."
  (interactive)
  (let ((command (if prev 'previous-buffer 'next-buffer)))
    (if (not (wg-filter-buffer-list-p))
        (call-interactively (wg-prior-mapping workgroups-mode command))
      (wg-with-buffer-list-filters command
        (wg-awhen (wg-filtered-buffer-list) (wg-next-buffer-internal it prev))
        (wg-message (wg-buffer-command-display))))))

(defun wg-previous-buffer ()
  "Switch to the next buffer in Workgroups' filtered buffer list."
  (interactive)
  (wg-next-buffer t))

(defun wg-bury-buffer (&optional buffer-or-name)
  "Remove BUFFER-OR-NAME from the current workgroup, bury it,
and switch to the next buffer in the buffer-list-filter."
  (interactive (list (current-buffer)))
  (if (not (wg-filter-buffer-list-p))
      (call-interactively (wg-prior-mapping workgroups-mode 'bury-buffer))
    (wg-with-buffer-list-filters 'bury-buffer
      (wg-next-buffer-internal (wg-filtered-buffer-list))
      (bury-buffer buffer-or-name)
      (wg-message (wg-buffer-command-display)))))

(defun wg-banish-buffer (&optional buffer-or-name)
  "Bury BUFFER-OR-NAME."
  (interactive)
  (let ((buffer (or buffer-or-name (current-buffer))))
    (wg-bury-buffer buffer)))


(defun wg-update-buffer-in-buf-list (&optional buffer)
  "Update BUFFER's corresponding buf in `wg-buf-list'.
BUFFER nil defaults to `current-buffer'."
  (let ((buffer (or buffer (current-buffer))))
    (wg-when-let ((uid (wg-buffer-uid buffer))
                  (old-buf (wg-find-buf-by-uid uid))
                  (new-buf (wg-buffer-to-buf buffer)))
      (setf (wg-buf-uid new-buf) (wg-buf-uid old-buf))
      (wg-asetf (wg-buf-list) (cons new-buf (remove old-buf it))))))

(defun wg-update-buf-list (&optional buffer-list)
  "Update all bufs in `wg-buf-list' corresponding to buffers in BUFFER-LIST."
  (mapc 'wg-update-buffer-in-buf-list (or buffer-list (buffer-list))))




(defun wg-buffer-list-display (buffer-list)
  "Return the BUFFER-LIST display string."
  (wg-display-internal
   'wg-buffer-display
   (if wg-center-rotate-buffer-list-display
       (wg-center-rotate-list buffer-list) buffer-list)))

(defun wg-buffer-list-filter-display (&optional workgroup blf-id)
  "Return a buffer-list-filter display string from WORKGROUP and BLF-ID."
  (wg-fontify
    "("
    (wg-workgroup-name (wg-get-workgroup workgroup))
    ":"
    (wg-get-buffer-list-filter-val blf-id 'indicator)
    ")"))

(defun wg-buffer-list-filter-prompt (prompt &optional workgroup blf-id)
  "Return a prompt string from PROMPT indicating WORKGROUP and BLF-ID."
  (wg-fontify
    prompt " "
    (wg-buffer-list-filter-display workgroup blf-id)
    ": "))

(defun wg-buffer-command-display (&optional buffer-list)
  "Return the buffer command display string."
  (concat
   (wg-buffer-list-filter-display) ": "
   (wg-buffer-list-display (or buffer-list (wg-filtered-buffer-list)))))


(defun wg-read-buffer (prompt &optional default require-match)
  "Workgroups' version of `read-buffer'.
Read with PROMT DEFAULT REQUIRE-MATCH."
  (if (not (wg-filter-buffer-list-p))
      (funcall (wg-read-buffer-function) prompt default require-match)
    (wg-with-buffer-list-filters 'read-buffer
      (funcall (wg-read-buffer-function)
               (wg-buffer-list-filter-prompt
                (wg-aif (string-match ": *$" prompt)
                    (substring prompt 0 it) prompt))
               default require-match))))



;;; filtered buffer-list construction

(defun wg-get-buffer-list-filter-id-flexibly (blf-id)
  "Return a buffer-list-filter-id one way or another."
  (or blf-id wg-current-buffer-list-filter-id 'all))

(defun wg-get-buffer-list-filter-val (id key &optional noerror)
  "Return ID's KEY's value in `wg-buffer-list-filter-definitions'.
Lots of possible errors here because
`wg-buffer-list-filter-definitions' can be modified by the user."
  (let ((slot-num (cl-case key (symbol 0) (indicator 1) (constructor 2))))
    (if (not slot-num)
        (unless noerror
          (error "`%S' is not a valid buffer-list-filter definition slot" key))
      (let* ((id (wg-get-buffer-list-filter-id-flexibly id))
             (entry (assq id (wg-local-value
                              'wg-buffer-list-filter-definitions))))
        (if (not entry)
            (unless noerror
              (error "`%S' is an undefined buffer-list-filter" id))
          (or (nth slot-num entry)
              (unless noerror
                (error "Slot `%S' is undefined in `%S's definition"
                       key id))))))))

(defun wg-filtered-buffer-list (&optional names workgroup bfl-id initial)
  "Return a filtered buffer-list from NAMES, WORKGROUP, BLF-ID and INITIAL.
NAMES non-nil means return a list of buffer-names instead of buffer objects.
WORKGROUP non-nil should be any workgroup identifier accepted by
`wg-get-workgroup'.
BLF-ID non-nil should be the identifier of a defined buffer-list-filter.
It defaults to `wg-get-buffer-list-filter-val'.
INITIAL non-nil should be an initial buffer-list to filter.  It defaults to
`wg-interesting-buffers'."
  (let ((buffer-list (funcall (wg-get-buffer-list-filter-val
                               (wg-get-buffer-list-filter-id-flexibly bfl-id)
                               'constructor)
                              (wg-get-workgroup workgroup)
                              (or initial (wg-interesting-buffers)))))
    (if names (mapcar 'wg-buffer-name buffer-list) buffer-list)))


;; buffer-list filters

(defun wg-buffer-list-filter-all (workgroup initial)
  "Return all buffers in INITIAL."
  initial)

(defun wg-filter-buffer-list-by-regexp (regexp buffer-list)
  "Return only those buffers in BUFFER-LIST with names matching REGEXP."
  (cl-remove-if-not (lambda (bname) (string-match regexp bname))
                    buffer-list :key 'buffer-name))

(defun wg-filter-buffer-list-by-root-dir (root-dir buffer-list)
  "Return only those buffers in BUFFER-LIST visiting files undo ROOT-DIR."
  (cl-remove-if-not (lambda (f) (when f (wg-file-under-root-path-p root-dir f)))
                    buffer-list :key 'buffer-file-name))

(defun wg-filter-buffer-list-by-major-mode (major-mode buffer-list)
  "Return only those buffers in BUFFER-LIST in major-mode MAJOR-MODE."
  (cl-remove-if-not (lambda (mm) (eq mm major-mode))
                    buffer-list :key 'wg-buffer-major-mode))


;; Example custom buffer-list-filters

(defun wg-buffer-list-filter-irc (workgroup buffer-list)
  "Return only those buffers in BUFFER-LIST with names starting in \"#\"."
  (wg-filter-buffer-list-by-regexp "^#" buffer-list))

(defun wg-buffer-list-filter-home-dir (workgroup buffer-list)
  "Return only those buffers in BUFFER-LIST visiting files under ~/."
  (wg-filter-buffer-list-by-root-dir "~/" buffer-list))



;; buffer-list-filter context

(defun wg-buffer-list-filter-order (command)
  "Return WORKGROUP's buffer-list-filter order for COMMAND, or a default."
  (let ((bfo (wg-local-value 'wg-buffer-list-filter-order-alist)))
    (or (wg-aget bfo command) (wg-aget bfo 'default))))

(defmacro wg-prior-mapping (mode command)
  "Return whatever COMMAND would call if MODE wasn't on."
  `(or (let (,mode) (command-remapping ,command)) ,command))

(defun wg-filter-buffer-list-p ()
  "Return the current workgroup when buffer-list-filters are on."
  (and workgroups-mode wg-buffer-list-filtration-on (wg-current-workgroup t)))

(defmacro wg-with-buffer-list-filters (command &rest body)
  "Create buffer-list filter context for COMMAND, and eval BODY.
Binds `wg-current-buffer-list-filter-id' in BODY."
  (declare (indent 1))
  (wg-with-gensyms (order status)
    `(let* ((wg-previous-minibuffer-contents nil)
            (,order (wg-buffer-list-filter-order ,command)))
       (catch 'wg-result
         (while 'your-mom
           (let* ((wg-current-buffer-list-filter-id (car ,order))
                  (,status (catch 'wg-action (list 'done (progn ,@body)))))
             (cl-case (car ,status)
               (done (throw 'wg-result (cadr ,status)))
               (next (setq ,order (wg-rotate-list ,order 1))
                     (setq wg-previous-minibuffer-contents (cadr ,status)))
               (prev (setq ,order (wg-rotate-list ,order -1))
                     (setq wg-previous-minibuffer-contents
                           (cadr ,status))))))))))

(defun wg-toggle-buffer-list-filtration ()
  "Toggle `wg-buffer-list-filtration-on'."
  (interactive)
  (wg-toggle-and-message 'wg-buffer-list-filtration-on))


(provide 'workgroups-buf)
;;; workgroups-buf.el ends here