;;; definitions.el --- definitions for my Emacs config  -*- lexical-binding: t; -*-

(defun other-window-or-switch-buffer (&optional arg)
  "Switch to the other window.
If a window is the only buffer on a frame, switch buffer.  When
run with \\[universal-argument], unconditionally switch buffer."
  (interactive "P")
  (if (or arg (one-window-p))
      (switch-to-buffer (other-buffer) nil t)
    (other-window 1)))

(defun cycle-spacing@ (&optional n)
  ;; `cycle-spacing' is wildly different in 29.1 over 28.
  "Negate N argument on `cycle-spacing'.
That is, with a positive N, deletes newlines as well, leaving -N
spaces.          If N is negative, it will not delete newlines and leave
N spaces."
  (interactive "*p")
  (cycle-spacing (- n)))

(defun first-frame@set-fonts ()
  (remove-hook 'server-after-make-frame-hook
               #'first-frame@set-fonts)
  (face-spec-set 'default
                 `((t :family "Recursive Mono Casual Static"
                      :height 110)))
  ;; Emojis
  (cl-loop with ffl = (font-family-list)
           for font in '("Noto Emoji" "Noto Color Emoji"
                         "Segoe UI Emoji" "Apple Color Emoji"
                         "FreeSans" "FreeMono" "FreeSerif"
                         "Unifont" "Symbola")
           if (member font ffl)
           do (set-fontset-font t 'symbol font))
  ;; International fonts
  (cl-loop with ffl = (font-family-list)
           for (charset . font)
           in '((latin . "Noto Sans")
                (han . "Noto Sans CJK SC Regular")
                (kana . "Noto Sans CJK JP Regular")
                (hangul . "Noto Sans CJK KR Regular")
                (cjk-misc . "Noto Sans CJK KR Regular")
                (khmer . "Noto Sans Khmer")
                (lao . "Noto Sans Lao")
                (burmese . "Noto Sans Myanmar")
                (thai . "Noto Sans Thai")
                (ethiopic . "Noto Sans Ethiopic")
                (hebrew . "Noto Sans Hebrew")
                (arabic . "Noto Sans Arabic")
                (gujarati . "Noto Sans Gujarati")
                (devanagari . "Noto Sans Devanagari")
                (kannada . "Noto Sans Kannada")
                (malayalam . "Noto Sans Malayalam")
                (oriya . "Noto Sans Oriya")
                (sinhala . "Noto Sans Sinhala")
                (tamil . "Noto Sans Tamil")
                (telugu . "Noto Sans Telugu")
                (tibetan . "Noto Sans Tibetan"))
           if (member font ffl)
           do (set-fontset-font t charset font)))

(defun switch-themes ()
  (interactive)
  (let ((current-theme (car custom-enabled-themes)))
    (mapc #'disable-theme custom-enabled-themes)
    (enable-theme (pcase current-theme
                    ('modus-operandi 'modus-vivendi)
                    ('modus-vivendi 'modus-operandi)))))

(defun renz/sort-by-alpha-length (elems)
  "Sort ELEMS first alphabetically, then by length."
  (sort elems (lambda (c1 c2)
                (or (string-version-lessp c1 c2)
                    (< (length c1) (length c2))))))

(defun renz/sort-by-history (elems)
  "Sort ELEMS by minibuffer history.
Use `mct-sort-sort-by-alpha-length' if no history is available."
  (if-let ((hist (and (not (eq minibuffer-history-variable t))
                      (symbol-value minibuffer-history-variable))))
      (minibuffer--sort-by-position hist elems)
    (renz/sort-by-alpha-length elems)))

(defun renz/completion-category ()
  "Return completion category."
  (when-let ((window (active-minibuffer-window)))
    (with-current-buffer (window-buffer window)
      (completion-metadata-get
       (completion-metadata (buffer-substring-no-properties
                             (minibuffer-prompt-end)
                             (max (minibuffer-prompt-end) (point)))
                            minibuffer-completion-table
                            minibuffer-completion-predicate)
       'category))))

(defun renz/sort-multi-category (elems)
  "Sort ELEMS per completion category."
  (pcase (renz/completion-category)
    ('nil elems) ; no sorting
    ('kill-ring elems)
    ('project-file (renz/sort-by-alpha-length elems))
    (_ (renz/sort-by-history elems))))

(defvar no-tabs-modes '(emacs-lisp-mode
                        lisp-mode
                        scheme-mode
                        python-mode
                        haskell-mode)
  "Modes /not/ to indent with tabs.")

(defun indent-tabs-mode-maybe ()
  (if (apply #'derived-mode-p no-tabs-modes)
      (indent-tabs-mode -1)
    (indent-tabs-mode 1)))

(define-minor-mode truncate-lines-mode
  "Buffer-local mode to toggle `truncate-lines'."
  :lighter ""
  (setq-local truncate-lines truncate-lines-mode))

;;; Region or buffer stuff

(defun call-with-region-or-buffer (fn &rest _r)
  "Call function FN with current region or buffer.
Good to use for :around advice."
  (if (region-active-p)
      (funcall fn (region-beginning) (region-end))
    (funcall fn (point-min) (point-max))))

(defun delete-trailing-whitespace-except-current-line ()
  (save-excursion
    (delete-trailing-whitespace (point-min)
                                (line-beginning-position))
    (delete-trailing-whitespace (line-end-position)
                                (point-max))))

(defun create-missing-directories ()
  "Automatically create missing directories."
  (let ((target-dir (file-name-directory buffer-file-name)))
    (unless (file-exists-p target-dir)
      (make-directory target-dir :parents))))


(defun vc-remote-off ()
  "Turn VC off when remote."
  (when (file-remote-p (buffer-file-name))
    (setq-local vc-handled-backends nil)))