[slime-cvs] CVS update: slime/slime.el
Helmut Eller
heller at common-lisp.net
Thu Dec 22 16:04:11 UTC 2005
Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv20076
Modified Files:
slime.el
Log Message:
Make highlighting of modified text a minor mode. Also use
after-change-functions instead of rebinding all self-inserting keys.
(slime-highlight-edits-mode): New minor mode.
(slime-self-insert-command): Deleted.
(slime-before-compile-functions): New hook to decouple edit
highlighting from compilation.
(slime-highlight-edits-face): Renamed from slime-display-edit-face.
Date: Thu Dec 22 17:03:43 2005
Author: heller
Index: slime/slime.el
diff -u slime/slime.el:1.572 slime/slime.el:1.573
--- slime/slime.el:1.572 Tue Dec 20 01:13:24 2005
+++ slime/slime.el Thu Dec 22 17:03:32 2005
@@ -67,12 +67,14 @@
(defvar slime-use-autodoc-mode nil
"When non-nil always enabled slime-autodoc-mode in slime-mode.")
-(defun* slime-setup (&key autodoc typeout-frame)
+(defun* slime-setup (&key autodoc typeout-frame highlight-edits)
"Setup Emacs so that lisp-mode buffers always use SLIME."
(add-hook 'lisp-mode-hook 'slime-lisp-mode-hook)
(when typeout-frame
(add-hook 'slime-connected-hook 'slime-ensure-typeout-frame))
- (setq slime-use-autodoc-mode autodoc))
+ (setq slime-use-autodoc-mode autodoc)
+ (when highlight-edits
+ (add-hook 'slime-mode-hook 'slime-highlight-edits-mode)))
(defun slime-lisp-mode-hook ()
(slime-mode 1)
@@ -228,20 +230,6 @@
:type 'string
:group 'slime-mode)
-(defcustom slime-display-edit-hilights t
- "Hilight code that has been edited but not recompiled."
- :type '(choice (const :tag "Enable" t) (const :tag "Disable" nil))
- :group 'slime-mode)
-
-(defface slime-display-edit-face
- `((((class color) (background light))
- (:background "yellow"))
- (((class color) (background dark))
- (:background "yellow"))
- (t (:background "yellow")))
- "Face for displaying edit but not compiled code."
- :group 'slime-mode-faces)
-
;;;;; slime-mode-faces
(defgroup slime-mode-faces nil
@@ -4195,6 +4183,11 @@
;;;; Compilation and the creation of compiler-note annotations
+(defvar slime-before-compile-functions nil
+ "A list of function called before compiling a buffer or region.
+The function receive two arguments: the beginning and the end of the
+region that will be compiled.")
+
(defun slime-compile-and-load-file ()
"Compile and load the buffer's file and highlight compiler notes.
@@ -4215,7 +4208,6 @@
See `slime-compile-and-load-file' for further details."
(interactive)
- (slime-remove-edits 1 (point-max))
(unless (memq major-mode slime-lisp-modes)
(error "Only valid in lisp-mode"))
(check-parens)
@@ -4224,6 +4216,7 @@
(when (and (buffer-modified-p)
(y-or-n-p (format "Save file %s? " (buffer-file-name))))
(save-buffer))
+ (run-hook-with-args 'slime-before-compile-functions (point-min) (point-max))
(let ((lisp-filename (slime-to-lisp-filename (buffer-file-name))))
(slime-insert-transcript-delimiter
(format "Compile file %s" lisp-filename))
@@ -4277,21 +4270,17 @@
(defun slime-compile-defun ()
"Compile the current toplevel form."
(interactive)
- (slime-compile-string (slime-defun-at-point)
- (save-excursion
- (end-of-defun)
- (beginning-of-defun)
- (point)))
- (save-excursion
- (beginning-of-defun)
- (let ((start (point)))
- (end-of-defun)
- (slime-remove-edits start (point)))))
+ (destructuring-bind (start end)
+ (save-excursion
+ (beginning-of-defun)
+ (list (point)
+ (progn (end-of-defun) (point))))
+ (slime-compile-region start end)))
(defun slime-compile-region (start end)
"Compile the region."
(interactive "r")
- (slime-remove-edits start end)
+ (run-hook-with-args 'slime-before-compile-functions start end)
(slime-compile-string (buffer-substring-no-properties start end) start))
(defun slime-compile-string (string start-offset)
@@ -4414,16 +4403,6 @@
(mapcar #'slime-merge-notes
(slime-group-similar 'slime-notes-in-same-location-p notes)))
-(defun slime-remove-edits (start end)
- "Delete the existing Slime edit hilights in the current buffer."
- (save-excursion
- (goto-char start)
- (while (< (point) end)
- (dolist (o (overlays-at (point)))
- (when (overlay-get o 'slime-edit)
- (delete-overlay o)))
- (goto-char (next-overlay-change (point))))))
-
(defun slime-merge-notes (notes)
"Merge NOTES together. Keep the highest severity, concatenate the messages."
(let* ((new-severity (reduce #'slime-most-severe notes
@@ -5173,7 +5152,7 @@
(when (and slime-space-information-p
(slime-background-activities-enabled-p))
(slime-echo-arglist))
- (self-insert-command n)))
+ (self-insert-command n)))
(defun slime-echo-arglist ()
"Display the arglist of the current form in the echo area."
@@ -5400,6 +5379,68 @@
(slime-make-typeout-frame)))
+;;;; edit highlighting
+
+(defface slime-highlight-edits-face
+ `((((class color) (background light))
+ (:background "lightgray"))
+ (((class color) (background dark))
+ (:background "dimgray"))
+ (t (:background "yellow")))
+ "Face for displaying edit but not compiled code."
+ :group 'slime-mode-faces)
+
+(define-minor-mode slime-highlight-edits-mode
+ "Minor mode to highlight not-yet-compiled code." nil)
+
+(add-hook 'slime-highlight-edits-mode-on-hook
+ 'slime-highlight-edits-init-buffer)
+
+(add-hook 'slime-highlight-edits-mode-off-hook
+ 'slime-highlight-edits-reset-buffer)
+
+(defun slime-highlight-edits-init-buffer ()
+ (make-local-variable 'after-change-functions)
+ (add-to-list 'after-change-functions
+ 'slime-highlight-edits)
+ (add-to-list 'slime-before-compile-functions
+ 'slime-highlight-edits-compile-hook))
+
+(defun slime-highlight-edits-reset-buffer ()
+ (setq after-change-functions
+ (remove 'slime-highlight-edits after-change-functions))
+ (slime-remove-edits (point-min) (point-max)))
+
+(defun slime-highlight-edits (beg end &optional len)
+ (when (and (slime-connected-p)
+ (not (slime-inside-comment-p beg end)))
+ (let ((overlay (make-overlay beg end)))
+ (overlay-put overlay 'face 'slime-highlight-edits-face)
+ (overlay-put overlay 'slime-edit t))))
+
+(defun slime-remove-edits (start end)
+ "Delete the existing Slime edit hilights in the current buffer."
+ (save-excursion
+ (goto-char start)
+ (while (< (point) end)
+ (dolist (o (overlays-at (point)))
+ (when (overlay-get o 'slime-edit)
+ (delete-overlay o)))
+ (goto-char (next-overlay-change (point))))))
+
+(defun slime-highlight-edits-compile-hook (start end)
+ (when slime-highlight-edits-mode
+ (slime-remove-edits start end)))
+
+(defun slime-inside-comment-p (beg end)
+ "Is the region from BEG to END in a comment?"
+ (let* ((hs-c-start-regexp ";\\|#|")
+ (comment (hs-inside-comment-p)))
+ (and comment
+ (destructuring-bind (cbeg cend) comment
+ (and (<= cbeg beg) (<= end cend))))))
+
+
;;;; Completion
;; XXX those long names are ugly to read; long names an indicator for
@@ -9884,29 +9925,6 @@
(defun sldb-xemacs-post-command-hook ()
(when (get-text-property (point) 'point-entered)
(funcall (get-text-property (point) 'point-entered))))
-
-(defun slime-self-insert-command ()
- (interactive)
- (self-insert-command 1)
- (when (and slime-display-edit-hilights
- (slime-connected-p)
- (not (in-comment-p)))
- (let ((overlay (make-overlay (- (point) 1) (point))))
- (flet ((putp (name value) (overlay-put overlay name value)))
- (putp 'face 'slime-display-edit-face)
- (putp 'slime-edit t)))))
-
-(defun in-comment-p ()
- (nth 4 (syntax-ppss (point))))
-
-(add-hook 'slime-mode-hook
- (lambda ()
- (unless (eq 'slime-repl-mode major-mode)
- (dotimes (i 127)
- (when (> i 31)
- ;; Don't stomp on previous bindings!
- (when (null (local-key-binding (string i)))
- (local-set-key (string i) 'slime-self-insert-command)))))))
;;;; Finishing up
More information about the slime-cvs
mailing list