md: 2026-09-03T15:50:32+02:00

1 files changed, 419 insertions, 0 deletions

diff --git a/lisp/my-quick-access.el b/lisp/my-quick-access.el
new file mode 100644
index 0000000..ae1d538
--- /dev/null
+++ b/lisp/my-quick-access.el
@@ -0,0 +1,419 @@
+;;; 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