From: Andreas Gerler Date: Sun, 26 Nov 2023 15:28:14 +0000 (+0100) Subject: update sesman X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=f2ffd1b17b0cef734fa5c4a2a34c277dcfe6d28b;p=emacsconfig.git update sesman Signed-off-by: Andreas Gerler --- diff --git a/elpa/sesman-20190909.1754/sesman-autoloads.el b/elpa/sesman-20190909.1754/sesman-autoloads.el deleted file mode 100644 index 8485ba72..00000000 --- a/elpa/sesman-20190909.1754/sesman-autoloads.el +++ /dev/null @@ -1,98 +0,0 @@ -;;; sesman-autoloads.el --- automatically extracted autoloads -;; -;;; Code: -(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path)))) - -;;;### (autoloads nil "sesman" "sesman.el" (23997 31641 490594 106000)) -;;; Generated autoloads from sesman.el - -(autoload 'sesman-start "sesman" "\ -Start a Sesman session. - -\(fn)" t nil) - -(autoload 'sesman-restart "sesman" "\ -Restart sesman session. -When WHICH is nil, restart the current session; when a single universal -argument or 'linked, restart all linked sessions; when a double universal -argument, t or 'all, restart all sessions. For programmatic use, WHICH can also -be a session or a name of the session, in which case that session is restarted. - -\(fn &optional WHICH)" t nil) - -(autoload 'sesman-quit "sesman" "\ -Terminate a Sesman session. -When WHICH is nil, kill only the current session; when a single universal -argument or 'linked, kill all linked sessions; when a double universal argument, -t or 'all, kill all sessions. For programmatic use, WHICH can also be a session -or a name of the session, in which case that session is killed. - -\(fn &optional WHICH)" t nil) - -(autoload 'sesman-info "sesman" "\ -Display info for all current sessions (`sesman-current-sessions'). -In the resulting minibuffer display linked sessions are numbered and the -other (friendly) sessions are not. When ALL is non-nil, show info for all -sessions. - -\(fn &optional ALL)" t nil) - -(autoload 'sesman-link-with-buffer "sesman" "\ -Ask for SESSION and link with BUFFER. -BUFFER defaults to current buffer. On universal argument, or if BUFFER is 'ask, -ask for buffer. - -\(fn &optional BUFFER SESSION)" t nil) - -(autoload 'sesman-link-with-directory "sesman" "\ -Ask for SESSION and link with DIR. -DIR defaults to `default-directory'. On universal argument, or if DIR is 'ask, -ask for directory. - -\(fn &optional DIR SESSION)" t nil) - -(autoload 'sesman-link-with-project "sesman" "\ -Ask for SESSION and link with PROJECT. -PROJECT defaults to current project. On universal argument, or if PROJECT is -'ask, ask for the project. SESSION defaults to the current session. - -\(fn &optional PROJECT SESSION)" t nil) - -(autoload 'sesman-link-with-least-specific "sesman" "\ -Ask for SESSION and link with the least specific context available. -Normally the least specific context is the project. If not in a project, link -with the `default-directory'. If `default-directory' is nil, link with current -buffer. - -\(fn &optional SESSION)" t nil) - -(autoload 'sesman-unlink "sesman" "\ -Break any of the previously created links. - -\(fn)" t nil) - (autoload 'sesman-map "sesman" "Session management prefix keymap." t 'keymap) - -;;;*** - -;;;### (autoloads nil "sesman-browser" "sesman-browser.el" (23997 -;;;;;; 31641 489204 100000)) -;;; Generated autoloads from sesman-browser.el - -(autoload 'sesman-browser "sesman-browser" "\ -Display an interactive session browser. -See `sesman-browser-mode' for more details. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil nil ("sesman-pkg.el") (23997 31641 487487 99000)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; End: -;;; sesman-autoloads.el ends here diff --git a/elpa/sesman-20190909.1754/sesman-browser.el b/elpa/sesman-20190909.1754/sesman-browser.el deleted file mode 100644 index 6f6c8cc5..00000000 --- a/elpa/sesman-20190909.1754/sesman-browser.el +++ /dev/null @@ -1,482 +0,0 @@ -;;; sesman-browser.el --- Interactive Browser for Sesman -*- lexical-binding: t -*- -;; -;; Copyright (C) 2018, Vitalie Spinu -;; Author: Vitalie Spinu -;; URL: https://github.com/vspinu/sesman -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; 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: -;; -;; Interactive session browser. -;; -;;; Code: - -(require 'seq) -(require 'sesman) - -(defgroup sesman-browser nil - "Browser for Sesman." - :prefix "sesman-browser-" - :group 'sesman - :link '(url-link :tag "GitHub" "https://github.com/vspinu/sesman")) - -(defface sesman-browser-highligh-face - '((default (:inherit highlight :weight bold))) - "Face used to highlight currently selected button." - :group 'sesman-browser) - -(defface sesman-browser-button-face - '((default (:inherit button :slant italic))) - "Face used to highlight currently selected object." - :group 'sesman-browser) - -(defvar-local sesman-browser--sort-types '(name relevance)) -(defcustom sesman-browser-sort-type 'name - "Default sorting type in sesman browser buffers. -Currently can be either 'name or 'relevance." - :type '(choice (const name) (const relevance)) - :group 'sesman-browser) - -(defvar sesman-browser-map - (let (sesman-browser-map) - (define-prefix-command 'sesman-browser-map) - (define-key sesman-browser-map (kbd "r") #'sesman-browser-restart-session) - (define-key sesman-browser-map (kbd "q") #'sesman-browser-quit-session) - (define-key sesman-browser-map (kbd "b") #'sesman-browser-link-with-buffer) - (define-key sesman-browser-map (kbd "d") #'sesman-browser-link-with-directory) - (define-key sesman-browser-map (kbd "p") #'sesman-browser-link-with-project) - (define-key sesman-browser-map (kbd "u") #'sesman-browser-unlink) - sesman-browser-map) - "Prefix keymap for sesman commands from sesman browser.") - -(defvar sesman-browser-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "n") #'sesman-browser-vertical-next) - (define-key map (kbd "p") #'sesman-browser-vertical-prev) - (define-key map (kbd "f") #'sesman-browser-forward) - (define-key map (kbd "b") #'sesman-browser-backward) - (define-key map [remap forward-paragraph] #'sesman-browser-session-next) - (define-key map [remap backward-paragraph] #'sesman-browser-session-prev) - (define-key map (kbd "C-M-n") #'sesman-browser-session-next) - (define-key map (kbd "C-M-p") #'sesman-browser-session-prev) - (define-key map (kbd "") #'sesman-browser-forward) - (define-key map (kbd "") #'sesman-browser-backward) - (define-key map (kbd "") #'sesman-goto) - (define-key map (kbd "o") #'sesman-show) - (define-key map (kbd "t") #'sesman-browser-toggle-sort) - (define-key map (kbd "S") #'sesman-browser-toggle-sort) - (define-key map (kbd "l b") #'sesman-browser-link-with-buffer) - (define-key map (kbd "l d") #'sesman-browser-link-with-directory) - (define-key map (kbd "l p") #'sesman-browser-link-with-project) - (define-key map (kbd "u") #'sesman-browser-unlink) - (define-key map (kbd "s") 'sesman-browser-map) - (define-key map (kbd "C-c C-s") 'sesman-browser-map) - (easy-menu-define sesman-browser-mode-map map - "Sesman Browser" - '("SesmanBrowser" - ["Next row" sesman-browser-vertical-next] - ["Previous row" sesman-browser-vertical-prev] - ["Next button" sesman-browser-forward] - ["Previous button" sesman-browser-backward] - ["Next session" sesman-browser-session-next] - ["Previous session" sesman-browser-session-prev] - "--" - ["Goto buffer" sesman-goto] - ["Show buffer" sesman-show] - "--" - ["Link with Buffer" sesman-browser-link-with-buffer] - ["Link with Directory" sesman-browser-link-with-directory] - ["Link with Project" sesman-browser-link-with-project] - ["Unlink" sesman-browser-unlink] - "--" - ["Toggle sort" sesman-browser-toggle-sort] - ["Refresh View" revert-buffer])) - map) - "Local keymap in `sesman-browser-mode'.") - - -;;; Utilities - -(defun sesman-browser--closeby-pos (prop lax) - (or (when (get-text-property (point) prop) - (point)) - (when (and (not (bobp)) - (get-text-property (1- (point)) prop)) - (1- (point))) - (when lax - (let ((next (save-excursion - (and - (goto-char (next-single-char-property-change (point) prop)) - (get-text-property (point) prop) - (point)))) - (prev (save-excursion - (and - (goto-char (previous-single-char-property-change (point) prop)) - (not (bobp)) - (get-text-property (1- (point)) prop) - (1- (point)))))) - (if next - (if prev - (if (< (- (point) prev) (- next (point))) - prev - next) - next) - prev))))) - -(defun sesman-browser--closeby-value (prop lax) - (when-let ((pos (sesman-browser--closeby-pos prop lax))) - (get-text-property pos prop))) - -(defun sesman-browser-get (what &optional no-error lax) - "Get value of the property WHAT at point. -If NO-ERROR is non-nil, don't throw an error if no value has been found and -return nil. If LAX is non-nil, search nearby and return the closest value." - (when (derived-mode-p 'sesman-browser-mode) - (or (let ((prop (pcase what - ('session :sesman-session) - ('link :sesman-link) - ('object :sesman-object) - (_ what)))) - (sesman-browser--closeby-value prop 'lax)) - (unless no-error - (user-error "No %s %s" what (if lax "nearby" "at point")))))) - - -;;; Navigation - -(defvar-local sesman-browser--section-overlay nil) -(defvar-local sesman-browser--stop-overlay nil) - -(when (fboundp 'define-fringe-bitmap) - (define-fringe-bitmap 'sesman-left-bar - [#b00001100] nil nil '(top t))) - -(defun sesman-browser--next (prop) - (let ((pos (point))) - (goto-char (previous-single-char-property-change (point) prop)) - (unless (get-text-property (point) prop) - (goto-char (previous-single-char-property-change (point) prop))) - (when (bobp) - (goto-char pos)))) - -(defun sesman-browser--prev (prop) - (let ((pos (point))) - (goto-char (next-single-char-property-change (point) prop)) - (unless (get-text-property (point) prop) - (goto-char (next-single-char-property-change (point) prop))) - (when (eobp) - (goto-char pos)))) - -(defun sesman-browser-forward () - "Go to next button." - (interactive) - (sesman-browser--prev :sesman-stop)) - -(defun sesman-browser-backward () - "Go to previous button." - (interactive) - (sesman-browser--next :sesman-stop)) - -(defun sesman-browser-vertical-next () - "Go to next button section or row." - (interactive) - (sesman-browser--prev :sesman-vertical-stop)) - -(defun sesman-browser-vertical-prev () - "Go to previous button section or row." - (interactive) - (sesman-browser--next :sesman-vertical-stop)) - -(defun sesman-browser-session-next () - "Go to next session." - (interactive) - (sesman-browser--prev :sesman-session-stop)) - -(defun sesman-browser-session-prev () - "Go to previous session." - (interactive) - (sesman-browser--next :sesman-session-stop)) - - -;;; Display - -(defun sesman-goto (&optional no-switch) - "Go to most relevant buffer for session at point. -If NO-SWITCH is non-nil, only display the buffer." - (interactive "P") - (let ((object (get-text-property (point) :sesman-object))) - (if (and object (bufferp object)) - (if no-switch - (display-buffer object) - (pop-to-buffer object)) - (let* ((session (sesman-browser-get 'session)) - (info (sesman-session-info (sesman--system) session)) - (buffers (or (plist-get info :buffers) - (let ((objects (plist-get info :objects))) - (seq-filter #'bufferp objects))))) - (if buffers - (let ((most-recent-buf (seq-find (lambda (b) - (member b buffers)) - (buffer-list)))) - (if no-switch - (display-buffer most-recent-buf) - (pop-to-buffer most-recent-buf))) - (user-error "Cannot jump to session %s; it doesn't contain any buffers" (car session))))))) - -(defun sesman-show () - "Show the most relevant buffer for the session at point." - (interactive) - (sesman-goto 'no-switch)) - -(defun sesman-browser--sensor-function (&rest _ignore) - (let ((beg (or (when (get-text-property (point) :sesman-stop) - (if (get-text-property (1- (point)) :sesman-stop) - (previous-single-char-property-change (point) :sesman-stop) - (point))) - (next-single-char-property-change (point) :sesman-stop))) - (end (next-single-char-property-change (point) :sesman-stop))) - (move-overlay sesman-browser--stop-overlay beg end) - (when window-system - (let ((beg (get-text-property (point) :sesman-fragment-beg)) - (end (get-text-property (point) :sesman-fragment-end))) - (when (and beg end) - (move-overlay sesman-browser--section-overlay beg end)))))) - - -;;; Sesman UI - -(defun sesman-browser-quit-session () - "Quite session at point." - (interactive) - (sesman-quit (sesman-browser-get 'session))) - -(defun sesman-browser-restart-session () - "Restart session at point." - (interactive) - (sesman-restart (sesman-browser-get 'session))) - -(defun sesman-browser-link-with-buffer () - "Ask for buffer to link session at point to." - (interactive) - (let ((session (sesman-browser-get 'session))) - (sesman-link-with-buffer 'ask session))) - -(defun sesman-browser-link-with-directory () - "Ask for directory to link session at point to." - (interactive) - (let ((session (sesman-browser-get 'session))) - (sesman-link-with-directory 'ask session))) - -(defun sesman-browser-link-with-project () - "Ask for project to link session at point to." - (interactive) - (let ((session (sesman-browser-get 'session))) - (sesman-link-with-project 'ask session))) - -(defun sesman-browser-unlink () - "Unlink the link at point or ask for link to unlink." - (interactive) - (if-let ((link (sesman-browser-get 'link 'no-error))) - (sesman--unlink link) - (if-let ((links (sesman-links (sesman--system) - (sesman-browser-get 'session)))) - (mapc #'sesman--unlink - (sesman--ask-for-link "Unlink: " links 'ask-all)) - (user-error "No links for session %s" (car (sesman-browser-get 'session))))) - (run-hooks 'sesman-post-command-hook)) - - -;;; Major Mode - -(defun sesman-browser-revert (&rest _ignore) - "Refresh current browser buffer." - (let ((pos (point))) - (sesman-browser) - ;; simple but not particularly reliable or useful - (goto-char (min pos (point-max))))) - -(defun sesman-browser-revert-all (system) - "Refresh all Sesman SYSTEM browsers." - (mapc (lambda (b) - (with-current-buffer b - (when (and (derived-mode-p 'sesman-browser-mode) - (eq system (sesman--system))) - (sesman-browser-revert)))) - (buffer-list))) - -(defun sesman-browser--goto-stop (stop-value) - (let ((search t)) - (goto-char (point-min)) - (while search - (goto-char (next-single-char-property-change (point) :sesman-stop)) - (if (eobp) - (progn (setq search nil) - (goto-char (next-single-char-property-change (point-min) :sesman-stop))) - (when (equal (get-text-property (point) :sesman-stop) stop-value) - (setq search nil)))))) - -(defun sesman-browser-toggle-sort () - "Toggle sorting of sessions. -See `sesman-browser-sort-type' for the default sorting type." - (interactive) - (when (eq sesman-browser-sort-type - (car sesman-browser--sort-types)) - (pop sesman-browser--sort-types)) - (unless sesman-browser--sort-types - (setq-local sesman-browser--sort-types (default-value 'sesman-browser--sort-types))) - (setq sesman-browser-sort-type (pop sesman-browser--sort-types)) - (let ((stop (sesman-browser-get :sesman-stop nil 'lax))) - (sesman-browser) - (sesman-browser--goto-stop stop) - (sesman-browser--sensor-function)) - (message "Sorted by %s" - (propertize (symbol-name sesman-browser-sort-type) 'face 'bold))) - -(define-derived-mode sesman-browser-mode special-mode "SesmanBrowser" - "Interactive view of Sesman sessions. -When applicable, system specific commands are locally bound to j when point is -on a session object." - ;; ensure there is a sesman-system here - (sesman--system) - (delete-all-overlays) - (setq-local sesman-browser--stop-overlay (make-overlay (point) (point))) - (overlay-put sesman-browser--stop-overlay 'face 'sesman-browser-highligh-face) - (setq-local sesman-browser--section-overlay (make-overlay (point) (point))) - (when window-system - (let* ((fringe-spec '(left-fringe sesman-left-bar sesman-browser-highligh-face)) - (dummy-string (propertize "|" 'display fringe-spec))) - (overlay-put sesman-browser--section-overlay 'line-prefix dummy-string))) - (add-hook 'sesman-post-command-hook 'sesman-browser-revert nil t) - (setq-local display-buffer-base-action '(nil . ((inhibit-same-window . t)))) - (setq-local sesman-browser--sort-types (default-value 'sesman-browser--sort-types)) - (setq-local revert-buffer-function #'sesman-browser-revert)) - -(defun sesman-browser--insert-session (system ses i) - (let ((ses-name (car ses)) - (head-template "%17s") - beg end) - (setq beg (point)) - - ;; session header - (insert (format "%3d: " i)) - (insert (propertize (car ses) - :sesman-stop ses-name - :sesman-vertical-stop t - :sesman-session-stop t - 'face 'bold - 'cursor-sensor-functions (list #'sesman-browser--sensor-function) - 'mouse-face 'highlight) - "\n") - - ;; links - (insert (format head-template "linked-to: ")) - (let ((link-groups (sesman-grouped-links system ses)) - (vert-stop)) - (dolist (grp link-groups) - (let* ((type (car grp))) - (dolist (link (cdr grp)) - (when (> (current-column) fill-column) - (insert "\n" (format head-template " ")) - (setq vert-stop nil)) - (let ((val (sesman--abbrev-path-maybe (sesman--lnk-value link)))) - (insert (propertize (sesman--format-context type val 'sesman-browser-button-face) - :sesman-stop (car link) - :sesman-vertical-stop (unless vert-stop (setq vert-stop t)) - :sesman-link link - 'cursor-sensor-functions (list #'sesman-browser--sensor-function) - 'mouse-face 'highlight))) - (insert " "))))) - (insert "\n") - - ;; objects - (insert (format head-template "objects: ")) - (let* ((info (sesman-session-info system ses)) - (map (plist-get info :map)) - (objects (plist-get info :objects)) - (strings (or (plist-get info :strings) - (mapcar (lambda (x) (format "%s" x)) objects))) - (kvals (seq-mapn #'cons objects strings)) - (kvals (seq-sort (lambda (a b) (string-lessp (cdr a) (cdr b))) - kvals)) - (vert-stop)) - (dolist (kv kvals) - (when (> (current-column) fill-column) - (insert "\n" (format head-template " ")) - (setq vert-stop nil)) - (let ((str (replace-regexp-in-string ses-name "%s" (cdr kv) nil t))) - (insert (propertize str - :sesman-stop str - :sesman-vertical-stop (unless vert-stop (setq vert-stop t)) - :sesman-object (car kv) - 'cursor-sensor-functions (list #'sesman-browser--sensor-function) - 'face 'sesman-browser-button-face - 'mouse-face 'highlight - 'help-echo "mouse-2: visit in other window" - 'keymap map) - " ")))) - - ;; session properties - (setq end (point)) - (put-text-property beg end :sesman-session ses) - (put-text-property beg end :sesman-session-name ses-name) - (put-text-property beg end :sesman-fragment-beg beg) - (put-text-property beg end :sesman-fragment-end end) - (insert "\n\n"))) - -;;;###autoload -(defun sesman-browser () - "Display an interactive session browser. -See `sesman-browser-mode' for more details." - (interactive) - (let* ((system (sesman--system)) - (pop-to (called-interactively-p 'any)) - (sessions (sesman-sessions system)) - (cur-session (when pop-to - (sesman-current-session 'CIDER))) - (buff (get-buffer-create (format "*sesman %s browser*" system)))) - (with-current-buffer buff - (setq-local sesman-system system) - (sesman-browser-mode) - (cursor-sensor-mode 1) - (let ((inhibit-read-only t) - (sessions (pcase sesman-browser-sort-type - ('name (seq-sort (lambda (a b) (string-greaterp (car b) (car a))) - sessions)) - ('relevance (sesman--sort-sessions system sessions)) - (_ (error "Invalid `sesman-browser-sort-type'")))) - (i 0)) - (erase-buffer) - (insert "\n ") - (insert (propertize (format "%s Sessions:" system) - 'face '(bold font-lock-keyword-face))) - (insert "\n\n") - (dolist (ses sessions) - (setq i (1+ i)) - (sesman-browser--insert-session system ses i)) - (when pop-to - (pop-to-buffer buff) - (sesman-browser--goto-stop (car cur-session))) - (sesman-browser--sensor-function))))) - -(provide 'sesman-browser) -;;; sesman-browser.el ends here diff --git a/elpa/sesman-20190909.1754/sesman-pkg.el b/elpa/sesman-20190909.1754/sesman-pkg.el deleted file mode 100644 index 5f896f3f..00000000 --- a/elpa/sesman-20190909.1754/sesman-pkg.el +++ /dev/null @@ -1,12 +0,0 @@ -(define-package "sesman" "20190909.1754" "Generic Session Manager" - '((emacs "25")) - :keywords - '("process") - :authors - '(("Vitalie Spinu")) - :maintainer - '("Vitalie Spinu") - :url "https://github.com/vspinu/sesman") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/sesman-20190909.1754/sesman.el b/elpa/sesman-20190909.1754/sesman.el deleted file mode 100644 index e0a16b37..00000000 --- a/elpa/sesman-20190909.1754/sesman.el +++ /dev/null @@ -1,1003 +0,0 @@ -;;; sesman.el --- Generic Session Manager -*- lexical-binding: t -*- -;; -;; Copyright (C) 2018, Vitalie Spinu -;; Author: Vitalie Spinu -;; URL: https://github.com/vspinu/sesman -;; Keywords: process -;; Version: 0.3.3-DEV -;; 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 'seq) -(require 'subr-x) -(require 'vc) - -(defgroup sesman nil - "Generic Session Manager." - :prefix "sesman-" - :group 'tools - :link '(url-link :tag "GitHub" "https://github.com/vspinu/sesman")) - -(defface sesman-project-face - '((default (:inherit font-lock-doc-face))) - "Face used to mark projects." - :group 'sesman) - -(defface sesman-directory-face - '((default (:inherit font-lock-type-face))) - "Face used to mark directories." - :group 'sesman) - -(defface sesman-buffer-face - '((default (:inherit font-lock-preprocessor-face))) - "Face used to mark buffers." - :group 'sesman) - -(defcustom sesman-use-friendly-sessions t - "If non-nil consider friendly sessions when looking for current sessions. -The definition of friendly sessions is system dependent but usually means -sessions running in dependent projects." - :group 'sesman - :type 'boolean - :package-version '(sesman . "0.3.2")) - -(defcustom sesman-follow-symlinks 'vc - "When non-nil, follow symlinks during the file expansion. -When nil, don't follow symlinks. When 'vc, follow symlinks only when -`vc-follow-symlinks' is non-nil. When t, always follow symlinks." - :group 'sesman - :type '(choice (const :tag "Comply with `vc-follow-symlinks'" vc) - (const :tag "Don't follow symlinks" nil) - (const :tag "Follow symlinks" t)) - :package-version '(sesman . "0.3.3")) -(put 'sesman-follow-symlinks 'safe-local-variable (lambda (x) (memq x '(vc nil t)))) - -;; (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) - :package-version '(sesman . "0.1.0")) - -;; 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.") -(put 'sesman-system 'permanent-local 't) - - - -;; 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 'sort)) - ((or (equal which '(16)) (eq which 'all) (eq which t)) - (sesman--all-system-sessions system 'sort)) - ;; session itself - ((and (listp which) - (or (stringp (car which)) - (symbolp (car which)))) - (list which)) - ;; session name - ((or (stringp which) - (symbolp which) - (gethash (cons system which) sesman-sessions-hashmap))) - (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--least-specific-context (system) - (seq-some (lambda (ctype) - (when-let (val (sesman-context ctype system)) - (cons ctype val))) - (reverse (sesman-context-types system)))) - -(defun sesman--link-session-interactively (session cxt-type cxt-val) - (let ((system (sesman--system))) - (unless cxt-type - (let ((cxt (sesman--least-specific-context system))) - (setq cxt-type (car cxt) - cxt-val (cdr cxt)))) - (let ((cxt-name (symbol-name cxt-type))) - (if (member cxt-type (sesman-context-types system)) - (let ((session (or session - (sesman-ask-for-session - system - (format "Link with %s %s: " - cxt-name (sesman--abbrev-path-maybe - (sesman-context cxt-type system))) - (sesman--all-system-sessions system 'sort) - 'ask-new)))) - (sesman-link-session system session cxt-type cxt-val)) - (error (format "%s association not allowed for this system (%s)" - (capitalize cxt-name) - system)))))) - -;; FIXME: incorporate `sesman-abbreviate-paths' -(defun sesman--abbrev-path-maybe (obj) - (if (stringp obj) - (abbreviate-file-name obj) - obj)) - -(defun sesman--system-in-buffer (&optional buffer) - (with-current-buffer (or buffer (current-buffer)) - (if (functionp sesman-system) - (funcall sesman-system) - sesman-system))) - -(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--linked-sessions (system &optional sort cxt-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) - (delete-dups - (mapcar (lambda (assoc) - (gethash (car assoc) sesman-sessions-hashmap)) - (sesman-current-links system nil sort cxt-types))))) - -(defun sesman--friendly-sessions (system &optional sort) - (let ((sessions (seq-filter (lambda (ses) (sesman-friendly-session-p system ses)) - (sesman--all-system-sessions system)))) - (if sort - (sesman--sort-sessions system sessions) - sessions))) - -(defun sesman--all-system-sessions (&optional system sort) - "Return a list of sessions registered with SYSTEM. -If SORT is non-nil, sort in relevance order." - (let ((system (or system (sesman--system))) - sessions) - (maphash - (lambda (k s) - (when (eql (car k) system) - (push s sessions))) - sesman-sessions-hashmap) - (if sort - (sesman--sort-sessions system sessions) - 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-session-objects (system session &optional sep) - (let ((info (sesman-session-info system session))) - (if (and (listp info) - (keywordp (car info))) - (let ((ses-name (car session)) - (sep (or sep " ")) - (strings (or (plist-get info :strings) - (mapcar (lambda (x) (format "%s" x)) - (plist-get info :objects))))) - (mapconcat (lambda (str) - (replace-regexp-in-string ses-name "..." str nil t)) - strings sep)) - (format "%s" info)))) - -(defun sesman--format-session (system ses &optional prefix) - (format (propertize "%s%s [%s] linked-to %s" 'face 'bold) - (or prefix "") - (propertize (car ses) 'face 'bold) - (propertize (sesman--format-session-objects system ses ", ") 'face 'italic) - (sesman-grouped-links system ses t t))) - -(defun sesman--format-link (link) - (let* ((system (sesman--lnk-system-name link)) - (session (gethash (car link) sesman-sessions-hashmap))) - (format "%s(%s) -> %s [%s]" - (sesman--lnk-context-type link) - (propertize (format "%s" (sesman--abbrev-path-maybe (sesman--lnk-value link))) - 'face 'bold) - (propertize (sesman--lnk-session-name link) 'face 'bold) - (if session - (sesman--format-session-objects system session) - "invalid")))) - -(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 - -(defun sesman-post-command-hook nil - "Normal hook ran after every state-changing Sesman command.") - -;;;###autoload -(defun sesman-start () - "Start a Sesman session." - (interactive) - (let ((system (sesman--system))) - (message "Starting new %s session ..." system) - (prog1 (sesman-start-session system) - (run-hooks 'sesman-post-command-hook)))) - -;;;###autoload -(defun sesman-restart (&optional which) - "Restart sesman session. -When WHICH is nil, restart the current session; when a single universal -argument or 'linked, restart all linked sessions; when a double universal -argument, t or 'all, restart all sessions. For programmatic use, WHICH can also -be a session or a name of the session, in which case that session is restarted." - (interactive "P") - (let* ((system (sesman--system)) - (sessions (sesman--on-C-u-u-sessions system which))) - (if (null sessions) - (message "No %s sessions found" system) - (with-temp-message (format "Restarting %s %s %s" system - (if (= 1 (length sessions)) "session" "sessions") - (mapcar #'car sessions)) - (mapc (lambda (s) - (sesman-restart-session system s)) - sessions)) - ;; restarting is not guaranteed to finish here, but what can we do? - (run-hooks 'sesman-post-command-hook)))) - -;;;###autoload -(defun sesman-quit (&optional which) - "Terminate a Sesman session. -When WHICH is nil, kill only the current session; when a single universal -argument or 'linked, kill all linked sessions; when a double universal argument, -t or 'all, kill all sessions. For programmatic use, WHICH can also be a session -or a name of the session, in which case that session is killed." - (interactive "P") - (let* ((system (sesman--system)) - (sessions (sesman--on-C-u-u-sessions system which))) - (if (null sessions) - (message "No %s sessions found" system) - (with-temp-message (format "Killing %s %s %s" system - (if (= 1 (length sessions)) "session" "sessions") - (mapcar #'car sessions)) - (mapc (lambda (s) - (sesman-unregister system s) - (sesman-quit-session system s)) - sessions)) - (run-hooks 'sesman-post-command-hook)))) - -;;;###autoload -(defun sesman-info (&optional all) - "Display info for all current sessions (`sesman-current-sessions'). -In the resulting minibuffer display linked sessions are numbered and the -other (friendly) sessions are not. When ALL is non-nil, show info for all -sessions." - (interactive "P") - (let* ((system (sesman--system)) - (i 1) - (sessions (if all - (sesman-sessions system t) - (sesman-current-sessions system))) - (empty-prefix (if (> (length sessions) 1) " " ""))) - (if sessions - (message (mapconcat (lambda (ses) - (let ((prefix (if (sesman-relevant-session-p system ses) - (prog1 (format "%d " i) - (setq i (1+ i))) - empty-prefix))) - (sesman--format-session system ses prefix))) - sessions - "\n")) - (message "No %s%s sessions" - (if all "" "current ") - system)))) - -;;;###autoload -(defun sesman-link-with-buffer (&optional buffer session) - "Ask for SESSION and link with BUFFER. -BUFFER defaults to current buffer. On universal argument, or if BUFFER is 'ask, -ask for buffer." - (interactive "P") - (let ((buf (if (or (eq buffer 'ask) - (equal buffer '(4))) - (let ((this-system (sesman--system))) - (read-buffer "Link buffer: " (current-buffer) t - (lambda (buf-cons) - (equal this-system - (sesman--system-in-buffer (cdr buf-cons)))))) - (or buffer (current-buffer))))) - (sesman--link-session-interactively session 'buffer buf))) - -;;;###autoload -(defun sesman-link-with-directory (&optional dir session) - "Ask for SESSION and link with DIR. -DIR defaults to `default-directory'. On universal argument, or if DIR is 'ask, -ask for directory." - (interactive "P") - (let ((dir (if (or (eq dir 'ask) - (equal dir '(4))) - (read-directory-name "Link directory: ") - (or dir default-directory)))) - (sesman--link-session-interactively session 'directory dir))) - -;;;###autoload -(defun sesman-link-with-project (&optional project session) - "Ask for SESSION and link with PROJECT. -PROJECT defaults to current project. On universal argument, or if PROJECT is -'ask, ask for the project. SESSION defaults to the current session." - (interactive "P") - (let* ((system (sesman--system)) - (project (expand-file-name - (if (or (eq project 'ask) - (equal project '(4))) - ;; FIXME: should be a completion over all known projects for this system - (read-directory-name "Project: " (sesman-project system)) - (or project (sesman-project system)))))) - (sesman--link-session-interactively session 'project project))) - -;;;###autoload -(defun sesman-link-with-least-specific (&optional session) - "Ask for SESSION and link with the least specific context available. -Normally the least specific context is the project. If not in a project, link -with the `default-directory'. If `default-directory' is nil, link with current -buffer." - (interactive "P") - (sesman--link-session-interactively session nil nil)) - -;;;###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))) - (run-hooks 'sesman-post-command-hook)) - -(declare-function sesman-browser "sesman-browser") -;;;###autoload (autoload 'sesman-map "sesman" "Session management prefix keymap." t 'keymap) -(defvar sesman-map - (let (sesman-map) - (define-prefix-command 'sesman-map) - (define-key sesman-map (kbd "C-i") #'sesman-info) - (define-key sesman-map (kbd "i") #'sesman-info) - (define-key sesman-map (kbd "C-w") #'sesman-browser) - (define-key sesman-map (kbd "w") #'sesman-browser) - (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-l") #'sesman-link-with-least-specific) - (define-key sesman-map (kbd "l") #'sesman-link-with-least-specific) - (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-info] - "--" - ["Start" sesman-start] - ["Restart" sesman-restart :active (sesman-current-session (sesman--system))] - ["Quit" sesman-quit :active (sesman-current-session (sesman--system))] - "--" - ["Link with Buffer" sesman-link-with-buffer :active (sesman-current-session (sesman--system))] - ["Link with Directory" sesman-link-with-directory :active (sesman-current-session (sesman--system))] - ["Link with Project" sesman-link-with-project :active (sesman-current-session (sesman--system))] - ["Unlink" sesman-unlink :active (sesman-current-session (sesman--system))] - "--" - ["Browser" sesman-browser :active (sesman-current-session (sesman--system))]) - "Sesman Menu.") - -(defun sesman-install-menu (map) - "Install `sesman-menu' into MAP." - (easy-menu-do-define 'sesman-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) - "Return a plist with :objects key containing user \"visible\" objects. -Optional :strings value is a list of string representations of objects. Optional -:map key is a local keymap to place on every object in the session browser. -Optional :buffers is a list of buffers which will be used for navigation from -the session browser. If :buffers is missing, buffers from :objects are used -instead." - (list :objects (cdr session))) - -(cl-defgeneric sesman-project (_system) - "Retrieve project root in current directory (`default-directory') for SYSTEM. -Return a string or nil if no project has been found." - nil) - -(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-recent-p' utility in this method." - (not (string-greaterp (car session1) (car session2)))) - -(cl-defgeneric sesman-friendly-session-p (_system _session) - "Return non-nil if SESSION is a friendly session in current context. -The \"friendship\" is system dependent but usually means sessions running in -dependent projects. Unless SYSTEM has defined a method for this generic, there -are no friendly sessions." - nil) - -(cl-defgeneric sesman-context-types (_system) - "Return a list of context types understood by SYSTEM. -Contexts must be sorted from most specific to least specific." - '(buffer directory project)) - - -;;; 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 &optional sort type cxt-types) - "Return a list of sessions registered with SYSTEM. -When TYPE is either 'all or nil return all sessions registered with the SYSTEM, -when 'linked, only linked to the current context sessions, when 'friendly - only -friendly sessions. If SORT is non-nil, sessions are sorted in the relevance -order with linked sessions leading the list. CXT-TYPES is a list of context -types to consider for linked sessions." - (let ((system (or system (sesman--system)))) - (cond - ((eq type 'linked) - (sesman--linked-sessions system sort cxt-types)) - ((eq type 'friendly) - (sesman--friendly-sessions system sort)) - ((memq type '(all nil)) - (if sort - (delete-dups - (append (sesman--linked-sessions system 'sort cxt-types) - (sesman--all-system-sessions system 'sort))) - (sesman--all-system-sessions system))) - (t (error "Invalid session TYPE argument %s" type))))) - -(defun sesman-current-sessions (system &optional cxt-types) - "Return a list of SYSTEM sessions active in the current context. -Sessions are ordered by the relevance order and linked sessions come first. If -`sesman-use-friendly-sessions' current sessions consist of linked and friendly -sessions, otherwise only of linked sessions. CXT-TYPES is a list of context -types to consider. Defaults to the list returned from `sesman-context-types'." - (if sesman-use-friendly-sessions - (delete-dups - (append (sesman--linked-sessions system 'sort cxt-types) - (sesman--friendly-sessions system 'sort))) - (sesman--linked-sessions system 'sort cxt-types))) - -(defun sesman-current-session (system &optional cxt-types) - "Get the most relevant current session for the SYSTEM. -CXT-TYPES is a list of context types to consider." - (or (car (sesman--linked-sessions system 'sort cxt-types)) - (car (sesman--friendly-sessions system 'sort)))) - -(defun sesman-ensure-session (system &optional cxt-types) - "Get the most relevant linked session for SYSTEM or throw if none exists. -CXT-TYPES is a list of context types to consider." - (or (sesman-current-session system cxt-types) - (user-error "No linked %s 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)))))) - -(defvar sesman--cxt-abbrevs '(buffer "buf" project "proj" directory "dir")) -(defun sesman--format-context (cxt-type cxt-val extra-face) - (let* ((face (intern (format "sesman-%s-face" cxt-type))) - (short-type (propertize (or (plist-get sesman--cxt-abbrevs cxt-type) - (symbol-value cxt-type)) - 'face (list (if (facep face) - face - 'font-lock-function-name-face) - extra-face)))) - (concat short-type - (propertize (format "(%s)" cxt-val) - 'face extra-face)))) - -(defun sesman-grouped-links (system session &optional current-first as-string) - "Retrieve all links for SYSTEM's SESSION from the global `sesman-links-alist'. -Return an alist of the form - - ((buffer buffers..) - (directory directories...) - (project projects...)). - -When `CURRENT-FIRST' is non-nil, a cons of two lists as above is returned with -car containing links relevant in current context and cdr all other links. 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))) - (out-rel (when current-first - (copy-alist out)))) - (mapc (lambda (link) - (let* ((type (sesman--lnk-context-type link)) - (entry (if (and current-first - (sesman-relevant-link-p link)) - (assoc type out-rel) - (assoc type out)))) - (when entry - (setcdr entry (cons link (cdr entry)))))) - links) - (let ((out (delq nil (mapcar (lambda (el) (and (cdr el) el)) out))) - (out-rel (delq nil (mapcar (lambda (el) (and (cdr el) el)) out-rel)))) - (if as-string - (let ((fmt-fn (lambda (typed-links) - (let* ((type (car typed-links))) - (mapconcat (lambda (lnk) - (let ((val (sesman--abbrev-path-maybe - (sesman--lnk-value lnk)))) - (sesman--format-context type val 'italic))) - (cdr typed-links) - ", "))))) - (if out-rel - (concat (mapconcat fmt-fn out-rel ", ") - (when out " | ") - (mapconcat fmt-fn out ", ")) - (mapconcat fmt-fn out ", "))) - (if current-first - (cons out-rel out) - out))))) - -(defun sesman-link-session (system session &optional cxt-type cxt-val) - "Link SYSTEM's SESSION to context give by CXT-TYPE and CXT-VAL. -If CXT-TYPE is nil, use the least specific type available in the current -context. If CXT-TYPE is non-nil, and CXT-VAL is not given, retrieve it with -`sesman-context'. See also `sesman-link-with-project', -`sesman-link-with-directory' and `sesman-link-with-buffer'." - (let* ((ses-name (or (car-safe session) - (error "SESSION must be a headed list"))) - (cxt-val (or cxt-val - (or (if cxt-type - (sesman-context cxt-type system) - (let ((cxt (sesman--least-specific-context system))) - (setq cxt-type (car cxt)) - (cdr cxt))) - (error "No local context of type %s" cxt-type)))) - (cxt-val (if (stringp cxt-val) - (expand-file-name cxt-val) - cxt-val)) - (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)))) - (run-hooks 'sesman-post-command-hook) - link)) - -(defun sesman-links (system &optional session-or-name cxt-types sort) - "Retrieve all links for SYSTEM, SESSION-OR-NAME and CXT-TYPES. -SESSION-OR-NAME can be either a session or a name of the session. If SORT is -non-nil links are sorted in relevance order and `sesman-current-links' lead the -list, otherwise links are returned in the creation order." - (let* ((ses-name (if (listp session-or-name) - (car session-or-name) - session-or-name)) - (lfn (sesman--link-lookup-fn system ses-name cxt-types))) - (if sort - (delete-dups (append - (sesman-current-links system ses-name) - (sesman--sort-links system (seq-filter lfn sesman-links-alist)))) - (seq-filter lfn sesman-links-alist)))) - -(defun sesman-current-links (system &optional session-or-name sort cxt-types) - "Retrieve all active links in current context for SYSTEM and SESSION-OR-NAME. -SESSION-OR-NAME can be either a session or a name of the session. CXT-TYPES is a -list of context types to consider. Returned links are a subset of -`sesman-links-alist' sorted in order of relevance if SORT is non-nil." - ;; mapcan is a built-in in 26.1; don't want to require cl-lib for one function - (let ((ses-name (if (listp session-or-name) - (car session-or-name) - session-or-name))) - (seq-mapcat - (lambda (cxt-type) - (let* ((lfn (sesman--link-lookup-fn system ses-name cxt-type)) - (links (seq-filter (lambda (l) - (and (funcall lfn l) - (sesman-relevant-context-p cxt-type (sesman--lnk-value l)))) - sesman-links-alist))) - (if sort - (sesman--sort-links system links) - links))) - (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) - i (1+ 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))))) - -;; path caching because file-truename is very slow -(defvar sesman--path-cache (make-hash-table :test #'equal)) -(defun sesman-expand-path (path) - "Expand PATH with optionally follow symlinks. -Whether symlinks are followed is controlled by `sesman-follow-symlinks' custom -variable. Always return the expansion without the trailing directory slash." - (directory-file-name - (if sesman-follow-symlinks - (let ((true-name (or (gethash path sesman--path-cache) - (puthash path (file-truename path) sesman--path-cache)))) - (if (or (eq sesman-follow-symlinks t) - vc-follow-symlinks) - true-name - ;; sesman-follow-symlinks is 'vc but vc-follow-symlinks is nil - (expand-file-name path))) - (expand-file-name path)))) - - -;;; Contexts - -(cl-defgeneric sesman-context (_cxt-type _system) - "Given SYSTEM and context type CXT-TYPE return the context.") -(cl-defmethod sesman-context ((_cxt-type (eql buffer)) _system) - "Return current buffer." - (current-buffer)) -(cl-defmethod sesman-context ((_cxt-type (eql directory)) _system) - "Return current directory." - (sesman-expand-path default-directory)) -(cl-defmethod sesman-context ((_cxt-type (eql project)) system) - "Return current project." - (let* ((default-directory (sesman-expand-path default-directory)) - (proj (or - (sesman-project (or system (sesman--system))) - ;; Normally we would use (project-roots (project-current)) but currently - ;; project-roots fails on nil and doesn't work on custom `('foo . - ;; "path/to/project"). So, use vc as a fallback and don't use project.el at - ;; all for now. - ;; NB: `vc-root-dir' doesn't work from symlinked files. Emacs Bug? - (vc-root-dir)))) - (when proj - (expand-file-name proj)))) - -(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 "^" (sesman-expand-path dir)) - (sesman-expand-path default-directory)))) -(cl-defmethod sesman-relevant-context-p ((_cxt-type (eql project)) proj) - "Non-nil if PROJ is the parent or equal to the `default-directory'." - (when (and proj default-directory) - (string-match-p (concat "^" (sesman-expand-path proj)) - (sesman-expand-path default-directory)))) - -(defun sesman-relevant-link-p (link &optional cxt-types) - "Return non-nil if LINK is relevant to the current context. -If CXT-TYPES is non-nil, only check relevance for those contexts." - (when (or (null cxt-types) - (member (sesman--lnk-context-type link) cxt-types)) - (sesman-relevant-context-p - (sesman--lnk-context-type link) - (sesman--lnk-value link)))) - -(defun sesman-relevant-session-p (system session &optional cxt-types) - "Return non-nil if SYSTEM's SESSION is relevant to the current context. -If CXT-TYPES is non-nil, only check relevance for those contexts." - (seq-some #'sesman-relevant-link-p - (sesman-links system session cxt-types))) - -(define-obsolete-function-alias 'sesman-linked-sessions 'sesman--linked-sessions "v0.3.2") - -(provide 'sesman) - -;;; sesman.el ends here diff --git a/elpa/sesman-20210901.1134/sesman-autoloads.el b/elpa/sesman-20210901.1134/sesman-autoloads.el new file mode 100644 index 00000000..791c3959 --- /dev/null +++ b/elpa/sesman-20210901.1134/sesman-autoloads.el @@ -0,0 +1,104 @@ +;;; sesman-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "sesman" "sesman.el" (0 0 0 0)) +;;; Generated autoloads from sesman.el + +(autoload 'sesman-start "sesman" "\ +Start a Sesman session." t nil) + +(autoload 'sesman-restart "sesman" "\ +Restart sesman session. +When WHICH is nil, restart the current session; when a single universal +argument or 'linked, restart all linked sessions; when a double universal +argument, t or 'all, restart all sessions. For programmatic use, WHICH can also +be a session or a name of the session, in which case that session is restarted. + +\(fn &optional WHICH)" t nil) + +(autoload 'sesman-quit "sesman" "\ +Terminate a Sesman session. +When WHICH is nil, kill only the current session; when a single universal +argument or 'linked, kill all linked sessions; when a double universal argument, +t or 'all, kill all sessions. For programmatic use, WHICH can also be a session +or a name of the session, in which case that session is killed. + +\(fn &optional WHICH)" t nil) + +(autoload 'sesman-info "sesman" "\ +Display info for all current sessions (`sesman-current-sessions'). +In the resulting minibuffer display linked sessions are numbered and the +other (friendly) sessions are not. When ALL is non-nil, show info for all +sessions. + +\(fn &optional ALL)" t nil) + +(autoload 'sesman-link-with-buffer "sesman" "\ +Ask for SESSION and link with BUFFER. +BUFFER defaults to current buffer. On universal argument, or if BUFFER is 'ask, +ask for buffer. + +\(fn &optional BUFFER SESSION)" t nil) + +(autoload 'sesman-link-with-directory "sesman" "\ +Ask for SESSION and link with DIR. +DIR defaults to `default-directory'. On universal argument, or if DIR is 'ask, +ask for directory. + +\(fn &optional DIR SESSION)" t nil) + +(autoload 'sesman-link-with-project "sesman" "\ +Ask for SESSION and link with PROJECT. +PROJECT defaults to current project. On universal argument, or if PROJECT is +'ask, ask for the project. SESSION defaults to the current session. + +\(fn &optional PROJECT SESSION)" t nil) + +(autoload 'sesman-link-with-least-specific "sesman" "\ +Ask for SESSION and link with the least specific context available. +Normally the least specific context is the project. If not in a project, link +with the `default-directory'. If `default-directory' is nil, link with current +buffer. + +\(fn &optional SESSION)" t nil) + +(autoload 'sesman-unlink "sesman" "\ +Break sesman LINKS. +If LINKS is nil, ask interactively for a link. With a prefix argument break all +links. + +\(fn &optional LINKS)" t nil) + (autoload 'sesman-map "sesman" "Session management prefix keymap." t 'keymap) + +(register-definition-prefixes "sesman" '("sesman-")) + +;;;*** + +;;;### (autoloads nil "sesman-browser" "sesman-browser.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from sesman-browser.el + +(autoload 'sesman-browser "sesman-browser" "\ +Display an interactive session browser. +See `sesman-browser-mode' for more details." t nil) + +(register-definition-prefixes "sesman-browser" '("sesman-")) + +;;;*** + +;;;### (autoloads nil nil ("sesman-pkg.el") (0 0 0 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; sesman-autoloads.el ends here diff --git a/elpa/sesman-20210901.1134/sesman-browser.el b/elpa/sesman-20210901.1134/sesman-browser.el new file mode 100644 index 00000000..6f6c8cc5 --- /dev/null +++ b/elpa/sesman-20210901.1134/sesman-browser.el @@ -0,0 +1,482 @@ +;;; sesman-browser.el --- Interactive Browser for Sesman -*- lexical-binding: t -*- +;; +;; Copyright (C) 2018, Vitalie Spinu +;; Author: Vitalie Spinu +;; URL: https://github.com/vspinu/sesman +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; 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: +;; +;; Interactive session browser. +;; +;;; Code: + +(require 'seq) +(require 'sesman) + +(defgroup sesman-browser nil + "Browser for Sesman." + :prefix "sesman-browser-" + :group 'sesman + :link '(url-link :tag "GitHub" "https://github.com/vspinu/sesman")) + +(defface sesman-browser-highligh-face + '((default (:inherit highlight :weight bold))) + "Face used to highlight currently selected button." + :group 'sesman-browser) + +(defface sesman-browser-button-face + '((default (:inherit button :slant italic))) + "Face used to highlight currently selected object." + :group 'sesman-browser) + +(defvar-local sesman-browser--sort-types '(name relevance)) +(defcustom sesman-browser-sort-type 'name + "Default sorting type in sesman browser buffers. +Currently can be either 'name or 'relevance." + :type '(choice (const name) (const relevance)) + :group 'sesman-browser) + +(defvar sesman-browser-map + (let (sesman-browser-map) + (define-prefix-command 'sesman-browser-map) + (define-key sesman-browser-map (kbd "r") #'sesman-browser-restart-session) + (define-key sesman-browser-map (kbd "q") #'sesman-browser-quit-session) + (define-key sesman-browser-map (kbd "b") #'sesman-browser-link-with-buffer) + (define-key sesman-browser-map (kbd "d") #'sesman-browser-link-with-directory) + (define-key sesman-browser-map (kbd "p") #'sesman-browser-link-with-project) + (define-key sesman-browser-map (kbd "u") #'sesman-browser-unlink) + sesman-browser-map) + "Prefix keymap for sesman commands from sesman browser.") + +(defvar sesman-browser-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "n") #'sesman-browser-vertical-next) + (define-key map (kbd "p") #'sesman-browser-vertical-prev) + (define-key map (kbd "f") #'sesman-browser-forward) + (define-key map (kbd "b") #'sesman-browser-backward) + (define-key map [remap forward-paragraph] #'sesman-browser-session-next) + (define-key map [remap backward-paragraph] #'sesman-browser-session-prev) + (define-key map (kbd "C-M-n") #'sesman-browser-session-next) + (define-key map (kbd "C-M-p") #'sesman-browser-session-prev) + (define-key map (kbd "") #'sesman-browser-forward) + (define-key map (kbd "") #'sesman-browser-backward) + (define-key map (kbd "") #'sesman-goto) + (define-key map (kbd "o") #'sesman-show) + (define-key map (kbd "t") #'sesman-browser-toggle-sort) + (define-key map (kbd "S") #'sesman-browser-toggle-sort) + (define-key map (kbd "l b") #'sesman-browser-link-with-buffer) + (define-key map (kbd "l d") #'sesman-browser-link-with-directory) + (define-key map (kbd "l p") #'sesman-browser-link-with-project) + (define-key map (kbd "u") #'sesman-browser-unlink) + (define-key map (kbd "s") 'sesman-browser-map) + (define-key map (kbd "C-c C-s") 'sesman-browser-map) + (easy-menu-define sesman-browser-mode-map map + "Sesman Browser" + '("SesmanBrowser" + ["Next row" sesman-browser-vertical-next] + ["Previous row" sesman-browser-vertical-prev] + ["Next button" sesman-browser-forward] + ["Previous button" sesman-browser-backward] + ["Next session" sesman-browser-session-next] + ["Previous session" sesman-browser-session-prev] + "--" + ["Goto buffer" sesman-goto] + ["Show buffer" sesman-show] + "--" + ["Link with Buffer" sesman-browser-link-with-buffer] + ["Link with Directory" sesman-browser-link-with-directory] + ["Link with Project" sesman-browser-link-with-project] + ["Unlink" sesman-browser-unlink] + "--" + ["Toggle sort" sesman-browser-toggle-sort] + ["Refresh View" revert-buffer])) + map) + "Local keymap in `sesman-browser-mode'.") + + +;;; Utilities + +(defun sesman-browser--closeby-pos (prop lax) + (or (when (get-text-property (point) prop) + (point)) + (when (and (not (bobp)) + (get-text-property (1- (point)) prop)) + (1- (point))) + (when lax + (let ((next (save-excursion + (and + (goto-char (next-single-char-property-change (point) prop)) + (get-text-property (point) prop) + (point)))) + (prev (save-excursion + (and + (goto-char (previous-single-char-property-change (point) prop)) + (not (bobp)) + (get-text-property (1- (point)) prop) + (1- (point)))))) + (if next + (if prev + (if (< (- (point) prev) (- next (point))) + prev + next) + next) + prev))))) + +(defun sesman-browser--closeby-value (prop lax) + (when-let ((pos (sesman-browser--closeby-pos prop lax))) + (get-text-property pos prop))) + +(defun sesman-browser-get (what &optional no-error lax) + "Get value of the property WHAT at point. +If NO-ERROR is non-nil, don't throw an error if no value has been found and +return nil. If LAX is non-nil, search nearby and return the closest value." + (when (derived-mode-p 'sesman-browser-mode) + (or (let ((prop (pcase what + ('session :sesman-session) + ('link :sesman-link) + ('object :sesman-object) + (_ what)))) + (sesman-browser--closeby-value prop 'lax)) + (unless no-error + (user-error "No %s %s" what (if lax "nearby" "at point")))))) + + +;;; Navigation + +(defvar-local sesman-browser--section-overlay nil) +(defvar-local sesman-browser--stop-overlay nil) + +(when (fboundp 'define-fringe-bitmap) + (define-fringe-bitmap 'sesman-left-bar + [#b00001100] nil nil '(top t))) + +(defun sesman-browser--next (prop) + (let ((pos (point))) + (goto-char (previous-single-char-property-change (point) prop)) + (unless (get-text-property (point) prop) + (goto-char (previous-single-char-property-change (point) prop))) + (when (bobp) + (goto-char pos)))) + +(defun sesman-browser--prev (prop) + (let ((pos (point))) + (goto-char (next-single-char-property-change (point) prop)) + (unless (get-text-property (point) prop) + (goto-char (next-single-char-property-change (point) prop))) + (when (eobp) + (goto-char pos)))) + +(defun sesman-browser-forward () + "Go to next button." + (interactive) + (sesman-browser--prev :sesman-stop)) + +(defun sesman-browser-backward () + "Go to previous button." + (interactive) + (sesman-browser--next :sesman-stop)) + +(defun sesman-browser-vertical-next () + "Go to next button section or row." + (interactive) + (sesman-browser--prev :sesman-vertical-stop)) + +(defun sesman-browser-vertical-prev () + "Go to previous button section or row." + (interactive) + (sesman-browser--next :sesman-vertical-stop)) + +(defun sesman-browser-session-next () + "Go to next session." + (interactive) + (sesman-browser--prev :sesman-session-stop)) + +(defun sesman-browser-session-prev () + "Go to previous session." + (interactive) + (sesman-browser--next :sesman-session-stop)) + + +;;; Display + +(defun sesman-goto (&optional no-switch) + "Go to most relevant buffer for session at point. +If NO-SWITCH is non-nil, only display the buffer." + (interactive "P") + (let ((object (get-text-property (point) :sesman-object))) + (if (and object (bufferp object)) + (if no-switch + (display-buffer object) + (pop-to-buffer object)) + (let* ((session (sesman-browser-get 'session)) + (info (sesman-session-info (sesman--system) session)) + (buffers (or (plist-get info :buffers) + (let ((objects (plist-get info :objects))) + (seq-filter #'bufferp objects))))) + (if buffers + (let ((most-recent-buf (seq-find (lambda (b) + (member b buffers)) + (buffer-list)))) + (if no-switch + (display-buffer most-recent-buf) + (pop-to-buffer most-recent-buf))) + (user-error "Cannot jump to session %s; it doesn't contain any buffers" (car session))))))) + +(defun sesman-show () + "Show the most relevant buffer for the session at point." + (interactive) + (sesman-goto 'no-switch)) + +(defun sesman-browser--sensor-function (&rest _ignore) + (let ((beg (or (when (get-text-property (point) :sesman-stop) + (if (get-text-property (1- (point)) :sesman-stop) + (previous-single-char-property-change (point) :sesman-stop) + (point))) + (next-single-char-property-change (point) :sesman-stop))) + (end (next-single-char-property-change (point) :sesman-stop))) + (move-overlay sesman-browser--stop-overlay beg end) + (when window-system + (let ((beg (get-text-property (point) :sesman-fragment-beg)) + (end (get-text-property (point) :sesman-fragment-end))) + (when (and beg end) + (move-overlay sesman-browser--section-overlay beg end)))))) + + +;;; Sesman UI + +(defun sesman-browser-quit-session () + "Quite session at point." + (interactive) + (sesman-quit (sesman-browser-get 'session))) + +(defun sesman-browser-restart-session () + "Restart session at point." + (interactive) + (sesman-restart (sesman-browser-get 'session))) + +(defun sesman-browser-link-with-buffer () + "Ask for buffer to link session at point to." + (interactive) + (let ((session (sesman-browser-get 'session))) + (sesman-link-with-buffer 'ask session))) + +(defun sesman-browser-link-with-directory () + "Ask for directory to link session at point to." + (interactive) + (let ((session (sesman-browser-get 'session))) + (sesman-link-with-directory 'ask session))) + +(defun sesman-browser-link-with-project () + "Ask for project to link session at point to." + (interactive) + (let ((session (sesman-browser-get 'session))) + (sesman-link-with-project 'ask session))) + +(defun sesman-browser-unlink () + "Unlink the link at point or ask for link to unlink." + (interactive) + (if-let ((link (sesman-browser-get 'link 'no-error))) + (sesman--unlink link) + (if-let ((links (sesman-links (sesman--system) + (sesman-browser-get 'session)))) + (mapc #'sesman--unlink + (sesman--ask-for-link "Unlink: " links 'ask-all)) + (user-error "No links for session %s" (car (sesman-browser-get 'session))))) + (run-hooks 'sesman-post-command-hook)) + + +;;; Major Mode + +(defun sesman-browser-revert (&rest _ignore) + "Refresh current browser buffer." + (let ((pos (point))) + (sesman-browser) + ;; simple but not particularly reliable or useful + (goto-char (min pos (point-max))))) + +(defun sesman-browser-revert-all (system) + "Refresh all Sesman SYSTEM browsers." + (mapc (lambda (b) + (with-current-buffer b + (when (and (derived-mode-p 'sesman-browser-mode) + (eq system (sesman--system))) + (sesman-browser-revert)))) + (buffer-list))) + +(defun sesman-browser--goto-stop (stop-value) + (let ((search t)) + (goto-char (point-min)) + (while search + (goto-char (next-single-char-property-change (point) :sesman-stop)) + (if (eobp) + (progn (setq search nil) + (goto-char (next-single-char-property-change (point-min) :sesman-stop))) + (when (equal (get-text-property (point) :sesman-stop) stop-value) + (setq search nil)))))) + +(defun sesman-browser-toggle-sort () + "Toggle sorting of sessions. +See `sesman-browser-sort-type' for the default sorting type." + (interactive) + (when (eq sesman-browser-sort-type + (car sesman-browser--sort-types)) + (pop sesman-browser--sort-types)) + (unless sesman-browser--sort-types + (setq-local sesman-browser--sort-types (default-value 'sesman-browser--sort-types))) + (setq sesman-browser-sort-type (pop sesman-browser--sort-types)) + (let ((stop (sesman-browser-get :sesman-stop nil 'lax))) + (sesman-browser) + (sesman-browser--goto-stop stop) + (sesman-browser--sensor-function)) + (message "Sorted by %s" + (propertize (symbol-name sesman-browser-sort-type) 'face 'bold))) + +(define-derived-mode sesman-browser-mode special-mode "SesmanBrowser" + "Interactive view of Sesman sessions. +When applicable, system specific commands are locally bound to j when point is +on a session object." + ;; ensure there is a sesman-system here + (sesman--system) + (delete-all-overlays) + (setq-local sesman-browser--stop-overlay (make-overlay (point) (point))) + (overlay-put sesman-browser--stop-overlay 'face 'sesman-browser-highligh-face) + (setq-local sesman-browser--section-overlay (make-overlay (point) (point))) + (when window-system + (let* ((fringe-spec '(left-fringe sesman-left-bar sesman-browser-highligh-face)) + (dummy-string (propertize "|" 'display fringe-spec))) + (overlay-put sesman-browser--section-overlay 'line-prefix dummy-string))) + (add-hook 'sesman-post-command-hook 'sesman-browser-revert nil t) + (setq-local display-buffer-base-action '(nil . ((inhibit-same-window . t)))) + (setq-local sesman-browser--sort-types (default-value 'sesman-browser--sort-types)) + (setq-local revert-buffer-function #'sesman-browser-revert)) + +(defun sesman-browser--insert-session (system ses i) + (let ((ses-name (car ses)) + (head-template "%17s") + beg end) + (setq beg (point)) + + ;; session header + (insert (format "%3d: " i)) + (insert (propertize (car ses) + :sesman-stop ses-name + :sesman-vertical-stop t + :sesman-session-stop t + 'face 'bold + 'cursor-sensor-functions (list #'sesman-browser--sensor-function) + 'mouse-face 'highlight) + "\n") + + ;; links + (insert (format head-template "linked-to: ")) + (let ((link-groups (sesman-grouped-links system ses)) + (vert-stop)) + (dolist (grp link-groups) + (let* ((type (car grp))) + (dolist (link (cdr grp)) + (when (> (current-column) fill-column) + (insert "\n" (format head-template " ")) + (setq vert-stop nil)) + (let ((val (sesman--abbrev-path-maybe (sesman--lnk-value link)))) + (insert (propertize (sesman--format-context type val 'sesman-browser-button-face) + :sesman-stop (car link) + :sesman-vertical-stop (unless vert-stop (setq vert-stop t)) + :sesman-link link + 'cursor-sensor-functions (list #'sesman-browser--sensor-function) + 'mouse-face 'highlight))) + (insert " "))))) + (insert "\n") + + ;; objects + (insert (format head-template "objects: ")) + (let* ((info (sesman-session-info system ses)) + (map (plist-get info :map)) + (objects (plist-get info :objects)) + (strings (or (plist-get info :strings) + (mapcar (lambda (x) (format "%s" x)) objects))) + (kvals (seq-mapn #'cons objects strings)) + (kvals (seq-sort (lambda (a b) (string-lessp (cdr a) (cdr b))) + kvals)) + (vert-stop)) + (dolist (kv kvals) + (when (> (current-column) fill-column) + (insert "\n" (format head-template " ")) + (setq vert-stop nil)) + (let ((str (replace-regexp-in-string ses-name "%s" (cdr kv) nil t))) + (insert (propertize str + :sesman-stop str + :sesman-vertical-stop (unless vert-stop (setq vert-stop t)) + :sesman-object (car kv) + 'cursor-sensor-functions (list #'sesman-browser--sensor-function) + 'face 'sesman-browser-button-face + 'mouse-face 'highlight + 'help-echo "mouse-2: visit in other window" + 'keymap map) + " ")))) + + ;; session properties + (setq end (point)) + (put-text-property beg end :sesman-session ses) + (put-text-property beg end :sesman-session-name ses-name) + (put-text-property beg end :sesman-fragment-beg beg) + (put-text-property beg end :sesman-fragment-end end) + (insert "\n\n"))) + +;;;###autoload +(defun sesman-browser () + "Display an interactive session browser. +See `sesman-browser-mode' for more details." + (interactive) + (let* ((system (sesman--system)) + (pop-to (called-interactively-p 'any)) + (sessions (sesman-sessions system)) + (cur-session (when pop-to + (sesman-current-session 'CIDER))) + (buff (get-buffer-create (format "*sesman %s browser*" system)))) + (with-current-buffer buff + (setq-local sesman-system system) + (sesman-browser-mode) + (cursor-sensor-mode 1) + (let ((inhibit-read-only t) + (sessions (pcase sesman-browser-sort-type + ('name (seq-sort (lambda (a b) (string-greaterp (car b) (car a))) + sessions)) + ('relevance (sesman--sort-sessions system sessions)) + (_ (error "Invalid `sesman-browser-sort-type'")))) + (i 0)) + (erase-buffer) + (insert "\n ") + (insert (propertize (format "%s Sessions:" system) + 'face '(bold font-lock-keyword-face))) + (insert "\n\n") + (dolist (ses sessions) + (setq i (1+ i)) + (sesman-browser--insert-session system ses i)) + (when pop-to + (pop-to-buffer buff) + (sesman-browser--goto-stop (car cur-session))) + (sesman-browser--sensor-function))))) + +(provide 'sesman-browser) +;;; sesman-browser.el ends here diff --git a/elpa/sesman-20210901.1134/sesman-pkg.el b/elpa/sesman-20210901.1134/sesman-pkg.el new file mode 100644 index 00000000..28483f7d --- /dev/null +++ b/elpa/sesman-20210901.1134/sesman-pkg.el @@ -0,0 +1,14 @@ +(define-package "sesman" "20210901.1134" "Generic Session Manager" + '((emacs "25")) + :commit "e0f555f963c9f02f8e4a50e06fc353eb4c15ee77" :authors + '(("Vitalie Spinu")) + :maintainers + '(("Vitalie Spinu")) + :maintainer + '("Vitalie Spinu") + :keywords + '("process") + :url "https://github.com/vspinu/sesman") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/sesman-20210901.1134/sesman.el b/elpa/sesman-20210901.1134/sesman.el new file mode 100644 index 00000000..22bd3fe8 --- /dev/null +++ b/elpa/sesman-20210901.1134/sesman.el @@ -0,0 +1,1009 @@ +;;; sesman.el --- Generic Session Manager -*- lexical-binding: t -*- +;; +;; Copyright (C) 2018, Vitalie Spinu +;; Author: Vitalie Spinu +;; URL: https://github.com/vspinu/sesman +;; Keywords: process +;; Version: 0.3.3-DEV +;; 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 'seq) +(require 'subr-x) +(require 'vc) + +(defgroup sesman nil + "Generic Session Manager." + :prefix "sesman-" + :group 'tools + :link '(url-link :tag "GitHub" "https://github.com/vspinu/sesman")) + +(defface sesman-project-face + '((default (:inherit font-lock-doc-face))) + "Face used to mark projects." + :group 'sesman) + +(defface sesman-directory-face + '((default (:inherit font-lock-type-face))) + "Face used to mark directories." + :group 'sesman) + +(defface sesman-buffer-face + '((default (:inherit font-lock-preprocessor-face))) + "Face used to mark buffers." + :group 'sesman) + +(defcustom sesman-use-friendly-sessions t + "If non-nil consider friendly sessions when looking for current sessions. +The definition of friendly sessions is system dependent but usually means +sessions running in dependent projects." + :group 'sesman + :type 'boolean + :package-version '(sesman . "0.3.2")) + +(defcustom sesman-follow-symlinks 'vc + "When non-nil, follow symlinks during the file expansion. +When nil, don't follow symlinks. When 'vc, follow symlinks only when +`vc-follow-symlinks' is non-nil. When t, always follow symlinks." + :group 'sesman + :type '(choice (const :tag "Comply with `vc-follow-symlinks'" vc) + (const :tag "Don't follow symlinks" nil) + (const :tag "Follow symlinks" t)) + :package-version '(sesman . "0.3.3")) +(put 'sesman-follow-symlinks 'safe-local-variable (lambda (x) (memq x '(vc nil t)))) + +;; (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) + :package-version '(sesman . "0.1.0")) + +;; 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.") +(put 'sesman-system 'permanent-local 't) + + + +;; 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 'sort)) + ((or (equal which '(16)) (eq which 'all) (eq which t)) + (sesman--all-system-sessions system 'sort)) + ;; session itself + ((and (listp which) + (or (stringp (car which)) + (symbolp (car which)))) + (list which)) + ;; session name + ((or (stringp which) + (symbolp which) + (gethash (cons system which) sesman-sessions-hashmap))) + (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--least-specific-context (system) + (seq-some (lambda (ctype) + (when-let (val (sesman-context ctype system)) + (cons ctype val))) + (reverse (sesman-context-types system)))) + +(defun sesman--link-session-interactively (session cxt-type cxt-val) + (let ((system (sesman--system))) + (unless cxt-type + (let ((cxt (sesman--least-specific-context system))) + (setq cxt-type (car cxt) + cxt-val (cdr cxt)))) + (let ((cxt-name (symbol-name cxt-type))) + (if (member cxt-type (sesman-context-types system)) + (let ((session (or session + (sesman-ask-for-session + system + (format "Link with %s %s: " + cxt-name (sesman--abbrev-path-maybe + (sesman-context cxt-type system))) + (sesman--all-system-sessions system 'sort) + 'ask-new)))) + (sesman-link-session system session cxt-type cxt-val)) + (error (format "%s association not allowed for this system (%s)" + (capitalize cxt-name) + system)))))) + +;; FIXME: incorporate `sesman-abbreviate-paths' +(defun sesman--abbrev-path-maybe (obj) + (if (stringp obj) + (abbreviate-file-name obj) + obj)) + +(defun sesman--system-in-buffer (&optional buffer) + (with-current-buffer (or buffer (current-buffer)) + (if (functionp sesman-system) + (funcall sesman-system) + sesman-system))) + +(defun sesman-get-system () + (if sesman-system + (if (functionp sesman-system) + (funcall sesman-system) + sesman-system) + (error "No `sesman-system' in buffer `%s'" (current-buffer)))) + +(defalias 'sesman--system #'sesman-get-system) + +(defun sesman--linked-sessions (system &optional sort cxt-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) + (delete-dups + (mapcar (lambda (assoc) + (gethash (car assoc) sesman-sessions-hashmap)) + (sesman-current-links system nil sort cxt-types))))) + +(defun sesman--friendly-sessions (system &optional sort) + (let ((sessions (seq-filter (lambda (ses) (sesman-friendly-session-p system ses)) + (sesman--all-system-sessions system)))) + (if sort + (sesman--sort-sessions system sessions) + sessions))) + +(defun sesman--all-system-sessions (&optional system sort) + "Return a list of sessions registered with SYSTEM. +If SORT is non-nil, sort in relevance order." + (let ((system (or system (sesman--system))) + sessions) + (maphash + (lambda (k s) + (when (eql (car k) system) + (push s sessions))) + sesman-sessions-hashmap) + (if sort + (sesman--sort-sessions system sessions) + 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-session-objects (system session &optional sep) + (let ((info (sesman-session-info system session))) + (if (and (listp info) + (keywordp (car info))) + (let ((ses-name (car session)) + (sep (or sep " ")) + (strings (or (plist-get info :strings) + (mapcar (lambda (x) (format "%s" x)) + (plist-get info :objects))))) + (mapconcat (lambda (str) + (replace-regexp-in-string ses-name "..." str nil t)) + strings sep)) + (format "%s" info)))) + +(defun sesman--format-session (system ses &optional prefix) + (format (propertize "%s%s [%s] linked-to %s" 'face 'bold) + (or prefix "") + (propertize (car ses) 'face 'bold) + (propertize (sesman--format-session-objects system ses ", ") 'face 'italic) + (sesman-grouped-links system ses t t))) + +(defun sesman--format-link (link) + (let* ((system (sesman--lnk-system-name link)) + (session (gethash (car link) sesman-sessions-hashmap))) + (format "%s(%s) -> %s [%s]" + (sesman--lnk-context-type link) + (propertize (format "%s" (sesman--abbrev-path-maybe (sesman--lnk-value link))) + 'face 'bold) + (propertize (sesman--lnk-session-name link) 'face 'bold) + (if session + (sesman--format-session-objects system session) + "invalid")))) + +(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 + +(defun sesman-post-command-hook nil + "Normal hook ran after every state-changing Sesman command.") + +;;;###autoload +(defun sesman-start () + "Start a Sesman session." + (interactive) + (let ((system (sesman--system))) + (message "Starting new %s session ..." system) + (prog1 (sesman-start-session system) + (run-hooks 'sesman-post-command-hook)))) + +;;;###autoload +(defun sesman-restart (&optional which) + "Restart sesman session. +When WHICH is nil, restart the current session; when a single universal +argument or 'linked, restart all linked sessions; when a double universal +argument, t or 'all, restart all sessions. For programmatic use, WHICH can also +be a session or a name of the session, in which case that session is restarted." + (interactive "P") + (let* ((system (sesman--system)) + (sessions (sesman--on-C-u-u-sessions system which))) + (if (null sessions) + (message "No %s sessions found" system) + (with-temp-message (format "Restarting %s %s %s" system + (if (= 1 (length sessions)) "session" "sessions") + (mapcar #'car sessions)) + (mapc (lambda (s) + (sesman-restart-session system s)) + sessions)) + ;; restarting is not guaranteed to finish here, but what can we do? + (run-hooks 'sesman-post-command-hook)))) + +;;;###autoload +(defun sesman-quit (&optional which) + "Terminate a Sesman session. +When WHICH is nil, kill only the current session; when a single universal +argument or 'linked, kill all linked sessions; when a double universal argument, +t or 'all, kill all sessions. For programmatic use, WHICH can also be a session +or a name of the session, in which case that session is killed." + (interactive "P") + (let* ((system (sesman--system)) + (sessions (sesman--on-C-u-u-sessions system which))) + (if (null sessions) + (message "No %s sessions found" system) + (with-temp-message (format "Killing %s %s %s" system + (if (= 1 (length sessions)) "session" "sessions") + (mapcar #'car sessions)) + (mapc (lambda (s) + (sesman-unregister system s) + (sesman-quit-session system s)) + sessions)) + (run-hooks 'sesman-post-command-hook)))) + +;;;###autoload +(defun sesman-info (&optional all) + "Display info for all current sessions (`sesman-current-sessions'). +In the resulting minibuffer display linked sessions are numbered and the +other (friendly) sessions are not. When ALL is non-nil, show info for all +sessions." + (interactive "P") + (let* ((system (sesman--system)) + (i 1) + (sessions (if all + (sesman-sessions system t) + (sesman-current-sessions system))) + (empty-prefix (if (> (length sessions) 1) " " ""))) + (if sessions + (message (mapconcat (lambda (ses) + (let ((prefix (if (sesman-relevant-session-p system ses) + (prog1 (format "%d " i) + (setq i (1+ i))) + empty-prefix))) + (sesman--format-session system ses prefix))) + sessions + "\n")) + (message "No %s%s sessions" + (if all "" "current ") + system)))) + +;;;###autoload +(defun sesman-link-with-buffer (&optional buffer session) + "Ask for SESSION and link with BUFFER. +BUFFER defaults to current buffer. On universal argument, or if BUFFER is 'ask, +ask for buffer." + (interactive "P") + (let ((buf (if (or (eq buffer 'ask) + (equal buffer '(4))) + (let ((this-system (sesman--system))) + (read-buffer "Link buffer: " (current-buffer) t + (lambda (buf-cons) + (equal this-system + (sesman--system-in-buffer (cdr buf-cons)))))) + (or buffer (current-buffer))))) + (sesman--link-session-interactively session 'buffer buf))) + +;;;###autoload +(defun sesman-link-with-directory (&optional dir session) + "Ask for SESSION and link with DIR. +DIR defaults to `default-directory'. On universal argument, or if DIR is 'ask, +ask for directory." + (interactive "P") + (let ((dir (if (or (eq dir 'ask) + (equal dir '(4))) + (read-directory-name "Link directory: ") + (or dir default-directory)))) + (sesman--link-session-interactively session 'directory dir))) + +;;;###autoload +(defun sesman-link-with-project (&optional project session) + "Ask for SESSION and link with PROJECT. +PROJECT defaults to current project. On universal argument, or if PROJECT is +'ask, ask for the project. SESSION defaults to the current session." + (interactive "P") + (let* ((system (sesman--system)) + (project (expand-file-name + (if (or (eq project 'ask) + (equal project '(4))) + ;; FIXME: should be a completion over all known projects for this system + (read-directory-name "Project: " (sesman-project system)) + (or project (sesman-project system)))))) + (sesman--link-session-interactively session 'project project))) + +;;;###autoload +(defun sesman-link-with-least-specific (&optional session) + "Ask for SESSION and link with the least specific context available. +Normally the least specific context is the project. If not in a project, link +with the `default-directory'. If `default-directory' is nil, link with current +buffer." + (interactive "P") + (sesman--link-session-interactively session nil nil)) + +;;;###autoload +(defun sesman-unlink (&optional links) + "Break sesman LINKS. +If LINKS is nil, ask interactively for a link. With a prefix argument break all +links." + (interactive) + (mapc #'sesman--unlink (or (when current-prefix-arg + (sesman-current-links (sesman--system))) + links + (sesman--ask-for-link "Unlink: " + (or (sesman-current-links (sesman--system)) + (user-error "No %s links found" (sesman--system))) + 'ask-all))) + (run-hooks 'sesman-post-command-hook)) + +(declare-function sesman-browser "sesman-browser") +;;;###autoload (autoload 'sesman-map "sesman" "Session management prefix keymap." t 'keymap) +(defvar sesman-map + (let (sesman-map) + (define-prefix-command 'sesman-map) + (define-key sesman-map (kbd "C-i") #'sesman-info) + (define-key sesman-map (kbd "i") #'sesman-info) + (define-key sesman-map (kbd "C-w") #'sesman-browser) + (define-key sesman-map (kbd "w") #'sesman-browser) + (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-l") #'sesman-link-with-least-specific) + (define-key sesman-map (kbd "l") #'sesman-link-with-least-specific) + (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-info] + "--" + ["Start" sesman-start] + ["Restart" sesman-restart :active (sesman-current-session (sesman--system))] + ["Quit" sesman-quit :active (sesman-current-session (sesman--system))] + "--" + ["Link with Buffer" sesman-link-with-buffer :active (sesman-current-session (sesman--system))] + ["Link with Directory" sesman-link-with-directory :active (sesman-current-session (sesman--system))] + ["Link with Project" sesman-link-with-project :active (sesman-current-session (sesman--system))] + ["Unlink" sesman-unlink :active (sesman-current-session (sesman--system))] + "--" + ["Browser" sesman-browser :active (sesman-current-session (sesman--system))]) + "Sesman Menu.") + +(defun sesman-install-menu (map) + "Install `sesman-menu' into MAP." + (easy-menu-do-define 'sesman-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) + "Return a plist with :objects key containing user \"visible\" objects. +Optional :strings value is a list of string representations of objects. Optional +:map key is a local keymap to place on every object in the session browser. +Optional :buffers is a list of buffers which will be used for navigation from +the session browser. If :buffers is missing, buffers from :objects are used +instead." + (list :objects (cdr session))) + +(cl-defgeneric sesman-project (_system) + "Retrieve project root in current directory (`default-directory') for SYSTEM. +Return a string or nil if no project has been found." + nil) + +(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-recent-p' utility in this method." + (not (string-greaterp (car session1) (car session2)))) + +(cl-defgeneric sesman-friendly-session-p (_system _session) + "Return non-nil if SESSION is a friendly session in current context. +The \"friendship\" is system dependent but usually means sessions running in +dependent projects. Unless SYSTEM has defined a method for this generic, there +are no friendly sessions." + nil) + +(cl-defgeneric sesman-context-types (_system) + "Return a list of context types understood by SYSTEM. +Contexts must be sorted from most specific to least specific." + '(buffer directory project)) + + +;;; 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 &optional sort type cxt-types) + "Return a list of sessions registered with SYSTEM. +When TYPE is either 'all or nil return all sessions registered with the SYSTEM, +when 'linked, only linked to the current context sessions, when 'friendly - only +friendly sessions. If SORT is non-nil, sessions are sorted in the relevance +order with linked sessions leading the list. CXT-TYPES is a list of context +types to consider for linked sessions." + (let ((system (or system (sesman--system)))) + (cond + ((eq type 'linked) + (sesman--linked-sessions system sort cxt-types)) + ((eq type 'friendly) + (sesman--friendly-sessions system sort)) + ((memq type '(all nil)) + (if sort + (delete-dups + (append (sesman--linked-sessions system 'sort cxt-types) + (sesman--all-system-sessions system 'sort))) + (sesman--all-system-sessions system))) + (t (error "Invalid session TYPE argument %s" type))))) + +(defun sesman-current-sessions (system &optional cxt-types) + "Return a list of SYSTEM sessions active in the current context. +Sessions are ordered by the relevance order and linked sessions come first. If +`sesman-use-friendly-sessions' current sessions consist of linked and friendly +sessions, otherwise only of linked sessions. CXT-TYPES is a list of context +types to consider. Defaults to the list returned from `sesman-context-types'." + (if sesman-use-friendly-sessions + (delete-dups + (append (sesman--linked-sessions system 'sort cxt-types) + (sesman--friendly-sessions system 'sort))) + (sesman--linked-sessions system 'sort cxt-types))) + +(defun sesman-current-session (system &optional cxt-types) + "Get the most relevant current session for the SYSTEM. +CXT-TYPES is a list of context types to consider." + (or (car (sesman--linked-sessions system 'sort cxt-types)) + (car (sesman--friendly-sessions system 'sort)))) + +(defun sesman-ensure-session (system &optional cxt-types) + "Get the most relevant linked session for SYSTEM or throw if none exists. +CXT-TYPES is a list of context types to consider." + (or (sesman-current-session system cxt-types) + (user-error "No linked %s 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)))))) + +(defvar sesman--cxt-abbrevs '(buffer "buf" project "proj" directory "dir")) +(defun sesman--format-context (cxt-type cxt-val extra-face) + (let* ((face (intern (format "sesman-%s-face" cxt-type))) + (short-type (propertize (or (plist-get sesman--cxt-abbrevs cxt-type) + (symbol-value cxt-type)) + 'face (list (if (facep face) + face + 'font-lock-function-name-face) + extra-face)))) + (concat short-type + (propertize (format "(%s)" cxt-val) + 'face extra-face)))) + +(defun sesman-grouped-links (system session &optional current-first as-string) + "Retrieve all links for SYSTEM's SESSION from the global `sesman-links-alist'. +Return an alist of the form + + ((buffer buffers..) + (directory directories...) + (project projects...)). + +When `CURRENT-FIRST' is non-nil, a cons of two lists as above is returned with +car containing links relevant in current context and cdr all other links. 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))) + (out-rel (when current-first + (copy-alist out)))) + (mapc (lambda (link) + (let* ((type (sesman--lnk-context-type link)) + (entry (if (and current-first + (sesman-relevant-link-p link)) + (assoc type out-rel) + (assoc type out)))) + (when entry + (setcdr entry (cons link (cdr entry)))))) + links) + (let ((out (delq nil (mapcar (lambda (el) (and (cdr el) el)) out))) + (out-rel (delq nil (mapcar (lambda (el) (and (cdr el) el)) out-rel)))) + (if as-string + (let ((fmt-fn (lambda (typed-links) + (let* ((type (car typed-links))) + (mapconcat (lambda (lnk) + (let ((val (sesman--abbrev-path-maybe + (sesman--lnk-value lnk)))) + (sesman--format-context type val 'italic))) + (cdr typed-links) + ", "))))) + (if out-rel + (concat (mapconcat fmt-fn out-rel ", ") + (when out " | ") + (mapconcat fmt-fn out ", ")) + (mapconcat fmt-fn out ", "))) + (if current-first + (cons out-rel out) + out))))) + +(defun sesman-link-session (system session &optional cxt-type cxt-val) + "Link SYSTEM's SESSION to context give by CXT-TYPE and CXT-VAL. +If CXT-TYPE is nil, use the least specific type available in the current +context. If CXT-TYPE is non-nil, and CXT-VAL is not given, retrieve it with +`sesman-context'. See also `sesman-link-with-project', +`sesman-link-with-directory' and `sesman-link-with-buffer'." + (let* ((ses-name (or (car-safe session) + (error "SESSION must be a headed list"))) + (cxt-val (or cxt-val + (or (if cxt-type + (sesman-context cxt-type system) + (let ((cxt (sesman--least-specific-context system))) + (setq cxt-type (car cxt)) + (cdr cxt))) + (error "No local context of type %s" cxt-type)))) + (cxt-val (if (stringp cxt-val) + (expand-file-name cxt-val) + cxt-val)) + (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)))) + (run-hooks 'sesman-post-command-hook) + link)) + +(defun sesman-links (system &optional session-or-name cxt-types sort) + "Retrieve all links for SYSTEM, SESSION-OR-NAME and CXT-TYPES. +SESSION-OR-NAME can be either a session or a name of the session. If SORT is +non-nil links are sorted in relevance order and `sesman-current-links' lead the +list, otherwise links are returned in the creation order." + (let* ((ses-name (if (listp session-or-name) + (car session-or-name) + session-or-name)) + (lfn (sesman--link-lookup-fn system ses-name cxt-types))) + (if sort + (delete-dups (append + (sesman-current-links system ses-name) + (sesman--sort-links system (seq-filter lfn sesman-links-alist)))) + (seq-filter lfn sesman-links-alist)))) + +(defun sesman-current-links (system &optional session-or-name sort cxt-types) + "Retrieve all active links in current context for SYSTEM and SESSION-OR-NAME. +SESSION-OR-NAME can be either a session or a name of the session. CXT-TYPES is a +list of context types to consider. Returned links are a subset of +`sesman-links-alist' sorted in order of relevance if SORT is non-nil." + ;; mapcan is a built-in in 26.1; don't want to require cl-lib for one function + (let ((ses-name (if (listp session-or-name) + (car session-or-name) + session-or-name))) + (seq-mapcat + (lambda (cxt-type) + (let* ((lfn (sesman--link-lookup-fn system ses-name cxt-type)) + (links (seq-filter (lambda (l) + (and (funcall lfn l) + (sesman-relevant-context-p cxt-type (sesman--lnk-value l)))) + sesman-links-alist))) + (if sort + (sesman--sort-links system links) + links))) + (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) + i (1+ 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))))) + +;; path caching because file-truename is very slow +(defvar sesman--path-cache (make-hash-table :test #'equal)) +(defun sesman-expand-path (path) + "Expand PATH with optionally follow symlinks. +Whether symlinks are followed is controlled by `sesman-follow-symlinks' custom +variable. Always return the expansion without the trailing directory slash." + (directory-file-name + (if sesman-follow-symlinks + (let ((true-name (or (gethash path sesman--path-cache) + (puthash path (file-truename path) sesman--path-cache)))) + (if (or (eq sesman-follow-symlinks t) + vc-follow-symlinks) + true-name + ;; sesman-follow-symlinks is 'vc but vc-follow-symlinks is nil + (expand-file-name path))) + (expand-file-name path)))) + + +;;; Contexts + +(cl-defgeneric sesman-context (_cxt-type _system) + "Given SYSTEM and context type CXT-TYPE return the context.") +(cl-defmethod sesman-context ((_cxt-type (eql buffer)) _system) + "Return current buffer." + (current-buffer)) +(cl-defmethod sesman-context ((_cxt-type (eql directory)) _system) + "Return current directory." + (sesman-expand-path default-directory)) +(cl-defmethod sesman-context ((_cxt-type (eql project)) system) + "Return current project." + (let* ((default-directory (sesman-expand-path default-directory)) + (proj (or + (sesman-project (or system (sesman--system))) + ;; Normally we would use (project-roots (project-current)) but currently + ;; project-roots fails on nil and doesn't work on custom `('foo . + ;; "path/to/project"). So, use vc as a fallback and don't use project.el at + ;; all for now. + ;; NB: `vc-root-dir' doesn't work from symlinked files. Emacs Bug? + (vc-root-dir)))) + (when proj + (expand-file-name proj)))) + +(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 "^" (sesman-expand-path dir)) + (sesman-expand-path default-directory)))) +(cl-defmethod sesman-relevant-context-p ((_cxt-type (eql project)) proj) + "Non-nil if PROJ is the parent or equal to the `default-directory'." + (when (and proj default-directory) + (string-match-p (concat "^" (sesman-expand-path proj)) + (sesman-expand-path default-directory)))) + +(defun sesman-relevant-link-p (link &optional cxt-types) + "Return non-nil if LINK is relevant to the current context. +If CXT-TYPES is non-nil, only check relevance for those contexts." + (when (or (null cxt-types) + (member (sesman--lnk-context-type link) cxt-types)) + (sesman-relevant-context-p + (sesman--lnk-context-type link) + (sesman--lnk-value link)))) + +(defun sesman-relevant-session-p (system session &optional cxt-types) + "Return non-nil if SYSTEM's SESSION is relevant to the current context. +If CXT-TYPES is non-nil, only check relevance for those contexts." + (seq-some #'sesman-relevant-link-p + (sesman-links system session cxt-types))) + +(define-obsolete-function-alias 'sesman-linked-sessions 'sesman--linked-sessions "v0.3.2") + +(provide 'sesman) + +;;; sesman.el ends here