(in-package :editor)

(defun linewise ()
  b-vim-linewise)

(defun exclusive ()
  b-vim-exclusive)

(defun inclusive ()
  (not b-vim-exclusive))

(defun (setf linewise) (val)
  (setf b-vim-linewise val))

(defun (setf exclusive) (val)
  (setf b-vim-exclusive val))

(defun (setf inclusive) (val)
  (setf b-vim-exclusive (not val)))

(defun just-blanks (start end)
  "Returns T if the characters from start to end are spaces."
  (loop for ch across (points-to-string start end)
        if (not (eql ch #\Space))
        do (return nil)
        finally (return t)))

(defun blanks-before (point)
  (with-point ((bol point :temporary))
    (line-start bol)
    (just-blanks bol point)))

(defun blanks-after (point)
  (with-point ((eol point :temporary))
    (line-end eol)
    (just-blanks point eol)))

(defun scroll-line-to-place (line-num place)
  (when line-num
    (move-point (current-point) (buffers-start (current-buffer)))
    ;; This seems like it could be a fairly expensive operation.  Hope not.
    (line-offset (current-point) (1- line-num)))
  (with-point ((point (current-point)))
    (setf point 
          (ecase place
            (:top point)
            (:middle
             (line-offset point
                          (- (floor (window-height (current-window))
                                    2))))
            (:bottom
             (line-offset point
                          (- 1 (window-height (current-window)))))))
    (if point
      (line-start point)
      (setf point (buffers-start (current-buffer))))
    (when point
      (move-point (window-display-start (current-window))
                  point))))

(defun copy-hash-table (source)
  (let ((dest (make-hash-table :test (hash-table-test source)
                               :size (hash-table-size source))))
    (loop for key being the hash-keys of source using (hash-value value) do
          (setf (gethash key dest) value))
    dest))

(def-vim-char-attribute :whitespace '(#\Space #\Return #\Newline #\Tab))
(def-vim-char-attribute :keyword
  (loop for ch across "-_0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
        collect ch))

(defmethod vim-char-attribute ((type symbol) &optional (point (current-point)))
  (member (next-character point) (gethash type b-vim-char-attributes)))
(defmethod vim-char-attribute ((test function) &optional (point (current-point)))
  (funcall test (next-character point)))
(defmethod vim-char-attribute ((types list) &optional (point (current-point)))
  (let* ((invert-p (eql (car types) :not))
         (types (if invert-p (cdr types) types)))
    (loop for type in types
          if (vim-char-attribute type point)
          return (not invert-p)
          finally return invert-p)))

(defun vim-find-attribute (forward attributes &optional (point (current-point)))
  (with-point ((started-at point))
    (let ((offset (if forward 1 -1)))
      (loop while (and (not (vim-char-attribute attributes point))
                       (character-offset point offset)))
      (and (point/= started-at point)
           (vim-char-attribute attributes point)))))

(defun xor (x y)
  (or (and x (not y))
      (and y (not x))))

(defun white-p (point)
  (vim-char-attribute :whitespace point))

(defun skip-white (point forward)
  (if (white-p point)
    (vim-find-attribute forward '(:not :whitespace) point)
    t))

(defun skip-non-white (point forward)
  (if (white-p point)
    t
    (vim-find-attribute forward :whitespace point)))

(defgeneric vim-offset (n type forward point &key &allow-other-keys))
(defmethod vim-offset (count (type (eql :word)) forward point &key end)
  (labels ((invert (list)
             (if (eql (car list) :not)
               (cdr list)
               (cons :not list)))
           (skip-current ()
             (loop for attrib in '((:whitespace)
                                   (:keyword)
                                   (:not :whitespace :keyword))
                   until (vim-char-attribute attrib point)
                   finally return (vim-find-attribute forward (invert attrib) point)))
           (boundary (&optional (final-offset 0))
             (when (skip-current)
               (character-offset point final-offset)))
           (move ()
             "This function highlights that e & b are inverses of each other, and
w and ge are inverses of each other.  That is, e & b do the same things in opposite
directions; same for w and ge."
             (if (xor forward end)
               (and (boundary)
                    (skip-white point forward))
               ;; If we're here then either forward and end are both true, or
               ;; both false.  So I could say just forward instead of
               ;; (and forward end), but that seems kind of unclear.
               (and (character-offset point (if (and forward end) 1 -1))
                    (skip-white point forward)
                    (boundary (if (and forward end) -1 1))))))
    (loop for n below (or count 1)
          while (move)
          finally return (= n (or count 1)))))