#+TITLE: Commands
#+STARTUP: content

Custom interactive commands.

* Configuration

#+begin_src emacs-lisp
;;; commands.el --- Custom interactive commands -*- lexical-binding: t; -*-

(defun circ/select-line ()
  "Select the current line."
  (interactive)
  (beginning-of-line)
  (set-mark (point))
  (end-of-line))

(defun circ/reload-config ()
  "Reload the Emacs configuration from init.el."
  (interactive)
  (load user-init-file)
  (message "Config reloaded."))
#+end_src

* Windows

#+begin_src emacs-lisp
(defun circ/shrink-window-horizontally ()
  "Shrink the current window horizontally by 5 columns."
  (interactive)
  (shrink-window-horizontally 5))

(defun circ/enlarge-window ()
  "Enlarge the current window vertically by 5 lines."
  (interactive)
  (enlarge-window 5))

(defun circ/shrink-window ()
  "Shrink the current window vertically by 5 lines."
  (interactive)
  (shrink-window 5))

(defun circ/enlarge-window-horizontally ()
  "Enlarge the current window horizontally by 5 columns."
  (interactive)
  (enlarge-window-horizontally 5))

(defun circ/window-resize-mode ()
  "Enter window resizing mode.
Use i/k to shrink/enlarge horizontally and j/l to enlarge/shrink vertically.
Press q or ESC to exit. Any other key exits and executes normally."
  (interactive)
  (let ((map (make-sparse-keymap))
        (resize-keys '(?i ?j ?k ?l)))
    (define-key map (kbd "j") #'circ/shrink-window-horizontally)
    (define-key map (kbd "l") #'circ/enlarge-window-horizontally)
    (define-key map (kbd "k") #'circ/enlarge-window)
    (define-key map (kbd "i") #'circ/shrink-window)
    (define-key map (kbd "q") #'ignore)
    (define-key map (kbd "ESC") #'ignore)
    (set-transient-map map (lambda () (memq (event-basic-type last-command-event) resize-keys)))
    (message "Window resize mode: i/j/k/l to resize, q/ESC to exit")))

(defun circ/scroll-mode ()
  "Enter a transient scrolling mode. u/d to scroll half page, q/ESC to exit."
  (interactive)
  (let ((map (make-sparse-keymap))
        (scroll-keys '(?u ?d)))
    (define-key map (kbd "d") #'circ/scroll-half-page-down)
    (define-key map (kbd "u") #'circ/scroll-half-page-up)
    (define-key map (kbd "q") #'ignore)
    (define-key map (kbd "ESC") #'ignore)
    (set-transient-map map (lambda () (memq (event-basic-type last-command-event) scroll-keys)))
    (message "Scroll mode: u/d to scroll half page, q/ESC to exit")))

(defun circ/move-buffer (direction)
  "Move the current buffer to the window in DIRECTION and show previous buffer here."
  (let ((buf (current-buffer))
        (orig-win (selected-window))
        (win (windmove-find-other-window direction)))
    (unless win (user-error "No window in that direction"))
    (circ/tab-line-close-tab buf)
    (set-window-buffer win buf)
    (select-window win)))

(defun circ/move-buffer-left ()
  "Move the current buffer to the window on the left."
  (interactive)
  (circ/move-buffer 'left))

(defun circ/move-buffer-right ()
  "Move the current buffer to the window on the right."
  (interactive)
  (circ/move-buffer 'right))

(defun circ/move-buffer-up ()
  "Move the current buffer to the window above."
  (interactive)
  (circ/move-buffer 'up))

(defun circ/move-buffer-down ()
  "Move the current buffer to the window below."
  (interactive)
  (circ/move-buffer 'down))

(defun circ/split-right ()
  "Split window right, move current buffer to the new window, and focus it."
  (interactive)
  (split-window-right)
  (circ/move-buffer-right))

(defun circ/split-below ()
  "Split window below, move current buffer to the new window, and focus it."
  (interactive)
  (split-window-below)
  (circ/move-buffer-down))

#+end_src

* Buffers

#+begin_src emacs-lisp
(defvar circ/side-window-options
  '((side . right)
    (slot . 0)
    (window-width . 0.33))
  "Options for `circ/move-buffer-to-side-window'.")

(defun circ/move-buffer-to-side-window ()
  "Display the current buffer in a side window and switch to it."
  (interactive)
  (let ((buf (current-buffer)))
    (bury-buffer)
    (select-window (display-buffer-in-side-window buf circ/side-window-options))))

(defun circ/revert-buffer ()
  "Revert the current buffer without confirmation."
  (interactive)
  (revert-buffer nil t))

(defun circ/copy-filepath ()
  "Copy the current buffer's file path to the clipboard."
  (interactive)
  (if-let ((path (buffer-file-name)))
      (progn
        (kill-new path)
        (message "Copied: %s" path))
    (user-error "Buffer is not visiting a file")))
#+end_src

* Transpose Buffers
#+begin_src emacs-lisp
(defun circ/transpose-buffers (dir &optional arg)
  "Transpose the buffers in the current window and the target window
If arg is non-nil, the selected window will change to keep the source buffer
selected."
  (let ((target-window (windmove-find-other-window dir))
        (source-window (selected-window)))
    (cond ((null target-window)
           (format "No window found in dir %s" dir))
          ((and (window-minibuffer-p target-window)
                (not (minibuffer-window-active-p target-window)))
           (user-error "Minibuffer is inactive"))
          (t
           (let ((target-buffer (window-buffer target-window))
                 (source-buffer (window-buffer)))
             (set-window-buffer target-window source-buffer)
             (set-window-buffer source-window target-buffer)
	     (with-selected-window target-window
	       (bury-buffer target-buffer))
	     (with-selected-window source-window
	       (bury-buffer source-buffer)))
           (if arg
               (select-window target-window))))))

(defun circ/transpose-buffers-left (&optional arg)
    "Transpose buffers from current window to buffer to the left"
  (interactive)
  (circ/transpose-buffers 'left arg))

(defun circ/transpose-buffers-up (&optional arg)
    "Transpose buffers from current window to buffer above"
  (interactive)
  (circ/transpose-buffers 'up arg))

(defun circ/transpose-buffers-right (&optional arg)
    "Transpose buffers from current window to buffer to the right"
  (interactive)
  (circ/transpose-buffers 'right arg))

(defun circ/transpose-buffers-down (&optional arg)
    "Transpose buffers from current window to buffer below"
  (interactive)
  (circ/transpose-buffers 'down arg))
#+end_src

* Duplicate Buffers
#+BEGIN_SRC emacs-lisp
(defun circ/duplicate-buffer (dir &optional arg)
  "Opens the current buffer in the window in the direction dir
If arg is non-nil, the targeted window is selected"
  (let ((target-window (windmove-find-other-window dir))
        (source-buffer (window-buffer)))
    (cond ((null target-window)
           (format "No window found in dir %s" dir))
          ((and (window-minibuffer-p target-window)
                (not (minibuffer-window-active-p target-window)))
           (user-error "Minibuffer is inactive"))
          (t
           (set-window-buffer target-window source-buffer)
           (if arg
               (select-window target-window))))))

(defun circ/duplicate-buffer-left (&optional arg)
  "Cast current buffer to the left"
  (interactive)
  (circ/duplicate-buffer 'left arg))

(defun circ/duplicate-buffer-up (&optional arg)
  "Cast current buffer up"
  (interactive)
  (circ/duplicate-buffer 'up arg))

(defun circ/duplicate-buffer-right (&optional arg)
  "Cast current buffer to the right"
  (interactive)
  (circ/duplicate-buffer 'right arg))

(defun circ/duplicate-buffer-down (&optional arg)
  "Cast current buffer down"
  (interactive)
  (circ/duplicate-buffer 'down arg))
#+END_SRC

* Vterm

#+begin_src emacs-lisp
(defun circ/new-vterm ()
  "Open a new vterm buffer with a unique name."
  (interactive)
  (vterm (generate-new-buffer-name "*vterm*")))
#+end_src

* Org

#+begin_src emacs-lisp
(defun circ/org-insert-subheading ()
  "Insert a subheading on a new line."
  (interactive)
  (end-of-line)
  (newline)
  (org-insert-subheading nil))

(defun circ/open-org-inbox-file ()
  (interactive)
  (find-file circ/org-inbox-file))

(defun circ/open-org-todo-file ()
  (interactive)
  (find-file circ/org-todo-file))
#+end_src

* Scrolling

#+begin_src emacs-lisp
(defun circ/scroll-half-page-down ()
  "Scroll down half a page."
  (interactive)
  (scroll-up-command (/ (window-body-height) 2)))

(defun circ/scroll-half-page-up ()
  "Scroll up half a page."
  (interactive)
  (scroll-down-command (/ (window-body-height) 2)))
#+end_src

* Tabs

#+begin_src emacs-lisp
(defun circ/tab-bar-new-tab ()
  "Create a new tab with only the *scratch* buffer."
  (interactive)
  (tab-bar-new-tab)
  (circ/tab-line-close-other-tabs))

(defun circ/move-tab-left ()
  "Move the current tab one position to the left."
  (interactive)
  (tab-bar-move-tab -1))

(defun circ/move-tab-right ()
  "Move the current tab one position to the right."
  (interactive)
  (tab-bar-move-tab 1))

(defun circ/tab-bar-select-tab-1 ()
  (interactive)
  (tab-bar-select-tab 1))
(defun circ/tab-bar-select-tab-2 ()
  (interactive)
  (tab-bar-select-tab 2))
(defun circ/tab-bar-select-tab-3 ()
  (interactive)
  (tab-bar-select-tab 3))
(defun circ/tab-bar-select-tab-4 ()
  (interactive)
  (tab-bar-select-tab 4))
(defun circ/tab-bar-select-tab-5 ()
  (interactive)
  (tab-bar-select-tab 5))
(defun circ/tab-bar-select-tab-6 ()
  (interactive)
  (tab-bar-select-tab 6))
(defun circ/tab-bar-select-tab-7 ()
  (interactive)
  (tab-bar-select-tab 7))
(defun circ/tab-bar-select-tab-8 ()
  (interactive)
  (tab-bar-select-tab 8))
(defun circ/tab-bar-select-tab-9 ()
  (interactive)
  (tab-bar-select-tab 9))

(defun circ/tab-line-close-tab (&optional buffer)
  "Close a tab-line tab. If BUFFER is nil, close the current tab. Code taken from the `bury-buffer' section of the `tab-line.el' code for `tab-line-close-tab' command. Rewritten here because `tab-line-close-tab' can only be invoked via a mouse event. This command allows closing the tab from a keyboard shortcut."
  (interactive)
  (let ((buffer (or buffer (current-buffer))))
    (if (eq buffer (current-buffer))
        (bury-buffer)
      (set-window-prev-buffers nil (assq-delete-all buffer (window-prev-buffers)))
      (set-window-next-buffers nil (delq buffer (window-next-buffers))))))

(defun circ/tab-line-switch-to-next-tab ()
  (interactive)
  (let* ((tabs (seq-filter
                (lambda (tab) (or (bufferp tab) (assq 'buffer tab)))
                (funcall tab-line-tabs-function)))
         (pos (seq-position
               tabs (current-buffer)
               (lambda (tab buffer)
                 (if (bufferp tab)
                     (eq buffer tab)
                   (eq buffer (cdr (assq 'buffer tab)))))))
         (tab (if pos
                  (if (and tab-line-switch-cycling (<= (length tabs) (1+ pos)))
                      (car tabs)
                    (nth (1+ pos) tabs))))
         (buffer (if (bufferp tab) tab (cdr (assq 'buffer tab)))))
    (when (bufferp buffer)
      (tab-line-select-tab-buffer buffer))))

(defun circ/tab-line-switch-to-prev-tab ()
  (interactive)
  (let* ((tabs (seq-filter
                (lambda (tab) (or (bufferp tab) (assq 'buffer tab)))
                (funcall tab-line-tabs-function)))
         (pos (seq-position
               tabs (current-buffer)
               (lambda (tab buffer)
                 (if (bufferp tab)
                     (eq buffer tab)
                   (eq buffer (cdr (assq 'buffer tab)))))))
         (tab (if pos
                  (if (and tab-line-switch-cycling (<= pos 0))
                      (nth (1- (length tabs)) tabs)
                    (nth (1- pos) tabs))))
         (buffer (if (bufferp tab) tab (cdr (assq 'buffer tab)))))
    (when (bufferp buffer)
      (tab-line-select-tab-buffer buffer))))

(defun circ/tab-line-close-other-tabs ()
  "Close all tab-line tabs except the current one."
  (interactive)
  (let ((current (current-buffer))
        (tabs (tab-line-tabs-window-buffers)))
    (dolist (tab tabs)
      (when (not (eq tab current))
        (circ/tab-line-close-tab tab)
	(force-mode-line-update)))))
#+end_src

* VC

#+begin_src emacs-lisp
(define-advice log-edit-done (:around (orig-fn) kill-buffer-after)
  (let ((buf (current-buffer)))
    (funcall orig-fn)
    (kill-buffer buf)))

(define-advice log-edit-kill-buffer (:after () message-aborted)
  (message "Aborted commit"))
#+end_src
* Other

** alignment functions
#+begin_src emacs-lisp
(defun circ/align-once-head (start end regexp)
  "Align by regex once, adding spaces to the head of the regexp"
  (interactive "r\nsAlign once head regexp: ")
  (align-regexp start end
                (concat "\\(\\s-*\\)" regexp) 1 1 nil))

(defun circ/align-once-tail (start end regexp)
  "Align by regex once, adding spaces to the tail of the regexp"
  (interactive "r\nsAlign once tail regexp: ")
  (align-regexp start end
                (concat regexp "\\(\\s-*\\)") 1 1 nil))

(defun circ/align-repeat-head (start end regexp)
  "Align by regex repeatedly, adding spaces to the head of the regexp"
  (interactive "r\nsAlign repeat head regexp: ")
  (align-regexp start end
                (concat "\\(\\s-*\\)" regexp) 1 1 t))

(defun circ/align-repeat-tail (start end regexp)
  "Align by regex repeatedly, adding spaces to the tail of the regexp"
  (interactive "r\nsAlign repeat tail regexp: ")
  (align-regexp start end
                (concat regexp "\\(\\s-*\\)") 1 1 t))
#+end_src

** Insert filepath

#+begin_src emacs-lisp
(defun circ/insert-project-filepath ()
  "Insert a project file path as a string at point."
  (interactive)
  (let* ((pr (project-current t))
         (root (project-root pr))
         (dirs (list root))
         (all-files (project-files pr dirs))
         (file (funcall project-read-file-name-function
                        "Insert file path" all-files nil 'file-name-history
                        (or (thing-at-point 'filename)
                            (and buffer-file-name
                                 (file-relative-name buffer-file-name root))))))
    (insert (file-relative-name file root))))
#+end_src
