;;; otpp.el --- One tab per project, with unique names -*- lexical-binding: t; -*-

;; Copyright (C) 2024-2026  Abdelhak Bougouffa

;; Author: Abdelhak Bougouffa (rot13 "nobhtbhssn@srqbencebwrpg.bet")
;; URL: https://github.com/abougouffa/one-tab-per-project
;; Created: July 07, 2024
;; Modified: June 06, 2026
;; Package-Version: 3.5.4
;; Package-Revision: ef1460cf7cd9
;; Package-Requires: ((emacs "28.1") (compat "29.1"))
;; Keywords: convenience
;; SPDX-License-Identifier: GPL-3.0

;;; Commentary:

;; This is a lightweight workspace management package that provides a thin layer
;; between builtin packages `project' and `tab-bar'. The whole idea consists of
;; creating a _tab per opened project_ while ensuring unique names for the
;; created tabs (when multiple opened projects have the same name).
;;
;; This package is inspired by `project-tab-groups' which creates a "tab group"
;; per project.

;;; Installation

;; This package is available on MELPA.
;;
;; ```emacs-lisp
;; (use-package otpp
;;   :straight t
;;   :after project
;;   :init
;;   ;; Enable `otpp-mode' globally
;;   (otpp-mode 1)
;;   ;; If you want to advice the commands in `otpp-override-commands'
;;   ;; to be run in the current's tab (so, current project's) root directory
;;   (otpp-override-mode 1))
;; ```

;;; Basic usage

;; The usage is quite straightforward, there is no extra commands to learn to be
;; able to use it. When `otpp-mode' global minor mode is enabled, you will have
;; this:
;;
;; - When you switch to a project `project-switch-project' (bound by default to
;;   `C-x p p`), `otpp' will create a tab with the project name.
;;
;; - When you kill a project with all its buffers with `project-kill-buffers',
;;   the tab is closed.
;;
;; - Lets say you've switched to the project under
;;   `/home/user/project1/backend/', `otpp' will create a tab named `backend'
;;   for this particular project. Now, you opened a second project under
;;   `/home/user/project2/backend/', `otpp' will detect that the name of the
;;   project `backend' is the same as the previously opened one, but it have a
;;   different path. In this case, `otpp' will create a tab named
;;   `backend[project2]` and renames the previously opened tab to
;;   `backend[project1]`. This conflict resolution is provided by the
;;   `otpp-uniq-*' routines.
;;
;; - For some cases, you might need to attach a manually created tab (by
;;   `tab-bar-new-tab') to an opened project so you have two tabs dedicated to
;;   the same project (with different windows layouts for example). In this
;;   case, you can call the command `otpp-change-tab-root-dir' and select the
;;   path of the project to attach to.
;;
;; - When you use some commands to jump to a file (`find-file',
;;   `xref-find-definitions', etc.), you can end up with a buffer belonging to a
;;   _different project (lets say `B')_ but displayed in the current project's
;;   tab _(`A')_. In this case, you can call `otpp-detach-buffer-to-tab' to
;;   create a new tab dedicated to the buffer's project `B'. When the opened
;;   buffer is project-less (not part of a project), the command will signal a
;;   user error unless `otpp-allow-detach-projectless-buffer' is non-nil, in
;;   this case, `otpp' creates a new project-less tab for the buffer.

;;; Advanced usage

;; Consider this use case: supposing you are using `otpp-mode' and you've run
;; `project-switch-project' to open the `X' project in a new `X' tab. Now you
;; `M-x find-file` then you open the `test.cpp` file outside the current `X'
;; project. Now, if you run `project-find-file', you will be in one of these two
;; situations:
;;
;; 1. If `test.cpp` is part of another project `Y', the `project-find-file' will
;;    prompt you with a list of `Y's files even though we are in the `X' tab.
;;
;; 2. If `test.cpp` isn't part of any project, `project-find-file' will prompt
;; you to select a project first, then to select a file.
;;
;; For this, `otpp' provides `otpp-prefix' (we recommend to bind it to some key,
;; like `C-x t P`, using `otpp-prefix' from `M-x' can have some limitations).
;; When you run `otpp-prefix' followed by `C-x p f` for example, you will be
;; prompted for files in the current's tab project files even if you are
;; visiting a file outside of the current project.
;;
;; In my workflow, I would like to always restrict the commands like
;; `project-find-file' and `project-kill-buffers' to the project bound to the
;; current tab, even if I'm visiting a file which is not part of this project.
;; If you like this behavior, you can enable the `otpp-override-mode'. This mode
;; will advice all the commands defined in `otpp-override-commands' to be ran in
;; the current's tab root directory (_i.e._, in the project bound to the current
;; tab).
;;
;; When `otpp-override-mode' is enabled, the `otpp-prefix' acts inversely. While
;; all `otpp-override-commands' are restricted to the current's tab project by
;; default, running a command with `otpp-prefix' will disable this behavior,
;; which results of the next command to be run in the `default-directory'
;; depending on the visited buffer.

;;; Similar packages

;; This section is not exhaustive, it includes only the packages that I used
;; before.
;;
;; - [`project-tab-groups'](https://github.com/fritzgrabo/project-tab-groups):
;;   This package provides a mode that enhances the Emacs built-in `project' to
;;   support keeping projects isolated in named tab groups. `otpp' is inspired
;;   by this package, but instead of setting the tab groups, `otpp' introduces a
;;   new attribute in the tab named `otpp-root-dir' where it stores the root
;;   directory of the project bound to the tab. This allows keeping the tabs
;;   updated in case another project with the same name (but a different path)
;;   is opened.
;;
;; - [`tabspaces'](https://github.com/mclear-tools/tabspaces): This package
;;   provide workspace management with `tab-bar' and with an integration with
;;   `project'. Contrary to `otpp' and `project-tab-groups', `tabspaces' don't
;;   create tabs automatically, you need to call specific commands like
;;   `tabspaces-open-or-create-project-and-workspace'. Also, `tabspaces'
;;   behavior isn't predictable when you open several projects with the same
;;   directory name.

;;; Code:

(require 'seq)
(require 'subr-x)
(require 'cl-lib)
(require 'project)

(defgroup otpp nil
  "One tab per project."
  :group 'project
  :prefix "otpp-")

(defcustom otpp-bury-on-kill-buffer-when-multiple-tabs t
  "Bury the current buffer when killed but it is opened in another tab.

When non-nil, this modifies the behavior of `kill-buffer' when killing
the current buffer. If the current buffer is opened in another tab, we
bury it instead of killing it. This only affects the current buffer,
when we explicitly select another buffer to kill, `otpp' assumes that we
have a good reason to kill it."
  :group 'otpp
  :type 'boolean
  :version "3.1.0")

(defcustom otpp-reconnect-tab t
  "Whether to reconnect a disconnected tab when switching to it.

When set to a function's symbol, that function will be called with the
switched-to project's root directory as its single argument.

When non-nil, show the project dispatch menu instead."
  :group 'otpp
  :type '(choice function boolean)
  :version "0.1.0")

(defcustom otpp-strictly-obey-dir-locals nil
  "Whether to strictly obey local variables.

Set a nil (default value) to only respect the local variables when they
are defined in the project's root (the `dir-locals-file' is located in
the project's root).

Set to a function that takes DIR, PROJECT-ROOT and DIR-LOCALS-ROOT as
arguments in this order, see the function `otpp-project-name'. The
function should return non-nil to take the local variables into account.

This can be useful when the project include sub-projects (a Git
repository with sub-modules, a Git repository with other Git repos
inside, a Repo workspace, etc)."
  :group 'otpp
  :type '(choice function boolean)
  :version "1.0.1")

(defcustom otpp-kill-project-buffers-on-tab-close nil
  "Kill the project's buffers when calling `tab-close'.

Can be nil, t, \"ask\" (as a string) or a function that returns one of
these values. When set to \"ask\", otpp will ask for confirmation before
killing the project's buffers."
  :group 'otpp
  :type '(choice function
                 (const :tag "Don't kill project buffers" nil)
                 (const :tag "Kill project buffers without asking" t)
                 (const :tag "Ask for confirmation" "ask"))
  :version "3.5.0")

(defcustom otpp-post-change-tab-root-functions nil
  "List of functions to call after changing the `otpp-root-dir' of a tab.

This hook is run at the end of the function `otpp-change-tab-root-dir'.
The current tab is supplied as an argument."
  :group 'otpp
  :type 'hook
  :version "1.0.1")

(defcustom otpp-project-name-function #'otpp-project-name
  "Derive project name from a directory.

This function receives a directory and return the project name for the
project that includes this path."
  :group 'otpp
  :type '(choice function (symbol nil))
  :version "1.1.0")

(defcustom otpp-project-name-local-variables '(otpp-project-name)
  "List of local variables to consider for project name.

This is used with the function `otpp-project-name'."
  :group 'otpp
  :type '(repeat symbol)
  :version "3.5.2")

(defcustom otpp-allow-detach-projectless-buffer nil
  "Allow detaching a buffer to a new tab even if it is projectless.

This can also be set to a function that receives the buffer, and return
non-nil if we should allow the tab creation."
  :type '(choice boolean function)
  :group 'otpp
  :version "2.0.0")

(defcustom otpp-find-file-integration nil
  "When non-nil, if a file is opened, switch to its project and tab.
Create the tab if the project isn't already open."
  :type 'boolean
  :group 'otpp
  :set (lambda (symbol value)
         (let ((was-enabled (bound-and-true-p otpp-mode)))
           (when was-enabled (otpp-mode -1))
           (set-default symbol value)
           (when was-enabled (otpp-mode 1))))
  :version "3.4.0")

(defcustom otpp-override-commands
  '(;; project
    project-find-file project-find-dir project-kill-buffers project-switch-to-buffer
    project-shell project-eshell project-dired project-compile
    project-find-regexp project-query-replace-regexp
    ;; consult
    consult-grep consult-find consult-fd consult-ripgrep consult-project-buffer
    ;; rg
    rg-project
    ;; magit
    magit-project-status
    ;; projection-multi
    projection-multi-compile projection-multi-projection
    ;; projection-dape
    projection-dape)
  "A list of commands to be advised in `otpp-override-mode'.

These commands will be run with `default-directory' set the to current's
tab directory."
  :type '(repeat function)
  :group 'otpp
  :set (lambda (symbol value)
         (let ((was-enabled (bound-and-true-p otpp-override-mode)))
           (when was-enabled (otpp-override-mode -1))
           (set-default symbol value)
           (when was-enabled (otpp-override-mode 1))))
  :version "1.2.0")

(defcustom otpp-default-tab-name "*default*"
  "The default tab name to use when the last otpp tab is killed."
  :type '(choice string function)
  :group 'otpp)

(defcustom otpp-rename-the-initial-tab t
  "Rename the initial tab to the default name.

When `otpp-mode' is enabled and only one tab exists, rename it to
`otpp-default-tab-name'."
  :type 'boolean
  :group 'otpp
  :version "3.3.0")

(defcustom otpp-project-aware-commands-regexp "^project\\(?:ion\\)?-"
  "A regular expression to detect project-aware commands in `otpp-prefix'."
  :type 'regexp
  :group 'otpp
  :version "3.2.0")

(defvar otpp-verbose nil)
(defvar-local otpp-project-name nil)
(defvar otpp-uniq-map-default (make-hash-table :test 'equal))
(defvar otpp-uniq-format "%s[%s]")
(defvar otpp-internal-call nil)

(defmacro otpp-with-internal-calls (&rest body)
  "Call BODY with `otpp-internal-call' set to t."
  `(let ((otpp-internal-call t)) ,@body))

;;;###autoload
(put 'otpp-project-name 'safe-local-variable 'stringp)
;;;###autoload
(put 'otpp-project-name 'permanent-local-hook t)

;;; Helpers for generating unique projects names from directories

(defun otpp-uniq--get-dir-elements (dir)
  "Get elements for the DIR path."
  (butlast (reverse (file-name-split (directory-file-name (expand-file-name dir))))))

(defun otpp-uniq--unique-elements (dir1 dir2 &optional base1 base2)
  "Return unique elements of DIR1 and DIR2.

Consider custom base names BASE1 and BASE2 when non-nil."
  (let* ((els1 (otpp-uniq--get-dir-elements dir1))
         (els2 (otpp-uniq--get-dir-elements dir2)))
    ;; Consider custom base names only when they aren't the same as the directory base
    (when (and base1 (not (equal base1 (car els1))))
      (push base1 els1))
    (when (and base2 (not (equal base2 (car els2))))
      (push base2 els2))
    (while-let ((el1 (car els1))
                (el2 (car els2))
                ((string= el1 el2)))
      (pop els1) (pop els2))
    (cons els1 els2)))

(cl-defun otpp-uniq--create-or-update (dir &key base rename-fn (map 'otpp-uniq-map-default))
  "Create or update a unique element for DIR.

For the meaning of :MAP, :RENAME-FN and :BASE, see `otpp-uniq-register'."
  (let* ((dir (expand-file-name dir))
         (dir-name (file-name-nondirectory (directory-file-name (expand-file-name dir))))
         (unique-map (eval map))
         (curr-element (gethash dir unique-map))
         (base (or base (alist-get 'base-name curr-element)))
         (name (or base dir-name))
         (unique-name
          (cl-loop for other-path in (hash-table-keys unique-map)
                   with len-min = most-positive-fixnum
                   with len-max = most-negative-fixnum
                   with max-path = nil
                   do
                   (let ((other-element (gethash other-path unique-map)))
                     (when (and (not (string= dir other-path)) ; not the same dir
                                (string= name (or (alist-get 'base-name other-element)
                                                  (alist-get 'dir-name other-element))))
                       (let ((dir-els (car (otpp-uniq--unique-elements dir other-path base (alist-get 'base-name other-element)))))
                         (let ((len (length dir-els)))
                           (setq len-min (min len-min len))
                           (when (> len len-max)
                             (setq len-max len
                                   max-path dir-els))))))
                   finally return
                   (let ((s (string-join
                             (reverse (butlast max-path
                                               (- (length max-path)
                                                  (1+ (- len-max len-min)))))
                             "/")))
                     (if (string-empty-p s)
                         name
                       (format otpp-uniq-format name s))))))
    (if curr-element
        (let* ((old-unique-name (assq 'unique-name curr-element))
               (old-base (assq 'base-name curr-element)))
          (when (and (functionp rename-fn) (not (equal (cdr old-unique-name) unique-name)))
            (ignore-errors (funcall rename-fn (cdr old-unique-name) unique-name)))
          (setcdr old-unique-name unique-name)
          (unless (equal (cdr old-base) base)
            (setcdr old-base base))
          nil) ; when the element already exist, update it and return nil
      (puthash dir `((dir-name . ,dir-name) (base-name . ,base) (unique-name . ,unique-name)) unique-map)
      t))) ; return t on newly created elements

(cl-defun otpp-uniq-update-all (&key rename-fn (map 'otpp-uniq-map-default))
  "Update all unique names.

This function can be called after manually modifying the hash table used
to keep track of the unique names.

For the meaning of :MAP and :RENAME-FN, see `otpp-uniq-register'."
  (let ((unique-map (eval map)))
    (dolist (path (hash-table-keys unique-map)) ; Update all the names
      (otpp-uniq--create-or-update path :map map :rename-fn rename-fn))))

;;;###autoload
(cl-defun otpp-uniq-register (dir &key base rename-fn (map 'otpp-uniq-map-default))
  "Make a unique name derived from DIR.

If the :BASE string is provided, it will be used as a basis for the
unique name, otherwise, this will be calculated from the directory name
of DIR.

The :MAP is a symbol for the hash-table used to register the names, all
names will be renamed accordingly when needed.

The :RENAME-FN is a function of signature (OLD NEW), called before renaming
the hash-table elements."
  (append
   `((path . ,dir))
   (if-let* ((dir (expand-file-name dir))
             (dir-name (file-name-nondirectory (directory-file-name (expand-file-name dir))))
             (name (or base dir-name))
             (unique-map (eval map))
             (element (gethash dir unique-map)))
       element
     (puthash dir `((dir-name . ,dir-name) (base-name . ,base) (unique-name . ,name)) unique-map)
     (otpp-uniq-update-all :map map :rename-fn rename-fn)
     (gethash dir unique-map))))

;;;###autoload
(cl-defun otpp-uniq-unregister (dir &key rename-fn (map 'otpp-uniq-map-default))
  "Unregister a unique name derived from DIR.
For the meaning of :MAP and :RENAME-FN, see `otpp-uniq-register'."
  (let* ((dir (expand-file-name dir))
         (unique-map (eval map)))
    (remhash dir unique-map)
    (otpp-uniq-update-all :map map :rename-fn rename-fn)
    unique-map))



;;; Internals and helpers

(defun otpp--same-dir-p (left right)
  "Returns non-nil when paths LEFT and RIGHT points to the same directory."
  (and left right (equal (file-name-as-directory (expand-file-name left)) (file-name-as-directory (expand-file-name right)))))

(defun otpp--tab-dir-p (dir tab)
  "Returns non-nil TAB have DIR as root directory."
  (and-let* ((tab-root (otpp-get-tab-root-dir tab))) (otpp--same-dir-p dir tab-root)))

(defvar otpp--unique-tabs-map (make-hash-table :test 'equal))

(defun otpp--update-all-tabs ()
  "Update all the unique tab names from the root directories."
  (otpp--cleanup-unique-map)
  (let ((all-tabs (funcall tab-bar-tabs-function)))
    (dolist (tab all-tabs)
      (when-let* ((path (otpp-get-tab-root-dir tab))
                  (unique (gethash path otpp--unique-tabs-map)))
        (let ((explicit-name (assoc 'explicit-name tab)))
          ;; Don't update the tab name if it was renamed explicitly using `tab-bar-rename-tab'
          (unless (eq (cdr explicit-name) t)
            ;; In case a tab has been created with `otpp-change-tab-root-dir',
            ;; it will have the same root as another tab and the same entry in
            ;; the unique map. We get the index of all similar tabs and we add a
            ;; numeric suffix to them in the same order.
            (let* ((same-path-tabs-indexes (mapcar #'tab-bar--tab-index (seq-filter (apply-partially #'otpp--tab-dir-p path) all-tabs)))
                   (name-suffix (and (length> same-path-tabs-indexes 1)
                                     (format "<%d>" (1+ (seq-position same-path-tabs-indexes (tab-bar--tab-index tab)))))))
              (setcdr (assoc 'name tab) (concat (alist-get 'unique-name unique) name-suffix)))
            ;; Set the `explicit-name' field to `otpp'. This tells us that we
            ;; are allowed to modify it it next time we update the names, while
            ;; distinguishing the explicitly named tabs using
            ;; `tab-bar-rename-tab'.
            (setcdr explicit-name 'otpp))))))
  (force-mode-line-update t))

(defun otpp--cleanup-unique-map ()
  "Cleanup the unique names hash-table."
  (mapc (lambda (dir) (remhash dir otpp--unique-tabs-map))
        (seq-filter
         (lambda (dir)
           (not (cl-some (apply-partially #'otpp--tab-dir-p dir) (funcall tab-bar-tabs-function))))
         (hash-table-keys otpp--unique-tabs-map)))
  (otpp-uniq-update-all :map 'otpp--unique-tabs-map))

(defun otpp--funcall-or-value (var &rest args)
  "If VAR is a function call it with ARGS, otherwise return VAR."
  (if (functionp var) (apply var args) var))

(defun otpp--call-command-in-root-dir-maybe (cmd &rest args)
  "Run CMD with ARGS in `otpp-root-dir' or fallback to `default-directory'."
  (let ((default-directory (or (otpp-get-tab-root-dir) default-directory)))
    (apply #'funcall-interactively (cons cmd args))))

(defun otpp--set-default-tab-name ()
  "Rename the first tab to `otpp-default-tab-name' if needed."
  (when-let* ((otpp-rename-the-initial-tab)
              (name (otpp--funcall-or-value otpp-default-tab-name)) ; We have a default name
              (tabs (funcall tab-bar-tabs-function))
              ((length= tabs 1)) ; Only one tab exists
              (tab (assq 'current-tab tabs)) ; Is the current tab
              ((not (otpp-get-tab-root-dir tab))) ; Not a project tab
              ((or (not (alist-get 'explicit-name tab))
                   (eq (alist-get 'explicit-name tab) 'otpp-def))))
    ;; A softer explicit name flag, so `otpp' can change it if relevant
    (setcdr (assq 'name tab) name)
    (setcdr (assq 'explicit-name tab) 'otpp-def)
    (force-mode-line-update t)))

(defun otpp--select-or-create-tab-root-dir (dir)
  "Select or create the tab with root directory DIR.

Returns non-nil if a new tab was created, and nil otherwise."
  (if-let* ((tab (car (otpp-find-tabs-by-root-dir dir))))
      (prog1 nil
        (tab-bar-select-tab (1+ (tab-bar--tab-index tab))))
    (tab-bar-new-tab)
    (otpp-change-tab-root-dir dir) ; Set the root directory for the current tab
    t))

;;; API

(defun otpp-get-tab-root-dir (&optional tab)
  "Get the root directory set to the TAB, default to the current tab."
  (alist-get 'otpp-root-dir (or tab (tab-bar--current-tab))))

(define-obsolete-function-alias 'otpp-current-tab-root-dir #'otpp-get-tab-root-dir "3.0.3")

(defun otpp-project-current (&optional tab)
  "Return TAB's (or the current tab's) project."
  (when-let* ((root-dir (otpp-get-tab-root-dir tab))
              (proj (project-current nil root-dir))
              ;; We check that the tab is pointing at the right porject. This
              ;; is important when we remove/rename a project while its tab is
              ;; still open, otherwise, it can propose to close the parent
              ;; project if any.
              ((otpp--same-dir-p root-dir (project-root proj))))
    proj))

(defun otpp-project-name (dir)
  "Get the project name from DIR.

This function extracts the project root. Then, it tries to find a
`dir-locals-file' file that can be applied to files inside the directory
DIR. When found, the local variables are read if any of these conditions
is correct:

- `otpp-strictly-obey-dir-locals' is set to a function, and calling it
  returns non-nil (we pass to this function the DIR, the project root
  and the directory containing the `dir-locals-file').
- `otpp-strictly-obey-dir-locals' is a *not* a function and it is
  non-nil.
- The `dir-locals-file' file is stored in the project root, i.e.,
  the project root is the same as the `dir-locals-file' directory.

Then, this function checks if any of the local variables in
`otpp-project-name-local-variables' is set locally in the
`dir-locals-file', when it is the case, we uses its value as project
name. Otherwise, we return the directory name of the project's root.

When DIR isn't part of any project, returns nil."
  (when-let* ((dir (expand-file-name dir))
              (proj (project-current nil dir))
              (root (project-root proj)))
    ;; When can find a `dir-locals-file' that can be applied to files inside
    ;; `dir', we do some extra checks to determine if we should take it into
    ;; account or not.
    (with-temp-buffer
      (setq default-directory dir)
      (when-let* ((dir-locals-root (car (ensure-list (dir-locals-find-file (expand-file-name "dummy-file" dir)))))
                  ((or (otpp--same-dir-p root dir-locals-root)
                       (otpp--funcall-or-value otpp-strictly-obey-dir-locals dir root dir-locals-root))))
        (hack-dir-local-variables)) ; Read the local variables, but don't apply them.
      (or (and
           ;; BUG: `cascading-dir-locals-mode' can cause nested projects to have the same name
           (not (bound-and-true-p cascading-dir-locals-mode))
           (cl-some (lambda (var)
                      (or (alist-get var dir-local-variables-alist)
                          (alist-get var file-local-variables-alist)))
                    otpp-project-name-local-variables))
          (file-name-nondirectory (directory-file-name root))))))

(defun otpp-find-tabs-by-root-dir (dir)
  "Return a list of tabs that have DIR as `otpp-root-dir' attribute."
  (seq-filter (apply-partially #'otpp--tab-dir-p dir) (funcall tab-bar-tabs-function)))


;;; Commands

;;;###autoload
(defun otpp-detach-buffer-to-tab (buffer)
  "Create or switch to the tab corresponding to the project of BUFFER.

When called with the a prefix, it asks for the buffer."
  (interactive (list (if current-prefix-arg (read-buffer "Select the buffer (leave empty for an unnamed buffer): ") (current-buffer))))
  (with-current-buffer buffer
    (if-let* ((proj (project-current))
              (proj-root (project-root proj))
              (this-buff (current-buffer)))
        (progn
          (bury-buffer)
          (otpp--select-or-create-tab-root-dir proj-root)
          (switch-to-buffer this-buff))
      (if (otpp--funcall-or-value otpp-allow-detach-projectless-buffer this-buff)
          (let* ((recent-tabs (mapcar (lambda (tab) (alist-get 'name tab)) (tab-bar--tabs-recent)))
                 (tab-name (completing-read "Switch to tab by name (leave empty to create an unnamed tab): " recent-tabs)))
            (bury-buffer)
            (if (string-empty-p tab-name)
                (tab-bar-new-tab)
              (tab-bar-select-tab-by-name tab-name))
            (switch-to-buffer this-buff))
        (user-error "The buffer %S doesn't seem to be a part of a project" (buffer-name))))))

;;;###autoload
(defun otpp-change-tab-root-dir (dir &optional tab-number)
  "Change the `otpp-root-dir' attribute to DIR.

If if the absolute TAB-NUMBER is provided, set it, otherwise, set the
current tab.

When DIR is empty or nil, delete it from the tab."
  (interactive
   (list (completing-read
          "Root directory for tab (leave blank to remove the tab root directory): "
          (delete-dups
           (delq nil (mapcar #'otpp-get-tab-root-dir (funcall tab-bar-tabs-function)))))
         current-prefix-arg))
  (let* ((tabs (funcall tab-bar-tabs-function))
         (index (if tab-number
                    (1- (max 0 (min tab-number (length tabs))))
                  (tab-bar--current-tab-index tabs)))
         (tab (nth index tabs))
         (root-dir (assq 'otpp-root-dir tab))
         (tab-new-root-dir (and dir (not (string-empty-p dir)) (expand-file-name dir))))
    (if root-dir
        (setcdr root-dir tab-new-root-dir)
      (nconc tab `((otpp-root-dir . ,tab-new-root-dir)))
      (otpp-uniq-register ; Register in the unique names hash-table
       tab-new-root-dir
       :base (and otpp-project-name-function (funcall otpp-project-name-function tab-new-root-dir))
       :map 'otpp--unique-tabs-map))
    (otpp--update-all-tabs) ; Update all tabs
    (run-hook-with-args 'otpp-post-change-tab-root-functions tab)))

(defun otpp-prefix ()
  "Run the next command in the tab's root directory (or not!).

The actual behavior depends on `otpp-override-mode'. For instance, when
you execute \\[otpp-prefix] followed by \\[project-find-file], if the
`otpp-override-mode' is enabled, this will run the `project-find-file'
command in the `default-directory', otherwise, it will bind the
`default-directory' to the current's tab directory before executing
`project-find-file'."
  (interactive)
  (when-let* ((command (key-binding
                        (read-key-sequence
                         (format
                          "Run next command in %s "
                          (if otpp-override-mode "default-directory" "current's tab `otpp' root directory")))
                        t)))
    (let ((project-aware (or (memq command otpp-override-commands)
                             (string-match-p otpp-project-aware-commands-regexp (symbol-name command))
                             (get command 'project-aware)))
          (root (if otpp-override-mode default-directory (otpp-get-tab-root-dir))))
      (when otpp-verbose (message "otpp: Running `%s' with `otpp-prefix'" command))
      (if project-aware
          (let ((project-current-directory-override root))
            (call-interactively command))
        (let ((default-directory root))
          (call-interactively command))))))

;;; Hook for `tab-bar'

(defun otpp--tab-bar-kill-project-buffers (tab _last-tab-p)
  "Propose to kill project buffers when the TAB is closed."
  (otpp-with-internal-calls
   (when-let* ((killp (otpp--funcall-or-value otpp-kill-project-buffers-on-tab-close))
               (proj (otpp-project-current tab)))
     (project-kill-buffers (not (equal killp "ask")) proj))))

;;; Advices for the integration with `project'

(defun otpp--project-current-a (orig-fn &rest args)
  "Call ORIG-FN with ARGS, set the `otpp-root-dir' accordingly.

Does nothing unless the user was allowed to be prompted for a project if
needed (that is, the `maybe-prompt' argument in the advised function
call was non-nil), or if they did not select a project when prompted.

Does nothing if the current tab belongs to the selected project.

Otherwise, select or create the tab of the selected project."
  (let ((proj-curr (apply orig-fn args)))
    (when-let* (((not otpp-internal-call))
                (proj-dir (and proj-curr (project-root proj-curr)))
                (maybe-prompt (car args)))
      (let ((curr-tab-root-dir (otpp-get-tab-root-dir))
            (target-proj-root-dir (expand-file-name proj-dir)))
        (unless (otpp--same-dir-p curr-tab-root-dir target-proj-root-dir)
          (otpp--select-or-create-tab-root-dir target-proj-root-dir))))
    proj-curr))

(defun otpp--project-switch-project-a (orig-fn &rest args)
  "Switch to the right tab after switching to a project.

Calls ORIG-FN based on ARGS."
  (if otpp-internal-call
      (apply orig-fn args)
    (let ((proj-dir (expand-file-name (or (car args) (when-let* ((proj (project-current t))) (project-root proj)))))
          (def-calling-dir default-directory)) ; `otpp--select-or-create-tab-root-dir' changes the `default-directory'
      (cond ((otpp--select-or-create-tab-root-dir proj-dir) (funcall orig-fn proj-dir))
            ((not (file-in-directory-p def-calling-dir proj-dir))
             (cond ((functionp otpp-reconnect-tab) (funcall otpp-reconnect-tab proj-dir))
                   (otpp-reconnect-tab (funcall orig-fn proj-dir))))))))

(defun otpp--project-kill-buffers-a (orig-fn &rest args)
  "Call ORIG-FN with ARGS, then close the current tab group, if any."
  (when-let* (((apply orig-fn args))
              ((not otpp-internal-call))
              (tabs (funcall tab-bar-tabs-function))
              (curr-tab (assq 'current-tab tabs))
              (curr-tab-root-dir (otpp-get-tab-root-dir curr-tab)))
    (if (length> tabs 1)
        ;; When closing the tab from from a `project-kill-buffers' command,
        ;; there is no need to run the hook
        (let ((tab-bar-tab-pre-close-functions (remq 'otpp--tab-bar-kill-project-buffers tab-bar-tab-pre-close-functions)))
          (tab-bar-close-tab))
      ;; When the tab cannot be removed (last tab), remove the association
      ;; with the current project and rename it to the default
      (otpp-change-tab-root-dir nil)
      (setcdr (assq 'name curr-tab) (otpp--funcall-or-value otpp-default-tab-name))
      (setcdr (assq 'explicit-name curr-tab) 'otpp-def))
    (otpp-uniq-unregister curr-tab-root-dir :map 'otpp--unique-tabs-map)
    (otpp--update-all-tabs)))

(defun otpp--bury-on-kill-buffer-in-multiple-tabs-a (fn &optional buffer)
  "Advise `kill-buffer' FN to burry BUFFER when it is visible in other tabs."
  (if-let* ((tabs (and (not (called-interactively-p)) ; when explicitly killing the current buffer, just obey
                       (or (null buffer) (eq (get-buffer buffer) (current-buffer)))
                       otpp-bury-on-kill-buffer-when-multiple-tabs
                       (tab-bar-get-buffer-tab buffer t t t))))
      (progn
        (message "Buffer still alive in %d tab%s, burying it instead." (length tabs) (if (length> tabs 1) "s" ""))
        (bury-buffer buffer))
    (funcall fn buffer)))


;;; Advices for the integration with `find-file'

(defun otpp--find-file-a (orig-fn &rest args)
  "Advice `find-file'.

The behavior is like this:

When opening a file that belongs to another project, switch to that
project (switchs to its tab). If the project isn't open, open it and
create the project's tab.

Calls ORIG-FN with ARGS."
  (when-let* ((proj-curr (project-current nil (file-name-directory (car args)))))
    (let ((project-switch-commands #'ignore))
      (project-switch-project (project-root proj-curr))))
  (apply orig-fn args))


;;; OTPP modes

;;;###autoload
(define-minor-mode otpp-mode
  "Automatically create a tab per project, name them uniquely."
  :group 'otpp
  :global t
  (dolist (fn '(project-current project-switch-project project-kill-buffers))
    (let ((advice-fn (intern (format "otpp--%s-a" fn))))
      (if otpp-mode
          (advice-add fn :around advice-fn)
        (advice-remove fn advice-fn))))
  (if otpp-mode
      (progn
        (when otpp-find-file-integration
          (advice-add 'find-file :around #'otpp--find-file-a))
        (advice-add 'kill-buffer :around #'otpp--bury-on-kill-buffer-in-multiple-tabs-a)
        ;; Rename the first tab to default name if needed
        (add-hook 'tab-bar-tab-pre-close-functions #'otpp--tab-bar-kill-project-buffers)
        (otpp--set-default-tab-name)
        (add-hook 'server-after-make-frame-hook #'otpp--set-default-tab-name))
    (advice-remove 'find-file #'otpp--find-file-a)
    (advice-remove 'kill-buffer #'otpp--bury-on-kill-buffer-in-multiple-tabs-a)
    (remove-hook 'tab-bar-tab-pre-close-functions #'otpp--tab-bar-kill-project-buffers)
    (remove-hook 'server-after-make-frame-hook #'otpp--set-default-tab-name)))

;;;###autoload
(define-minor-mode otpp-override-mode
  "Run commands in `otpp-override-commands' in the current's tab directory."
  :group 'otpp
  :global t
  (dolist (cmd otpp-override-commands)
    (if otpp-override-mode
        (advice-add cmd :around #'otpp--call-command-in-root-dir-maybe)
      (advice-remove cmd #'otpp--call-command-in-root-dir-maybe))))


;;; Define some aliases for better user experience

;;;###autoload(defalias 'one-tab-per-project-mode 'otpp-mode)
;;;###autoload(defalias 'one-tab-per-project-override-mode 'otpp-override-mode)


(provide 'one-tab-per-project)
(provide 'otpp)
;;; otpp.el ends here

;; Local Variables:
;; time-stamp-pattern: "^;; Modified: %%$"
;; time-stamp-format: "%B %d, %Y"
;; End:
