;;; window-plus.el --- Provides improved Emacs window operation commands -*- lexical-binding: nil -*-
;;;
;;; ver2.03 2026/05/01
;;;
;;; Install
;;;  copy window-plus.el to /usr/share/emacs/site-lisp/.
;;;
;;; Setting
;;;  add to .emacs
;;;  ----
;;; (reqire 'window-plus)
;;; (window-plus-init)
;;; (global-set-key "\C-xo" 'other-window+)
;;; (global-set-key "\C-x0" 'delete-window+)
;;; (global-set-key "\C-x1" 'delete-other-windows+)
;;; (setq windowP-ignore-buffers (list "*wclock*" "*Calendar*")) ; example
;;;  ----
;;;

(defcustom windowP-ignore-buffers nil
  "other-window+, delete-window+, delete-other-windows+ および
   windowP-display-buffer-function で対象としないバッファリスト
   設定例
   (setq windowP-ignore-buffers (list \"*bijin-tokei*\" \"*Calendar*\"))
  "
  :type  '(string)
  :group 'window-plus)

(defcustom windowP-window-aspect-ratio-to-split-window-right 1.45
  "split-window-right にするアスペクト比を指定する"
  :type  'number
  :group 'window-plus)

(defcustom windowP-window-height-to-split-window-right 40
  "split-window-right にするウインドウ高さの下限"
  :type  'number
  :group 'window-plus)

(defvar windowP-display-buffer-function
  (lambda (buffer inhibit-same-window action frame)
    (let* ((user-action
            (display-buffer-assq-regexp
             (buffer-name buffer) display-buffer-alist action))
           (special-action (display-buffer--special-action buffer))
           ;; Extra actions from the arguments to this function:
           (extra-action
            (cons nil (append (if inhibit-same-window
                                  '((inhibit-same-window . t)))
                              (if frame
                                  `((reusable-frames . ,frame))))))
           ;; Construct action function list and action alist.
           (actions (list display-buffer-overriding-action
                          user-action special-action action extra-action
                          display-buffer-base-action
                          display-buffer-fallback-action))
           (functions (apply 'append
                             (mapcar (lambda (x)
                                       (setq x (car x))
                                       (if (functionp x) (list x) x))
                                     actions)))
           (alist (apply 'append (mapcar 'cdr actions)))
           window)
      (unless (buffer-live-p buffer)
        (error "Invalid buffer"))
      (if (and action (car action))
          (progn
            (while (and functions (not window))
              (setq window (funcall (car functions) buffer alist)
                    functions (cdr functions)))
            (and (windowp window) window)
            )
        (progn
;         (message (format "%s" action))
          (let (considerwlist)
            (dolist (win (window-list))
              (if (not (string-match "*Minibuf-" (format "%s" (window-buffer win))))
                  (let ((ignmatch nil))
                    (dolist (ignbuf windowP-ignore-buffers)
                      (if (string= (format "%s" (window-buffer win)) ignbuf)
                          (setq ignmatch t))
                      )
                    (if (not ignmatch)
                        (setq considerwlist (append considerwlist (list win))))
                    )))
            (if (<= (length considerwlist) 1)
                (progn
;                  (if (not inhibit-same-window)
;                      (setq window (get-buffer-window (current-buffer))))
                  (if (< (window-height) 3)
                      (dolist (win (window-list))
                        (if (and (not window) (<= 3 (window-height win)))
                            (setq window win))
                        ))
                  (if (or (not window) inhibit-same-window)
                      (let ((window-aspect-ratio (/ (float (window-width)) (float (* (window-height) 2)))))
                        (if (and
                             (numberp windowP-window-aspect-ratio-to-split-window-right)
                             (> window-aspect-ratio windowP-window-aspect-ratio-to-split-window-right)
                             (numberp windowP-window-height-to-split-window-right)
                             (> (window-height) windowP-window-height-to-split-window-right))
                            (setq window (split-window-right))
                          (setq window (split-window)))))
                  )
              (let ((bufwin (get-buffer-window buffer)))
                (if inhibit-same-window
                    (setq window (car (cdr considerwlist)))
                  (progn
                    (if bufwin
                        (setq window bufwin)
                      (setq window (car considerwlist))))
                  )
                ))
            (window--display-buffer (window-normalize-buffer-to-switch-to buffer) window nil)
            window)
          ))
      )))

(defun display-buffer (buffer-or-name &optional action frame)
  "This function is overrided by window-plus.el.
Original function is in lisp/window.el"
  (interactive (list (read-buffer "Display buffer: " (other-buffer))
                     (if current-prefix-arg t)))
  (let ((buffer (if (bufferp buffer-or-name)
                    buffer-or-name
                  (get-buffer buffer-or-name)))
        ;; Make sure that when we split windows the old window keeps
        ;; point, bug#14829.
        (split-window-keep-point t)
        ;; Handle the old form of the first argument.
        (inhibit-same-window (and action (not (listp action)))))
    (unless (listp action) (setq action nil))
    (if display-buffer-function
        ;; If `display-buffer-function' is defined, let it do the job.
        (funcall display-buffer-function buffer inhibit-same-window action frame)
      ;; Otherwise, use the defined actions.
      (let* ((user-action
              (display-buffer-assq-regexp
               (buffer-name buffer) display-buffer-alist action))
             (special-action (display-buffer--special-action buffer))
             ;; Extra actions from the arguments to this function:
             (extra-action
              (cons nil (append (if inhibit-same-window
                                    '((inhibit-same-window . t)))
                                (if frame
                                    `((reusable-frames . ,frame))))))
             ;; Construct action function list and action alist.
             (actions (list display-buffer-overriding-action
                            user-action special-action action extra-action
                            display-buffer-base-action
                            display-buffer-fallback-action))
             (functions (apply 'append
                               (mapcar (lambda (x)
                                         (setq x (car x))
                                         (if (functionp x) (list x) x))
                                       actions)))
             (alist (apply 'append (mapcar 'cdr actions)))
             window)
        (unless (buffer-live-p buffer)
          (error "Invalid buffer"))
        (while (and functions (not window))
          (setq window (funcall (car functions) buffer alist)
                functions (cdr functions)))
        (and (windowp window) window)))))

(defun window-plus-init ()
  (interactive)
  (setq display-buffer-function windowP-display-buffer-function)
  )

(defun winp-show-ignore-buffers ()
  "Show window-plus-ignore-buffers"
  (interactive)
  (message (format "%s" windowP-ignore-buffers)))

(defun winp-add-ignore-buffer ()
  "Add buffer to window-plus-ignore-buffers"
  (interactive)
  (add-to-list 'windowP-ignore-buffers
               (completing-read "buffer-name: "
                                (let ((buflist))
                                  (dolist (buf (buffer-list))
                                    (let ((imatch nil)
                                          (bufn (buffer-name buf)))
                                      (dolist (ibuf windowP-ignore-buffers)
                                        (if (string= bufn ibuf)
                                            (setq imatch t)))
                                      (if (not imatch)
                                          (setq buflist (append buflist (list bufn))))))
                                  buflist
                                  )))
  (winp-show-ignore-buffers))

(defun winp-add-ignore-current-buffer ()
  "Add current-buffer to window-plus-ignore-buffers"
  (interactive)
  (add-to-list 'windowP-ignore-buffers (buffer-name))
  (winp-show-ignore-buffers))

(defun winp-remove-ignore-buffer ()
  "Remove buffer from window-plus-ignore-buffers"
  (interactive)
  (setq windowP-ignore-buffers
        (delete (completing-read "buffer-name: " windowP-ignore-buffers)
                windowP-ignore-buffers))
  (winp-show-ignore-buffers))

(defun winp-remove-ignore-current-buffer ()
  "Remove current-buffer from window-plus-ignore-buffers"
  (interactive)
  (setq windowP-ignore-buffers
        (delete (buffer-name) windowP-ignore-buffers))
  (winp-show-ignore-buffers))

(defun winp-window-list ()
  "Returns the list of windows on FRAME excluding the window displaying
windowP-ignore-buffers"
  (let (winlist '())
    (dolist (win (window-list))
      (let ((matchflag nil))
        (dolist (buf windowP-ignore-buffers)
          (if (eq (get-buffer-window buf) win)
              (setq matchflag t)))
        (if (not matchflag)
            (add-to-list 'winlist win))))
    (reverse winlist)
    ))


(defun other-window+ (&optional window)
  "windowP-ignore-buffers に含まれないバッファウインドウにカレントウインドウを変更する"
  (interactive)
  (let* ((wlist (cdr (window-list)))
         (isleave nil))
    (dolist (win wlist)
      (if (not isleave)
        (let ((ignmatch nil))
          (dolist (bufname windowP-ignore-buffers)
            (if (not (eq (get-buffer-window bufname) nil))
                (dolist (ignwin (get-buffer-window-list bufname))
                  (if (eq win ignwin) (setq ignmatch t)))))

          (if (not ignmatch)
              (progn
                (select-window win)
                (setq isleave t))))))
    )
  )

(defun delete-window+ (&optional window)
  "windowP-ignore-buffers に含まれるバッファウインドウを残したままカレントウインドウを閉じる"
  (interactive)
  (let* ((wlist (window-list))
         (considerwlist))

    (dolist (win wlist)
      (let ((ignmatch nil))
        (dolist (bufname windowP-ignore-buffers)
          (if (not (eq (get-buffer-window bufname) nil))
              (dolist (ignwin (get-buffer-window-list bufname))
                (if (eq win ignwin) (setq ignmatch t)))))

        (if (not ignmatch)
            (setq considerwlist (append considerwlist (list win))))))
    (if (not (eq (length considerwlist) 0))
        (if (not (eq (length considerwlist) 1))
            (progn
              (delete-window (car considerwlist))
              (select-window (car (cdr considerwlist))))))
    ))

(defun delete-other-windows+ (&optional window)
  "カレントウインドウと windowP-ignore-buffers に含まれないバッファウインドウを閉じる"
  (interactive)
  (let* ((wlist (window-list))
         (curwin (car (get-buffer-window-list)))
         (delwins))

    (dolist (win wlist)
      (if (not (eq win curwin))
        (let ((ignmatch nil))
          (dolist (bufname windowP-ignore-buffers)
            (if (not (eq (get-buffer-window bufname) nil))
                (dolist (ignwin (get-buffer-window-list bufname))
                  (if (eq win ignwin) (setq ignmatch t)))))
          (if (not ignmatch) (push win delwins)))))
    (dolist (win delwins)
      (delete-window win))
    ))

(defun count-windows+ ()
  "windowP-ignore-buffers に含まれないバッファウインドウの数を返す"

  (let ((wlist (window-list))
        (count 0))
    (dolist (win wlist)
      (let ((match nil))
        (dolist (bufname windowP-ignore-buffers)
          (if (eq (get-buffer-window bufname) win)
              (setq match t)))
        (if (not match)
            (setq count (+ count 1)))))
    count))

(provide 'window-plus)
