[slime-cvs] CVS update: slime/slime.el
Matthias Koeppe
mkoeppe at common-lisp.net
Wed Aug 10 19:57:58 UTC 2005
Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv27418
Modified Files:
slime.el
Log Message:
(slime-presentation-around-point): Change interface,
return presentation as primary return value.
(slime-copy-presentation-at-point): Use
slime-presentation-around-point. Copying now also works when the
first character is clicked and when the REPL buffer is not current.
(slime-presentation-menu): Use slime-presentation-around-point.
Date: Wed Aug 10 21:57:57 2005
Author: mkoeppe
Index: slime/slime.el
diff -u slime/slime.el:1.520 slime/slime.el:1.521
--- slime/slime.el:1.520 Tue Aug 9 21:34:55 2005
+++ slime/slime.el Wed Aug 10 21:57:56 2005
@@ -2859,15 +2859,19 @@
(values after-end t)))
(values (point) nil)))))
-(defun slime-presentation-around-point ()
- "Return start index, end index, and whether the presentation is complete."
- (multiple-value-bind (start good-start)
- (slime-presentation-start)
- (multiple-value-bind (end good-end)
+(defun slime-presentation-around-point (&optional point)
+ "Return presentation, start index, end index, and whether the presentation is complete."
+ (save-excursion
+ (when point
+ (goto-char point))
+ (multiple-value-bind (start good-start)
+ (slime-presentation-start)
+ (multiple-value-bind (end good-end)
(slime-presentation-end)
- (values start end
- (and good-start good-end
- (slime-presentation-whole-p start end))))))
+ (values (get-text-property (point) 'slime-repl-presentation)
+ start end
+ (and good-start good-end
+ (slime-presentation-whole-p start end)))))))
;; XEmacs compatibility hack, from message by Stephen J. Turnbull on
;; xemacs-beta at xemacs.org of 18 Mar 2002
@@ -2890,7 +2894,7 @@
(while (< (point) real-end)
(let ((presentation (get-text-property (point) 'slime-repl-presentation)))
(when presentation
- (multiple-value-bind (from to whole)
+ (multiple-value-bind (presentation from to whole)
(slime-presentation-around-point)
;;(message "presentation %s whole-p %s" (buffer-substring from to) whole)
(unless whole
@@ -2911,24 +2915,24 @@
(defun slime-copy-presentation-at-point (event)
(interactive "e")
(unless (and (featurep 'xemacs) (not (button-press-event-p event)))
- (let* ((point (if (featurep 'xemacs) (event-point event) (posn-point (event-end event))))
- (what (get-text-property point 'slime-repl-old-output))
- (start (previous-single-property-change point 'slime-repl-old-output))
- (end (or (next-single-property-change point 'slime-repl-old-output)
- (point-max))))
- (flet ((do-insertion ()
- (when (not (string-match "\\s-"
- (buffer-substring (1- (point)) (point))))
- (insert " "))
- (slime-propertize-region '(face slime-repl-inputed-output-face)
- (insert (buffer-substring start end)))
- (when (and (not (eolp)) (not (looking-at "\\s-")))
- (insert " "))))
- (if (>= (point) slime-repl-prompt-start-mark)
- (do-insertion)
- (save-excursion
- (goto-char (point-max))
- (do-insertion)))))))
+ (let ((point (if (featurep 'xemacs) (event-point event) (posn-point (event-end event))))
+ (window (if (featurep 'xemacs) (event-window event) (caadr event))))
+ (with-current-buffer (window-buffer window)
+ (multiple-value-bind (presentation start end)
+ (slime-presentation-around-point point)
+ (flet ((do-insertion ()
+ (when (not (string-match "\\s-"
+ (buffer-substring (1- (point)) (point))))
+ (insert " "))
+ (slime-propertize-region '(face slime-repl-inputed-output-face)
+ (insert (buffer-substring start end)))
+ (when (and (not (eolp)) (not (looking-at "\\s-")))
+ (insert " "))))
+ (if (>= (point) slime-repl-prompt-start-mark)
+ (do-insertion)
+ (save-excursion
+ (goto-char (point-max))
+ (do-insertion)))))))))
(defvar slime-presentation-map (make-sparse-keymap))
@@ -2950,24 +2954,28 @@
(let* ((point (if (featurep 'xemacs) (event-point event) (posn-point (event-end event))))
(window (if (featurep 'xemacs) (event-window event) (caadr event))))
(with-current-buffer (window-buffer window)
- (let* ((what (get-text-property point 'slime-repl-old-output))
- (choices (slime-eval `(swank::menu-choices-for-presentation-id ',what)))
- (count 0))
- (when choices
- (if (symbolp choices)
- (x-popup-menu event `("Object no longer recorded" ("sorry" . ,(if (featurep 'xemacs) nil '(nil)))))
- (let ((choice
- (x-popup-menu event
- `(,(if (featurep 'xemacs) " " "")
- ("" ,@(mapcar
- (lambda(choice)
- (cons choice (intern choice))) ; use symbol as value to appease xemacs
- choices))))))
- (when choice
- (let ((nchoice (1+ (position (symbol-name choice) choices :test 'equal))))
- (eval (slime-eval
- `(swank::execute-menu-choice-for-presentation-id
- ',what ,nchoice ,(nth (1- nchoice) choices)))))))))))))
+ (multiple-value-bind (presentation)
+ (slime-presentation-around-point point)
+ (unless presentation
+ (error "No presentation at event position"))
+ (let* ((what (slime-presentation-id presentation))
+ (choices (slime-eval `(swank::menu-choices-for-presentation-id ',what)))
+ (count 0))
+ (when choices
+ (if (symbolp choices)
+ (x-popup-menu event `("Object no longer recorded" ("sorry" . ,(if (featurep 'xemacs) nil '(nil)))))
+ (let ((choice
+ (x-popup-menu event
+ `(,(if (featurep 'xemacs) " " "")
+ ("" ,@(mapcar
+ (lambda(choice)
+ (cons choice (intern choice))) ; use symbol as value to appease xemacs
+ choices))))))
+ (when choice
+ (let ((nchoice (1+ (position (symbol-name choice) choices :test 'equal))))
+ (eval (slime-eval
+ `(swank::execute-menu-choice-for-presentation-id
+ ',what ,nchoice ,(nth (1- nchoice) choices))))))))))))))
(defun slime-repl-insert-prompt (result &optional time)
More information about the slime-cvs
mailing list