about summary refs log tree commit diff
path: root/configs/shared/emacs/.emacs.d/elpa/sesman-20180903.1826/sesman-browser.el
diff options
context:
space:
mode:
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/sesman-20180903.1826/sesman-browser.el')
-rw-r--r--configs/shared/emacs/.emacs.d/elpa/sesman-20180903.1826/sesman-browser.el461
1 files changed, 0 insertions, 461 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/sesman-20180903.1826/sesman-browser.el b/configs/shared/emacs/.emacs.d/elpa/sesman-20180903.1826/sesman-browser.el
deleted file mode 100644
index e9cccb00ef54..000000000000
--- a/configs/shared/emacs/.emacs.d/elpa/sesman-20180903.1826/sesman-browser.el
+++ /dev/null
@@ -1,461 +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 ((sesman-browser-mode-map (make-sparse-keymap)))
-    (define-key sesman-browser-mode-map (kbd "n") #'sesman-browser-vertical-next)
-    (define-key sesman-browser-mode-map (kbd "p") #'sesman-browser-vertical-prev)
-    (define-key sesman-browser-mode-map (kbd "f") #'sesman-browser-forward)
-    (define-key sesman-browser-mode-map (kbd "b") #'sesman-browser-backward)
-    (define-key sesman-browser-mode-map [remap forward-paragraph] #'sesman-browser-session-next)
-    (define-key sesman-browser-mode-map [remap backward-paragraph] #'sesman-browser-session-prev)
-    (define-key sesman-browser-mode-map (kbd "C-M-n") #'sesman-browser-session-next)
-    (define-key sesman-browser-mode-map (kbd "C-M-p") #'sesman-browser-session-prev)
-    (define-key sesman-browser-mode-map (kbd "<tab>") #'sesman-browser-forward)
-    (define-key sesman-browser-mode-map (kbd "<backtab>") #'sesman-browser-backward)
-    (define-key sesman-browser-mode-map (kbd "<RET>") #'sesman-goto)
-    (define-key sesman-browser-mode-map (kbd "o") #'sesman-show)
-    (define-key sesman-browser-mode-map (kbd "t") #'sesman-browser-toggle-sort)
-    (define-key sesman-browser-mode-map (kbd "S") #'sesman-browser-toggle-sort)
-    (define-key sesman-browser-mode-map (kbd "l b") #'sesman-browser-link-with-buffer)
-    (define-key sesman-browser-mode-map (kbd "l d") #'sesman-browser-link-with-directory)
-    (define-key sesman-browser-mode-map (kbd "l p") #'sesman-browser-link-with-project)
-    (define-key sesman-browser-mode-map (kbd "u") #'sesman-browser-unlink)
-    (define-key sesman-browser-mode-map (kbd "s") 'sesman-browser-map)
-    (define-key sesman-browser-mode-map (kbd "C-c C-s") 'sesman-browser-map)
-    sesman-browser-mode-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
-      (when-let* ((beg (get-text-property (point) :sesman-fragment-beg))
-                  (end (get-text-property (point) :sesman-fragment-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