diff options
Diffstat (limited to 'modules')
| -rw-r--r-- | modules/coverage-core.el | 33 | ||||
| -rw-r--r-- | modules/dirvish-config.el | 99 | ||||
| -rw-r--r-- | modules/jumper.el | 45 | ||||
| -rw-r--r-- | modules/system-utils.el | 3 |
4 files changed, 164 insertions, 16 deletions
diff --git a/modules/coverage-core.el b/modules/coverage-core.el index 687a042fe..9b102bb7b 100644 --- a/modules/coverage-core.el +++ b/modules/coverage-core.el @@ -249,6 +249,27 @@ Signals `user-error' for any other SCOPE." (maphash (lambda (k _v) (push k keys)) table) (sort keys #'<))) +(defun cj/--coverage-relativize-keys (table root) + "Return a copy of TABLE with each file-path key made relative to ROOT. +An absolute key is relativized against ROOT via `file-relative-name'; an +already-relative key is kept as-is. Line-set values are shared, not copied. + +`cj/--coverage-parse-simplecov' emits absolute path keys (simplecov reports +absolute source paths) while `cj/--coverage-parse-diff-output' emits +repo-relative keys (git's \"+++ b/<path>\"). Both must be normalized to +repo-relative before `cj/--coverage-intersect' joins them by key, or every +diff-aware match misses and each changed file reads `:tracked nil'." + (let ((result (make-hash-table :test 'equal))) + (when table + (maphash + (lambda (path lines) + (let ((key (if (file-name-absolute-p path) + (file-relative-name path root) + path))) + (puthash key lines result))) + table)) + result)) + (defun cj/--coverage-intersect (covered changed) "Combine COVERED (LCOV) with CHANGED (git diff) into per-file records. COVERED and CHANGED are each hash tables from file path to a hash table @@ -479,10 +500,14 @@ line in the simplecov data — the intersect then classifies each line as covered or uncovered. For diff-aware scopes, the changed set comes from `git diff' via `cj/--coverage-changed-lines'." (let* ((report-path (funcall (plist-get backend :report-path))) - (covered (cj/--coverage-parse-simplecov report-path)) - (changed (if (eq scope 'whole-project) - (cj/--coverage-simplecov-executable-lines report-path) - (cj/--coverage-changed-lines scope))) + (root (cj/--coverage-project-root)) + (covered (cj/--coverage-relativize-keys + (cj/--coverage-parse-simplecov report-path) root)) + (changed (cj/--coverage-relativize-keys + (if (eq scope 'whole-project) + (cj/--coverage-simplecov-executable-lines report-path) + (cj/--coverage-changed-lines scope)) + root)) (records (cj/--coverage-intersect covered changed))) (cj/--coverage-render-to-buffer records scope))) diff --git a/modules/dirvish-config.el b/modules/dirvish-config.el index c86f3d1bf..04f9ce20e 100644 --- a/modules/dirvish-config.el +++ b/modules/dirvish-config.el @@ -411,6 +411,101 @@ Uses feh on X11, swww on Wayland." (message "Wallpaper set: %s (%s)" (file-name-nondirectory file) (car cmd)))))) +;;; ------------------------- Dirvish Hyprland Popup ---------------------------- + +;; The Hyprland Super+F popup opens an emacsclient frame named "dirvish" (window +;; rules float/size/center it by that name) and runs `cj/dirvish-popup', rooted +;; at home. `q' in that frame runs `cj/dirvish-popup-quit', which quits Dirvish +;; and deletes the popup frame so a stray launch never orphans it; `q' in any +;; other frame quits Dirvish normally. The launcher script calls this command +;; instead of plain `dirvish'. This mirrors the Super+Shift+N quick-capture +;; popup (see `cj/quick-capture' in org-capture-config.el). + +(defun cj/--dirvish-popup-frame () + "Return a live frame named \"dirvish\" (the Hyprland popup), or nil." + (seq-find (lambda (f) + (and (frame-live-p f) + (equal (frame-parameter f 'name) "dirvish"))) + (frame-list))) + +(defun cj/dirvish-popup () + "Open Dirvish in the Hyprland popup frame (frame \"dirvish\"), rooted at home. +The launcher script calls this through =emacsclient -c -e=. `q' +(`cj/dirvish-popup-quit') closes the frame. + +Selects the \"dirvish\" frame by name before opening rather than trusting the +ambient selected frame: the launching =emacsclient -c -e= runs before Hyprland +settles focus on the new float, so =(selected-frame)= is still the daemon's main +frame and Dirvish would otherwise open there." + (interactive) + (let ((frame (cj/--dirvish-popup-frame))) + (when frame (select-frame-set-input-focus frame)) + (dirvish (expand-file-name "~/")))) + +(defun cj/dirvish-popup-focus-existing () + "Raise and focus the live dirvish popup frame, returning t; nil if none. +The launcher script calls this before creating a frame, so a second Super+F +re-uses the open popup instead of spawning a second one (the popup is a +single-instance, transient launcher -- use =C-x d= for several independent +Dirvish sessions)." + (let ((popup (cj/--dirvish-popup-frame))) + (when popup + (select-frame-set-input-focus popup) + t))) + +(defun cj/dirvish-popup-quit () + "Quit Dirvish. In the Hyprland popup frame (\"dirvish\"), delete the frame too. +Bound to `q' in `dirvish-mode-map'. A normal Dirvish session (any other frame) +quits as usual; only the popup frame is torn down, so the Super+F launch never +leaves an empty frame behind." + (interactive) + (let ((popup (cj/--dirvish-popup-frame))) + (if (and popup (eq popup (selected-frame))) + (progn + (ignore-errors (dirvish-quit)) + (when (frame-live-p popup) (delete-frame popup))) + (dirvish-quit)))) + +(defun cj/--dirvish-popup-selected-p () + "Return non-nil when the selected frame is the dirvish popup frame." + (let ((popup (cj/--dirvish-popup-frame))) + (and popup (eq popup (selected-frame))))) + +(defun cj/dirvish-popup-find-file () + "Open the file at point. +In the Hyprland popup frame the popup is a context-free launcher: files open +through the OS handler (`cj/xdg-open' -> xdg-open), so nothing lands inside the +throwaway frame and the launch is independent of the running Emacs session (a +text/code file opens its own new emacsclient frame, not your working session -- +use =C-x d= when you want a file in the session you're in). Directories are +entered normally so you can keep browsing. The popup then dismisses itself on +focus loss. Outside the popup this is exactly `dired-find-file'." + (interactive) + (if (cj/--dirvish-popup-selected-p) + (let ((file (dired-get-file-for-visit))) + (if (file-directory-p file) + (dired-find-file) + (cj/xdg-open file))) + (dired-find-file))) + +(defun cj/--dirvish-popup-focus-watch (&rest _) + "Dismiss the dirvish popup frame once it loses focus. +Armed only after the popup has actually held focus (a per-frame flag), so the +frame is never torn down during its own creation, before Hyprland settles focus +on the new float. Installed on `after-focus-change-function'; a no-op whenever +no popup frame is live." + (let ((popup (cj/--dirvish-popup-frame))) + (when popup + (if (frame-focus-state popup) + (set-frame-parameter popup 'cj-dirvish-popup-had-focus t) + (when (frame-parameter popup 'cj-dirvish-popup-had-focus) + (delete-frame popup)))))) + +;; Install idempotently: remove any prior copy before adding, so re-loading the +;; module updates the watch rather than stacking duplicate copies. +(remove-function after-focus-change-function #'cj/--dirvish-popup-focus-watch) +(add-function :after after-focus-change-function #'cj/--dirvish-popup-focus-watch) + ;;; ---------------------------------- Dirvish ---------------------------------- (use-package dirvish @@ -515,7 +610,8 @@ Uses feh on X11, swww on Wayland." ("bg" . cj/set-wallpaper) ("/" . dirvish-narrow) ("<left>" . dired-up-directory) - ("<right>" . dired-find-file) + ("RET" . cj/dirvish-popup-find-file) ; popup: launch file externally; else normal + ("<right>" . cj/dirvish-popup-find-file) ("C-," . dirvish-history-go-backward) ("C-." . dirvish-history-go-forward) ("F" . dirvish-file-info-menu) @@ -537,6 +633,7 @@ Uses feh on X11, swww on Wayland." ("O" . cj/open-file-with-command) ; Prompts for command to run ("p" . (lambda () (interactive) (cj/dired-copy-path-as-kill nil t))) ("P" . cj/dirvish-print-file) + ("q" . cj/dirvish-popup-quit) ; quit; in the Hyprland popup frame, close it ("r" . dirvish-rsync) ("S" . cj/dirvish-drill-file) ; Study: org-drill the .org file at point ("s" . dirvish-quicksort) diff --git a/modules/jumper.el b/modules/jumper.el index de270de66..d5d0cf7a7 100644 --- a/modules/jumper.el +++ b/modules/jumper.el @@ -114,7 +114,8 @@ marker's buffer with point at the marker (within `save-current-buffer' and marker." (let* ((reg (aref jumper--registers index)) (marker (get-register reg))) - (when (and marker (markerp marker)) + (when (and marker (markerp marker) + (buffer-live-p (marker-buffer marker))) (save-current-buffer (set-buffer (marker-buffer marker)) (save-excursion @@ -156,6 +157,20 @@ Indices whose marker is no longer valid are skipped (their for fmt = (jumper--format-location i) when fmt collect (cons fmt i))) +(defun jumper--first-free-register () + "Return the lowest register char in 0..N-1 not held by a live slot. +N is `jumper-max-locations'. Only the live slice (indices 0 through +`jumper--next-index' minus 1) is consulted, so a char freed by a removal is +reused on the next store instead of colliding with a surviving slot's +register and silently overwriting its marker." + (let ((used (make-hash-table :test 'eql))) + (dotimes (i jumper--next-index) + (let ((r (aref jumper--registers i))) + (when r (puthash r t used)))) + (cl-loop for c from ?0 below (+ ?0 jumper-max-locations) + unless (gethash c used) + return c))) + (defun jumper--do-store-location () "Store current location in the next free register. Returns: \\='already-exists if location is already stored, @@ -165,7 +180,7 @@ Returns: \\='already-exists if location is already stored, ((jumper--location-exists-p) 'already-exists) ((not (jumper--register-available-p)) 'no-space) (t - (let ((reg (+ ?0 jumper--next-index))) + (let ((reg (jumper--first-free-register))) (point-to-register reg) (aset jumper--registers jumper--next-index reg) (setq jumper--next-index (1+ jumper--next-index)) @@ -190,7 +205,13 @@ Returns: \\='no-locations if no locations stored, ;; Toggle behavior when target-idx is nil and only 1 location ((and (null target-idx) (= jumper--next-index 1)) (if (jumper--location-exists-p) - 'already-there + ;; Already at the only location: toggle back to where we came from + ;; when a last-location is recorded, otherwise report no movement. + (if (get-register jumper--last-location-register) + (progn + (jump-to-register jumper--last-location-register) + 'jumped-back) + 'already-there) (let ((reg (aref jumper--registers 0))) (point-to-register jumper--last-location-register) (jump-to-register reg) @@ -217,6 +238,7 @@ Returns: \\='no-locations if no locations stored, ((= jumper--next-index 1) (pcase (jumper--do-jump-to-location nil) ('already-there (message "You're already at the stored location")) + ('jumped-back (message "Jumped back to previous location")) ('jumped (message "Jumped to location")))) ;; Multiple locations - prompt user (t @@ -233,13 +255,16 @@ Returns: \\='no-locations if no locations stored, (message "Jumped to location"))))) (defun jumper--reorder-registers (removed-idx) - "Reorder registers after removing the one at REMOVED-IDX." - (when (< removed-idx (1- jumper--next-index)) - ;; Shift all higher registers down - (cl-loop for i from removed-idx below (1- jumper--next-index) - do (let ((next-reg (aref jumper--registers (1+ i)))) - (aset jumper--registers i next-reg)))) - (setq jumper--next-index (1- jumper--next-index))) + "Reorder registers after removing the one at REMOVED-IDX. +Shift the higher registers down and clear the freed register so its marker +no longer pins its buffer." + (let ((freed (aref jumper--registers removed-idx))) + (when (< removed-idx (1- jumper--next-index)) + ;; Shift all higher registers down + (cl-loop for i from removed-idx below (1- jumper--next-index) + do (aset jumper--registers i (aref jumper--registers (1+ i))))) + (setq jumper--next-index (1- jumper--next-index)) + (when freed (set-register freed nil)))) (defun jumper--do-remove-location (index) "Remove location at INDEX. diff --git a/modules/system-utils.el b/modules/system-utils.el index 254a2f502..c76193a71 100644 --- a/modules/system-utils.el +++ b/modules/system-utils.el @@ -123,7 +123,8 @@ detached from Emacs." read-char-history face-name-history bookmark-history - file-name-history)) + file-name-history + wttrin--location-history)) (put 'minibuffer-history 'history-length 50) (put 'file-name-history 'history-length 50) |