countvajhula · October 30, 2025 20:24
diff --git a/racket-search-and-replace.rkt b/racket-search-and-replace.rkt
 ;; Emacs Lisp

 ;; This uses a slightly modified version of Racket Mode's
 ;; `racket-xp-rename' to rename an identifier in a project *by
 ;; binding* rather than just textually by regex. The Racket Mode
 ;; function only works within a single module and doesn't have a
 ;; notion of a "project." So, the search and replace function below
 ;; uses Projectile's definition of a project --- i.e., the files
 ;; listed in the Git index for the current repo via
 ;; `projectile-project-files' --- to apply `racket-xp-rename'
 ;; non-interactively (i.e., after initially accepting the FROM and TO
 ;; names interactively) to every Racket module in the project.
 ;;
 ;; Next steps:
 ;; If this were to be integrated into Racket Mode, we would need a
 ;; version of `racket-xp-rename' that relaxes its restriction on
 ;; renaming identifiers defined elsewhere, and which also supports
 ;; being called non-interactively. The script below makes these
 ;; changes in `my-racket-xp-rename'.

 (defun my-racket-search-and-replace (old-id new-id)
  "Search and replace occurrences of OLD-ID with NEW-ID in the current project"
  (interactive
   (list
    (read-string "Rename what: " (thing-at-point 'symbol))
    (read-string "Rename to: ")))
  (message "Renaming %s to %s ..." old-id new-id)
  (let* ((root (my-repo-root))
         (files (mapcar (lambda (p)
                          (concat root p))
                        (projectile-project-files root))))
    (dolist (file files)
      (when (equal "rkt" (file-name-extension file))
        (message "Renaming in %s..." (file-name-nondirectory file))
        (let ((buf (find-file-noselect file)))
          (with-current-buffer buf
            (goto-char (point-min))
            (condition-case nil
                (progn (re-search-forward old-id)
                       (backward-char 1)
                       (condition-case e
                           (my-racket-xp-rename new-id)
                         (error (message "Racket Mode signaled error: %s" e))))
              (error nil))))))))

 (defun my-repo-root (&optional buffer)
  "Get the root folder of the VCS for BUFFER."
  (let ((buffer (or buffer (current-buffer))))
    (with-current-buffer buffer
      (magit-toplevel))))

 (defun my-racket-xp-rename (new-id)
  "Rename a local definition and its uses in the current file."
  (pcase-let*
      (;; Try to get a def prop and a use prop at point
       (def-prop     (get-text-property (point) 'racket-xp-def))
       (uses-prop    (get-text-property (point) 'racket-xp-use))
       (_            (unless (or uses-prop def-prop)
                       (user-error "Not a definition or use")))
       ;; OK, we have one of the props. Use it to get the the other one.
       (uses-prop    (or uses-prop
                         (pcase-let ((`(,_kind ,_id ((,beg ,_end) . ,_)) def-prop))
                           (get-text-property beg 'racket-xp-use))))
       (def-prop     (or def-prop
                         (pcase-let ((`(,beg ,_end) uses-prop))
                           (get-text-property beg 'racket-xp-def))))
       (`(,kind ,old-id ,uses-locs)  def-prop)
       (def-loc      uses-prop)
       (locs         (cons def-loc uses-locs))
       (marker-pairs (mapcar (lambda (loc)
                               (let ((beg (make-marker))
                                     (end (make-marker)))
                                 (set-marker beg (nth 0 loc) (current-buffer))
                                 (set-marker end (nth 1 loc) (current-buffer))
                                 (list beg end)))
                             locs))
       (point-marker (let ((m (make-marker)))
                       (set-marker m (point) (current-buffer)))))
    ;; Don't let our after-change hook run until all changes are
    ;; made, otherwise check-syntax will find a syntax error.
    (let ((inhibit-modification-hooks t))
      (dolist (marker-pair marker-pairs)
        (let ((beg (marker-position (nth 0 marker-pair)))
              (end (marker-position (nth 1 marker-pair))))
          (delete-region beg end)
          (goto-char beg)
          (insert new-id))))
    (goto-char (marker-position point-marker))
    (racket-xp-annotate)))
No results found