;;; my-quick-access.el --- Workspace bookmarks and recent buffers -*- lexical-binding: t; -*- (require 'cl-lib) (require 'subr-x) (require 'seq) (require 'bookmark) (require 'persp-mode) (defgroup my/quick-access nil "Quick access to workspace bookmarks and buffers." :group 'convenience) (defcustom my/quick-access-recent-count 5 "Maximum number of recently visited buffers shown in the popup." :type 'natnum :group 'my/quick-access) (defface my/quick-access-title '((t (:inherit mode-line-buffer-id :weight normal))) "Theme accent for popup titles and selection keys." :group 'my/quick-access) (defcustom my/quick-access-selection-keys '("f" "j" "d" "k" "g" "h") "Distinct single-letter keys for recent buffers and ambiguous initials; use at least two." :type '(repeat string) :group 'my/quick-access) (defcustom my/quick-access-max-height 0.48 "Maximum popup height as a fraction of the frame height." :type '(float :tag "Frame height fraction") :group 'my/quick-access) (defcustom my/quick-access-page-size 6 "Maximum entries per page; small frames show fewer to keep the footer visible." :type 'natnum :group 'my/quick-access) (defconst my/quick-access--buffer-name " *Workspace Quick Access*") (defvar my/quick-access--history (make-hash-table :test #'eq :weakness 'key)) (defvar my/quick-access--hidden (make-hash-table :test #'eq :weakness 'key) "Buffers hidden from quick access per workspace during this session.") (defvar my/quick-access--last-visit nil) (defvar my/quick-access--active nil) (defun my/quick-access--eligible-p (buffer) "Whether BUFFER is a live, user-visible buffer." (and (buffer-live-p buffer) (not (minibufferp buffer)) (not (string-prefix-p " " (buffer-name buffer))))) (defun my/quick-access--track () "Remember visits independently for each workspace." (when (and (bound-and-true-p persp-mode) (not my/quick-access--active) (not (active-minibuffer-window))) (let* ((persp (get-current-persp)) (buffer (window-buffer (selected-window))) (visit (cons persp buffer))) (unless (and (eq persp (car my/quick-access--last-visit)) (eq buffer (cdr my/quick-access--last-visit))) (setq my/quick-access--last-visit visit) (when (and (my/quick-access--eligible-p buffer) (memq buffer (safe-persp-buffers persp))) (puthash persp (cons buffer (cl-remove-if (lambda (old) (or (eq old buffer) (not (buffer-live-p old)))) (gethash persp my/quick-access--history))) my/quick-access--history)))))) (defun my/quick-access--buffers (persp current) "Return live buffers of PERSP in visit order, excluding CURRENT. The frame's buffer order seeds history for buffers not visited since loading." (let ((members (safe-persp-buffers persp)) (hidden (cl-remove-if-not #'buffer-live-p (gethash persp my/quick-access--hidden)))) (puthash persp hidden my/quick-access--hidden) (cl-remove-if-not (lambda (buffer) (and (not (eq buffer current)) (not (memq buffer hidden)) (my/quick-access--eligible-p buffer) (memq buffer members))) (delete-dups (append (gethash persp my/quick-access--history) (buffer-list (selected-frame))))))) (defun my/quick-access--scope-record (args) "Tag stored bookmark ARGS before the bookmark library saves them. Existing assignments are retained when a shared bookmark is updated." (if (not (bound-and-true-p persp-mode)) args (pcase-let ((`(,name ,record ,no-overwrite) args)) (bookmark-maybe-load-default-file) (let* ((old (and (not no-overwrite) (assoc name bookmark-alist))) (scopes (delete-dups (cons (safe-persp-name (get-current-persp)) (append (alist-get 'my/quick-access-workspaces record) (and old (bookmark-prop-get old 'my/quick-access-workspaces))))))) (list name (cons (cons 'my/quick-access-workspaces scopes) (assq-delete-all 'my/quick-access-workspaces (copy-tree record))) no-overwrite))))) (defun my/quick-access--renamed (original new-name &rest args) "Keep bookmark assignments when ORIGINAL renames a workspace to NEW-NAME." (bookmark-maybe-load-default-file) (let ((old-name (apply original new-name args)) changed) (when old-name (dolist (record bookmark-alist) (let ((scopes (bookmark-prop-get record 'my/quick-access-workspaces))) (when (member old-name scopes) (bookmark-prop-set record 'my/quick-access-workspaces (delete-dups (cons new-name (remove old-name scopes)))) (setq changed t)))) (when changed (cl-incf bookmark-alist-modification-count) (bookmark-save))) old-name)) (defun my/quick-access--bookmarks (workspace) "Return bookmark records explicitly assigned to WORKSPACE." (bookmark-maybe-load-default-file) (cl-remove-if-not (lambda (record) (member workspace (bookmark-prop-get record 'my/quick-access-workspaces))) (copy-sequence bookmark-alist))) (defun my/quick-access--add-bookmark (workspace) "Assign an existing bookmark to WORKSPACE without moving or copying it." (bookmark-maybe-load-default-file) (unless bookmark-alist (user-error "No existing bookmarks; use C-s to save one")) (let* ((name (completing-read "Add bookmark to workspace: " (bookmark-all-names) nil t)) (record (bookmark-get-bookmark name)) (scopes (bookmark-prop-get record 'my/quick-access-workspaces))) (unless (member workspace scopes) (bookmark-prop-set record 'my/quick-access-workspaces (cons workspace scopes)) (cl-incf bookmark-alist-modification-count) (bookmark-save)))) (defun my/quick-access--remove (item persp workspace) "Remove ITEM from quick access in PERSP, named WORKSPACE. Buffers remain live and workspace members; bookmarks retain other assignments." (if (bufferp item) (when (buffer-live-p item) (puthash persp (cons item (delq item (cl-remove-if-not #'buffer-live-p (gethash persp my/quick-access--hidden)))) my/quick-access--hidden)) (let ((scopes (bookmark-prop-get item 'my/quick-access-workspaces))) (when (member workspace scopes) (bookmark-prop-set item 'my/quick-access-workspaces (remove workspace scopes)) (cl-incf bookmark-alist-modification-count) (bookmark-save))))) (defun my/quick-access-restore-buffers () "Restore all buffers hidden from quick access in the current workspace." (interactive) (remhash (get-current-persp) my/quick-access--hidden) (message "Hidden buffers restored for %s" (safe-persp-name (get-current-persp)))) (defun my/quick-access--label (item) "Return the display name of bookmark or buffer ITEM." (if (bufferp item) (buffer-name item) (car item))) (defun my/quick-access--detail (item) "Return a compact target description without accessing the filesystem." (let ((file (if (bufferp item) (buffer-local-value 'buffer-file-name item) (bookmark-get-filename item)))) (if (and (stringp file) (not (equal file ""))) (abbreviate-file-name file) (if (bufferp item) (with-current-buffer item (abbreviate-file-name default-directory)) (or (bookmark-prop-get item 'buffer-name) ""))))) (defun my/quick-access--initial (item) "Return ITEM's first letter, ignoring punctuation and leading stars." (let ((name (my/quick-access--label item))) (if (string-match "[[:alnum:]]" name) (downcase (match-string 0 name)) "?"))) (defun my/quick-access--codes (count) "Return COUNT prefix-free labels made from comfortable letter keys." (unless (and (>= (length my/quick-access-selection-keys) 2) (cl-every (lambda (key) (and (stringp key) (string-match-p "\\`[a-z]\\'" key))) my/quick-access-selection-keys) (= (length my/quick-access-selection-keys) (length (delete-dups (copy-sequence my/quick-access-selection-keys))))) (user-error "Selection keys must contain at least two distinct lowercase letters")) (let ((codes (copy-sequence my/quick-access-selection-keys))) (while (< (length codes) count) (let* ((shortest (apply #'min (mapcar #'length codes))) (index (cl-position shortest codes :key #'length :from-end t)) (prefix (nth index codes))) (setq codes (append (cl-subseq codes 0 index) (mapcar (lambda (key) (concat prefix key)) my/quick-access-selection-keys) (nthcdr (1+ index) codes))))) (cl-subseq codes 0 count))) (defun my/quick-access--entries (items home prefix) "Label ITEMS using HOME keys or initials; filter HOME labels by PREFIX." (let ((codes (and home (my/quick-access--codes (length items))))) (cl-loop for item in items for index from 0 for code = (if home (nth index codes) (my/quick-access--initial item)) when (or (not home) (string-prefix-p prefix code)) collect (cons code item)))) (defun my/quick-access--clean-text (text) "Keep TEXT on one display line and remove embedded text properties." (replace-regexp-in-string "[\n\r\t]" " " (substring-no-properties text))) (defun my/quick-access--render (buffer window workspace source entries page size prefix group &optional removing) "Draw ENTRIES in BUFFER and WINDOW, indicating REMOVING when active." (let* ((pages (max 1 (ceiling (length entries) size))) (page (min page (1- pages))) (visible (seq-subseq entries (min (* page size) (length entries)) (min (* (1+ page) size) (length entries))))) (with-current-buffer buffer (let ((inhibit-read-only t) (width (max 20 (- (window-body-width window) 4)))) (erase-buffer) (insert " " (propertize (if removing (if (eq source 'bookmarks) "Remove bookmark" "Hide recent buffer") (if (eq source 'bookmarks) "Bookmarks" "Recent buffers")) 'face 'my/quick-access-title) " " (propertize (my/quick-access--clean-text workspace) 'face 'shadow)) (when group (insert (format " / %s%s" group prefix))) (when (> pages 1) (insert (propertize (format " (%d/%d)" (1+ page) pages) 'face 'shadow))) (insert "\n\n") (if (null entries) (insert " " (propertize (if (eq source 'bookmarks) "No bookmarks yet. C-s: save current location; C-i: add existing." "No other recent buffers in this workspace.") 'face 'shadow) "\n") (dolist (entry visible) (let* ((item (cdr entry)) (key (substring (car entry) (length prefix))) (start (point))) (insert " " (propertize (format "%-3s" key) 'face 'my/quick-access-title) (truncate-string-to-width (my/quick-access--clean-text (my/quick-access--label item)) (- width 3) nil nil "…") "\n" " " (propertize (truncate-string-to-width (my/quick-access--clean-text (my/quick-access--detail item)) (- width 3) nil nil "…") 'face 'shadow) "\n") (add-text-properties start (point) `(my/quick-access-item ,item mouse-face highlight))))) (insert "\n " (propertize (concat (if (eq source 'bookmarks) "SPC Recent buffers" "SPC Bookmarks") (if removing " C-d Cancel removal" " C-d Remove") " C-f Search Esc Close") 'face 'shadow) "\n " (propertize (concat "C-s Save bookmark C-i Add existing" (when group " Backspace Back") (when (> pages 1) " C-j/C-k Page")) 'face 'shadow) "\n") (goto-char (point-min)))) (set-window-start window 1) (fit-window-to-buffer window (max 6 (floor (* my/quick-access-max-height (frame-height)))) 5) page)) (defun my/quick-access--search (items &optional prompt) "Read an ITEM through the user's existing completion interface." (unless items (user-error "No entries in this workspace")) (let* ((table (cl-loop for item in items for index from 1 collect (cons (format "%s — %s <%d>" (my/quick-access--label item) (my/quick-access--detail item) index) item))) (choice (completing-read (or prompt "Open: ") table nil t))) (cdr (assoc choice table)))) ;;;###autoload (defun my/quick-access () "Open workspace bookmarks; SPC toggles recent buffers. Select bookmarks by initial and resolve collisions with `my/quick-access-selection-keys'; recent buffers use those keys directly. C-f searches the current source, including all eligible workspace buffers from the recent view. C-s saves the original location; C-i assigns an existing bookmark. C-d toggles removal: select an entry to unassign its bookmark or hide its buffer in this workspace. The popup stays open after removal. Hidden buffers stay hidden for this session; `my/quick-access-restore-buffers' restores them. Escape or C-g closes the popup and restores the original window." (interactive) (when (or my/quick-access--active (active-minibuffer-window)) (user-error "Finish the current selection first")) (let* ((persp (get-current-persp)) (workspace (safe-persp-name persp)) (origin (selected-window)) (current (current-buffer)) (buffers (my/quick-access--buffers persp current)) (bookmarks (my/quick-access--bookmarks workspace)) (my/quick-access--active t) (source 'bookmarks) group (prefix "") (page 0) removing (size (max 1 (min my/quick-access-page-size (/ (- (floor (* my/quick-access-max-height (frame-height))) 7) 2)))) popup window selected (pick (lambda (item) (when item (if removing (progn (my/quick-access--remove item persp workspace) (if (bufferp item) (setq buffers (delq item buffers)) (setq bookmarks (delq item bookmarks))) (setq removing nil group nil prefix "" page 0)) (throw 'my/quick-access-done item)))))) (unwind-protect (progn (let ((persp-add-buffer-on-after-change-major-mode nil)) (setq popup (generate-new-buffer my/quick-access--buffer-name)) (with-current-buffer popup (special-mode) (setq-local header-line-format nil mode-line-format nil display-line-numbers nil cursor-type nil truncate-lines t show-trailing-whitespace nil))) (setq window (display-buffer-in-side-window popup `((side . bottom) (slot . 10) (window-height . ,my/quick-access-max-height) (window-parameters . ((no-other-window . t) (no-delete-other-windows . t)))))) (unless (window-live-p window) (user-error "Cannot display quick access")) (setq selected (catch 'my/quick-access-done (while (and (window-live-p window) (window-live-p origin)) (let* ((items (if (eq source 'bookmarks) (if group (cl-remove-if-not (lambda (item) (equal group (my/quick-access--initial item))) bookmarks) bookmarks) (seq-take buffers my/quick-access-recent-count))) (home (or group (eq source 'buffers))) (entries (my/quick-access--entries items home prefix))) (setq page (my/quick-access--render popup window workspace source entries page size prefix group removing)) (let ((event (read-key))) (cond ((memq event '(27 escape ?\C-g)) (throw 'my/quick-access-done nil)) ((eq event ?\C-d) (setq removing (not removing))) ((eq event ?\s) (setq source (if (eq source 'bookmarks) 'buffers 'bookmarks) group nil prefix "" page 0 removing nil)) ((eq event ?\M-b) (setq source 'bookmarks group nil prefix "" page 0 removing nil)) ((memq event '(backspace 127)) (if (string-empty-p prefix) (setq group nil) (setq prefix (substring prefix 0 -1))) (setq page 0)) ((memq event '(?\C-j ?\C-k)) (setq page (mod (+ page (if (eq event ?\C-j) 1 -1)) (max 1 (ceiling (length entries) size))))) ((memq event '(?\C-f ?/)) (condition-case err (funcall pick (my/quick-access--search (if (eq source 'bookmarks) bookmarks buffers) (when removing "Remove from quick access: "))) (quit nil) (user-error (message "%s" (cadr err))))) ((memq event '(?\C-s ?\C-i tab)) (condition-case err (progn (with-selected-window origin (if (eq event ?\C-s) (call-interactively #'bookmark-set) (my/quick-access--add-bookmark workspace))) (setq bookmarks (my/quick-access--bookmarks workspace) source 'bookmarks group nil prefix "" page 0 removing nil)) (quit nil) (user-error (message "%s" (cadr err))))) ((and (consp event) (eq (car event) 'mouse-1)) (let ((pos (event-start event))) (when (eq (posn-window pos) window) (when-let* ((point (posn-point pos)) ((integerp point)) (item (get-text-property point 'my/quick-access-item popup))) (funcall pick item))))) ((and (characterp event) (>= event 32)) (let* ((key (downcase (char-to-string event))) (code (concat prefix key)) (matches (cl-remove-if-not (lambda (entry) (if home (string-prefix-p code (car entry)) (equal key (car entry)))) entries))) (cond ((and home (assoc code matches)) (funcall pick (cdr (assoc code matches)))) ((and (not home) (= 1 (length matches))) (funcall pick (cdar matches))) (matches (if home (setq prefix code) (setq group key)) (setq page 0)))))))))))) (when (and (window-live-p window) (eq (window-buffer window) popup)) (delete-window window)) (when (buffer-live-p popup) (kill-buffer popup)) (when (window-live-p origin) (select-window origin))) (when selected (if (bufferp selected) (if (buffer-live-p selected) (switch-to-buffer selected) (user-error "That buffer has been closed")) (bookmark-jump selected)) (when (bound-and-true-p persp-mode) (persp-add-buffer (current-buffer) persp nil nil))))) (define-minor-mode my/quick-access-mode "Track workspace buffer visits and assign newly saved bookmarks to their workspace." :global t :group 'my/quick-access (if my/quick-access-mode (progn (add-hook 'post-command-hook #'my/quick-access--track) (advice-add 'bookmark-store :filter-args #'my/quick-access--scope-record) (advice-add 'persp-rename :around #'my/quick-access--renamed)) (remove-hook 'post-command-hook #'my/quick-access--track) (advice-remove 'bookmark-store #'my/quick-access--scope-record) (advice-remove 'persp-rename #'my/quick-access--renamed))) (provide 'my-quick-access) ;;; my-quick-access.el ends here