;;; Custom definitions, with prefix "my/"  -*- lexical-binding: t; -*-

(defvar surround-keys '("(" "{" "[" "$" "\"" "'"))
(defun my/wrap-pair ()
  "Ensure the region is active and then \"insert-pair\"."
  (interactive)
  (activate-mark)
  (insert-pair))
(eval
 `(define-keymap
    :full nil
    :name "Surround"
    :prefix 'surround-prefix
    ,@(mapcan
       (lambda (key) (list key ''my/wrap-pair))
       surround-keys
       )))

(defun my/toggle-frame-transparency ()
  "Toggle transparency."
  (interactive)
  (let ((alpha-transparency 90))
    (if (eq alpha-transparency (frame-parameter nil 'alpha-background))
        (set-frame-parameter nil 'alpha-background 100)
      (set-frame-parameter nil 'alpha-background alpha-transparency))))

(defvar my/prog-cleanup-excluded-modes
  '(makefile-gmake-mode makefile-mode makefile-imake-mode
                        makefile-makepp-mode makefile-bsdmake-mode
                        makefile-automake-mode
                        python-mode
                        fundamental-mode)
  "Major modes for which \"my/clean-prog-file\" should not be run before save.")

(defvar my/prog-cleanup-want-tabs-modes
  '(makefile-gmake-mode makefile-mode makefile-imake-mode
                        makefile-makepp-mode makefile-bsdmake-mode makefile-automake-mode)
  "Major modes that need tabs instead of spaces.
\"my/clean-prog-file\" should convert spaces to tabs instead of tabs to spaces.")

(defvar my/prog-cleanup-indent-max-lines 500
  "Skip reindenting the buffer if it is longer than this many lines.
Nil for no limit.")

(define-minor-mode my/global-prog-clean-mode
  "Do auto formating on save in prog mode buffers."
  :global t
  (if my/global-prog-clean-mode
      (progn ;enable
        (add-hook 'before-save-hook 'my/clean-prog-file))
    (progn ;disable
      (remove-hook 'before-save-hook 'my/clean-prog-file))))
(my/global-prog-clean-mode 1)

(defun my/clean-prog-file (&optional buffer)
  "Perform whitespace cleanup and some normalization on `buffer'.
Defaults to the current BUFFER.  Converts tabs to spaces unless the
major mode is in `my/prog-cleanup-want-tabs-modes', otherwise do the
reverse.  Delete trailing whitespace."
  (unless buffer (setq buffer (current-buffer)))
  (with-current-buffer buffer
    (when (and my/global-prog-clean-mode
               (not (member major-mode my/prog-cleanup-excluded-modes))
               (derived-mode-p '(prog-mode))
               (cond
                ((and (functionp 'clang-format-buffer)
                                        ; safety valve for undef'd
                      (derived-mode-p '(c-mode c++-mode)))
                 (clang-format-buffer))
                (t
                 (when (and my/prog-cleanup-indent-max-lines
                            (< (car (buffer-line-statistics buffer))
                               my/prog-cleanup-indent-max-lines))
                   (indent-region (point-min) (point-max)))))
               (if (member major-mode my/prog-cleanup-want-tabs-modes)
                   (tabify (point-min) (point-max))
                 (untabify (point-min) (point-max)))
               (delete-trailing-whitespace)))))

(defun my/prog-buffer-setup ()
  "Do setup in for code buffers."
  ;; (superword-mode 1)
  ;; (modify-syntax-entry ?_ "w")
  ;; (hs-minor-mode 1)
  (display-fill-column-indicator-mode 1)
  (smerge-mode 1)
  (ignore-errors
    (when (and (derived-mode-p '(c-mode c++-mode))
               (> (car (buffer-line-statistics)) 0))
      (c-guess))))
(add-hook 'prog-mode-hook 'my/prog-buffer-setup)

(defun my/wrap-region-paren ()
  "Wraps the region in parens.  Similar to pressing ( with the region active."
  (interactive)
  (let ((beg (region-beginning))
        (end (region-end)))
    (save-excursion
      (goto-char beg)
      (insert "(")
      (goto-char (+ end 1))
      (insert ")"))))

(defun my/zap-whitespace ()
  "Zaps (deletes) the whitespace around the point in both directions."
  (interactive)
  (push-mark)
  (skip-chars-backward " \t\n")
  (push-mark)
  (skip-chars-forward " \t\n")
  (delete-region (mark) (point))
  (pop-mark)
  (goto-char (mark))
  (pop-mark))

(defun my/wrap-sexp (&optional arg)
  "Wraps the following sexp in a pair of parens.
Places point inside the new pair, pushing the mark before the new pair.
With prefix ARG do ARG number sexps if given, including backwards."
  (interactive "p")
  (message "%s" arg)
  (if arg
      (progn
        (push-mark)
        (insert-pair arg ?\( ?\)))
    (insert-pair 1 ?\( ?\))))

(defun my/toggle-window-other-reachability ()
  "Toggle whether this window can be selected by `other-window'."
  (interactive)
  (let* ((win (get-buffer-window (current-buffer)))
         (current (window-parameter win 'no-other-window)))
    (set-window-parameter win 'no-other-window (not current))
    (force-mode-line-update)))
;; small hack to make other window reachability visible like window dedication
(advice-add 'mode-line-window-control :around
            (lambda (f) (concat (funcall f)
                                (if (window-parameter nil 'no-other-window) "o" "")))
            '(:name "other-window-indicator"))

;; TODO find a bind for this
(defun my/open-window-by-buffer (buffer)
  "Move focus to an extant window by the buffer it contains.
If no such window exists, switch to BUFFER in the current window."
  (interactive "bBuffer: ")
  (let ((win (get-buffer-window buffer t)))
    (if win
        (select-window win)
      (switch-to-buffer buffer))))

(defun my/new-text ()
  "Produce a new text buffer to write a scrap of text in."
  (interactive)
  (let ((buf (generate-new-buffer "text")))
    (switch-to-buffer buf)
    (text-mode)
    (olivetti-mode 1)
    buf))

(defun my/shorten-path (path)
  "Shorten string PATH.  Initialize all but the last path component."
  (let* ((components (split-string path "/"))
         (last-component (-last (lambda (s) (not (string-empty-p s))) components))
         (shortened-components
          (mapcar (lambda (comp)
                    (if (or (string-equal comp last-component) (string-empty-p comp))
                        comp
                      (substring comp 0 1)))
                  components)))
    (mapconcat 'identity shortened-components "/")))

(defun my/swap-other-window-buffer ()
  "Exchange buffer contents with the next window.
Tries to switch the buffer contents of the current window and the next
in the cyclic ordering.  Doesn't consider windows that are dedicated."
  (interactive)
  (let* ((cw (get-mru-window nil nil nil t))
         (cb (window-buffer cw))
         (ow (next-window))
         (ob (window-buffer ow)))
    (unless (window-dedicated-p cw)
      (while (window-dedicated-p ow)
        (setq ow (next-window ow)
              ob (window-buffer ow)))
      (unless (eq cw ow)
        (progn
          (with-selected-window ow
            (switch-to-buffer cb))
          (with-selected-window cw
            (switch-to-buffer ob)))))))

(defun my/activate-mark ()
  "Activate the region a la `C-SPC C-SPC', but don't move the point.
Useful in combination with `query-replace' for acting on the region."
  (interactive)
  (if (region-active-p)
      (deactivate-mark)
    (activate-mark)))

(defun my/c-x-n-to-m-n (&optional keymap)
  "Copy bindings from C-x [n] to M-[n] in KEYMAP, defaulting to the global
keymap."
  (unless keymap (setq keymap global-map))
  (mapc (lambda (n)
          (let* ((from (concat "C-x " (format "%d" n)))
                 (to (concat "M-" (format "%d" n)))
                 (bind (keymap-lookup keymap from)))
            (keymap-set keymap to bind)))
        '(0 1 2 3 4 5 6 7 8 9)))
(my/c-x-n-to-m-n)

(defun my/keymap-keys (map)
  "Return a list of all key sequences in a keymap MAP recursively."
  (mapcan (lambda (c)
            (let ((ks (car c))
                  (km (cdr c))
                  (acc nil))
              (map-keymap (lambda (key bind)
                            (let ((kss (vconcat ks (vector key))))
                              (when (commandp bind)
                                (push kss acc))))
                          km)
              acc))
          (accessible-keymaps map)))

(defun my/eshell (&optional arg)
  "Create a new eshell or switch to an existing one.
With ARG, make a new shell.  If the current buffer is an eshell, switch
back to the previous selected buffer."
  (interactive "P")
  (if (eq major-mode 'eshell-mode)
      (switch-to-prev-buffer)
    (eshell arg)))

(defun my/eshell-clear-or-center (&optional clear)
  "Either clear the screen or recenter display depending on point location."
  (interactive "P")
  (cond
   (clear (eshell/clear clear))
   ((>= (point) eshell-last-output-end) ;; at the input line
    (eshell/clear clear))
   (t ;; in scroll back somewhere
    (recenter-top-bottom))))

(defun my/vc-on-root (&optional arg)
  "Open a vc dir buffer at the project root.
With ARG, open a Dired buffer instead."
  (interactive "P")
  (let ((dir (project-root (project-current t))))
    (if arg
        (dired dir)
      (vc-dir dir))))

(defun my/shell-at-root ()
  "Execute an async shell commmand at the root of the current project."
  (interactive)
  (let ((prior-cwd default-directory)
        (want-quit inhibit-quit))
    (setq inhibit-quit t)
    (with-local-quit
      (setq default-directory (project-root (project-current)))
      (call-interactively 'async-shell-command))
    (setq default-directory prior-cwd
          inhibit-quit want-quit)))

(defun my/kill-buffer (&optional arg)
  "Kill the current buffer.  With ARG kill the window as well."
  (interactive "P")
  (if arg
      (kill-buffer-and-window)
    (kill-buffer)))

(defvar my/layout-pair (cons nil nil)
  "Cons pair of window configurations.")
(add-hook 'after-init-hook
          (lambda ()
            (setq my/layout-pair (cons (current-window-configuration)
                                       (current-window-configuration)))))
(defun my/layout-swap (&optional arg)
  "Swap between the two saved window configurations.
With ARG, don't save the current layout."
  (interactive "p")
  (let ((left (car my/layout-pair))
        (right (cdr my/layout-pair))
        (cwc (current-window-configuration)))
    (cond
     ((>= arg 16) (setq my/layout-pair (cons cwc cwc)))
     ((eq (selected-frame) (window-configuration-frame right))
      (unless (>= arg 4) (setq left cwc))
      (set-window-configuration right t t)
      (setq my/layout-pair (cons right left)))
     (t (message "Quick layout swap only works with same frame!")))))

(defun my/unfill-paragraph ()
  "Inverse of `fill-paragraph'."
  (interactive)
  (let ((fill-column most-positive-fixnum))
    (call-interactively 'fill-paragraph)))

(defun my/unfill-region (start end)
  "Inverse of `fill-region'."
  (interactive "r")
  (let ((fill-column most-positive-fixnum))
    (fill-region start end)))

(defun my/display-lines-advice (func &rest r)
  "Around advice that temporarily shows line numbers."
  (let ((want-quit inhibit-quit))
    (setq inhibit-quit t)
    (display-line-numbers-mode 1)
    (force-window-update)
    (with-local-quit
      (call-interactively func))
    (display-line-numbers-mode -1)
    (force-window-update)
    (setq inhibit-quit want-quit)))

(progn ; my global keybinds
  (define-minor-mode my/keys-mode
    "Minor mode collecting global keybinds"
    :global t
    :keymap (make-sparse-keymap)

    (if my/keys-mode
        (repeat-mode 1)
      (repeat-mode -1)))
  (require 'eshell)
  (require 'em-prompt)
  (put 'other-window 'repeat-map nil)
  (put 'other-window-backward 'repeat-map nil)
  (put 'eshell-previous-prompt 'repeat-map nil)
  (put 'eshell-next-prompt 'repeat-map nil)

  ;; The keymaps in `emulation-mode-map-alists' take precedence over
  ;; `minor-mode-map-alist'
  (add-to-list 'emulation-mode-map-alists
               '((my/keys-mode . my/keys-keymap)))

  (keymap-set my/keys-mode-map "C-x -" 'my/swap-other-window-buffer)
  (keymap-set my/keys-mode-map "C-x w o" 'my/toggle-window-other-reachability)
  (keymap-set my/keys-mode-map "C-x w r r" 'window-layout-rotate-clockwise)
  (keymap-set my/keys-mode-map "C-x w r R" 'window-layout-rotate-anticlockwise)
  (keymap-set window-layout-rotate-repeat-map "r" 'window-layout-rotate-clockwise)
  (keymap-set window-layout-rotate-repeat-map "R" 'window-layout-rotate-anticlockwise)

  (keymap-set my/keys-mode-map "C-M-z" 'my/wrap-sexp)

  (keymap-set my/keys-mode-map "C-c R" 'raise-sexp)
  (keymap-set my/keys-mode-map "C-c r" 'delete-pair)

  (keymap-set my/keys-mode-map "M-s g" 'grep)
  (keymap-set my/keys-mode-map "M-s r" 'query-replace-regexp)
  (keymap-set my/keys-mode-map "M-s a" 'align-regexp)

  (keymap-set my/keys-mode-map "M-w" 'copy-region-as-kill)
  (keymap-set my/keys-mode-map "M-(" 'my/wrap-region-paren)
  (keymap-set my/keys-mode-map "M-z" 'my/zap-whitespace)
  (keymap-set my/keys-mode-map "M-o" 'other-window)
  (keymap-set my/keys-mode-map "M-O" 'other-window-backward)
  (keymap-set my/keys-mode-map "M-RET" 'my/eshell)
  (keymap-set my/keys-mode-map "M-C" 'calc)
  (keymap-set my/keys-mode-map "M-K" 'my/kill-buffer)
  (keymap-set my/keys-mode-map "M-D" 'my/vc-on-root)
  (keymap-set my/keys-mode-map "M-Q" 'auto-fill-mode)
  (keymap-set my/keys-mode-map "M-A" 'beginning-of-line-text)
  (keymap-set my/keys-mode-map "M-R" 'my/layout-swap)
  (keymap-set my/keys-mode-map "M-W" 'switch-to-buffer)
  (keymap-set my/keys-mode-map "M-N" 'man)
  (keymap-set my/keys-mode-map "M-*" 'my/shell-at-root)
  (keymap-set my/keys-mode-map "M-S" 'surround-prefix)
  (keymap-set my/keys-mode-map "M-H" 'my/activate-mark)
  (keymap-set my/keys-mode-map "M-J" 'delete-indentation)

  (my/keys-mode 1))

(progn ; mode for log files
  (define-derived-mode
    generic-log-mode
    fundamental-mode
    "Log"
    "Major mode for following log files."
    (setq-local auto-revert-verbose nil)
    (auto-revert-tail-mode 1))
  (add-to-list 'auto-mode-alist
               '("\\.log\\'" . generic-log-mode)))