about summary refs log tree commit diff
path: root/configs/shared/emacs/.emacs.d/elpa/sesman-20180719.213/sesman.el
diff options
context:
space:
mode:
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/sesman-20180719.213/sesman.el')
-rw-r--r--configs/shared/emacs/.emacs.d/elpa/sesman-20180719.213/sesman.el728
1 files changed, 728 insertions, 0 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/sesman-20180719.213/sesman.el b/configs/shared/emacs/.emacs.d/elpa/sesman-20180719.213/sesman.el
new file mode 100644
index 000000000000..9279300d050a
--- /dev/null
+++ b/configs/shared/emacs/.emacs.d/elpa/sesman-20180719.213/sesman.el
@@ -0,0 +1,728 @@
+;;; sesman.el --- Generic Session Manager -*- lexical-binding: t -*-
+;;
+;; Copyright (C) 2018, Vitalie Spinu
+;; Author: Vitalie Spinu
+;; URL: https://github.com/vspinu/sesman
+;; Package-Version: 20180719.213
+;; Keywords: process
+;; Version: 0.1.1-snapshot
+;; Package-Requires: ((emacs "25"))
+;; Keywords: processes, tools, vc
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This file is *NOT* part of GNU Emacs.
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Sesman provides facilities for session management and interactive session
+;; association with the current contexts (project, directory, buffers etc).  See
+;; project's readme for more details.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(require 'cl-generic)
+(require 'project)
+(require 'seq)
+(require 'subr-x)
+
+(defgroup sesman nil
+  "Generic Session Manager."
+  :prefix "sesman-"
+  :group 'tools)
+
+;; (defcustom sesman-disambiguate-by-relevance t
+;;   "If t choose most relevant session in ambiguous situations, otherwise ask.
+;; Ambiguity arises when multiple sessions are associated with current context.  By
+;; default only projects could be associated with multiple sessions.  See
+;; `sesman-single-link-contexts' in order to change that.  Relevance is decided by
+;; system's implementation, see `sesman-more-relevant-p'."
+;;   :group 'sesman
+;;   :type 'boolean)
+
+(defcustom sesman-single-link-context-types '(buffer)
+  "List of context types to which at most one session can be linked."
+  :group 'sesman
+  :type '(repeat symbol))
+
+;; fixme;
+;; (defcustom sesman-abbreviate-paths 2
+;;   "Abbreviate paths to that many parents.
+;; When set to nil, don't abbreviate directories."
+;;   :group 'sesman
+;;   :type '(choice number
+;;                  (const :tag "Don't abbreviate" nil)))
+
+(defvar sesman-sessions-hashmap (make-hash-table :test #'equal)
+  "Hash-table of all sesman sessions.
+Key is a cons (system-name . session-name).")
+
+(defvar sesman-links-alist nil
+  "An alist of all sesman links.
+Each element is of the form (key cxt-type cxt-value) where
+\"key\" is of the form (system-name . session-name). system-name
+and cxt-type must be symbols.")
+
+(defvar-local sesman-system nil
+  "Name of the system managed by `sesman'.
+Can be either a symbol, or a function returning a symbol.")
+
+
+;; Internal Utilities
+
+(defun sesman--on-C-u-u-sessions (system which)
+  (cond
+   ((null which)
+    (let ((ses (sesman-current-session system)))
+      (when ses
+        (list ses))))
+   ((or (equal which '(4)) (eq which 'linked))
+    (sesman-linked-sessions system))
+   ((or (equal which '(16)) (eq which 'all) (eq which t))
+    (sesman--all-system-sessions system))
+   (t (error "Invalid which argument (%s)" which))))
+
+(defun sesman--cap-system-name (system)
+  (let ((name (symbol-name system)))
+    (if (string-match-p "^[[:upper:]]" name)
+        name
+      (capitalize name))))
+
+(defun sesman--link-session (system session &optional cxt-type)
+  (let* ((ses-name (or (car-safe session)
+                       (error "SESSION must be a headed list")))
+         (cxt-val (sesman--expand-path-maybe
+                   (or (if cxt-type
+                           (sesman-context cxt-type)
+                         ;; use the lest specific context-type available
+                         (seq-some (lambda (ctype)
+                                     (let ((val (sesman-context ctype)))
+                                       (setq cxt-type ctype)
+                                       val))
+                                   (reverse (sesman-context-types system))))
+                       (error "No local context of type %s" cxt-type))))
+         (key (cons system ses-name))
+         (link (list key cxt-type cxt-val)))
+    (if (member cxt-type sesman-single-link-context-types)
+        (thread-last sesman-links-alist
+          (seq-remove (sesman--link-lookup-fn system nil cxt-type cxt-val))
+          (cons link)
+          (setq sesman-links-alist))
+      (unless (seq-filter (sesman--link-lookup-fn system ses-name cxt-type cxt-val)
+                          sesman-links-alist)
+        (setq sesman-links-alist (cons link sesman-links-alist))))
+    key))
+
+(defmacro sesman--link-session-interactively (cxt-type)
+  (declare (indent 1)
+           (debug (symbolp &rest)))
+  (let ((cxt-name (symbol-name cxt-type)))
+    `(let ((system (sesman--system)))
+       (if (member ',cxt-type (sesman-context-types system))
+           (let ((session (sesman-ask-for-session
+                           system
+                           (format "Link with %s %s: "
+                                   ,cxt-name (sesman--abbrev-path-maybe
+                                              (sesman-context ',cxt-type)))
+                           (sesman--all-system-sessions system)
+                           'ask-new)))
+             (sesman--link-session system session ',cxt-type))
+         (error (format "%s association not allowed for this system (%s)"
+                        ,(capitalize (symbol-name cxt-type))
+                        system))))))
+
+(defun sesman--expand-path-maybe (obj)
+  (cond
+   ((stringp obj) (expand-file-name obj))
+   ((and (consp obj) (stringp (cdr obj)))
+    (cons (car obj) (expand-file-name (cdr obj))))
+   (t obj)))
+
+;; FIXME: incorporate `sesman-abbreviate-paths'
+(defun sesman--abbrev-path-maybe (obj)
+  (cond
+   ((stringp obj) (abbreviate-file-name obj))
+   ((and (consp obj) (stringp (cdr obj)))
+    (cons (car obj) (abbreviate-file-name (cdr obj))))
+   (t obj)))
+
+(defun sesman--system ()
+  (if sesman-system
+      (if (functionp sesman-system)
+          (funcall sesman-system)
+        sesman-system)
+    (error "No `sesman-system' in buffer `%s'" (current-buffer))))
+
+(defun sesman--all-system-sessions (&optional system)
+  "Return a list of sessions registered with SYSTEM."
+  (let ((system (or system (sesman--system)))
+        sessions)
+    (maphash
+     (lambda (k s)
+       (when (eql (car k) system)
+         (push s sessions)))
+     sesman-sessions-hashmap)
+    (sesman--sort-sessions system sessions)))
+
+;; FIXME: make this a macro
+(defun sesman--link-lookup-fn (&optional system ses-name cxt-type cxt-val x)
+  (let ((system (or system (caar x)))
+        (ses-name (or ses-name (cdar x)))
+        (cxt-type (or cxt-type (nth 1 x)))
+        (cxt-val (or cxt-val (nth 2 x))))
+    (lambda (el)
+      (and (or (null system) (eq (caar el) system))
+           (or (null ses-name) (equal (cdar el) ses-name))
+           (or (null cxt-type)
+               (if (listp cxt-type)
+                   (member (nth 1 el) cxt-type)
+                 (eq (nth 1 el) cxt-type)))
+           (or (null cxt-val) (equal (nth 2 el) cxt-val))))))
+
+(defun sesman--unlink (x)
+  (setq sesman-links-alist
+        (seq-remove (sesman--link-lookup-fn nil nil nil nil x)
+                    sesman-links-alist)))
+
+(defun sesman--clear-links ()
+  (setq sesman-links-alist
+        (seq-filter (lambda (x)
+                      (gethash (car x) sesman-sessions-hashmap))
+                    sesman-links-alist)))
+
+(defun sesman--format-link (link)
+  (let ((val (sesman--abbrev-path-maybe
+              (sesman--lnk-value link))))
+    (format "%s(%s)->%s"
+            (sesman--lnk-context-type link)
+            (if (listp val) (cdr val) val)
+            (propertize (sesman--lnk-session-name link) 'face 'bold))))
+
+(defun sesman--ask-for-link (prompt links &optional ask-all)
+  (let* ((name.keys (mapcar (lambda (link)
+                              (cons (sesman--format-link link) link))
+                            links))
+         (name.keys (append name.keys
+                            (when (and ask-all (> (length name.keys) 1))
+                              '(("*all*")))))
+         (nms (mapcar #'car name.keys))
+         (sel (completing-read prompt nms nil t nil nil (car nms))))
+    (cond ((string= sel "*all*")
+           links)
+          (ask-all
+           (list (cdr (assoc sel name.keys))))
+          (t
+           (cdr (assoc sel name.keys))))))
+
+(defun sesman--sort-sessions (system sessions)
+  (seq-sort (lambda (x1 x2)
+              (sesman-more-relevant-p system x1 x2))
+            sessions))
+
+(defun sesman--sort-links (system links)
+  (seq-sort (lambda (x1 x2)
+              (sesman-more-relevant-p system
+                                      (gethash (car x1) sesman-sessions-hashmap)
+                                      (gethash (car x2) sesman-sessions-hashmap)))
+            links))
+
+;; link data structure accessors
+(defun sesman--lnk-system-name (lnk)
+  (caar lnk))
+(defun sesman--lnk-session-name (lnk)
+  (cdar lnk))
+(defun sesman--lnk-context-type (lnk)
+  (cadr lnk))
+(defun sesman--lnk-value (lnk)
+  (nth 2 lnk))
+
+
+;;; User Interface
+
+ ;;;###autoload
+(defun sesman-start ()
+  "Start sesman session."
+  (interactive)
+  (let* ((system (sesman--system)))
+    (message "Starting new %s session ..." system)
+    (sesman-start-session system)))
+
+ ;;;###autoload
+(defun sesman-restart ()
+  "Restart sesman session."
+  (interactive)
+  (let* ((system (sesman--system))
+         (old-session (sesman-ensure-session system "Restart session: ")))
+    (message "Restarting %s '%s' session" system (car old-session))
+    (sesman-restart-session system old-session)))
+
+ ;;;###autoload
+(defun sesman-quit (which)
+  "Terminate sesman session.
+When WHICH is nil, kill only the current session; when a single universal
+argument or 'linked, kill all linked session; when a double universal argument,
+t or 'all, kill all sessions."
+  (interactive "P")
+  (let* ((system (sesman--system))
+         (sessions (sesman--on-C-u-u-sessions system which)))
+    (if (null sessions)
+        (message "No more %s sessions" system)
+      (mapc (lambda (s)
+              (sesman-unregister system s)
+              (sesman-quit-session system s))
+            sessions)
+      (message
+       "Killed %s %s %s"  system
+       (if (= 1 (length sessions)) "session" "sessions")
+       (mapcar #'car sessions)))))
+
+ ;;;###autoload
+(defun sesman-show-session-info (which)
+  "Display session(s) info.
+When WHICH is nil, show info for current session; when a single universal
+argument or 'linked, show info for all linked sessions; when a double universal
+argument or 'all, show info for all sessions."
+  (interactive "P")
+  (let* ((system (sesman--system))
+         (sessions (sesman--on-C-u-u-sessions system which)))
+    (if sessions
+        (message (mapconcat
+                  (lambda (ses)
+                    (format "%s [linked: %s]\n%s"
+                            (propertize (car ses) 'face 'bold)
+                            (sesman-session-links system ses t)
+                            (sesman-session-info system ses)))
+                  (delete-consecutive-dups sessions)
+                  "\n"))
+      (message "No %s sessions" system))))
+
+ ;;;###autoload
+(defun sesman-show-links ()
+  "Display links active in the current context."
+  (interactive)
+  (let* ((system (sesman--system))
+         (links (sesman-current-links system)))
+    (if links
+        (message (mapconcat #'sesman--format-link links "\n"))
+      (message "No %s links in the current context" system))))
+
+ ;;;###autoload
+(defun sesman-link-with-buffer ()
+  "Associate a session with current buffer."
+  (interactive)
+  (sesman--link-session-interactively buffer))
+
+ ;;;###autoload
+(defun sesman-link-with-directory ()
+  "Associate a session with current directory."
+  (interactive)
+  (sesman--link-session-interactively directory))
+
+ ;;;###autoload
+(defun sesman-link-with-project ()
+  "Associate a session with current project."
+  (interactive)
+  (sesman--link-session-interactively project))
+
+ ;;;###autoload
+(defun sesman-unlink ()
+  "Break any of the previously created links."
+  (interactive)
+  (let* ((system (sesman--system))
+         (links (or (sesman-current-links system)
+                    (user-error "No %s links found" system))))
+    (mapc #'sesman--unlink
+          (sesman--ask-for-link "Unlink: " links 'ask-all))))
+
+(defvar sesman-map
+  (let (sesman-map)
+    (define-prefix-command 'sesman-map)
+    (define-key sesman-map (kbd "C-i") 'sesman-show-session-info)
+    (define-key sesman-map (kbd   "i") 'sesman-show-session-info)
+    (define-key sesman-map (kbd "C-l") 'sesman-show-links)
+    (define-key sesman-map (kbd   "l") 'sesman-show-links)
+    (define-key sesman-map (kbd "C-s") 'sesman-start)
+    (define-key sesman-map (kbd   "s") 'sesman-start)
+    (define-key sesman-map (kbd "C-r") 'sesman-restart)
+    (define-key sesman-map (kbd   "r") 'sesman-restart)
+    (define-key sesman-map (kbd "C-q") 'sesman-quit)
+    (define-key sesman-map (kbd   "q") 'sesman-quit)
+    (define-key sesman-map (kbd "C-b") 'sesman-link-with-buffer)
+    (define-key sesman-map (kbd   "b") 'sesman-link-with-buffer)
+    (define-key sesman-map (kbd "C-d") 'sesman-link-with-directory)
+    (define-key sesman-map (kbd   "d") 'sesman-link-with-directory)
+    (define-key sesman-map (kbd "C-p") 'sesman-link-with-project)
+    (define-key sesman-map (kbd   "p") 'sesman-link-with-project)
+    (define-key sesman-map (kbd "C-u") 'sesman-unlink)
+    (define-key sesman-map (kbd "  u") 'sesman-unlink)
+    sesman-map)
+  "Session management prefix keymap.")
+
+(defvar sesman-menu
+  '("Sesman"
+    ["Show Session Info" sesman-show-session-info]
+    ["Show Links" sesman-show-links]
+    "--"
+    ["Start" sesman-start]
+    ["Restart" sesman-restart :active (sesman-connected-p)]
+    ["Quit" sesman-quit :active (sesman-connected-p)]
+    "--"
+    ["Link with Buffer" sesman-link-with-buffer :active (sesman-connected-p)]
+    ["Link with Directory" sesman-link-with-directory :active (sesman-connected-p)]
+    ["Link with Project" sesman-link-with-project :active (sesman-connected-p)]
+    "--"
+    ["Unlink" sesman-unlink :active (sesman-connected-p)])
+  "Sesman Menu.")
+
+(defun sesman-install-menu (map)
+  "Install `sesman-menu' into MAP."
+  (easy-menu-do-define 'seman-menu-open
+                       map
+                       (get 'sesman-menu 'variable-documentation)
+                       sesman-menu))
+
+
+;;; System Generic
+
+(cl-defgeneric sesman-start-session (system)
+  "Start and return SYSTEM SESSION.")
+
+(cl-defgeneric sesman-quit-session (system session)
+  "Terminate SYSTEM SESSION.")
+
+(cl-defgeneric sesman-restart-session (system session)
+  "Restart SYSTEM SESSION.
+By default, calls `sesman-quit-session' and then
+`sesman-start-session'."
+  (let ((old-name (car session)))
+    (sesman-quit-session system session)
+    (let ((new-session (sesman-start-session system)))
+      (setcar new-session old-name))))
+
+(cl-defgeneric sesman-session-info (_system session)
+  (cdr session))
+
+(cl-defgeneric sesman-context-types (_system)
+  "Return a list of context types understood by SYSTEM."
+  '(buffer directory project))
+
+(cl-defgeneric sesman-more-relevant-p (_system session1 session2)
+  "Return non-nil if SESSION1 should be sorted before SESSION2.
+By default, sort by session name. Systems should overwrite this method to
+provide a more meaningful ordering. If your system objects are buffers you
+can use `sesman-more-relevant-p' utility in this method."
+  (not (string-greaterp (car session1) (car session2))))
+
+
+;;; System API
+
+(defun sesman-session (system session-name)
+  "Retrieve SYSTEM's session with SESSION-NAME from global hash."
+  (let ((system (or system (sesman--system))))
+    (gethash (cons system session-name) sesman-sessions-hashmap)))
+
+(defun sesman-sessions (system)
+  "Return a list of all sessions registered with SYSTEM.
+`sesman-linked-sessions' lead the list."
+  (let ((system (or system (sesman--system))))
+    (delete-dups
+     (append (sesman-linked-sessions system)
+             ;; (sesman-friendly-sessions system)
+             (sesman--all-system-sessions system)))))
+
+(defun sesman-has-sessions-p (system)
+  "Return t if there is at least one session registered with SYSTEM."
+  (let ((system (or system (sesman--system)))
+        (found))
+    (condition-case nil
+        (maphash (lambda (k _)
+                   (when (eq (car k) system)
+                     (setq found t)
+                     (throw 'found nil)))
+                 sesman-sessions-hashmap)
+      (error))
+    found))
+
+(defvar sesman--select-session-history nil)
+(defun sesman-ask-for-session (system prompt &optional sessions ask-new ask-all)
+  "Ask for a SYSTEM session with PROMPT.
+SESSIONS defaults to value returned from `sesman-sessions'.  If
+ASK-NEW is non-nil, offer *new* option to start a new session.  If
+ASK-ALL is non-nil offer *all* option.  If ASK-ALL is non-nil,
+return a list of sessions, otherwise a single session."
+  (let* ((sessions (or sessions (sesman-sessions system)))
+         (name.syms (mapcar (lambda (s)
+                              (let ((name (car s)))
+                                (cons (if (symbolp name) (symbol-name name) name)
+                                      name)))
+                            sessions))
+         (nr (length name.syms))
+         (syms (if (and (not ask-new) (= nr 0))
+                   (error "No %s sessions found" system)
+                 (append name.syms
+                         (when ask-new '(("*new*")))
+                         (when (and ask-all (> nr 1))
+                           '(("*all*"))))))
+         (def (caar syms))
+         ;; (def (if (assoc (car sesman--select-session-history) syms)
+         ;;          (car sesman--select-session-history)
+         ;;        (caar syms)))
+         (sel (completing-read
+               prompt (mapcar #'car syms) nil t nil 'sesman--select-session-history def)))
+    (cond
+     ((string= sel "*new*")
+      (let ((ses (sesman-start-session system)))
+        (message "Started %s" (car ses))
+        (if ask-all (list ses) ses)))
+     ((string= sel "*all*")
+      sessions)
+     (t
+      (let* ((sym (cdr (assoc sel syms)))
+             (ses (assoc sym sessions)))
+        (if ask-all (list ses) ses))))))
+
+(defun sesman-current-session (system &optional cxt-types)
+  "Get the most relevant linked session for SYSTEM.
+CXT-TYPES is as in `sesman-linked-sessions'."
+  (car (sesman-linked-sessions system cxt-types)))
+
+(defun sesman-ensure-session (system &optional cxt-types)
+  "Get the most relevant linked session for SYSTEM or throw if none exists.
+CXT-TYPES is as in `sesman-linked-sessions'."
+  (or (car (sesman-linked-sessions system))
+      (user-error "No linked %s sessions" system)))
+
+(defun sesman-linked-sessions (system &optional cxt-types)
+  "Return a list of SYSTEM sessions linked in current context.
+CXT-TYPES is a list of context types to consider.  Defaults to the
+list returned from `sesman-context-types'."
+  (let* ((system (or system (sesman--system)))
+         (cxt-types (or cxt-types (sesman-context-types system))))
+    ;; just in case some links are lingering due to user errors
+    (sesman--clear-links)
+    (mapcar (lambda (assoc)
+              (gethash (car assoc) sesman-sessions-hashmap))
+            (sesman-current-links system cxt-types))))
+
+(defun sesman-session-links (system session &optional as-string)
+  "Retrieve all links for SYSTEM's SESSION from the global `SESSION-LINKS'.
+Return an alist of the form
+   ((buffer buffers..)
+    (directory directories...)
+    (project projects...)).
+If AS-STRING is non-nil, return an equivalent string representation."
+  (let* ((system (or system (sesman--system)))
+         (session (or session (sesman-current-session system)))
+         (ses-name (car session))
+         (links (thread-last sesman-links-alist
+                  (seq-filter (sesman--link-lookup-fn system ses-name))
+                  (sesman--sort-links system)
+                  (reverse)))
+         (out (mapcar (lambda (x) (list x))
+                      (sesman-context-types system))))
+    (mapc (lambda (link)
+            (let* ((type (sesman--lnk-context-type link))
+                   (val (sesman--lnk-value link))
+                   (entry (assoc type out)))
+              (when entry
+                (setcdr entry (cons val (cdr entry))))))
+          links)
+    (let ((out (delq nil (mapcar (lambda (el) (and (cdr el) el)) out))))
+      (if as-string
+          (mapconcat (lambda (link-vals)
+                       (let ((type (car link-vals)))
+                         (mapconcat (lambda (l)
+                                      (let ((l (if (listp l) (cdr l) l)))
+                                        (format "%s(%s)" type l)))
+                                    (cdr link-vals)
+                                    " ")))
+                     out
+                     " ")
+        out))))
+
+(defun sesman-links (system &optional session-name cxt-types)
+  "Retrieve all links for SYSTEM, SESSION-NAME and CXT-TYPES."
+  (let ((lfn (sesman--link-lookup-fn system session-name cxt-types)))
+    (seq-filter lfn sesman-links-alist)))
+
+(defun sesman-current-links (system &optional cxt-types)
+  "Retrieve all active links in current context for SYSTEM.
+CXT-TYPES is a list of context types to consider.  Returned links
+are a subset of `sesman-links-alist' sorted in order of relevance."
+  ;; mapcan is a built-in in 26.1; don't want to require cl-lib for one function
+  (seq-mapcat
+   (lambda (cxt-type)
+     (let ((lfn (sesman--link-lookup-fn system nil cxt-type)))
+       (sesman--sort-links
+        system
+        (seq-filter (lambda (l)
+                      (and (funcall lfn l)
+                           (sesman-relevant-context-p cxt-type (nth 2 l))))
+                    sesman-links-alist))))
+   (or cxt-types (sesman-context-types system))))
+
+(defun sesman-has-links-p (system &optional cxt-types)
+  "Return t if there is at least one linked session.
+CXT-TYPES defaults to `sesman-context-types' for current SYSTEM."
+  (let ((cxt-types (or cxt-types (sesman-context-types system)))
+        (found))
+    (condition-case nil
+        (mapc (lambda (l)
+                (when (eq system (sesman--lnk-system-name l))
+                  (let ((cxt (sesman--lnk-context-type l)))
+                    (when (and (member cxt cxt-types)
+                               (sesman-relevant-context-p cxt (sesman--lnk-value l)))
+                      (setq found t)
+                      (throw 'found nil)))))
+              sesman-links-alist)
+      (error))
+    found))
+
+(defun sesman-register (system session)
+  "Register SESSION into `sesman-sessions-hashmap' and `sesman-links-alist'.
+SYSTEM defaults to current system.  If a session with same name is already
+registered in `sesman-sessions-hashmap', change the name by appending \"#1\",
+\"#2\" ... to the name.  This function should be called by system-specific
+connection initializers (\"run-xyz\", \"xyz-jack-in\" etc.)."
+  (let* ((system (or system (sesman--system)))
+         (ses-name (car session))
+         (ses-name0 (car session))
+         (i 1))
+    (while (sesman-session system ses-name)
+      (setq ses-name (format "%s#%d" ses-name0 i)))
+    (setq session (cons ses-name (cdr session)))
+    (puthash (cons system ses-name) session sesman-sessions-hashmap)
+    (sesman--link-session system session)
+    session))
+
+(defun sesman-unregister (system session)
+  "Unregister SESSION.
+SYSTEM defaults to current system.  Remove session from
+`sesman-sessions-hashmap' and `sesman-links-alist'."
+  (let ((ses-key (cons system (car session))))
+    (remhash ses-key sesman-sessions-hashmap)
+    (sesman--clear-links)
+    session))
+
+(defun sesman-add-object (system session-name object &optional allow-new)
+  "Add (destructively) OBJECT to session SESSION-NAME of SYSTEM.
+If ALLOW-NEW is nil and session with SESSION-NAME does not exist
+throw an error, otherwise register a new session with
+session (list SESSION-NAME OBJECT)."
+  (let* ((system (or system (sesman--system)))
+         (session (sesman-session system session-name)))
+    (if session
+        (setcdr session (cons object (cdr session)))
+      (if allow-new
+          (sesman-register system (list session-name object))
+        (error "%s session '%s' does not exist"
+               (sesman--cap-system-name system) session-name)))))
+
+(defun sesman-remove-object (system session-name object &optional auto-unregister no-error)
+  "Remove (destructively) OBJECT from session SESSION-NAME of SYSTEM.
+If SESSION-NAME is nil, retrieve the session with
+`sesman-session-for-object'.  If OBJECT is the last object in sesman
+session, `sesman-unregister' the session.  If AUTO-UNREGISTER is non-nil
+unregister sessions of length 0 and remove all the links with the session.
+If NO-ERROR is non-nil, don't throw an error if OBJECT is not found in any
+session.  This is useful if there are several \"concurrent\" parties which
+can remove the object."
+  (let* ((system (or system (sesman--system)))
+         (session (if session-name
+                      (sesman-session system session-name)
+                    (sesman-session-for-object system object no-error)))
+         (new-session (delete object session)))
+    (cond ((null new-session))
+          ((= (length new-session) 1)
+           (when auto-unregister
+             (sesman-unregister system session)))
+          (t
+           (puthash (cons system (car session)) new-session sesman-sessions-hashmap)))))
+
+(defun sesman-session-for-object (system object &optional no-error)
+  "Retrieve SYSTEM session which contains OBJECT.
+When NO-ERROR is non-nil, don't throw an error if OBJECT is not part of any
+session.  In such case, return nil."
+  (let* ((system (or system (sesman--system)))
+         (sessions (sesman--all-system-sessions system)))
+    (or (seq-find (lambda (ses)
+                    (seq-find (lambda (x) (equal object x)) (cdr ses)))
+                  sessions)
+        (unless no-error
+          (error "%s is not part of any %s sessions"
+                 object system)))))
+
+(defun sesman-session-name-for-object (system object &optional no-error)
+  "Retrieve the name of the SYSTEM's session containing OBJECT.
+When NO-ERROR is non-nil, don't throw an error if OBJCECT is not part of
+any session.  In such case, return nil."
+  (car (sesman-session-for-object system object no-error)))
+
+(defun sesman-more-recent-p (bufs1 bufs2)
+  "Return t if BUFS1 is more recent than BUFS2.
+BUFS1 and BUFS2 are either buffers or lists of buffers.  When lists of
+buffers, most recent buffers from each list are considered.  To be used
+primarily in `sesman-more-relevant-p' methods when session objects are
+buffers."
+  (let ((bufs1 (if (bufferp bufs1) (list bufs1) bufs1))
+        (bufs2 (if (bufferp bufs2) (list bufs2) bufs2)))
+    (eq 1 (seq-some (lambda (b)
+                      (if (member b bufs1)
+                          1
+                        (when (member b bufs2)
+                          -1)))
+                    (buffer-list)))))
+
+
+;;; Contexts
+
+(cl-defgeneric sesman-context (_cxt-type)
+  "Given context type CXT-TYPE return the context.")
+(cl-defmethod sesman-context ((_cxt-type (eql buffer)))
+  "Return current buffer."
+  (current-buffer))
+(cl-defmethod sesman-context ((_cxt-type (eql directory)))
+  "Return current directory."
+  default-directory)
+(cl-defmethod sesman-context ((_cxt-type (eql project)))
+  "Return current project."
+  (project-current))
+
+(cl-defgeneric sesman-relevant-context-p (_cxt-type cxt)
+  "Non-nil if context CXT is relevant to current context of type CXT-TYPE.")
+(cl-defmethod sesman-relevant-context-p ((_cxt-type (eql buffer)) buf)
+  "Non-nil if BUF is `current-buffer'."
+  (eq (current-buffer) buf))
+(cl-defmethod sesman-relevant-context-p ((_cxt-type (eql directory)) dir)
+  "Non-nil if DIR is the parent or equals the `default-directory'."
+  (when (and dir default-directory)
+    (string-match-p (concat "^" dir) (expand-file-name default-directory))))
+(cl-defmethod sesman-relevant-context-p ((_cxt-type (eql project)) proj)
+  "Non-nil if PROJ is the parent or equals the `default-directory'."
+  (when (and proj default-directory)
+    (string-match-p (concat "^" (cdr proj))
+                    (expand-file-name default-directory))))
+
+
+(provide 'sesman)
+
+;;; sesman.el ends here