;;; common.el --- Some common functions -*- lexical-binding: t; -*-

;;;###autoload
(defun center-string-in-width (str width)
  "Add spaces to STR so that it is centered in a box which is WIDTH wide."
  (let ((len (length str)))
    (cond
     ((> len width)
      (error "String %s longer than %d" str width))
     (t (format "%s%s"
                (make-string (round (- width len) 2)
                             32)
                str)))))

;;; jump between the completions buffer and the minibuffer

;;;###autoload
(defvar durand-completion-buffer-names (list "Completions"
                                             "Embark Collect"
                                             "comb")
  "The list of names that match the names of \"completion buffers\".")

;;;###autoload
(defun durand-focus-completion-or-minibuffer (&optional arg)
  "Jump between the completions buffer and the minibuffer."
  (interactive "P")
  (let* ((completion-windows
          (delq nil
                (mapcar
                 (lambda (w)
                   (and (consp
                         (delq nil
                               (mapcar (lambda (name)
                                         (string-match-p
                                          name
                                          (buffer-name (window-buffer w))))
                                       durand-completion-buffer-names)))
                        w))
                 (window-list nil 'nomini))))
         (in-completion-p (consp
                           (delq nil
                                 (mapcar
                                  (lambda (name)
                                    (string-match-p name (buffer-name)))
                                  durand-completion-buffer-names))))
         (minibuffer-active-p (active-minibuffer-window))
         (in-minibuffer-p (minibuffer-window-active-p (selected-window))))
    (cond
     ((and minibuffer-active-p
           (not in-minibuffer-p))
      (select-window (active-minibuffer-window)))
     ((and (consp completion-windows)
           (not in-completion-p))
      (select-window (car completion-windows)))
     (t
      (other-window 1)))))

;;;###autoload
(defun durand-embark-scroll-down-or-go-to-completions (&optional arg)
  "Scroll down; if this is not feasible, go to the completions buffer.
ARG means do this command ARG times."
  (interactive "p")
  (let ((original-point (point))
        (left (abs (forward-line arg)))
        (completion-windows
         (delq nil
               (mapcar
                (lambda (w)
                  (and (consp
                        (delq nil
                              (mapcar (lambda (name)
                                        (string-match-p
                                         name
                                         (buffer-name (window-buffer w))))
                                      durand-completion-buffer-names)))
                       w))
                (window-list nil 'nomini))))
        (in-completion-p (consp
                          (delq nil
                                (mapcar
                                 (lambda (name)
                                   (string-match-p name (buffer-name)))
                                 durand-completion-buffer-names)))))
    (cond ((= (point) (point-max))
           (setq left (1+ left)))
          ((get-text-property (point) 'field)
           (goto-char original-point)))
    (cond ((and (> left 0)
                (consp completion-windows)
                (not in-completion-p))
           (select-window (car completion-windows))
           (cond
            ((> arg 0)
             (goto-char (point-min))
             (cond
              ((derived-mode-p 'completion-list-mode)
               (next-completion 1))))
            ((< arg 0)
             (goto-char (point-max))
             (cond
              ((derived-mode-p 'completion-list-mode)
               (next-completion -1)))))))))

;;;###autoload
(defun durand-embark-scroll-up-or-go-to-completions (&optional arg)
  "Scroll up; if this is not feasible, go to the completions buffer.
ARG means do this command ARG times."
  (interactive "p")
  (durand-embark-scroll-down-or-go-to-completions (- arg)))

;;;###autoload
(defun durand-completion-scroll-down-or-go-to-minibuffer (&optional arg)
  "Scroll down; if this is not feasible, go to the mini-buffer.
ARG means do this command ARG times."
  (interactive "p")
  (let ((original-point (point))
        (left (abs (forward-line arg)))
        (minibuffer-active-p (active-minibuffer-window))
        (in-minibuffer-p (minibuffer-window-active-p (selected-window))))
    (cond ((= (point) (point-max))
           (setq left (1+ left)))
          ((get-text-property (point) 'field)
           (goto-char original-point)))
    (cond ((and (> left 0)
                minibuffer-active-p
                (not in-minibuffer-p))
           (select-window (active-minibuffer-window))
           (cond
            ((> arg 0)
             (goto-char (point-min)))
            ((< arg 0)
             (goto-char (point-max))))))))

;;;###autoload
(defun durand-display-in-one-window (buffer _alist)
  "Display BUFFER in one window.
ALIST is an association list of action symbols and values. See
Info node `(elisp) Buffer Display Action Alists' for details of
such alists. 

This function pops up a new window and then deletes all other
windows. And ALIST is completely ignored."
  (let ((window (split-window (frame-root-window (selected-frame)))))
    (set-window-buffer window buffer)
    (select-window window)
    (delete-other-windows)
    window))

;;;###autoload
(defun durand-completion-scroll-up-or-go-to-minibuffer (&optional arg)
  "Scroll up; if this is not feasible, go to the mini-buffer.
ARG means do this command ARG times."
  (interactive "p")
  (durand-completion-scroll-down-or-go-to-minibuffer (- arg)))

;;; Don't ask me if I want to visit the file again.

(require 'register)

;;;###autoload
(cl-defmethod register-val-jump-to ((val cons) delete)
  (cond
   ((frame-configuration-p (car val))
    (set-frame-configuration (car val) (not delete))
    (goto-char (cadr val)))
   ((window-configuration-p (car val))
    (set-window-configuration (car val))
    (goto-char (cadr val)))
   ((eq (car val) 'file)
    (find-file (cdr val)))
   ((eq (car val) 'file-query)
    (find-buffer-visiting (nth 1 val))
    (find-file (nth 1 val))
    (goto-char (nth 2 val)))
   (t (cl-call-next-method val delete))))

;;; Intentionally disable some key-bindings.

;;;###autoload
(defun intentionally-disabled-bind ()
  "Warn the user that this key-binding is intentionally disabled."
  (interactive)
  (user-error "You pressed an intentionally disabled key-binding: %s"
              (key-description (this-command-keys-vector))))

;;; Hide some minor mode from the mode line display.

;;;###autoload
(defmacro durand-hide-minor-mode (minor &optional to-require)
  "Hide MINOR from the mode line.
Require TO-REQUIRE so that we don't have errors."
  (cond (to-require (require to-require)))
  `(setcdr (assq ',minor minor-mode-alist) (list "")))

(provide 'common)
;;; common.el ends here.