[slime-cvs] CVS slime
trittweiler
trittweiler at common-lisp.net
Wed Aug 15 13:45:43 UTC 2007
Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv4199
Modified Files:
slime.el
Log Message:
Make `M-.' work on definitions outside the current restriction.
`M-,' will also properly restore the narrowing as of before the
jump. Similiarly for quiting from the compilation notes buffer and
the Xref buffers.
* slime.el (slime-narrowing-configuration, slime-emacs-snapshot),
(current-slime-narrowing-configuration),
(set-slime-narrowing-configuration),
(current-slime-emacs-snapshot),
(set-slime-emacs-snapshot),
(current-slime-emacs-snapshot-fingerprint): New. Emacs' window
configurations do not restore narrowing, so introduce a
snapshot facility that contains the necessary information.
* slime.el: Various renaming and adaptions in the Slime temp
buffer, xref, goto-definition and compilation notes section to use
the newly introduced snapshots instead of mere window
configurations.
* slime.el: (slime-highlight-notes, slime-remove-old-overlays):
Still operate on whole buffer, but restore previous restriction if
there was any.
(slime-goto-location-position): Now widens the buffer to properly
jump to definitions outside of the current restriction.
* slime.el (slime-push-definition-stack),
(slime-pop-find-definition-stack): Now also stores information
about narrowing on the definition stack, in order to properly
restore narrowing on `M-,'.
* slime.el (def-slime-test narrowing): Test case for properly
dealing with narrowing.
* slime.el (slime-buffer-narrowed-p): New function, tests whether
the current buffer is narrowed or not.
(save-restriction-if-possibly): Like `save-restriction', but not
as strict---see doc string.
* slime.el (slime-length=): New function; semantically the same
as (= (length seq) n), but more efficiently implemented for lists.
Changed the above pattern into a call to SLIME-LENGTH= where
appropriate.
--- /project/slime/cvsroot/slime/slime.el 2007/08/02 15:42:23 1.795
+++ /project/slime/cvsroot/slime/slime.el 2007/08/15 13:45:43 1.796
@@ -1192,20 +1192,87 @@
(put 'slime-with-rigid-indentation 'lisp-indent-function 1)
+;;;;; Snapshots of current Emacs state
+
+;;; Window configurations do not save (and hence not restore)
+;;; any narrowing that could be applied to a buffer.
+;;;
+;;; For this purpose, we introduce a superset of a window
+;;; configuration that does include the necessary information to
+;;; properly restore narrowing.
+;;;
+;;; We call this superset an Emacs Snapshot.
+
+(defstruct (slime-narrowing-configuration
+ (:conc-name slime-narrowing-configuration.))
+ narrowedp beg end)
+
+(defstruct (slime-emacs-snapshot (:conc-name slime-emacs-snapshot.))
+ window-configuration narrowing-configuration)
+
+(defun current-slime-narrowing-configuration (&optional buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ (make-slime-narrowing-configuration :narrowedp (slime-buffer-narrowed-p)
+ :beg (point-min-marker)
+ :end (point-max-marker))))
+
+(defun set-slime-narrowing-configuration (narrowing-cfg)
+ (when (slime-narrowing-configuration.narrowedp narrowing-cfg)
+ (narrow-to-region (slime-narrowing-configuration.beg narrowing-cfg)
+ (slime-narrowing-configuration.end narrowing-cfg))))
+
+(defun current-slime-emacs-snapshot (&optional frame)
+ "Returns a snapshot of the current state of FRAME, or the
+currently active frame if FRAME is not given respectively."
+ (with-current-buffer
+ (if frame
+ (window-buffer (frame-selected-window (selected-frame)))
+ (current-buffer))
+ (make-slime-emacs-snapshot
+ :window-configuration (current-window-configuration frame)
+ :narrowing-configuration (current-slime-narrowing-configuration))))
+
+(defun set-slime-emacs-snapshot (snapshot)
+ "Restores the state of Emacs according to the information saved
+in SNAPSHOT."
+ (let ((window-cfg (slime-emacs-snapshot.window-configuration snapshot))
+ (narrowing-cfg (slime-emacs-snapshot.narrowing-configuration snapshot)))
+ (set-window-configuration window-cfg) ; restores previously current buffer.
+ (set-slime-narrowing-configuration narrowing-cfg)))
+
+(defun current-slime-emacs-snapshot-fingerprint (&optional frame)
+ "Return a fingerprint of the current emacs snapshot.
+Fingerprints are `equalp' if and only if they represent window
+configurations that are very similar (same windows and buffers.)
+
+Unlike real window-configuration objects, fingerprints are not
+sensitive to the point moving and they can't be restored."
+ (mapcar (lambda (window) (list window (window-buffer window)))
+ (slime-frame-windows frame)))
+
+(defun slime-frame-windows (&optional frame)
+ "Return the list of windows in FRAME."
+ (loop with last-window = (previous-window (frame-first-window frame))
+ for window = (frame-first-window frame) then (next-window window)
+ collect window
+ until (eq window last-window)))
+
+
;;;;; Temporary popup buffers
(make-variable-buffer-local
- (defvar slime-temp-buffer-saved-window-configuration nil
- "The window configuration before the temp-buffer was displayed.
+ (defvar slime-temp-buffer-saved-emacs-snapshot nil
+ "The snapshot of the current state in Emacs before the temp-buffer
+was displayed, so that this state can be restored later on.
Buffer local in temp-buffers."))
(make-variable-buffer-local
- (defvar slime-temp-buffer-fingerprint nil
- "The window config \"fingerprint\" after displaying the buffer."))
+ (defvar slime-temp-buffer-saved-fingerprint nil
+ "The emacs snapshot \"fingerprint\" after displaying the buffer."))
;; Interface
(defun* slime-get-temp-buffer-create (name &key mode noselectp reusep
- window-configuration)
+ emacs-snapshot)
"Return a fresh temporary buffer called NAME in MODE.
The buffer also uses the minor-mode `slime-temp-buffer-mode'. Pressing
`q' in the buffer will restore the window configuration to the way it
@@ -1217,23 +1284,22 @@
If REUSEP is true and a buffer does already exist with name NAME,
then the buffer will be reused instead of being killed.
-If WINDOW-CONFIGURATION is non-NIL, it's used to restore the
-original window configuration after closing the temporary
-buffer. Otherwise, the current configuration will be saved and
-that one used for restoration then.
+If EMACS-SNAPSHOT is non-NIL, it's used to restore the previous
+state of Emacs after closing the temporary buffer. Otherwise, the
+current state will be saved and later restored.
"
- (let ((window-config (or window-configuration (current-window-configuration)))
+ (let ((snapshot (or emacs-snapshot (current-slime-emacs-snapshot)))
(buffer (get-buffer name)))
(when (and buffer (not reusep))
(kill-buffer name)
(setq buffer nil))
(with-current-buffer (or buffer (get-buffer-create name))
(when mode
- (let ((original-configuration slime-temp-buffer-saved-window-configuration)
- (original-fingerprint slime-temp-buffer-fingerprint))
+ (let ((original-configuration slime-temp-buffer-saved-emacs-snapshot)
+ (original-fingerprint slime-temp-buffer-saved-fingerprint))
(funcall mode)
- (setq slime-temp-buffer-saved-window-configuration original-configuration)
- (setq slime-temp-buffer-fingerprint original-fingerprint)))
+ (setq slime-temp-buffer-saved-emacs-snapshot original-configuration)
+ (setq slime-temp-buffer-saved-fingerprint original-fingerprint)))
(slime-temp-buffer-mode 1)
(let ((window (get-buffer-window (current-buffer))))
(if window
@@ -1244,16 +1310,18 @@
(display-buffer (current-buffer) t)
(pop-to-buffer (current-buffer))
(selected-window))
- (setq slime-temp-buffer-saved-window-configuration window-config)
- (setq slime-temp-buffer-fingerprint (slime-window-config-fingerprint)))))
+ (setq slime-temp-buffer-saved-emacs-snapshot snapshot)
+ (setq slime-temp-buffer-saved-fingerprint
+ (current-slime-emacs-snapshot-fingerprint)))))
(current-buffer))))
;; Interface
(defmacro* slime-with-output-to-temp-buffer ((name &key mode reusep)
package &rest body)
"Similar to `with-output-to-temp-buffer'.
-Also saves the window configuration, and inherits the current
-`slime-connection' in a buffer-local variable."
+Also saves the current state of Emacs (window configuration &c),
+and inherits the current `slime-connection' in a buffer-local
+variable. Cf. `slime-get-temp-buffer-create'"
`(let ((connection (slime-connection))
(standard-output (slime-get-temp-buffer-create ,name :mode ',mode
:reusep ,reusep)))
@@ -1281,34 +1349,16 @@
"Get rid of the current (temp) buffer without asking. Restore the
window configuration unless it was changed since we last activated the buffer."
(interactive)
- (let ((saved-window-config slime-temp-buffer-saved-window-configuration)
+ (let ((snapshot slime-temp-buffer-saved-emacs-snapshot)
(temp-buffer (current-buffer)))
- (setq slime-temp-buffer-saved-window-configuration nil)
- (if (and saved-window-config
- (equalp (slime-window-config-fingerprint)
- slime-temp-buffer-fingerprint))
- (set-window-configuration saved-window-config)
+ (setq slime-temp-buffer-saved-emacs-snapshot nil)
+ (if (and snapshot (equalp (current-slime-emacs-snapshot-fingerprint)
+ slime-temp-buffer-saved-fingerprint))
+ (set-slime-emacs-snapshot snapshot)
(bury-buffer))
(when kill-buffer-p
(kill-buffer temp-buffer))))
-(defun slime-window-config-fingerprint (&optional frame)
- "Return a fingerprint of the current window configuration.
-Fingerprints are `equalp' if and only if they represent window
-configurations that are very similar (same windows and buffers.)
-
-Unlike window-configuration objects fingerprints are not sensitive to
-the point moving and they can't be restored."
- (mapcar (lambda (window) (list window (window-buffer window)))
- (slime-frame-windows frame)))
-
-(defun slime-frame-windows (&optional frame)
- "Return the list of windows in FRAME."
- (loop with last-window = (previous-window (frame-first-window frame))
- for window = (frame-first-window frame) then (next-window window)
- collect window
- until (eq window last-window)))
-
;;;;; Filename translation
;;;
;;; Filenames passed between Emacs and Lisp should be translated using
@@ -2519,7 +2569,7 @@
"Evaluate EXPR on the superior Lisp and call CONT with the result."
(slime-rex (cont)
(sexp (or package (slime-current-package)))
- ((:ok result)
+ ((:ok result)
(when cont (funcall cont result)))
((:abort &optional reason)
(message (or reason "Evaluation aborted.")))))
@@ -4649,17 +4699,17 @@
(save-buffer))
(run-hook-with-args 'slime-before-compile-functions (point-min) (point-max))
(let ((lisp-filename (slime-to-lisp-filename (buffer-file-name)))
- (window-config (current-window-configuration)))
+ (snapshot (current-slime-emacs-snapshot)))
(slime-insert-transcript-delimiter
(format "Compile file %s" lisp-filename))
- ;; The following may alter the current window-config, so we saved
- ;; it, to pass it on for it to be restored!
+ ;; The following may alter the current window configuration, so we saved
+ ;; it above to pass it on for it to be properly restored!
(when slime-display-compilation-output
(slime-display-output-buffer))
(slime-eval-async
`(swank:compile-file-for-emacs
,lisp-filename ,(if load t nil))
- (slime-make-compilation-finished-continuation (current-buffer) window-config))
+ (slime-make-compilation-finished-continuation (current-buffer) snapshot))
(message "Compiling %s.." lisp-filename)))
(defun slime-find-asd (system-names)
@@ -4775,14 +4825,7 @@
(replace-match " "))
(buffer-string)))
-(defun slime-length> (list n)
- "Test if (length LIST) is greater than N."
- (while (and (> n 0) list)
- (setq list (cdr list))
- (decf n))
- list)
-
-(defun slime-compilation-finished (result buffer &optional window-config)
+(defun slime-compilation-finished (result buffer &optional emacs-snapshot)
(let ((notes (slime-compiler-notes)))
(with-current-buffer buffer
(setf slime-compilation-just-finished t)
@@ -4790,20 +4833,22 @@
(slime-show-note-counts notes secs)
(when slime-highlight-compiler-notes
(slime-highlight-notes notes))))
- (run-hook-with-args 'slime-compilation-finished-hook notes window-config)))
+ (run-hook-with-args 'slime-compilation-finished-hook notes emacs-snapshot)))
-(defun slime-make-compilation-finished-continuation (current-buffer &optional window-config)
- (lexical-let ((buffer current-buffer) (config window-config))
+(defun slime-make-compilation-finished-continuation (current-buffer &optional emacs-snapshot)
+ (lexical-let ((buffer current-buffer) (snapshot emacs-snapshot))
(lambda (result)
- (slime-compilation-finished result buffer config))))
+ (slime-compilation-finished result buffer snapshot))))
(defun slime-highlight-notes (notes)
"Highlight compiler notes, warnings, and errors in the buffer."
(interactive (list (slime-compiler-notes)))
(with-temp-message "Highlighting notes..."
(save-excursion
- (slime-remove-old-overlays)
- (mapc #'slime-overlay-note (slime-merge-notes-for-display notes)))))
+ (save-restriction
+ (widen) ; highlight notes on the whole buffer
+ (slime-remove-old-overlays)
+ (mapc #'slime-overlay-note (slime-merge-notes-for-display notes))))))
(defun slime-compiler-notes ()
"Return all compiler notes, warnings, and errors."
@@ -4814,12 +4859,14 @@
(dolist (buffer (slime-filter-buffers (lambda () slime-mode)))
(with-current-buffer buffer
(save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (dolist (o (overlays-at (point)))
- (when (overlay-get o 'slime)
- (delete-overlay o)))
- (goto-char (next-overlay-change (point))))))))
+ (save-restriction
+ (widen) ; remove overlays within the whole buffer.
+ (goto-char (point-min))
+ (while (not (eobp))
+ (dolist (o (overlays-at (point)))
+ (when (overlay-get o 'slime)
+ (delete-overlay o)))
+ (goto-char (next-overlay-change (point)))))))))
(defun slime-filter-buffers (predicate)
"Return a list of where PREDICATE returns true.
@@ -4877,33 +4924,33 @@
;;;;; Compiler notes list
-(defun slime-maybe-show-xrefs-for-notes (&optional notes window-config)
+(defun slime-maybe-show-xrefs-for-notes (&optional notes emacs-snapshot)
"Show the compiler notes NOTES if they come from more than one file."
(let* ((notes (or notes (slime-compiler-notes)))
(xrefs (slime-xrefs-for-notes notes)))
- (when (> (length xrefs) 1) ; >1 file
+ (when (slime-length> xrefs 1) ; >1 file
(slime-show-xrefs
xrefs 'definition "Compiler notes" (slime-current-package)
- window-config))))
+ emacs-snapshot))))
(defun slime-note-has-location-p (note)
(not (eq ':error (car (slime-note.location note)))))
-(defun slime-maybe-list-compiler-notes (notes &optional window-config)
+(defun slime-maybe-list-compiler-notes (notes &optional emacs-snapshot)
"Show the compiler notes if appropriate."
;; don't pop up a buffer if all notes will are already annotated in
;; the buffer itself
(unless (every #'slime-note-has-location-p notes)
- (slime-list-compiler-notes notes window-config)))
+ (slime-list-compiler-notes notes emacs-snapshot)))
-(defun slime-list-compiler-notes (notes &optional window-config)
+(defun slime-list-compiler-notes (notes &optional emacs-snapshot)
"Show the compiler notes NOTES in tree view."
(interactive (list (slime-compiler-notes)))
(with-temp-message "Preparing compiler note tree..."
(with-current-buffer
(slime-get-temp-buffer-create "*compiler notes*"
:mode 'slime-compiler-notes-mode
- :window-configuration window-config)
+ :emacs-snapshot emacs-snapshot)
(let ((inhibit-read-only t))
(erase-buffer)
(when (null notes)
@@ -5011,7 +5058,7 @@
(cond ((not (slime-tree-leaf-p tree))
(slime-tree-toggle tree))
(t
- (slime-show-source-location (slime-note.location note))))))
+ (slime-show-source-location (slime-note.location note) t)))))
;;;;;; Tree Widget
@@ -5291,41 +5338,43 @@
(goto-char (point-min))))))
(defun slime-goto-location-position (position)
- (destructure-case position
- ((:position pos &optional align-p)
- (goto-char pos)
- (when align-p
- (slime-forward-sexp)
- (beginning-of-sexp)))
- ((:line start &optional column)
- (goto-line start)
- (cond (column (move-to-column column))
- (t (skip-chars-forward " \t"))))
- ((:function-name name)
- (let ((case-fold-search t)
- (name (regexp-quote name)))
- (or
- (re-search-forward
- (format "\\s *(def\\(\\s_\\|\\sw\\)*\\s +%s\\S_" name) nil t)
- (re-search-forward
- (format "\\s *(def\\(\\s_\\|\\sw\\)*\\s +(*%s\\S_" name) nil t)
- (re-search-forward
- (format "[( \t]%s\\>\\(\\s \\|$\\)" name) nil t)))
- (goto-char (match-beginning 0)))
- ((:method name specializers &rest qualifiers)
- (slime-search-method-location name specializers qualifiers))
- ((:source-path source-path start-position)
- (cond (start-position
- (goto-char start-position)
- (slime-forward-positioned-source-path source-path))
- (t
- (slime-forward-source-path source-path))))
- ;; Goes to "start" then looks for the anchor text, then moves
- ;; delta from that position.
- ((:text-anchored start text delta)
- (goto-char start)
- (slime-isearch text)
- (forward-char delta))))
+ (save-restriction-if-possible ; try to keep restriction if possible.
+ (widen)
+ (destructure-case position
+ ((:position pos &optional align-p)
+ (goto-char pos)
+ (when align-p
+ (slime-forward-sexp)
+ (beginning-of-sexp)))
+ ((:line start &optional column)
+ (goto-line start)
+ (cond (column (move-to-column column))
+ (t (skip-chars-forward " \t"))))
+ ((:function-name name)
+ (let ((case-fold-search t)
+ (name (regexp-quote name)))
+ (or
+ (re-search-forward
+ (format "\\s *(def\\(\\s_\\|\\sw\\)*\\s +%s\\S_" name) nil t)
+ (re-search-forward
+ (format "\\s *(def\\(\\s_\\|\\sw\\)*\\s +(*%s\\S_" name) nil t)
+ (re-search-forward
+ (format "[( \t]%s\\>\\(\\s \\|$\\)" name) nil t)))
+ (goto-char (match-beginning 0)))
+ ((:method name specializers &rest qualifiers)
[341 lines skipped]
More information about the slime-cvs
mailing list