From jgarcia at common-lisp.net Wed Aug 3 09:40:21 2005 From: jgarcia at common-lisp.net (Juan Jose Garcia Ripoll) Date: Wed, 3 Aug 2005 11:40:21 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-ecl.lisp slime/swank-loader.lisp Message-ID: <20050803094021.F0B6C8815C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv19902 Modified Files: swank-loader.lisp Added Files: swank-ecl.lisp Log Message: Initial port to ECL Date: Wed Aug 3 11:40:20 2005 Author: jgarcia Index: slime/swank-loader.lisp diff -u slime/swank-loader.lisp:1.50 slime/swank-loader.lisp:1.51 --- slime/swank-loader.lisp:1.50 Sun Jul 3 17:40:23 2005 +++ slime/swank-loader.lisp Wed Aug 3 11:40:20 2005 @@ -34,6 +34,7 @@ #+clisp '("xref" "metering" "swank-clisp" "swank-gray") #+armedbear '("swank-abcl") #+cormanlisp '("swank-corman" "swank-gray") + #+ecl '("swank-ecl" "swank-gray") ))) (defparameter *implementation-features* @@ -125,9 +126,9 @@ (load source-pathname)) )))))) -#+cormanlisp +#+(or cormanlisp ecl) (defun compile-files-if-needed-serially (files) - "Corman Lisp has trouble with compiled files." + "Corman Lisp and ECL have trouble with compiled files." (dolist (file files) (load file :verbose t) (force-output))) From heller at common-lisp.net Thu Aug 4 00:03:43 2005 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 4 Aug 2005 02:03:43 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: <20050804000343.1CA0B88544@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12561 Modified Files: swank-sbcl.lisp Log Message: Remove SBCL 0.9.1 support. (swank-compile-string): Funcall the compiled function outside with-compilation-hooks to prevent runtime warnings from popping up a *compiler-notes* buffer. From Juho Snellman. (swank-compile-string): Restore honoring of *trap-load-time-warnings*. >From Zach Beane. Date: Thu Aug 4 02:03:42 2005 Author: heller Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.138 slime/swank-sbcl.lisp:1.139 --- slime/swank-sbcl.lisp:1.138 Tue Jul 26 16:59:45 2005 +++ slime/swank-sbcl.lisp Thu Aug 4 02:03:41 2005 @@ -14,11 +14,6 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (require 'sb-bsd-sockets) (require 'sb-introspect) - ;; KLUDGE: Support for 0.9.1 and older concurrently with 0.9.1.25 - ;; and newer -- the #-swank-backend::source-plist cases can be - ;; deleted after SBCL 0.9.2 has been released. - (when (find-symbol "DEFINITION-SOURCE-PLIST" :sb-introspect) - (pushnew 'swank-backend::source-plist *features*)) (require 'sb-posix)) (in-package :swank-backend) @@ -298,8 +293,7 @@ (list :error "No error location available"))) (defun locate-compiler-note (file source-path source) - (cond ((and #+swank-backend::source-plist (eq file :lisp) - #-swank-backend::source-plist (pathnamep file) + (cond ((and (eq file :lisp) *buffer-name*) ;; Compiling from a buffer (let ((position (+ *buffer-offset* @@ -385,93 +379,24 @@ ;;;; compile-string -#-swank-backend::source-plist -(progn - ;; We patch sb-c::debug-source-for-info so that we can dump our own - ;; bits of source info. Our *user-source-info* is stored in the - ;; debug-source-info slot. - (defvar *real-debug-source-for-info*) - (defvar *user-source-info*) - - (defun debug-source-for-info-advice (info) - (destructuring-bind (source) (funcall *real-debug-source-for-info* info) - (when (boundp '*user-source-info*) - (setf (sb-c::debug-source-info source) *user-source-info*)) - (list source))) - - (defun install-debug-source-patch () - (unless (boundp '*real-debug-source-for-info*) - (setq *real-debug-source-for-info* #'sb-c::debug-source-for-info)) - (sb-ext:without-package-locks - (setf (symbol-function 'sb-c::debug-source-for-info) - #'debug-source-for-info-advice))) - - (defimplementation swank-compile-string (string &key buffer position directory) - (declare (ignore directory)) - (install-debug-source-patch) - (call/temp-file - string - (lambda (filename) - (let ((*user-source-info* (list :emacs-buffer buffer :emacs-string string - :emacs-position position)) - (*buffer-name* buffer) - (*buffer-offset* position) - (*buffer-substring* string)) - (let ((fasl (with-compilation-hooks () - (compile-file filename)))) - (load fasl) - (delete-file fasl)))))) - - (defun call/temp-file (string fun) - (let ((filename (temp-file-name))) - (unwind-protect - (with-open-file (s filename :direction :output :if-exists :error) - (write-string string s) - (finish-output s) - (funcall fun filename)) - (when (probe-file filename) - (delete-file filename))))) - - (defun temp-file-name () - "Return a temporary file name to compile strings into." - (sb-alien:alien-funcall - (sb-alien:extern-alien - "tmpnam" - (function sb-alien:c-string sb-alien:system-area-pointer)) - (sb-sys:int-sap 0))) - - (defun find-temp-function-source-location (function) - (let ((info (function-debug-source-info function))) - (with-struct (sb-introspect::definition-source- - form-path character-offset) - (sb-introspect:find-definition-source function) - (destructuring-bind (&key emacs-buffer emacs-position emacs-string) info - (let ((pos (if form-path - (with-debootstrapping - (source-path-string-position - form-path emacs-string)) - character-offset))) - (make-location `(:buffer ,emacs-buffer) - `(:position ,(+ pos emacs-position)) - `(:snippet ,emacs-string)))))))) - -#+swank-backend::source-plist (defimplementation swank-compile-string (string &key buffer position directory) (declare (ignore directory)) - (let ((*buffer-name* buffer) - (*buffer-offset* position) - (*buffer-substring* string)) - (with-compilation-hooks () - (with-compilation-unit (:source-plist - (list :emacs-buffer buffer - :emacs-string string - :emacs-position position)) - #+nil - (with-input-from-string (stream string) - (load stream)) - (funcall (compile nil - `(lambda () - ,(read-from-string string)))))))) + (flet ((compileit (cont) + (let ((*buffer-name* buffer) + (*buffer-offset* position) + (*buffer-substring* string)) + (with-compilation-hooks () + (with-compilation-unit (:source-plist + (list :emacs-buffer buffer + :emacs-string string + :emacs-position position)) + (funcall cont (compile nil + `(lambda () + ,(read-from-string string))))))))) + (if *trap-load-time-warnings* + (compileit #'funcall) + (funcall (compileit #'identity))))) + ;;;; Definitions @@ -513,16 +438,6 @@ ;;; the position of the first code-location; for some reason, that ;;; doesn't seem to work.) -#-swank-backend::source-plist -(defun function-source-location (function &optional name) - "Try to find the canonical source location of FUNCTION." - (declare (type function function) - (ignore name)) - (if (function-from-emacs-buffer-p function) - (find-temp-function-source-location function) - (find-function-source-location function))) - -#+swank-backend::source-plist (defun function-source-location (function &optional name) "Try to find the canonical source location of FUNCTION." (declare (type function function) @@ -536,21 +451,6 @@ (error (e) (list :error (format nil "Error: ~A" e)))))) -#-swank-backend::source-plist -(defun find-function-source-location (function) - (cond #+(or) ;; doesn't work for unknown reasons - ((function-has-start-location-p function) - (code-location-source-location (function-start-location function))) - ((not (function-source-filename function)) - (error "Source filename not recorded for ~A" function)) - (t - (let* ((pos (function-source-position function)) - (snippet (function-hint-snippet function pos))) - (make-location `(:file ,(function-source-filename function)) - `(:position ,pos) - `(:snippet ,snippet)))))) - -#+swank-backend::source-plist (defun find-function-source-location (function) (with-struct (sb-introspect::definition-source- form-path character-offset plist) (sb-introspect:find-definition-source function) @@ -767,14 +667,6 @@ ;;; If there's no debug-block info, we return the (less precise) ;;; source-location of the corresponding function. -#-swank-backend::source-plist -(defun code-location-source-location (code-location) - (let ((dsource (sb-di:code-location-debug-source code-location))) - (ecase (sb-di:debug-source-from dsource) - (:file (file-source-location code-location)) - (:lisp (lisp-source-location code-location))))) - -#+swank-backend::source-plist (defun code-location-source-location (code-location) (let* ((dsource (sb-di:code-location-debug-source code-location)) (plist (sb-c::debug-source-plist dsource))) @@ -790,22 +682,10 @@ ;;; which returns the source location for a _code-location_. ;;; ;;; Maybe these should be named code-location-file-source-location, -;;; etc, turned into generic functions, or something. In the very least the names -;;; should indicate the main entry point vs. helper status. - -#-swank-backend::source-plist -(defun file-source-location (code-location) - (cond ((code-location-has-debug-block-info-p code-location) - (if (code-location-from-emacs-buffer-p code-location) - (temp-file-source-location code-location) - (source-file-source-location code-location))) - (t - (let ((fun (code-location-debug-fun-fun code-location))) - (cond (fun (function-source-location fun)) - (t (error "Cannot find source location for: ~A " - code-location))))))) +;;; etc, turned into generic functions, or something. In the very +;;; least the names should indicate the main entry point vs. helper +;;; status. -#+swank-backend::source-plist (defun file-source-location (code-location) (if (code-location-has-debug-block-info-p code-location) (source-file-source-location code-location) @@ -821,18 +701,6 @@ (sb-debug::code-location-source-form code-location 100)))) (make-location `(:source-form ,source) '(:position 0)))) -#-swank-backend::source-plist -(defun temp-file-source-location (code-location) - (let ((info (code-location-debug-source-info code-location))) - (destructuring-bind (&key emacs-buffer emacs-position emacs-string) info - (let* ((pos (string-source-position code-location emacs-string)) - (snipped (with-input-from-string (s emacs-string) - (read-snippet s pos)))) - (make-location `(:buffer ,emacs-buffer) - `(:position ,(+ emacs-position pos)) - `(:snippet ,snipped)))))) - -#+swank-backend::source-plist (defun emacs-buffer-source-location (code-location plist) (if (code-location-has-debug-block-info-p code-location) (destructuring-bind (&key emacs-buffer emacs-position emacs-string) plist @@ -854,28 +722,6 @@ (make-location `(:file ,filename) `(:position ,(1+ pos)) `(:snippet ,snippet)))))) - -#-swank-backend::source-plist -(progn - (defun code-location-debug-source-info (code-location) - (sb-c::debug-source-info (sb-di::code-location-debug-source code-location))) - - (defun code-location-from-emacs-buffer-p (code-location) - (info-from-emacs-buffer-p (code-location-debug-source-info code-location))) - - (defun function-from-emacs-buffer-p (function) - (info-from-emacs-buffer-p (function-debug-source-info function))) - - (defun function-debug-source-info (function) - (let* ((comp (sb-di::compiled-debug-fun-component - (sb-di::fun-debug-fun function)))) - (sb-c::debug-source-info (car (sb-c::debug-info-source - (sb-kernel:%code-debug-info comp)))))) - - (defun info-from-emacs-buffer-p (info) - (and info - (consp info) - (eq :emacs-buffer (car info))))) (defun code-location-debug-source-name (code-location) (sb-c::debug-source-name (sb-di::code-location-debug-source code-location))) From heller at common-lisp.net Thu Aug 4 00:04:33 2005 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 4 Aug 2005 02:04:33 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050804000433.D8AA388544@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12578 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Thu Aug 4 02:04:33 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.729 slime/ChangeLog:1.730 --- slime/ChangeLog:1.729 Fri Jul 29 14:34:56 2005 +++ slime/ChangeLog Thu Aug 4 02:04:33 2005 @@ -1,3 +1,15 @@ +2005-08-03 Zach Beane + + * swank-sbcl.lisp (swank-compile-string): Restore honoring of + *trap-load-time-warnings*. + +2005-08-03 Juho Snellman + + * swank-sbcl.lisp: Remove SBCL 0.9.1 support. + (swank-compile-string): Funcall the compiled function outside + with-compilation-hooks to prevent runtime warnings from + popping up a *compiler-notes* buffer. + 2005-07-29 Marco Baringer * doc/slime.texi (Other configurables): Document From mkoeppe at common-lisp.net Thu Aug 4 19:14:58 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Thu, 4 Aug 2005 21:14:58 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050804191458.23E998815C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv24608 Modified Files: slime.el Log Message: * slime.el (slime-dispatch-event): New events :presentation-start, :presentation-end for bridge-less presentation markup. Date: Thu Aug 4 21:14:54 2005 Author: mkoeppe Index: slime/slime.el diff -u slime/slime.el:1.515 slime/slime.el:1.516 --- slime/slime.el:1.515 Fri Jul 29 14:37:24 2005 +++ slime/slime.el Thu Aug 4 21:14:51 2005 @@ -2285,6 +2285,10 @@ (destructure-case event ((:read-output output) (slime-output-string output)) + ((:presentation-start id) + (slime-mark-presentation-start id)) + ((:presentation-end id) + (slime-mark-presentation-end id)) ;; ((:emacs-rex form package thread continuation) (slime-set-state "|eval...") From mkoeppe at common-lisp.net Thu Aug 4 19:16:20 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Thu, 4 Aug 2005 21:16:20 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050804191620.B9A118815C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25168 Modified Files: swank.lisp Log Message: (dispatch-event, send-to-socket-io): New events :presentation-start, :presentation-end for bridge-less presentation markup. Date: Thu Aug 4 21:16:19 2005 Author: mkoeppe Index: slime/swank.lisp diff -u slime/swank.lisp:1.313 slime/swank.lisp:1.314 --- slime/swank.lisp:1.313 Fri Jul 29 14:38:21 2005 +++ slime/swank.lisp Thu Aug 4 21:16:14 2005 @@ -599,7 +599,8 @@ (encode-message `(:eval ,(thread-id thread) , at args) socket-io)) ((:emacs-return thread-id tag value) (send (find-thread thread-id) `(take-input ,tag ,value))) - (((:read-output :new-package :new-features :ed :%apply :indentation-update + (((:read-output :presentation-start :presentation-end + :new-package :new-features :ed :%apply :indentation-update :eval-no-wait) &rest _) (declare (ignore _)) @@ -719,6 +720,7 @@ (declare (ignore thread)) (send `(:return , at args))) (((:read-output :new-package :new-features :debug-condition + :presentation-start :presentation-end :indentation-update :ed :%apply :eval-no-wait) &rest _) (declare (ignore _)) From mkoeppe at common-lisp.net Thu Aug 4 19:19:46 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Thu, 4 Aug 2005 21:19:46 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050804191946.81BFD88544@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25583 Modified Files: slime.el Log Message: (slime-repl-insert-prompt): Accept a list of strings, representing individual values of a multiple-value result. Mark them up as separate presentations. (reify-old-output): Support reifying individual values of a multiple-value result. (slime-pre-command-hook): Don't call slime-presentation-command-hook. (slime-post-command-hook): Don't call slime-presentation-post-command-hook. (slime-presentation-command-hook): Removed. (slime-presentation-post-command-hook): Removed. (slime-presentation-whole-p): New. (slime-same-presentation-p): New. (slime-presentation-start, slime-presentation-end): New. (slime-presentation-around-point): New. (slime-after-change-function): New. (slime-setup-command-hooks): Install slime-after-change-function as an after-change-function. (slime-repl-enable-presentations): Make slime-repl-presentation nonsticky. (slime-mark-presentation-start, slime-mark-presentation-end): New functions. (slime-mark-presentation-start-handler): Renamed from slime-mark-presentation-start. (slime-mark-presentation-end-handler): Renamed from slime-mark-presentation-end. (slime-presentation): New structure. (slime-add-presentation-properties): New function. (slime-insert-presentation): New function. Date: Thu Aug 4 21:19:43 2005 Author: mkoeppe Index: slime/slime.el diff -u slime/slime.el:1.516 slime/slime.el:1.517 --- slime/slime.el:1.516 Thu Aug 4 21:14:51 2005 +++ slime/slime.el Thu Aug 4 21:19:43 2005 @@ -868,15 +868,13 @@ "Execute all functions in `slime-pre-command-actions', then NIL it." (dolist (undo-fn slime-pre-command-actions) (ignore-errors (funcall undo-fn))) - (setq slime-pre-command-actions nil) - (slime-presentation-command-hook)) + (setq slime-pre-command-actions nil)) (defun slime-post-command-hook () (when (and slime-mode (slime-connected-p)) (slime-process-available-input)) (when (null pre-command-hook) ; sometimes this is lost - (add-hook 'pre-command-hook 'slime-pre-command-hook)) - (slime-presentation-post-command-hook) ) + (add-hook 'pre-command-hook 'slime-pre-command-hook))) (defun slime-setup-command-hooks () "Setup a buffer-local `pre-command-h'ook' to call `slime-pre-command-hook'." @@ -884,7 +882,8 @@ (make-local-hook 'post-command-hook) ;; alanr: need local t (add-hook 'pre-command-hook 'slime-pre-command-hook nil t) - (add-hook 'post-command-hook 'slime-post-command-hook nil t)) + (add-hook 'post-command-hook 'slime-post-command-hook nil t) + (add-hook 'after-change-functions 'slime-after-change-function nil t)) ;(add-hook 'slime-mode-hook 'slime-setup-command-hooks) ;(setq post-command-hook nil) @@ -2570,40 +2569,85 @@ (when (boundp 'text-property-default-nonsticky) (pushnew '(slime-repl-old-output . t) text-property-default-nonsticky :test 'equal) + (pushnew '(slime-repl-presentation . t) text-property-default-nonsticky + :test 'equal) (pushnew '(slime-repl-result-face . t) text-property-default-nonsticky :test 'equal))) (make-variable-buffer-local (defvar slime-presentation-start-to-point (make-hash-table))) -(defun slime-mark-presentation-start (process string) +(defun slime-mark-presentation-start (id) + (setf (gethash id slime-presentation-start-to-point) + (with-current-buffer (slime-output-buffer) + (marker-position (symbol-value 'slime-output-end))))) + +(defun slime-mark-presentation-start-handler (process string) (if (and string (string-match "<\\([0-9]+\\)" string)) - (progn - (let* ((match (substring string (match-beginning 1) (match-end 1))) - (id (car (read-from-string match)))) - (setf (gethash id slime-presentation-start-to-point) - (with-current-buffer (slime-output-buffer) - (marker-position (symbol-value 'slime-output-end)))))))) + (let* ((match (substring string (match-beginning 1) (match-end 1))) + (id (car (read-from-string match)))) + (slime-mark-presentation-start id)))) + +(defun slime-mark-presentation-end (id) + (let ((start (gethash id slime-presentation-start-to-point))) + (setf (gethash id slime-presentation-start-to-point) nil) + (when start + (with-current-buffer (slime-output-buffer) + (slime-add-presentation-properties start (symbol-value 'slime-output-end) + id nil))))) -(defun slime-mark-presentation-end (process string) +(defun slime-mark-presentation-end-handler (process string) (if (and string (string-match ">\\([0-9]+\\)" string)) - (progn - (let* ((match (substring string (match-beginning 1) (match-end 1))) - (id (car (read-from-string match)))) - (let ((start (gethash id slime-presentation-start-to-point))) - (setf (gethash id slime-presentation-start-to-point) nil) - (when start - (with-current-buffer (slime-output-buffer) - (add-text-properties - start (symbol-value 'slime-output-end) - `(face slime-repl-result-face - slime-repl-old-output ,id - mouse-face slime-repl-output-mouseover-face - keymap ,slime-presentation-map - rear-nonsticky (slime-repl-old-output - slime-repl-result-face - slime-repl-output-mouseover-face)))))))))) + (let* ((match (substring string (match-beginning 1) (match-end 1))) + (id (car (read-from-string match)))) + (slime-mark-presentation-end id)))) + +(defstruct (slime-presentation) + (text) + (id) + (start-p) + (stop-p)) + +(defun slime-add-presentation-properties (start end id result-p) + "Make the text between START and END a presentation with ID. +RESULT-P decides whether a face for a return value or output text is used." + (add-text-properties start end + `(face slime-repl-inputed-output-face + slime-repl-old-output ,id + mouse-face slime-repl-output-mouseover-face + keymap ,slime-presentation-map + rear-nonsticky (slime-repl-old-output + slime-repl-presentation + face mouse-face))) + (let ((text (buffer-substring-no-properties start end))) + (case (- end start) + (0) + (1 + (add-text-properties start end + `(slime-repl-presentation + ,(make-slime-presentation :text text :id id + :start-p t :stop-p t)))) + (t + (let ((inhibit-modification-hooks t)) + (add-text-properties start (1+ start) + `(slime-repl-presentation + ,(make-slime-presentation :text text :id id + :start-p t :stop-p nil))) + (when (> (- end start) 2) + (add-text-properties (1+ start) (1- end) + `(slime-repl-presentation + ,(make-slime-presentation :text text :id id + :start-p nil :stop-p nil)))) + (add-text-properties (1- end) end + `(slime-repl-presentation + ,(make-slime-presentation :text text :id id + :start-p nil :stop-p t)))))))) +(defun slime-insert-presentation (result output-id) + (let ((start (point))) + (insert result) + (slime-add-presentation-properties start (point) output-id t))) + (defun slime-open-stream-to-lisp (port) (let ((stream (open-network-stream "*lisp-output-stream*" (slime-with-connection-buffer () @@ -2619,8 +2663,8 @@ (install-bridge) (setq bridge-destination-insert nil) (setq bridge-source-insert nil) - (setq bridge-handlers (list* '("<" . slime-mark-presentation-start) - '(">" . slime-mark-presentation-end) + (setq bridge-handlers (list* '("<" . slime-mark-presentation-start-handler) + '(">" . slime-mark-presentation-end-handler) bridge-handlers)) (set-process-coding-system stream slime-net-coding-system @@ -2756,61 +2800,105 @@ (slime-setup-command-hooks) (run-hooks 'slime-repl-mode-hook)) -(defvar slime-not-copying-whole-presentation nil) - -;; alanr -(defun slime-presentation-command-hook () - (let* ((props-here (text-properties-at (point))) - (props-before (and (not (= (point) (point-min))) - (text-properties-at (1- (point))))) - (inside (and (getf props-here 'slime-repl-old-output))) - (at-beginning (and inside - (not (getf props-before 'slime-repl-old-output)))) - (at-end (and (or (= (point) (point-max)) - (not (getf props-here 'slime-repl-old-output))) - (getf props-before 'slime-repl-old-output))) - (start (cond (at-beginning (point)) - (inside (previous-single-property-change - (point) 'slime-repl-old-output)) - (at-end (previous-single-property-change - (1- (point)) 'slime-repl-old-output)))) - (end (cond (at-beginning (or (next-single-property-change - (point) 'slime-repl-old-output) - (point-max))) - (inside (or (next-single-property-change (point) 'slime-repl-old-output) - (point-max))) - (at-end (point))))) - ; (setq message (format "%s %s %s %s %s" at-beginning inside at-end start end)) - (when (and (or inside at-end) start end (> end start)) - (let ((kind (get this-command 'action-type))) - ; (message (format "%s %s %s %s" at-beginning inside at-end kind)) - (cond ((and (eq kind 'inserts) inside (not at-beginning)) - (setq this-command 'ignore)) - ((and (eq kind 'deletes-forward) inside (not at-end)) - (kill-region start end) - (setq this-command 'ignore)) - ((and (eq kind 'deletes-backward) (or inside at-end) (not at-beginning)) - (kill-region start end) - (setq this-command 'ignore)) - ((eq kind 'copies) - (multiple-value-bind (start end) (slime-property-bounds 'slime-repl-old-input) - (setq slime-not-copying-whole-presentation - (not (or (and at-beginning (>= (mark) end)) - (and at-end (<= (mark) start))))))) - ;(message (format "%s %s" length (abs (- (point) (mark)))))))) - ))))) - -;; if we did not copy the whole presentation, then remove the text properties from the -;; top of the kill ring - -(defun slime-presentation-post-command-hook () - (when (eq (get this-command 'action-type) 'copies) - (when slime-not-copying-whole-presentation - (remove-text-properties 0 (length (car kill-ring)) - '(slime-repl-old-output t mouse-face t rear-nonsticky t) - (car kill-ring)))) - (setq slime-not-copying-whole-presentation nil) - ) +(defun slime-presentation-whole-p (start end) + (let ((presentation (get-text-property start 'slime-repl-presentation))) + (and presentation + (string= (buffer-substring-no-properties start end) + (slime-presentation-text presentation))))) + +(defun slime-same-presentation-p (a b) + (and (string= (slime-presentation-text a) (slime-presentation-text b)) + (equal (slime-presentation-id a) (slime-presentation-id b)))) + +(defun* slime-presentation-start () + "Find start of presentation at point. Return buffer index and + whether a start-tag was found. When there is no presentation at + point, return nil and nil." + (let* ((presentation (get-text-property (point) 'slime-repl-presentation)) + (this-presentation presentation)) + (unless presentation + (return-from slime-presentation-start + (values nil nil))) + (save-excursion + (while (not (slime-presentation-start-p this-presentation)) + (let ((change-point (previous-single-property-change (point) 'slime-repl-presentation))) + (unless change-point + (return-from slime-presentation-start + (values (point-min) nil))) + (setq this-presentation (get-text-property change-point 'slime-repl-presentation)) + (unless (and this-presentation + (slime-same-presentation-p presentation this-presentation)) + (return-from slime-presentation-start + (values (point) nil))) + (goto-char change-point))) + (values (point) t)))) + +(defun* slime-presentation-end () + "Find end of presentation at point. Return buffer index (after last + character of the presentation) and whether an end-tag was found." + (let* ((presentation (get-text-property (point) 'slime-repl-presentation)) + (this-presentation presentation)) + (unless presentation + (return-from slime-presentation-end + (values nil nil))) + (save-excursion + (while (and this-presentation + (slime-same-presentation-p presentation this-presentation) + (not (slime-presentation-stop-p this-presentation))) + (let ((change-point (next-single-property-change (point) 'slime-repl-presentation))) + (unless change-point + (return-from slime-presentation-end + (values (point-max) nil))) + (goto-char change-point) + (setq this-presentation (get-text-property (point) 'slime-repl-presentation)))) + (if (and this-presentation + (slime-same-presentation-p presentation this-presentation)) + (let ((after-end (next-single-property-change (point) 'slime-repl-presentation))) + (if (not after-end) + (values (point-max) t) + (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) + (slime-presentation-end) + (values start end + (and good-start good-end + (slime-presentation-whole-p start end)))))) + +(defun slime-after-change-function (start end old-len) + "Check all presentations within and adjacent to the change. When a + presentation has been altered, change it to plain text." + (unless undo-in-progress + (let ((real-start (max (point-min) (1- start))) + (real-end (min (point-max) (1+ end))) + (any-change nil)) + ;; positions around the change + (save-excursion + (goto-char real-start) + (while (< (point) real-end) + (let ((presentation (get-text-property (point) 'slime-repl-presentation))) + (when presentation + (multiple-value-bind (from to whole) + (slime-presentation-around-point) + ;;(message "presentation %s whole-p %s" (buffer-substring from to) whole) + (unless whole + (setq any-change t) + (remove-text-properties from to + '(slime-repl-old-output t + slime-repl-inputed-output-face t + face t mouse-face t rear-nonsticky t + slime-repl-presentation t)))))) + (let ((next-change + (next-single-property-change (point) 'slime-repl-presentation nil + real-end))) + (if next-change + (goto-char next-change) + (undo-boundary) + (return)))))))) (defun slime-copy-presentation-at-point (event) (interactive "e") @@ -2834,20 +2922,6 @@ (goto-char (point-max)) (do-insertion))))))) -(put 'self-insert-command 'action-type 'inserts) -(put 'self-insert-command-1 'action-type 'inserts) -(put 'yank 'action-type 'inserts) -(put 'kill-word 'action-type 'deletes-forward) -(put 'delete-char 'action-type 'deletes-forward) -(put 'kill-sexp 'action-type 'deletes-forward) -(put 'backward-kill-sexp 'action-type 'deletes-backward) -(put 'backward-delete-char 'action-type 'deletes-backward) -(put 'delete-backward-char 'action-type 'deletes-backward) -(put 'backward-kill-word 'action-type 'deletes-backward) -(put 'backward-delete-char-untabify 'action-type 'deletes-backward) -(put 'slime-repl-newline-and-indent 'action-type 'inserts) -(put 'kill-ring-save 'action-type 'copies) - (defvar slime-presentation-map (make-sparse-keymap)) (define-key slime-presentation-map [mouse-2] 'slime-copy-presentation-at-point) @@ -2891,25 +2965,31 @@ (defun slime-repl-insert-prompt (result &optional time) "Goto to point max, insert RESULT and the prompt. Set slime-output-end to start of the inserted text slime-input-start to -end end." +end end. If RESULT is not a string, it must be a list of +result strings, each of which is marked-up as a presentation." (slime-flush-output) (goto-char (point-max)) (let ((start (point))) (unless (bolp) (insert "\n")) - (unless (string= "" result) - (slime-propertize-region `(face slime-repl-result-face) - (slime-propertize-region - (and slime-repl-enable-presentations - `(face slime-repl-result-face - slime-repl-old-output ,(- slime-current-output-id) - mouse-face slime-repl-output-mouseover-face - keymap ,slime-presentation-map)) - (insert result))) - (unless (bolp) (insert "\n")) - (let ((inhibit-read-only t)) - (put-text-property (- (point) 2) (point) - 'rear-nonsticky - '(slime-repl-old-output face read-only)))) + (flet ((insert-result (result id) + (if (and slime-repl-enable-presentations id) + (slime-insert-presentation result id) + (slime-propertize-region `(face slime-repl-result-face) + (insert result))) + (unless (bolp) (insert "\n")) + (let ((inhibit-read-only t)) + (put-text-property (- (point) 2) (point) + 'rear-nonsticky + '(slime-repl-old-output slime-repl-presentation face read-only))))) + (etypecase result + (list + (loop + for res in result + for index from 0 + do (insert-result res (cons (- slime-current-output-id) index)))) + (string + (unless (string= result "") + (insert-result result nil))))) (let ((prompt-start (point)) (prompt (format "%s> " (slime-lisp-package-prompt-string)))) (slime-propertize-region @@ -2973,7 +3053,11 @@ (concat (substring str-no-props 0 pos) ;; Eval in the reader so that we play nice with quote. ;; -luke (19/May/2005) - "#." (slime-prin1-to-string `(swank:get-repl-result ,id)) + "#." (slime-prin1-to-string + (if (consp id) + `(cl:nth ,(cdr id) + (swank:get-repl-result ,(car id))) + `(swank:get-repl-result ,id))) (reify-old-output (substring str-props end-pos) (substring str-no-props end-pos))))))) @@ -3027,8 +3111,11 @@ (set-marker slime-output-end position))) (defun slime-mark-output-end () + ;; Don't put slime-repl-output-face again; it would remove the + ;; special presentation face, for instance in the SBCL inspector. (add-text-properties slime-output-start slime-output-end - '(face slime-repl-output-face rear-nonsticky (face)))) + '(;;face slime-repl-output-face + rear-nonsticky (face)))) (defun slime-repl-bol () "Go to the beginning of line or the prompt." From mkoeppe at common-lisp.net Thu Aug 4 19:23:15 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Thu, 4 Aug 2005 21:23:15 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050804192315.63CF98815C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv26126 Modified Files: swank.lisp Log Message: (encode-message): Don't use the pretty printer for printing the message length. (listener-eval): Store the whole values-list with add-repl-result. Date: Thu Aug 4 21:23:14 2005 Author: mkoeppe Index: slime/swank.lisp diff -u slime/swank.lisp:1.314 slime/swank.lisp:1.315 --- slime/swank.lisp:1.314 Thu Aug 4 21:16:14 2005 +++ slime/swank.lisp Thu Aug 4 21:23:13 2005 @@ -975,7 +975,8 @@ (let* ((string (prin1-to-string-for-emacs message)) (length (1+ (length string)))) (log-event "WRITE: ~A~%" string) - (format stream "~6,'0x" length) + (let ((*print-pretty* nil)) + (format stream "~6,'0x" length)) (write-string string stream) (terpri stream) (force-output stream))) @@ -1852,13 +1853,13 @@ (setq *** ** ** * * (car values) /// // // / / values) (when *record-repl-results* - (add-repl-result *current-id* *))) + (add-repl-result *current-id* values))) (setq +++ ++ ++ + + last-form) (if (eq *slime-repl-suppress-output* t) "" (cond ((null values) "; No value") (t - (format nil "~{~S~^~%~}" values)))))))) + (mapcar #'prin1-to-string values)))))))) (defun add-repl-result (id val) (push (cons id val) *repl-results*) From mkoeppe at common-lisp.net Thu Aug 4 19:27:56 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Thu, 4 Aug 2005 21:27:56 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050804192756.821F08815C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv26262 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Thu Aug 4 21:27:55 2005 Author: mkoeppe Index: slime/ChangeLog diff -u slime/ChangeLog:1.730 slime/ChangeLog:1.731 --- slime/ChangeLog:1.730 Thu Aug 4 02:04:33 2005 +++ slime/ChangeLog Thu Aug 4 21:27:55 2005 @@ -1,3 +1,47 @@ +2005-08-04 Matthias Koeppe + + * swank.lisp (encode-message): Don't use the pretty printer for + printing the message length. + + * slime.el (slime-dispatch-event): New events :presentation-start, + :presentation-end for bridge-less presentation markup. + * swank.lisp (dispatch-event, send-to-socket-io): Likewise. + + * swank.lisp (listener-eval): Store the whole values-list with + add-repl-result. + * slime.el (slime-repl-insert-prompt): Accept a list of strings, + representing individual values of a multiple-value result. Mark + them up as separate presentations. + (reify-old-output): Support reifying individual values of a + multiple-value result. + + * slime.el (slime-pre-command-hook): Don't call + slime-presentation-command-hook. + (slime-post-command-hook): Don't call + slime-presentation-post-command-hook. + (slime-presentation-command-hook): Removed. + (slime-presentation-post-command-hook): Removed. + + * slime.el (slime-presentation-whole-p): New. + (slime-same-presentation-p): New. + (slime-presentation-start, slime-presentation-end): New. + (slime-presentation-around-point): New. + (slime-after-change-function): New. + (slime-setup-command-hooks): Install slime-after-change-function + as an after-change-function. + + * slime.el (slime-repl-enable-presentations): Make + slime-repl-presentation nonsticky. + (slime-mark-presentation-start, slime-mark-presentation-end): New + functions. + (slime-mark-presentation-start-handler): Renamed from + slime-mark-presentation-start. + (slime-mark-presentation-end-handler): Renamed from + slime-mark-presentation-end. + (slime-presentation): New structure. + (slime-add-presentation-properties): New function. + (slime-insert-presentation): New function. + 2005-08-03 Zach Beane * swank-sbcl.lisp (swank-compile-string): Restore honoring of From mkoeppe at common-lisp.net Thu Aug 4 19:34:47 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Thu, 4 Aug 2005 21:34:47 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050804193447.998CD8815C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv27235 Modified Files: swank.lisp Log Message: (*can-print-presentation*): New variable, moved here from present.lisp. (interactive-eval, listener-eval, backtrace) (swank-compiler, compile-file-for-emacs, load-file) (init-inspector): Bind *can-print-presentation* to an appropriate value. Date: Thu Aug 4 21:34:46 2005 Author: mkoeppe Index: slime/swank.lisp diff -u slime/swank.lisp:1.315 slime/swank.lisp:1.316 --- slime/swank.lisp:1.315 Thu Aug 4 21:23:13 2005 +++ slime/swank.lisp Thu Aug 4 21:34:35 2005 @@ -1691,11 +1691,12 @@ (t (format nil "~{~S~^, ~}" values)))))) (defslimefun interactive-eval (string) - (with-buffer-syntax () - (let ((values (multiple-value-list (eval (from-string string))))) - (fresh-line) - (force-output) - (format-values-for-echo-area values)))) + (let ((*can-print-presentation* t)) + (with-buffer-syntax () + (let ((values (multiple-value-list (eval (from-string string))))) + (fresh-line) + (force-output) + (format-values-for-echo-area values))))) (defslimefun eval-and-grab-output (string) (with-buffer-syntax () @@ -1842,12 +1843,17 @@ (defparameter *repl-results* '() "Association list of old repl results.") +(defvar *can-print-presentation* nil + "set this to t in contexts where it is ok to print presentations at all") + (defslimefun listener-eval (string) (clear-user-input) (with-buffer-syntax () (let ((*slime-repl-suppress-output* :unset) (*slime-repl-advance-history* :unset)) - (multiple-value-bind (values last-form) (eval-region string t) + (multiple-value-bind (values last-form) + (let ((*can-print-presentation* t)) + (eval-region string t)) (unless (or (and (eq values nil) (eq last-form nil)) (eq *slime-repl-advance-history* nil)) (setq *** ** ** * * (car values) @@ -2044,9 +2050,13 @@ (defslimefun backtrace (start end) "Return a list ((I FRAME) ...) of frames from START to END. I is an integer describing and FRAME a string." - (loop for frame in (compute-backtrace start end) - for i from start - collect (list i (frame-for-emacs i frame)))) + (let ((*can-print-presentation* nil)) + ;; Disable presentations during backtrack, for now. For one thing, + ;; the filter isn't set up for the sldb buffer. Also there is + ;; higher likelyhood of lossage due to dynamic extent objects. + (loop for frame in (compute-backtrace start end) + for i from start + collect (list i (frame-for-emacs i frame))))) (defslimefun debugger-info-for-emacs (start end) "Return debugger state, with stack frames from START to END. @@ -2197,21 +2207,23 @@ (if s (list :short-message s))))) (defun swank-compiler (function) - (clear-compiler-notes) - (with-simple-restart (abort "Abort SLIME compilation.") - (multiple-value-bind (result usecs) - (handler-bind ((compiler-condition #'record-note-for-condition)) - (measure-time-interval function)) - (list (to-string result) - (format nil "~,2F" (/ usecs 1000000.0)))))) + (let ((*can-print-presentation* t)) + (clear-compiler-notes) + (with-simple-restart (abort "Abort SLIME compilation.") + (multiple-value-bind (result usecs) + (handler-bind ((compiler-condition #'record-note-for-condition)) + (measure-time-interval function)) + (list (to-string result) + (format nil "~,2F" (/ usecs 1000000.0))))))) (defslimefun compile-file-for-emacs (filename load-p &optional external-format) "Compile FILENAME and, when LOAD-P, load the result. Record compiler notes signalled as `compiler-condition's." - (with-buffer-syntax () - (let ((*compile-print* nil)) - (swank-compiler (lambda () (swank-compile-file filename load-p - external-format)))))) + (let ((*can-print-presentation* t)) + (with-buffer-syntax () + (let ((*compile-print* nil)) + (swank-compiler (lambda () (swank-compile-file filename load-p + external-format))))))) (defslimefun compile-string-for-emacs (string buffer position directory) "Compile STRING (exerpted from BUFFER at POSITION). @@ -2269,7 +2281,8 @@ ;;;; Loading (defslimefun load-file (filename) - (to-string (load filename))) + (let ((*can-print-presentation* t)) + (to-string (load filename)))) (defslimefun load-file-set-package (filename &optional package) (load-file filename) @@ -3750,10 +3763,12 @@ *inspector-history* (make-array 10 :adjustable t :fill-pointer 0))) (defslimefun init-inspector (string) - (with-buffer-syntax () - (reset-inspector) - (inspect-object (eval (read-from-string string))))) - + (let ((*can-print-presentation* nil)) + ;; Disable presentations. + (with-buffer-syntax () + (reset-inspector) + (inspect-object (eval (read-from-string string)))))) + (defun print-part-to-string (value) (let ((string (to-string value)) (pos (position value *inspector-history*))) From mkoeppe at common-lisp.net Thu Aug 4 19:36:30 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Thu, 4 Aug 2005 21:36:30 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/present.lisp Message-ID: <20050804193630.749CB8815C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv27284 Modified Files: present.lisp Log Message: (interactive-eval, listener-eval, backtrace) (swank-compiler, compile-file-for-emacs, load-file) (init-inspector): Remove code duplication with swank.lisp. Date: Thu Aug 4 21:36:28 2005 Author: mkoeppe Index: slime/present.lisp diff -u slime/present.lisp:1.4 slime/present.lisp:1.5 --- slime/present.lisp:1.4 Tue May 24 04:42:01 2005 +++ slime/present.lisp Thu Aug 4 21:36:27 2005 @@ -15,9 +15,6 @@ ;; ultimately prints to a slime stream. ;; Control -(defvar *can-print-presentation* nil - "set this to t in contexts where it is ok to print presentations at all") - (defvar *enable-presenting-readable-objects* t "set this to enable automatically printing presentations for some subset of readable objects, such as pathnames." ) @@ -110,52 +107,6 @@ (write-string "" stream))) (funcall continue))) -;; enable presentations inside listener eval, when compiling, when evaluating -(defslimefun listener-eval (string) - (clear-user-input) - (with-buffer-syntax () - (let ((*slime-repl-suppress-output* :unset) - (*slime-repl-advance-history* :unset)) - (multiple-value-bind (values last-form) - (let ((*can-print-presentation* t)) - (eval-region string t)) - (unless (or (and (eq values nil) (eq last-form nil)) - (eq *slime-repl-advance-history* nil)) - (setq *** ** ** * * (car values) - /// // // / / values) - (when *record-repl-results* - (add-repl-result *current-id* *))) - (setq +++ ++ ++ + + last-form) - (if (eq *slime-repl-suppress-output* t) - "" - (cond ((null values) "; No value") - (t - (format nil "~{~S~^~%~}" values)))))))) - -(defslimefun compile-string-for-emacs (string buffer position directory) - "Compile STRING (exerpted from BUFFER at POSITION). -Record compiler notes signalled as `compiler-condition's." - (let ((*can-print-presentation* t)) - (with-buffer-syntax () - (swank-compiler - (lambda () - (let ((*compile-print* nil) (*compile-verbose* t)) - (swank-compile-string string :buffer buffer :position position - :directory directory))))))) - -(defslimefun interactive-eval (string) - (let ((*can-print-presentation* t)) - (with-buffer-syntax () - (let ((values (multiple-value-list (eval (from-string string))))) - (fresh-line) - (force-output) - (format-values-for-echo-area values))))) - -(defslimefun load-file (filename) - (let ((*can-print-presentation* t)) - (to-string (load filename)))) - - ;; hook up previous implementation. Use negative ids for repl results so as to not conflict with ;; the ones for other printout (defun add-repl-result (id val) @@ -180,34 +131,6 @@ id '*record-repl-results*))) previous-output)) -;; Disable during backtrack, for now. For one thing, the filter isn't set up for the sldb -;; buffer. Also there is higher likelyhood of lossage due to dynamic extent objects. - -(defslimefun backtrace (start end) - "Return a list ((I FRAME) ...) of frames from START to END. -I is an integer describing and FRAME a string." - (let ((*can-print-presentation* nil)) - (loop for frame in (compute-backtrace start end) - for i from start - collect (list i (frame-for-emacs i frame))))) - -;; ditto inspector - isn't needed -(defslimefun init-inspector (string) - (let ((*can-print-presentation* nil)) - (with-buffer-syntax () - (reset-inspector) - (inspect-object (eval (read-from-string string)))))) - -;; for load system etc -(defun swank-compiler (function) - (let ((*can-print-presentation* t)) - (clear-compiler-notes) - (with-simple-restart (abort "Abort SLIME compilation.") - (multiple-value-bind (result usecs) - (handler-bind ((compiler-condition #'record-note-for-condition)) - (measure-time-interval function)) - (list (to-string result) - (format nil "~,2F" (/ usecs 1000000.0))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; menu protocol From mkoeppe at common-lisp.net Thu Aug 4 19:40:00 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Thu, 4 Aug 2005 21:40:00 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/present.lisp Message-ID: <20050804194000.1BDF68815C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv27316 Modified Files: present.lisp Log Message: [sbcl, allegro]: Add printer hooks for unreadable objects and pathnames. Date: Thu Aug 4 21:39:59 2005 Author: mkoeppe Index: slime/present.lisp diff -u slime/present.lisp:1.5 slime/present.lisp:1.6 --- slime/present.lisp:1.5 Thu Aug 4 21:36:27 2005 +++ slime/present.lisp Thu Aug 4 21:39:59 2005 @@ -294,3 +294,29 @@ (fwrappers::fwrap 'lisp::%print-pathname #'presenting-pathname-wrapper) (fwrappers::fwrap 'lisp::%print-unreadable-object #'presenting-unreadable-wrapper) ) + +#+sbcl +(progn + (defvar *saved-%print-unreadable-object* + (fdefinition 'sb-impl::%print-unreadable-object)) + (sb-ext:without-package-locks + (setf (fdefinition 'sb-impl::%print-unreadable-object) + (lambda (object stream type identity body) + (presenting-object object stream + (funcall *saved-%print-unreadable-object* + object stream type identity body)))) + (defmethod print-object :around ((object pathname) stream) + (presenting-object object stream + (call-next-method))))) + +#+allegro +(progn + (excl:def-fwrapper presenting-unreadable-wrapper (object stream type identity continuation) + (swank::presenting-object object stream (excl:call-next-fwrapper))) + (excl:def-fwrapper presenting-pathname-wrapper (pathname stream depth) + (presenting-object-if (can-present-readable-objects stream) pathname stream + (excl:call-next-fwrapper))) + (excl:fwrap 'excl::print-unreadable-object-1 + 'print-unreadable-present 'presenting-unreadable-wrapper) + (excl:fwrap 'excl::pathname-printer + 'print-pathname-present 'presenting-pathname-wrapper)) From mkoeppe at common-lisp.net Thu Aug 4 19:49:12 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Thu, 4 Aug 2005 21:49:12 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/present.lisp Message-ID: <20050804194912.2BDA68815C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv28276 Modified Files: present.lisp Log Message: (write-annotation): New function. (presentation-record): New structure. (presentation-start, presentation-end): New functions. (presenting-object-1): Use them here. Date: Thu Aug 4 21:49:11 2005 Author: mkoeppe Index: slime/present.lisp diff -u slime/present.lisp:1.6 slime/present.lisp:1.7 --- slime/present.lisp:1.6 Thu Aug 4 21:39:59 2005 +++ slime/present.lisp Thu Aug 4 21:49:10 2005 @@ -91,20 +91,60 @@ (declare (ignore stream)) *enable-presenting-readable-objects*) +;; If we are printing to an XP (pretty printing) stream, printing the +;; escape sequences directly would mess up the layout because column +;; counting is disturbed. Use "annotations" instead. +#+allegro +(defun write-annotation (stream function arg) + (if (typep stream 'excl:xp-simple-stream) + (excl::schedule-annotation stream function arg) + (funcall function arg stream nil))) +#-allegro +(defun write-annotation (stream function arg) + (funcall function arg stream nil)) + +(defstruct presentation-record + (id) + (printed-p)) + +(defun presentation-start (record stream truncatep) + (unless truncatep + ;; Don't start new presentations when nothing is going to be + ;; printed due to *print-lines*. + (let ((pid (presentation-record-id record))) + (cond (*use-dedicated-output-stream* + (write-string "<" stream) + (prin1 pid stream) + (write-string "" stream)) + (t + (force-output stream) + (send-to-emacs `(:presentation-start ,pid))))) + (setf (presentation-record-printed-p record) t))) + +(defun presentation-end (record stream truncatep) + (declare (ignore truncatep)) + ;; Always end old presentations that were started. + (when (presentation-record-printed-p record) + (let ((pid (presentation-record-id record))) + (cond (*use-dedicated-output-stream* + (write-string ">" stream) + (prin1 pid stream) + (write-string "" stream)) + (t + (force-output stream) + (send-to-emacs `(:presentation-end ,pid))))))) + (defun presenting-object-1 (object stream continue) "Uses the bridge mechanism with two messages >id and " stream) - (prin1 pid stream) - (write-string "" stream))) + (write-annotation stream #'presentation-end record))) (funcall continue))) ;; hook up previous implementation. Use negative ids for repl results so as to not conflict with From mkoeppe at common-lisp.net Thu Aug 4 19:54:44 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Thu, 4 Aug 2005 21:54:44 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/present.lisp Message-ID: <20050804195444.45BEC8815C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv28320 Modified Files: present.lisp Log Message: (slime-stream-p) [allegro]: Allow printing presentations through pretty printing streams. Date: Thu Aug 4 21:54:44 2005 Author: mkoeppe Index: slime/present.lisp diff -u slime/present.lisp:1.7 slime/present.lisp:1.8 --- slime/present.lisp:1.7 Thu Aug 4 21:49:10 2005 +++ slime/present.lisp Thu Aug 4 21:54:43 2005 @@ -81,6 +81,9 @@ #+cmu (and (typep stream 'pretty-print::pretty-stream) (slime-stream-p (pretty-print::pretty-stream-target stream))) + #+allegro + (and (typep stream 'excl:xp-simple-stream) + (slime-stream-p (excl::stream-output-handle stream))) (loop for connection in *connections* thereis (or (eq stream (connection.dedicated-output connection)) (eq stream (connection.socket-io connection)) From mkoeppe at common-lisp.net Thu Aug 4 20:13:08 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Thu, 4 Aug 2005 22:13:08 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/present.lisp Message-ID: <20050804201308.77D9A8815C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv29367 Modified Files: present.lisp Log Message: (slime-stream-p) [cmu]: Allow printing presentations through pretty printing streams, if CMUCL has annotations support and we are using the bridge-less protocol. [sbcl]: Allow printing presentations through indenting streams. Date: Thu Aug 4 22:13:07 2005 Author: mkoeppe Index: slime/present.lisp diff -u slime/present.lisp:1.8 slime/present.lisp:1.9 --- slime/present.lisp:1.8 Thu Aug 4 21:54:43 2005 +++ slime/present.lisp Thu Aug 4 22:13:07 2005 @@ -79,8 +79,21 @@ ;(slime-stream-p (ccl::xp-base-stream (slot-value stream 'ccl::xp-structure))) (slime-stream-p (ccl::%svref (slot-value stream 'ccl::xp-structure) 1))) #+cmu - (and (typep stream 'pretty-print::pretty-stream) - (slime-stream-p (pretty-print::pretty-stream-target stream))) + (or (and (typep stream 'lisp::indenting-stream) + (slime-stream-p (lisp::indenting-stream-stream stream))) + (and (typep stream 'pretty-print::pretty-stream) + (fboundp 'pretty-print::enqueue-annotation) + (not *use-dedicated-output-stream*) + ;; Printing through CMUCL pretty streams + ;; is only cleanly possible if we are + ;; using the bridge-less protocol with + ;; annotations, because the bridge escape + ;; sequences disturb the pretty printer + ;; layout. + (slime-stream-p (pretty-print::pretty-stream-target stream)))) + #+sbcl + (and (typep stream 'sb-impl::indenting-stream) + (slime-stream-p (sb-impl::indenting-stream-stream stream))) #+allegro (and (typep stream 'excl:xp-simple-stream) (slime-stream-p (excl::stream-output-handle stream))) @@ -102,7 +115,13 @@ (if (typep stream 'excl:xp-simple-stream) (excl::schedule-annotation stream function arg) (funcall function arg stream nil))) -#-allegro +#+cmu +(defun write-annotation (stream function arg) + (if (and (typep stream 'pp:pretty-stream) + (fboundp 'pp::enqueue-annotation)) + (pp::enqueue-annotation stream function arg) + (funcall function arg stream nil))) +#-(or allegro cmu) (defun write-annotation (stream function arg) (funcall function arg stream nil)) From mkoeppe at common-lisp.net Thu Aug 4 20:14:57 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Thu, 4 Aug 2005 22:14:57 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050804201457.D3A638815C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv29435 Modified Files: swank.lisp Log Message: (*can-print-presentation*): Move up. Date: Thu Aug 4 22:14:57 2005 Author: mkoeppe Index: slime/swank.lisp diff -u slime/swank.lisp:1.316 slime/swank.lisp:1.317 --- slime/swank.lisp:1.316 Thu Aug 4 21:34:35 2005 +++ slime/swank.lisp Thu Aug 4 22:14:57 2005 @@ -329,7 +329,7 @@ ;;;; TCP Server -(defvar *use-dedicated-output-stream* t +(defvar *use-dedicated-output-stream* nil "When T swank will attempt to create a second connection to Emacs which is used just to send output.") (defvar *dedicated-output-stream-port* 0 @@ -917,7 +917,7 @@ (out (connection.user-output connection)) (*standard-output* out) (*error-output* out) - (*trace-output* out) + ;;(*trace-output* out) (*debug-io* io) (*query-io* io) (*standard-input* in) @@ -1657,6 +1657,9 @@ (defvar *current-id* nil) +(defvar *can-print-presentation* nil + "set this to t in contexts where it is ok to print presentations at all") + (defun eval-for-emacs (form buffer-package id) "Bind *BUFFER-PACKAGE* BUFFER-PACKAGE and evaluate FORM. Return the result to the continuation ID. @@ -1843,9 +1846,6 @@ (defparameter *repl-results* '() "Association list of old repl results.") -(defvar *can-print-presentation* nil - "set this to t in contexts where it is ok to print presentations at all") - (defslimefun listener-eval (string) (clear-user-input) (with-buffer-syntax () From mkoeppe at common-lisp.net Thu Aug 4 20:16:47 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Thu, 4 Aug 2005 22:16:47 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050804201647.327628815C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv30298 Modified Files: swank.lisp Log Message: Undo changes I checked in by mistake. Date: Thu Aug 4 22:16:46 2005 Author: mkoeppe Index: slime/swank.lisp diff -u slime/swank.lisp:1.317 slime/swank.lisp:1.318 --- slime/swank.lisp:1.317 Thu Aug 4 22:14:57 2005 +++ slime/swank.lisp Thu Aug 4 22:16:45 2005 @@ -329,7 +329,7 @@ ;;;; TCP Server -(defvar *use-dedicated-output-stream* nil +(defvar *use-dedicated-output-stream* t "When T swank will attempt to create a second connection to Emacs which is used just to send output.") (defvar *dedicated-output-stream-port* 0 @@ -917,7 +917,7 @@ (out (connection.user-output connection)) (*standard-output* out) (*error-output* out) - ;;(*trace-output* out) + (*trace-output* out) (*debug-io* io) (*query-io* io) (*standard-input* in) From mkoeppe at common-lisp.net Thu Aug 4 20:27:03 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Thu, 4 Aug 2005 22:27:03 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050804202703.9BB498815C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv30463 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Thu Aug 4 22:27:02 2005 Author: mkoeppe Index: slime/ChangeLog diff -u slime/ChangeLog:1.731 slime/ChangeLog:1.732 --- slime/ChangeLog:1.731 Thu Aug 4 21:27:55 2005 +++ slime/ChangeLog Thu Aug 4 22:27:01 2005 @@ -1,5 +1,42 @@ 2005-08-04 Matthias Koeppe + Improvements to the presentations feature. Parts of presentations + can be copied reliably using all available Emacs facilities (not + just kill-ring-save), and they are no longer "semi-readonly" (in + the sense that keypresses are silently ignored). Whenever a user + attempts to edit a presentation, it now simply turns into plain + text (which is indicated by changing the face); this can be + undone. Presentations are now also supported if + *use-dedicated-output-stream* is nil. It is now possible to + access the individual values of multiple-value results. For some + systems (Allegro CL and upcoming CMUCL snapshots), presentations + can be reliably printed through pretty-printing streams. + + * present.lisp (slime-stream-p) [allegro]: Allow printing + presentations through pretty printing streams. + [cmu]: Allow printing presentations through pretty printing + streams, if CMUCL has annotations support and we are using the + bridge-less protocol. + [sbcl]: Allow printing presentations through indenting streams. + + * present.lisp (write-annotation): New function. + (presentation-record): New structure. + (presentation-start, presentation-end): New functions, supporting + both bridge protocol and bridge-less protocol. + (presenting-object-1): Use them here. + + * present.lisp [sbcl, allegro]: Add printer hooks for unreadable + objects and pathnames. + + * swank.lisp (*can-print-presentation*): New variable, moved here + from present.lisp. + * swank.lisp (interactive-eval, listener-eval, backtrace) + (swank-compiler, compile-file-for-emacs, load-file) + (init-inspector): Bind *can-print-presentation* to an appropriate + value. + * present.lisp: Remove code duplication with swank.lisp for the + functions above. + * swank.lisp (encode-message): Don't use the pretty printer for printing the message length. From mkoeppe at common-lisp.net Sat Aug 6 14:45:32 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sat, 6 Aug 2005 16:45:32 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/doc/slime.texi Message-ID: <20050806144532.C2D3788542@common-lisp.net> Update of /project/slime/cvsroot/slime/doc In directory common-lisp.net:/tmp/cvs-serv6114 Modified Files: slime.texi Log Message: (Programming Helpers): Document C-c C-s, slime-complete-form. Date: Sat Aug 6 16:45:31 2005 Author: mkoeppe Index: slime/doc/slime.texi diff -u slime/doc/slime.texi:1.40 slime/doc/slime.texi:1.41 --- slime/doc/slime.texi:1.40 Fri Jul 29 14:40:51 2005 +++ slime/doc/slime.texi Sat Aug 6 16:45:31 2005 @@ -46,7 +46,7 @@ @end macro @set EDITION 1.2 - at set UPDATED @code{$Date: 2005/07/29 12:40:51 $} + at set UPDATED @code{$Date: 2005/08/06 14:45:31 $} @titlepage @title SLIME User Manual @@ -640,9 +640,33 @@ The space key inserts a space and also looks up and displays the argument list for the function at point, if there is one. - at kbditem{C-c C-s, slime-insert-arglist} + at kbditem{C-c C-s, slime-complete-form} Looks up and inserts into the current buffer the argument list for the -function at point, if there is one. +function at point, if there is one. More generally, the command +completes an incomplete form with a template for the missing arguments. +There is special code for discovering extra keywords of generic +functions and for handling @code{make-instance} and + at code{defmethod}. Examples: + + at example +(subseq "abc" + --inserts--> start [end]) +(find 17 + --inserts--> sequence :from-end from-end :test test + :test-not test-not :start start :end end + :key key) +(find 17 '(17 18 19) :test #'= + --inserts--> :from-end from-end + :test-not test-not :start start :end end + :key key) +(defclass foo () ((bar :initarg :bar))) +(defmethod print-object + --inserts--> (object stream) + body...) +(defmethod initialize-instance :after ((object foo) &key blub)) +(make-instance 'foo + --inserts--> :bar bar :blub blub initargs...) + at end example @kbditem{C-c C-m, slime-macroexpand-1} Macroexpand the expression at point once. If invoked with a prefix From mkoeppe at common-lisp.net Sat Aug 6 14:50:21 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sat, 6 Aug 2005 16:50:21 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050806145021.8112588542@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6615 Modified Files: swank.lisp Log Message: (form-completion): New generic function, factored out from complete-form. (complete-form): Factor out form-completion. (form-completion): Specialize on defmethod forms to insert arglist of generic function. Date: Sat Aug 6 16:50:20 2005 Author: mkoeppe Index: slime/swank.lisp diff -u slime/swank.lisp:1.318 slime/swank.lisp:1.319 --- slime/swank.lisp:1.318 Thu Aug 4 22:16:45 2005 +++ slime/swank.lisp Sat Aug 6 16:50:20 2005 @@ -1614,6 +1614,46 @@ (arglist.keyword-args decoded-arglist) :key #'keyword-arg.keyword)))) +(defgeneric form-completion (operator-form &rest argument-forms)) + +(defmethod form-completion (operator-form &rest argument-forms) + (when (and (symbolp operator-form) + (valid-operator-symbol-p operator-form)) + (let ((arglist (arglist operator-form))) + (etypecase arglist + ((member :not-available) + :not-available) + (list + (let ((decoded-arglist (decode-arglist arglist))) + (enrich-decoded-arglist-with-extra-keywords decoded-arglist + (cons operator-form + argument-forms)) + ;; get rid of formal args already provided + (remove-actual-args decoded-arglist argument-forms) + (return-from form-completion decoded-arglist)))))) + :not-available) + +(defmethod form-completion ((operator-form (eql 'defmethod)) + &rest argument-forms) + (when (and (listp argument-forms) + (not (null argument-forms)) ;have generic function name + (notany #'listp (rest argument-forms))) ;don't have arglist yet + (let* ((gf-name (first argument-forms)) + (gf (and (or (symbolp gf-name) + (and (listp gf-name) + (eql (first gf-name) 'setf))) + (fboundp gf-name) + (fdefinition gf-name)))) + (when (typep gf 'generic-function) + (let ((arglist (arglist gf))) + (etypecase arglist + ((member :not-available)) + (list + (return-from form-completion + (make-arglist :required-args (list arglist) + :rest "body" :body-p t)))))))) + (call-next-method)) + (defslimefun complete-form (form-string) "Read FORM-STRING in the current buffer package, then complete it by adding a template for the missing arguments." @@ -1623,21 +1663,13 @@ (when (consp form) (let ((operator-form (first form)) (argument-forms (rest form))) - (when (and (symbolp operator-form) - (valid-operator-symbol-p operator-form)) - (let ((arglist (arglist operator-form))) - (etypecase arglist - ((member :not-available) - :not-available) - (list - (let ((decoded-arglist (decode-arglist arglist))) - (enrich-decoded-arglist-with-extra-keywords decoded-arglist form) - ;; get rid of formal args already provided - (remove-actual-args decoded-arglist argument-forms) - (return-from complete-form - (decoded-arglist-to-template-string decoded-arglist - *buffer-package* - :prefix ""))))))))) + (let ((form-completion + (apply #'form-completion operator-form argument-forms))) + (unless (eql form-completion :not-available) + (return-from complete-form + (decoded-arglist-to-template-string form-completion + *buffer-package* + :prefix "")))))) :not-available) (reader-error (c) (declare (ignore c)) From mkoeppe at common-lisp.net Sat Aug 6 14:51:12 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sat, 6 Aug 2005 16:51:12 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050806145112.A278488542@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6649 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sat Aug 6 16:51:12 2005 Author: mkoeppe Index: slime/ChangeLog diff -u slime/ChangeLog:1.732 slime/ChangeLog:1.733 --- slime/ChangeLog:1.732 Thu Aug 4 22:27:01 2005 +++ slime/ChangeLog Sat Aug 6 16:51:11 2005 @@ -1,3 +1,14 @@ +2005-08-06 Matthias Koeppe + + * swank.lisp (form-completion): New generic function, factored out + from complete-form. + (complete-form): Factor out form-completion. + (form-completion): Specialize on defmethod forms to insert arglist + of generic function. + + * doc/slime.texi (Programming Helpers): Document C-c C-s, + slime-complete-form. + 2005-08-04 Matthias Koeppe Improvements to the presentations feature. Parts of presentations From mkoeppe at common-lisp.net Sun Aug 7 16:53:33 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sun, 7 Aug 2005 18:53:33 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050807165333.64E6F88525@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv13037 Modified Files: slime.el Log Message: (slime-presentation-menu, slime-presentation-menu) (slime-inspect-presented-object): Quote the presentation id, as it can be a cons. Date: Sun Aug 7 18:53:32 2005 Author: mkoeppe Index: slime/slime.el diff -u slime/slime.el:1.517 slime/slime.el:1.518 --- slime/slime.el:1.517 Thu Aug 4 21:19:43 2005 +++ slime/slime.el Sun Aug 7 18:53:31 2005 @@ -2943,7 +2943,7 @@ (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))) + (choices (slime-eval `(swank::menu-choices-for-presentation-id ',what))) (count 0)) (when choices (if (symbolp choices) @@ -2959,7 +2959,7 @@ (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))))))))))))) + ',what ,nchoice ,(nth (1- nchoice) choices))))))))))))) (defun slime-repl-insert-prompt (result &optional time) @@ -7731,7 +7731,7 @@ (defvar slime-saved-window-config) (defun slime-inspect-presented-object (id) - (slime-inspect `(swank::init-inspector ,(format "(swank::lookup-presented-object %s)" id)))) + (slime-inspect `(swank::init-inspector ,(format "(swank::lookup-presented-object '%s)" id)))) (defun slime-inspect (form) "Eval an expression and inspect the result." From mkoeppe at common-lisp.net Sun Aug 7 17:03:36 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sun, 7 Aug 2005 19:03:36 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/present.lisp Message-ID: <20050807170336.378DE88525@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14045 Modified Files: present.lisp Log Message: (lookup-presented-object): Handle ids that are conses. (execute-menu-choice-for-presentation-id): Use equal for comparing ids, to handle the cons case. (menu-choices-for-presentation): Quote the presentation id, as it can be a cons. Date: Sun Aug 7 19:03:35 2005 Author: mkoeppe Index: slime/present.lisp diff -u slime/present.lisp:1.9 slime/present.lisp:1.10 --- slime/present.lisp:1.9 Thu Aug 4 22:13:07 2005 +++ slime/present.lisp Sun Aug 7 19:03:35 2005 @@ -35,7 +35,12 @@ (defun lookup-presented-object (id) "Retrieve the object corresponding to id. :not-present returned if it isn't there" - (gethash id *presentation-id-to-object* :not-present)) + (if (consp id) + (let ((values (gethash (car id) *presentation-id-to-object* :not-present))) + (if (eql values :not-present) + :not-present + (nth (cdr id) values))) + (gethash id *presentation-id-to-object* :not-present))) (defun save-presented-object (object) "If the object doesn't already have an id, save it and allocate @@ -234,7 +239,7 @@ (defun execute-menu-choice-for-presentation-id (id count item) (let ((ob (lookup-presented-object id))) - (assert (eql id (car *presentation-active-menu*)) () + (assert (equal id (car *presentation-active-menu*)) () "Bug: Execute menu call for id ~a but menu has id ~a" id (car *presentation-active-menu*)) (let ((action (second (nth (1- count) (cdr *presentation-active-menu*))))) @@ -247,7 +252,7 @@ (declare (ignore ob)) (list (list "Inspect" (lambda(choice object id) (declare (ignore choice object)) - `(slime-inspect-presented-object ,id))) + `(slime-inspect-presented-object ',id))) (list "Describe" (lambda(choice object id) (declare (ignore id choice)) (describe object) nil)) From mkoeppe at common-lisp.net Sun Aug 7 17:06:42 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sun, 7 Aug 2005 19:06:42 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050807170642.A94EC88525@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14136 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sun Aug 7 19:06:41 2005 Author: mkoeppe Index: slime/ChangeLog diff -u slime/ChangeLog:1.733 slime/ChangeLog:1.734 --- slime/ChangeLog:1.733 Sat Aug 6 16:51:11 2005 +++ slime/ChangeLog Sun Aug 7 19:06:41 2005 @@ -1,3 +1,16 @@ +2005-08-07 Matthias Koeppe + + Fix for the presentations menu. Reported by Aleksandar Bakic. + + * present.lisp (lookup-presented-object): Handle ids that are + conses. + (execute-menu-choice-for-presentation-id): Use equal for comparing + ids, to handle the cons case. + (menu-choices-for-presentation): Quote the presentation id, as it + can be a cons. + * slime.el (slime-presentation-menu, slime-presentation-menu) + (slime-inspect-presented-object): Quote the presentation id. + 2005-08-06 Matthias Koeppe * swank.lisp (form-completion): New generic function, factored out From mkoeppe at common-lisp.net Mon Aug 8 16:31:48 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Mon, 8 Aug 2005 18:31:48 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050808163148.CCC5388542@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv11392 Modified Files: slime.el Log Message: (undo-in-progress): Define for XEmacs compatibility. Reported by Friedrich Dominicus. Date: Mon Aug 8 18:31:47 2005 Author: mkoeppe Index: slime/slime.el diff -u slime/slime.el:1.518 slime/slime.el:1.519 --- slime/slime.el:1.518 Sun Aug 7 18:53:31 2005 +++ slime/slime.el Mon Aug 8 18:31:47 2005 @@ -2869,6 +2869,14 @@ (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 +(unless (boundp 'undo-in-progress) + (defvar undo-in-progress nil + "Placeholder defvar for XEmacs compatibility from SLIME.") + (defadvice undo-more (around slime activate) + (let ((undo-in-progress t)) ad-do-it))) + (defun slime-after-change-function (start end old-len) "Check all presentations within and adjacent to the change. When a presentation has been altered, change it to plain text." From mkoeppe at common-lisp.net Mon Aug 8 16:32:05 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Mon, 8 Aug 2005 18:32:05 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050808163205.8D53488552@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv11452 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Mon Aug 8 18:32:04 2005 Author: mkoeppe Index: slime/ChangeLog diff -u slime/ChangeLog:1.734 slime/ChangeLog:1.735 --- slime/ChangeLog:1.734 Sun Aug 7 19:06:41 2005 +++ slime/ChangeLog Mon Aug 8 18:32:02 2005 @@ -1,3 +1,8 @@ +2005-08-08 Matthias Koeppe + + * slime.el (undo-in-progress): Define for XEmacs compatibility. + Reported by Friedrich Dominicus. + 2005-08-07 Matthias Koeppe Fix for the presentations menu. Reported by Aleksandar Bakic. From eweitz at common-lisp.net Tue Aug 9 13:56:57 2005 From: eweitz at common-lisp.net (Edi Weitz) Date: Tue, 9 Aug 2005 15:56:57 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog slime/swank.lisp Message-ID: <20050809135657.792FE88525@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv32297 Modified Files: ChangeLog swank.lisp Log Message: New version of SWANK::TRANSPOSE-LISTS Date: Tue Aug 9 15:56:55 2005 Author: eweitz Index: slime/ChangeLog diff -u slime/ChangeLog:1.735 slime/ChangeLog:1.736 --- slime/ChangeLog:1.735 Mon Aug 8 18:32:02 2005 +++ slime/ChangeLog Tue Aug 9 15:56:54 2005 @@ -1,3 +1,8 @@ +2005-08-09 Edi Weitz + + * swank.lisp (transpose-lists): Reimplemented without APPLY so we + don't have problems with CALL-ARGUMENTS-LIMIT. + 2005-08-08 Matthias Koeppe * slime.el (undo-in-progress): Define for XEmacs compatibility. Index: slime/swank.lisp diff -u slime/swank.lisp:1.319 slime/swank.lisp:1.320 --- slime/swank.lisp:1.319 Sat Aug 6 16:50:20 2005 +++ slime/swank.lisp Tue Aug 9 15:56:54 2005 @@ -2566,8 +2566,17 @@ For example: \(transpose-lists '((ONE TWO THREE) (1 2))) => ((ONE 1) (TWO 2))" - ;; A cute function from PAIP p.574 - (if lists (apply #'mapcar #'list lists))) + (catch 'done + (loop with result + with collectors = (loop for list in lists + collect (let ((list list)) + (lambda () + (cond ((null list) + (throw 'done result)) + (t (pop list)))))) + collect (loop for collector in collectors + collect (funcall collector)) into temp-result + do (setq result temp-result)))) ;;;;; Completion Tests From mkoeppe at common-lisp.net Tue Aug 9 19:35:05 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Tue, 9 Aug 2005 21:35:05 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050809193505.E189488540@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv24287 Modified Files: slime.el Log Message: (slime-read-object): Handle ids that are conses. Patch by "Thas" on #lisp. Date: Tue Aug 9 21:34:59 2005 Author: mkoeppe Index: slime/slime.el diff -u slime/slime.el:1.519 slime/slime.el:1.520 --- slime/slime.el:1.519 Mon Aug 8 18:31:47 2005 +++ slime/slime.el Tue Aug 9 21:34:55 2005 @@ -7749,7 +7749,9 @@ (defun slime-read-object (prompt) (let ((id (get-text-property (point) 'slime-repl-old-output))) (if id - `(swank:init-inspector ,(format "(swank:get-repl-result %S)" id)) + (if (consp id) + `(swank:init-inspector ,(format "(cl:nth #10r%d (swank:get-repl-result #10r%d))" (cdr id) (car id))) + `(swank:init-inspector ,(format "(swank:get-repl-result %S)" id))) `(swank:init-inspector ,(slime-read-from-minibuffer "Inspect value (evaluated): " (slime-sexp-at-point)))))) From mkoeppe at common-lisp.net Tue Aug 9 19:35:27 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Tue, 9 Aug 2005 21:35:27 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050809193527.5A24F88540@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv24314 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Tue Aug 9 21:35:26 2005 Author: mkoeppe Index: slime/ChangeLog diff -u slime/ChangeLog:1.736 slime/ChangeLog:1.737 --- slime/ChangeLog:1.736 Tue Aug 9 15:56:54 2005 +++ slime/ChangeLog Tue Aug 9 21:35:25 2005 @@ -1,3 +1,8 @@ +2005-08-09 Matthias Koeppe + + * slime.el (slime-read-object): Handle ids that are conses. + Patch by "Thas" on #lisp. + 2005-08-09 Edi Weitz * swank.lisp (transpose-lists): Reimplemented without APPLY so we From eweitz at common-lisp.net Wed Aug 10 00:21:59 2005 From: eweitz at common-lisp.net (Edi Weitz) Date: Wed, 10 Aug 2005 02:21:59 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog slime/swank.lisp Message-ID: <20050810002159.776538852B@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv11166 Modified Files: ChangeLog swank.lisp Log Message: Helmut's version is much nicer... Date: Wed Aug 10 02:21:58 2005 Author: eweitz Index: slime/ChangeLog diff -u slime/ChangeLog:1.737 slime/ChangeLog:1.738 --- slime/ChangeLog:1.737 Tue Aug 9 21:35:25 2005 +++ slime/ChangeLog Wed Aug 10 02:21:57 2005 @@ -1,3 +1,8 @@ +2005-08-10 Edi Weitz + + * swank.lisp (transpose-lists): Replaced with much nicer function + by Helmut Eller. + 2005-08-09 Matthias Koeppe * slime.el (slime-read-object): Handle ids that are conses. Index: slime/swank.lisp diff -u slime/swank.lisp:1.320 slime/swank.lisp:1.321 --- slime/swank.lisp:1.320 Tue Aug 9 15:56:54 2005 +++ slime/swank.lisp Wed Aug 10 02:21:57 2005 @@ -2566,17 +2566,9 @@ For example: \(transpose-lists '((ONE TWO THREE) (1 2))) => ((ONE 1) (TWO 2))" - (catch 'done - (loop with result - with collectors = (loop for list in lists - collect (let ((list list)) - (lambda () - (cond ((null list) - (throw 'done result)) - (t (pop list)))))) - collect (loop for collector in collectors - collect (funcall collector)) into temp-result - do (setq result temp-result)))) + (cond ((some #'null lists) '()) + (t (cons (mapcar #'car lists) + (transpose-lists (mapcar #'cdr lists)))))) ;;;;; Completion Tests From msimmons at common-lisp.net Wed Aug 10 15:46:44 2005 From: msimmons at common-lisp.net (Martin Simmons) Date: Wed, 10 Aug 2005 17:46:44 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-lispworks.lisp Message-ID: <20050810154644.EFBFE880DE@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv9824 Modified Files: swank-lispworks.lisp Log Message: (defadvice compile-file): Return all values from the real compile-file. Date: Wed Aug 10 17:46:44 2005 Author: msimmons Index: slime/swank-lispworks.lisp diff -u slime/swank-lispworks.lisp:1.74 slime/swank-lispworks.lisp:1.75 --- slime/swank-lispworks.lisp:1.74 Tue Jul 5 22:30:59 2005 +++ slime/swank-lispworks.lisp Wed Aug 10 17:46:43 2005 @@ -388,7 +388,7 @@ (lw:defadvice (compile-file compile-file-and-collect-notes :around) (pathname &rest rest) - (prog1 (apply #'lw:call-next-advice pathname rest) + (multiple-value-prog1 (apply #'lw:call-next-advice pathname rest) (when *within-call-with-compilation-hooks* (maphash (lambda (unfun dspecs) (dolist (dspec dspecs) From msimmons at common-lisp.net Wed Aug 10 15:52:22 2005 From: msimmons at common-lisp.net (Martin Simmons) Date: Wed, 10 Aug 2005 17:52:22 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050810155222.5A94F880DE@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv10864 Modified Files: ChangeLog Log Message: Date: Wed Aug 10 17:52:21 2005 Author: msimmons Index: slime/ChangeLog diff -u slime/ChangeLog:1.738 slime/ChangeLog:1.739 --- slime/ChangeLog:1.738 Wed Aug 10 02:21:57 2005 +++ slime/ChangeLog Wed Aug 10 17:52:21 2005 @@ -1,3 +1,8 @@ +2005-08-10 Martin Simmons + + * swank-lispworks.lisp (defadvice compile-file): Return all values + from the real compile-file. + 2005-08-10 Edi Weitz * swank.lisp (transpose-lists): Replaced with much nicer function From mkoeppe at common-lisp.net Wed Aug 10 19:57:58 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Wed, 10 Aug 2005 21:57:58 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050810195758.CAAE1880DE@common-lisp.net> 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) From mkoeppe at common-lisp.net Wed Aug 10 19:59:47 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Wed, 10 Aug 2005 21:59:47 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050810195947.975A2880DE@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv27467 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Wed Aug 10 21:59:43 2005 Author: mkoeppe Index: slime/ChangeLog diff -u slime/ChangeLog:1.739 slime/ChangeLog:1.740 --- slime/ChangeLog:1.739 Wed Aug 10 17:52:21 2005 +++ slime/ChangeLog Wed Aug 10 21:59:43 2005 @@ -1,3 +1,12 @@ +2005-08-10 Matthias Koeppe + + * slime.el (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. + 2005-08-10 Martin Simmons * swank-lispworks.lisp (defadvice compile-file): Return all values From aruttenberg at common-lisp.net Thu Aug 11 03:06:37 2005 From: aruttenberg at common-lisp.net (Alan Ruttenberg) Date: Thu, 11 Aug 2005 05:06:37 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050811030637.B86F5880DE@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv23645/slime Modified Files: ChangeLog Log Message: Date: Thu Aug 11 05:06:33 2005 Author: aruttenberg Index: slime/ChangeLog diff -u slime/ChangeLog:1.740 slime/ChangeLog:1.741 --- slime/ChangeLog:1.740 Wed Aug 10 21:59:43 2005 +++ slime/ChangeLog Thu Aug 11 05:06:33 2005 @@ -1,3 +1,11 @@ +2005-08-10 Alan Ruttenberg + + * slime.el move slime-repl-add-to-input-history to + slime-repl-send-input so we can see the presentations we copied to + input when we reuse history rather than #.(blah...) + [Thanks Matthias! - was very busy and just returned to see your + changes merged. Most excellent.] + 2005-08-10 Matthias Koeppe * slime.el (slime-presentation-around-point): Change interface, From aruttenberg at common-lisp.net Thu Aug 11 03:07:08 2005 From: aruttenberg at common-lisp.net (Alan Ruttenberg) Date: Thu, 11 Aug 2005 05:07:08 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050811030708.3D790880DE@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv23679/slime Modified Files: slime.el Log Message: Date: Thu Aug 11 05:07:07 2005 Author: aruttenberg Index: slime/slime.el diff -u slime/slime.el:1.521 slime/slime.el:1.522 --- slime/slime.el:1.521 Wed Aug 10 21:57:56 2005 +++ slime/slime.el Thu Aug 11 05:07:07 2005 @@ -3100,7 +3100,6 @@ ((:abort) (slime-repl-show-abort)))) (defun slime-repl-send-string (string &optional command-string) - (slime-repl-add-to-input-history (or command-string string)) (cond (slime-repl-read-mode (slime-repl-return-string string)) (t (slime-repl-eval-string string)))) @@ -3263,6 +3262,11 @@ (overlay-put overlay 'read-only t) (overlay-put overlay 'face 'slime-repl-input-face) (overlay-put overlay 'rear-nonsticky '(face slime-repl-old-input-counter))) + + (slime-repl-add-to-input-history + (buffer-substring slime-repl-input-start-mark + slime-repl-input-end-mark)) + (let ((input (slime-repl-current-input))) (goto-char slime-repl-input-end-mark) (slime-mark-input-start) From eweitz at common-lisp.net Thu Aug 11 08:41:36 2005 From: eweitz at common-lisp.net (Edi Weitz) Date: Thu, 11 Aug 2005 10:41:36 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog slime/swank.lisp Message-ID: <20050811084136.8D1188852B@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv13108/slime Modified Files: ChangeLog swank.lisp Log Message: TRANSPOSE-LISTS again... Date: Thu Aug 11 10:41:35 2005 Author: eweitz Index: slime/ChangeLog diff -u slime/ChangeLog:1.741 slime/ChangeLog:1.742 --- slime/ChangeLog:1.741 Thu Aug 11 05:06:33 2005 +++ slime/ChangeLog Thu Aug 11 10:41:34 2005 @@ -1,3 +1,7 @@ +2005-08-11 Edi Weitz + + * swank.lisp (transpose-lists): Fixed it. + 2005-08-10 Alan Ruttenberg * slime.el move slime-repl-add-to-input-history to Index: slime/swank.lisp diff -u slime/swank.lisp:1.321 slime/swank.lisp:1.322 --- slime/swank.lisp:1.321 Wed Aug 10 02:21:57 2005 +++ slime/swank.lisp Thu Aug 11 10:41:34 2005 @@ -2566,7 +2566,8 @@ For example: \(transpose-lists '((ONE TWO THREE) (1 2))) => ((ONE 1) (TWO 2))" - (cond ((some #'null lists) '()) + (cond ((null lists) '()) + ((some #'null lists) '()) (t (cons (mapcar #'car lists) (transpose-lists (mapcar #'cdr lists)))))) From mbaringer at common-lisp.net Fri Aug 12 11:14:27 2005 From: mbaringer at common-lisp.net (Marco Baringer) Date: Fri, 12 Aug 2005 13:14:27 +0200 (CEST) Subject: [slime-cvs] CVS update: /slime/swank-clisp.lisp Message-ID: <20050812111427.73EE688537@common-lisp.net> Update of /project/slime/cvsroot//slime In directory common-lisp.net:/tmp/cvs-serv23200 Modified Files: swank-clisp.lisp Log Message: (fspec-pathname): Use the documentation function instead of accessing clisp internals. Date: Fri Aug 12 13:14:24 2005 Author: mbaringer From mbaringer at common-lisp.net Fri Aug 12 11:14:49 2005 From: mbaringer at common-lisp.net (Marco Baringer) Date: Fri, 12 Aug 2005 13:14:49 +0200 (CEST) Subject: [slime-cvs] CVS update: /slime/ChangeLog Message-ID: <20050812111449.7854E88537@common-lisp.net> Update of /project/slime/cvsroot//slime In directory common-lisp.net:/tmp/cvs-serv23238 Modified Files: ChangeLog Log Message: Date: Fri Aug 12 13:14:49 2005 Author: mbaringer From mkoeppe at common-lisp.net Fri Aug 12 20:51:44 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Fri, 12 Aug 2005 22:51:44 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050812205144.5EAD788540@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv31089 Modified Files: slime.el Log Message: * slime.el (substring-no-properties): Fix to handle non-zero start argument correctly. * slime.el (slime-presentation-whole-p): Generalize to work with strings too. (slime-presentation-start, slime-presentation-end): Likewise. (slime-presentation-around-point): Likewise. (slime-presentation-around-or-before-point): New. * slime.el (reify-old-output): Use slime-repl-presentation property and slime-presentation-around-point function rather than slime-repl-old-output property. (slime-repl-return): Use slime-repl-presentation rather than slime-repl-old-output. (slime-repl-grab-old-output): Use slime-presentation-around-or-before-point. (slime-read-object): Use slime-presentation-around-point. * slime.el (toplevel): Don't handle slime-repl-old-output text property. (slime-add-presentation-properties): Likewise. (slime-after-change-function): Likewise. Date: Fri Aug 12 22:51:43 2005 Author: mkoeppe Index: slime/slime.el diff -u slime/slime.el:1.522 slime/slime.el:1.523 --- slime/slime.el:1.522 Thu Aug 11 05:07:07 2005 +++ slime/slime.el Fri Aug 12 22:51:42 2005 @@ -2567,8 +2567,6 @@ ;; here does not work in XEmacs. (when slime-repl-enable-presentations (when (boundp 'text-property-default-nonsticky) - (pushnew '(slime-repl-old-output . t) text-property-default-nonsticky - :test 'equal) (pushnew '(slime-repl-presentation . t) text-property-default-nonsticky :test 'equal) (pushnew '(slime-repl-result-face . t) text-property-default-nonsticky @@ -2613,11 +2611,9 @@ RESULT-P decides whether a face for a return value or output text is used." (add-text-properties start end `(face slime-repl-inputed-output-face - slime-repl-old-output ,id mouse-face slime-repl-output-mouseover-face keymap ,slime-presentation-map - rear-nonsticky (slime-repl-old-output - slime-repl-presentation + rear-nonsticky (slime-repl-presentation face mouse-face))) (let ((text (buffer-substring-no-properties start end))) (case (- end start) @@ -2800,78 +2796,93 @@ (slime-setup-command-hooks) (run-hooks 'slime-repl-mode-hook)) -(defun slime-presentation-whole-p (start end) - (let ((presentation (get-text-property start 'slime-repl-presentation))) +(defun* slime-presentation-whole-p (start end &optional (object (current-buffer))) + (let ((presentation (get-text-property start 'slime-repl-presentation object))) (and presentation - (string= (buffer-substring-no-properties start end) + (string= (etypecase object + (buffer (with-current-buffer object + (buffer-substring-no-properties start end))) + (string (substring-no-properties object start end))) (slime-presentation-text presentation))))) (defun slime-same-presentation-p (a b) (and (string= (slime-presentation-text a) (slime-presentation-text b)) (equal (slime-presentation-id a) (slime-presentation-id b)))) -(defun* slime-presentation-start () - "Find start of presentation at point. Return buffer index and +(defun* slime-presentation-start (point &optional (object (current-buffer))) + "Find start of presentation at `point' in `object'. Return buffer index and whether a start-tag was found. When there is no presentation at point, return nil and nil." - (let* ((presentation (get-text-property (point) 'slime-repl-presentation)) + (let* ((presentation (get-text-property point 'slime-repl-presentation object)) (this-presentation presentation)) (unless presentation (return-from slime-presentation-start (values nil nil))) - (save-excursion - (while (not (slime-presentation-start-p this-presentation)) - (let ((change-point (previous-single-property-change (point) 'slime-repl-presentation))) - (unless change-point - (return-from slime-presentation-start - (values (point-min) nil))) - (setq this-presentation (get-text-property change-point 'slime-repl-presentation)) - (unless (and this-presentation - (slime-same-presentation-p presentation this-presentation)) - (return-from slime-presentation-start - (values (point) nil))) - (goto-char change-point))) - (values (point) t)))) - -(defun* slime-presentation-end () - "Find end of presentation at point. Return buffer index (after last - character of the presentation) and whether an end-tag was found." - (let* ((presentation (get-text-property (point) 'slime-repl-presentation)) + (while (not (slime-presentation-start-p this-presentation)) + (let ((change-point (previous-single-property-change point 'slime-repl-presentation object))) + (unless change-point + (return-from slime-presentation-start + (values (etypecase object + (buffer (with-current-buffer object (point-min))) + (string 0)) + nil))) + (setq this-presentation (get-text-property change-point 'slime-repl-presentation object)) + (unless (and this-presentation + (slime-same-presentation-p presentation this-presentation)) + (return-from slime-presentation-start + (values point nil))) + (setq point change-point))) + (values point t))) + +(defun* slime-presentation-end (point &optional (object (current-buffer))) + "Find end of presentation at `point' in `object'. Return buffer +index (after last character of the presentation) and whether an +end-tag was found." + (let* ((presentation (get-text-property point 'slime-repl-presentation object)) (this-presentation presentation)) (unless presentation (return-from slime-presentation-end (values nil nil))) - (save-excursion - (while (and this-presentation - (slime-same-presentation-p presentation this-presentation) - (not (slime-presentation-stop-p this-presentation))) - (let ((change-point (next-single-property-change (point) 'slime-repl-presentation))) - (unless change-point - (return-from slime-presentation-end - (values (point-max) nil))) - (goto-char change-point) - (setq this-presentation (get-text-property (point) 'slime-repl-presentation)))) - (if (and this-presentation - (slime-same-presentation-p presentation this-presentation)) - (let ((after-end (next-single-property-change (point) 'slime-repl-presentation))) - (if (not after-end) - (values (point-max) t) + (while (and this-presentation + (slime-same-presentation-p presentation this-presentation) + (not (slime-presentation-stop-p this-presentation))) + (let ((change-point (next-single-property-change point 'slime-repl-presentation object))) + (unless change-point + (return-from slime-presentation-end + (values (etypecase object + (buffer (with-current-buffer object (point-max))) + (string (length object))) + nil))) + (setq point change-point) + (setq this-presentation (get-text-property point 'slime-repl-presentation object)))) + (if (and this-presentation + (slime-same-presentation-p presentation this-presentation)) + (let ((after-end (next-single-property-change point 'slime-repl-presentation object))) + (if (not after-end) + (values (etypecase object + (buffer (with-current-buffer object (point-max))) + (string (length object))) + t) (values after-end t))) - (values (point) nil))))) + (values point nil)))) -(defun slime-presentation-around-point (&optional point) +(defun* slime-presentation-around-point (point &optional (object (current-buffer))) "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 (get-text-property (point) 'slime-repl-presentation) - start end - (and good-start good-end - (slime-presentation-whole-p start end))))))) + (multiple-value-bind (start good-start) + (slime-presentation-start point object) + (multiple-value-bind (end good-end) + (slime-presentation-end point object) + (values (get-text-property point 'slime-repl-presentation object) + start end + (and good-start good-end + (slime-presentation-whole-p start end object)))))) + +(defun* slime-presentation-around-or-before-point (point &optional (object (current-buffer))) + (multiple-value-bind (presentation start end whole-p) + (slime-presentation-around-point point object) + (if presentation + (values presentation start end whole-p) + (slime-presentation-around-point (1- point) object)))) ;; XEmacs compatibility hack, from message by Stephen J. Turnbull on ;; xemacs-beta at xemacs.org of 18 Mar 2002 @@ -2895,15 +2906,14 @@ (let ((presentation (get-text-property (point) 'slime-repl-presentation))) (when presentation (multiple-value-bind (presentation from to whole) - (slime-presentation-around-point) + (slime-presentation-around-point (point)) ;;(message "presentation %s whole-p %s" (buffer-substring from to) whole) (unless whole (setq any-change t) (remove-text-properties from to - '(slime-repl-old-output t - slime-repl-inputed-output-face t - face t mouse-face t rear-nonsticky t - slime-repl-presentation t)))))) + '(slime-repl-inputed-output-face t + face t mouse-face t rear-nonsticky t + slime-repl-presentation t)))))) (let ((next-change (next-single-property-change (point) 'slime-repl-presentation nil real-end))) @@ -2996,7 +3006,7 @@ (let ((inhibit-read-only t)) (put-text-property (- (point) 2) (point) 'rear-nonsticky - '(slime-repl-old-output slime-repl-presentation face read-only))))) + '(slime-repl-presentation face mouse-face read-only))))) (etypecase result (list (loop @@ -3010,13 +3020,13 @@ (prompt (format "%s> " (slime-lisp-package-prompt-string)))) (slime-propertize-region '(face slime-repl-prompt-face - read-only t - intangible t - slime-repl-prompt t - ;; emacs stuff - rear-nonsticky (slime-repl-prompt read-only face intangible) - ;; xemacs stuff - start-open t end-open t) + read-only t + intangible t + slime-repl-prompt t + ;; emacs stuff + rear-nonsticky (slime-repl-prompt read-only face intangible) + ;; xemacs stuff + start-open t end-open t) (insert prompt)) ;; FIXME: we could also set beginning-of-defun-function (setq defun-prompt-regexp (concat "^" prompt)) @@ -3060,22 +3070,22 @@ (reify-old-output str-props str-no-props))) (defun reify-old-output (str-props str-no-props) - (let ((pos (slime-property-position 'slime-repl-old-output str-props))) + (let ((pos (slime-property-position 'slime-repl-presentation str-props))) (if (null pos) str-no-props - (let ((end-pos (or (next-single-property-change pos 'slime-repl-old-output str-props) - (length str-props))) - (id (get-text-property pos 'slime-repl-old-output str-props))) - (concat (substring str-no-props 0 pos) - ;; Eval in the reader so that we play nice with quote. - ;; -luke (19/May/2005) - "#." (slime-prin1-to-string - (if (consp id) - `(cl:nth ,(cdr id) - (swank:get-repl-result ,(car id))) - `(swank:get-repl-result ,id))) - (reify-old-output (substring str-props end-pos) - (substring str-no-props end-pos))))))) + (multiple-value-bind (presentation start-pos end-pos whole-p) + (slime-presentation-around-point pos str-props) + (let ((id (slime-presentation-id presentation))) + (concat (substring str-no-props 0 pos) + ;; Eval in the reader so that we play nice with quote. + ;; -luke (19/May/2005) + "#." (slime-prin1-to-string + (if (consp id) + `(cl:nth ,(cdr id) + (swank:get-repl-result ,(car id))) + `(swank:get-repl-result ,id))) + (reify-old-output (substring str-props end-pos) + (substring str-no-props end-pos)))))))) (defun slime-property-position (text-property &optional object) "Return the first position of TEXT-PROPERTY, or nil." @@ -3224,8 +3234,8 @@ (save-excursion (goto-char slime-repl-input-end-mark) (recenter -1)))) - ((and (or (get-text-property (point) 'slime-repl-old-output) - (get-text-property (1- (point)) 'slime-repl-old-output)) + ((and (or (get-text-property (point) 'slime-repl-presentation) + (get-text-property (1- (point)) 'slime-repl-presentation)) (< (point) slime-repl-input-start-mark)) (slime-repl-grab-old-output end-of-input) (unless (pos-visible-in-window-p slime-repl-input-end-mark) @@ -3295,8 +3305,11 @@ "Resend the old REPL output at point. If replace it non-nil the current input is replaced with the old output; otherwise the new input is appended. The old output has the -text property `slime-repl-old-output'." - (multiple-value-bind (beg end) (slime-property-bounds 'slime-repl-old-output) +text property `slime-repl-presentation'." + (multiple-value-bind (presentation beg end) + (slime-presentation-around-or-before-point (point)) + (unless presentation + (error "No presentation at point")) (let ((old-output (buffer-substring beg end))) ;;keep properties ;; Append the old input or replace the current input (cond (replace (goto-char slime-repl-input-start-mark)) @@ -7759,14 +7772,16 @@ (slime-eval-async form 'slime-open-inspector)) (defun slime-read-object (prompt) - (let ((id (get-text-property (point) 'slime-repl-old-output))) - (if id - (if (consp id) - `(swank:init-inspector ,(format "(cl:nth #10r%d (swank:get-repl-result #10r%d))" (cdr id) (car id))) - `(swank:init-inspector ,(format "(swank:get-repl-result %S)" id))) - `(swank:init-inspector - ,(slime-read-from-minibuffer "Inspect value (evaluated): " - (slime-sexp-at-point)))))) + (multiple-value-bind (presentation start end) + (slime-presentation-around-point (point)) + (let ((id (and presentation (slime-presentation-id presentation)))) + (if id + (if (consp id) + `(swank:init-inspector ,(format "(cl:nth #10r%d (swank:get-repl-result #10r%d))" (cdr id) (car id))) + `(swank:init-inspector ,(format "(swank:get-repl-result %S)" id))) + `(swank:init-inspector + ,(slime-read-from-minibuffer "Inspect value (evaluated): " + (slime-sexp-at-point))))))) (define-derived-mode slime-inspector-mode fundamental-mode "Slime-Inspector" (set-syntax-table lisp-mode-syntax-table) @@ -9282,7 +9297,7 @@ (let* ((start (or start 0)) (end (or end (length string))) (string (substring string start end))) - (set-text-properties start end nil string) + (set-text-properties 0 (- end start) nil string) string)) (slime-defun-if-undefined set-window-text-height (window height) From mkoeppe at common-lisp.net Fri Aug 12 20:52:35 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Fri, 12 Aug 2005 22:52:35 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050812205235.B1EA988540@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv31129 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Fri Aug 12 22:52:34 2005 Author: mkoeppe Index: slime/ChangeLog diff -u slime/ChangeLog:1.743 slime/ChangeLog:1.744 --- slime/ChangeLog:1.743 Fri Aug 12 13:14:48 2005 +++ slime/ChangeLog Fri Aug 12 22:52:34 2005 @@ -1,3 +1,32 @@ +2005-08-12 Matthias Koeppe + + * slime.el (substring-no-properties): Fix to handle non-zero start + argument correctly. + + Patch to remove use of the slime-repl-old-output text property in + favor of the slime-repl-presentation text property, in order to + simplify the code. + + * slime.el (slime-presentation-whole-p): Generalize to work with + strings too. + (slime-presentation-start, slime-presentation-end): Likewise. + (slime-presentation-around-point): Likewise. + (slime-presentation-around-or-before-point): New. + + * slime.el (reify-old-output): Use slime-repl-presentation + property and slime-presentation-around-point function rather than + slime-repl-old-output property. + (slime-repl-return): Use slime-repl-presentation rather than + slime-repl-old-output. + (slime-repl-grab-old-output): Use + slime-presentation-around-or-before-point. + (slime-read-object): Use slime-presentation-around-point. + + * slime.el (toplevel): Don't handle slime-repl-old-output text + property. + (slime-add-presentation-properties): Likewise. + (slime-after-change-function): Likewise. + 2005-08-12 Yaroslav Kavenchuk * swank-clisp.lisp (fspec-pathname): Use the documentation From mkoeppe at common-lisp.net Sun Aug 14 15:41:25 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sun, 14 Aug 2005 17:41:25 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050814154125.6F4B38854E@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv5808 Modified Files: swank.lisp Log Message: * swank.lisp (*object-to-presentation-id*) (*presentation-id-to-object*, clear-presentation-tables) (*presentation-counter*, lookup-presented-object): Move here from present.lisp. (save-presented-object): Likewise. Assign negative numbers only, so as not to clash with continuation ids. * swank.lisp (*repl-results*): Removed. * swank.lisp (get-repl-result, clear-repl-results): Use new implementations from present.lisp. (add-repl-result): Likewise, don't take the negative of the id. (*last-repl-result-id*): New variable. (clear-last-repl-result): Use it here. Date: Sun Aug 14 17:41:20 2005 Author: mkoeppe Index: slime/swank.lisp diff -u slime/swank.lisp:1.322 slime/swank.lisp:1.323 --- slime/swank.lisp:1.322 Thu Aug 11 10:41:34 2005 +++ slime/swank.lisp Sun Aug 14 17:41:18 2005 @@ -1676,6 +1676,78 @@ :not-available)))) +;;;; Recording and accessing results of computations + +(defvar *record-repl-results* t + "Non-nil means that REPL results are saved for later lookup.") + +(defvar *object-to-presentation-id* + (make-hash-table :test 'eq + #+openmcl :weak #+openmcl :key) + "Store the mapping of objects to numeric identifiers") + +(defvar *presentation-id-to-object* + (make-hash-table :test 'eq + #+openmcl :weak #+openmcl :value) + "Store the mapping of numeric identifiers to objects") + +(defun clear-presentation-tables () + (clrhash *object-to-presentation-id*) + (clrhash *presentation-id-to-object*)) + +(defvar *presentation-counter* 0 "identifier counter") + +(defun save-presented-object (object &optional id) + "If the object doesn't already have an id, save it and allocate +one. Otherwise return the old one." + (cond + ((and (not id) + (gethash object *object-to-presentation-id*))) + (t + (let ((newid (or id (decf *presentation-counter*)))) + (setf (gethash newid *presentation-id-to-object*) object) + (setf (gethash object *object-to-presentation-id*) newid) + newid)))) + +(defvar *not-present* (gensym "NOT-PRESENT")) + +(defun lookup-presented-object (id) + "Retrieve the object corresponding to id. *not-present* returned if it isn't there" + (if (consp id) + (let ((values (gethash (car id) *presentation-id-to-object* *not-present*))) + (if (eql values *not-present*) + *not-present* + (nth (cdr id) values))) + (gethash id *presentation-id-to-object* *not-present*))) + +(defvar *last-repl-result-id* nil) + +(defun add-repl-result (id val) + (save-presented-object val id) + (setq *last-repl-result-id* id) + t) + +(defslimefun get-repl-result (id) + "Get the result of the previous REPL evaluation with ID." + (let ((previous-output (lookup-presented-object id))) + (when (eq previous-output *not-present*) + (if swank::*record-repl-results* + (error "Attempt to access no longer existing result (number ~D)." id) + (error "Attempt to access unrecorded result (number ~D). ~&See ~S." + id '*record-repl-results*))) + previous-output)) + +(defslimefun clear-last-repl-result () + "Forget the result of the previous REPL evaluation." + (remhash *last-repl-result-id* *presentation-id-to-object*) + t) + +(defslimefun clear-repl-results () + "Forget the results of all previous REPL evaluations." + (clear-presentation-tables) + t) + + ;;;; Evaluation (defvar *pending-continuations* '() @@ -1871,13 +1943,6 @@ (let ((p (setq *package* (guess-package-from-string package)))) (list (package-name p) (package-string-for-prompt p)))) - -(defvar *record-repl-results* t - "Non-nil means that REPL results are saved in *REPL-RESULTS*.") - -(defparameter *repl-results* '() - "Association list of old repl results.") - (defslimefun listener-eval (string) (clear-user-input) (with-buffer-syntax () @@ -1898,30 +1963,6 @@ (cond ((null values) "; No value") (t (mapcar #'prin1-to-string values)))))))) - -(defun add-repl-result (id val) - (push (cons id val) *repl-results*) - t) - -(defslimefun get-repl-result (id) - "Get the result of the previous REPL evaluation with ID." - (let ((previous-output (assoc (- id) *repl-results*))) - (when (null previous-output) - (if *record-repl-results* - (error "Attempt to access no longer existing result (number ~D)." (- id)) - (error "Attempt to access unrecorded result (number ~D). ~&See ~S." - id '*record-repl-results*))) - (cdr previous-output))) - -(defslimefun clear-last-repl-result () - "Forget the result of the previous REPL evaluation." - (pop *repl-results*) - t) - -(defslimefun clear-repl-results () - "Forget the results of all previous REPL evaluations." - (setf *repl-results* '()) - t) (defslimefun ed-in-emacs (&optional what) "Edit WHAT in Emacs. From mkoeppe at common-lisp.net Sun Aug 14 15:42:17 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sun, 14 Aug 2005 17:42:17 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050814154217.7332B8854E@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv5841 Modified Files: slime.el Log Message: (slime-repl-insert-prompt): Don't take the negative of the id. (slime-presentation-expression): New, take care to handle arbitrary *read-base* settings. (reify-old-output): Use it here. (slime-read-object): Use it here. Date: Sun Aug 14 17:42:15 2005 Author: mkoeppe Index: slime/slime.el diff -u slime/slime.el:1.523 slime/slime.el:1.524 --- slime/slime.el:1.523 Fri Aug 12 22:51:42 2005 +++ slime/slime.el Sun Aug 14 17:42:14 2005 @@ -3012,7 +3012,7 @@ (loop for res in result for index from 0 - do (insert-result res (cons (- slime-current-output-id) index)))) + do (insert-result res (cons slime-current-output-id index)))) (string (unless (string= result "") (insert-result result nil))))) @@ -3069,23 +3069,32 @@ slime-repl-input-end-mark))) (reify-old-output str-props str-no-props))) +(defun slime-presentation-expression (presentation) + "Return a string that contains a CL s-expression accessing +the presented object." + (let ((id (slime-presentation-id presentation))) + ;; Make sure it works even if *read-base* is not 10. + (cond + ((and (consp id) (integerp (car id)) (integerp (cdr id))) + (format "(swank:get-repl-result '(#10r%d . #10r%d))" (car id) (cdr id))) + ((integerp id) + (format "(swank:get-repl-result #10r%d)" id)) + (t + (slime-prin1-to-string + `(swank:get-repl-result ',id)))))) + (defun reify-old-output (str-props str-no-props) (let ((pos (slime-property-position 'slime-repl-presentation str-props))) (if (null pos) str-no-props (multiple-value-bind (presentation start-pos end-pos whole-p) (slime-presentation-around-point pos str-props) - (let ((id (slime-presentation-id presentation))) - (concat (substring str-no-props 0 pos) - ;; Eval in the reader so that we play nice with quote. - ;; -luke (19/May/2005) - "#." (slime-prin1-to-string - (if (consp id) - `(cl:nth ,(cdr id) - (swank:get-repl-result ,(car id))) - `(swank:get-repl-result ,id))) - (reify-old-output (substring str-props end-pos) - (substring str-no-props end-pos)))))))) + (concat (substring str-no-props 0 pos) + ;; Eval in the reader so that we play nice with quote. + ;; -luke (19/May/2005) + "#." (slime-presentation-expression presentation) + (reify-old-output (substring str-props end-pos) + (substring str-no-props end-pos))))))) (defun slime-property-position (text-property &optional object) "Return the first position of TEXT-PROPERTY, or nil." @@ -7774,14 +7783,11 @@ (defun slime-read-object (prompt) (multiple-value-bind (presentation start end) (slime-presentation-around-point (point)) - (let ((id (and presentation (slime-presentation-id presentation)))) - (if id - (if (consp id) - `(swank:init-inspector ,(format "(cl:nth #10r%d (swank:get-repl-result #10r%d))" (cdr id) (car id))) - `(swank:init-inspector ,(format "(swank:get-repl-result %S)" id))) - `(swank:init-inspector - ,(slime-read-from-minibuffer "Inspect value (evaluated): " - (slime-sexp-at-point))))))) + `(swank:init-inspector + ,(if presentation + (slime-presentation-expression presentation) + (slime-read-from-minibuffer "Inspect value (evaluated): " + (slime-sexp-at-point)))))) (define-derived-mode slime-inspector-mode fundamental-mode "Slime-Inspector" (set-syntax-table lisp-mode-syntax-table) From mkoeppe at common-lisp.net Sun Aug 14 15:43:35 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sun, 14 Aug 2005 17:43:35 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/present.lisp Message-ID: <20050814154335.338BE8854E@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv5871 Modified Files: present.lisp Log Message: Move code to swank.lisp Date: Sun Aug 14 17:43:34 2005 Author: mkoeppe Index: slime/present.lisp diff -u slime/present.lisp:1.10 slime/present.lisp:1.11 --- slime/present.lisp:1.10 Sun Aug 7 19:03:35 2005 +++ slime/present.lisp Sun Aug 14 17:43:33 2005 @@ -19,38 +19,6 @@ "set this to enable automatically printing presentations for some subset of readable objects, such as pathnames." ) -;; Saving presentations -(defvar *object-to-presentation-id* (make-hash-table :test 'eq #+openmcl :weak #+openmcl :key) - "Store the mapping of objects to numeric identifiers") - -(defvar *presentation-id-to-object* (make-hash-table :test 'eq #+openmcl :weak #+openmcl :value) - "Store the mapping of numeric identifiers to objects") - -(defvar *presentation-counter* 0 "identifier counter") - -(defun clear-presentation-tables () - (clrhash *object-to-presentation-id*) - (clrhash *presentation-id-to-object*) - ) - -(defun lookup-presented-object (id) - "Retrieve the object corresponding to id. :not-present returned if it isn't there" - (if (consp id) - (let ((values (gethash (car id) *presentation-id-to-object* :not-present))) - (if (eql values :not-present) - :not-present - (nth (cdr id) values))) - (gethash id *presentation-id-to-object* :not-present))) - -(defun save-presented-object (object) - "If the object doesn't already have an id, save it and allocate -one. Otherwise return the old one" - (or (gethash object *presentation-id-to-object*) - (let ((newid (incf *presentation-counter*))) - (setf (gethash newid *presentation-id-to-object*) object) - (setf (gethash object *object-to-presentation-id*) newid) - newid))) - ;; doing it (defmacro presenting-object (object stream &body body) @@ -173,31 +141,6 @@ (funcall continue) (write-annotation stream #'presentation-end record))) (funcall continue))) - -;; hook up previous implementation. Use negative ids for repl results so as to not conflict with -;; the ones for other printout -(defun add-repl-result (id val) - (setf (gethash (- id) *presentation-id-to-object*) val) - (save-presented-object val) - t) - -;; hook up previous implementation -(defslimefun clear-repl-results () - "Forget the results of all previous REPL evaluations." - (clear-presentation-tables) - t) - -;; hook up previous implementation -(defslimefun get-repl-result (id) - "Get the result of the previous REPL evaluation with ID." - (let ((previous-output (lookup-presented-object id))) - (when (eq previous-output :not-present) - (if swank::*record-repl-results* - (error "Attempt to access no longer existing result (number ~D)." id) - (error "Attempt to access unrecorded result (number ~D). ~&See ~S." - id '*record-repl-results*))) - previous-output)) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; menu protocol From mkoeppe at common-lisp.net Sun Aug 14 17:36:39 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sun, 14 Aug 2005 19:36:39 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050814173639.56F6B88545@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14095 Modified Files: slime.el Log Message: (slime-mark-presentation-end): Really remove the presentation-start entry from the hash table. Date: Sun Aug 14 19:36:38 2005 Author: mkoeppe Index: slime/slime.el diff -u slime/slime.el:1.524 slime/slime.el:1.525 --- slime/slime.el:1.524 Sun Aug 14 17:42:14 2005 +++ slime/slime.el Sun Aug 14 19:36:37 2005 @@ -2588,7 +2588,7 @@ (defun slime-mark-presentation-end (id) (let ((start (gethash id slime-presentation-start-to-point))) - (setf (gethash id slime-presentation-start-to-point) nil) + (remhash id slime-presentation-start-to-point) (when start (with-current-buffer (slime-output-buffer) (slime-add-presentation-properties start (symbol-value 'slime-output-end) From mkoeppe at common-lisp.net Sun Aug 14 17:37:51 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sun, 14 Aug 2005 19:37:51 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050814173751.3042288545@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14124 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sun Aug 14 19:37:50 2005 Author: mkoeppe Index: slime/ChangeLog diff -u slime/ChangeLog:1.744 slime/ChangeLog:1.745 --- slime/ChangeLog:1.744 Fri Aug 12 22:52:34 2005 +++ slime/ChangeLog Sun Aug 14 19:37:50 2005 @@ -1,3 +1,33 @@ +2005-08-14 Matthias Koeppe + + * slime.el (slime-mark-presentation-end): Really remove the + presentation-start entry from the hash table. + + Merge some code from present.lisp, removing code duplication. + Minor code clean-up. + + * swank.lisp (*object-to-presentation-id*) + (*presentation-id-to-object*, clear-presentation-tables) + (*presentation-counter*, lookup-presented-object): Move here from + present.lisp. + (save-presented-object): Likewise. Assign negative numbers only, + so as not to clash with continuation ids. + + * swank.lisp (*repl-results*): Removed. + + * swank.lisp (get-repl-result, clear-repl-results): Use new + implementations from present.lisp. + (add-repl-result): Likewise, don't take the negative of the id. + (*last-repl-result-id*): New variable. + (clear-last-repl-result): Use it here. + + * slime.el (slime-repl-insert-prompt): Don't take the negative of + the id. + (slime-presentation-expression): New, take care to handle + arbitrary *read-base* settings. + (reify-old-output): Use it here. + (slime-read-object): Use it here. + 2005-08-12 Matthias Koeppe * slime.el (substring-no-properties): Fix to handle non-zero start From mbaringer at common-lisp.net Mon Aug 15 08:57:54 2005 From: mbaringer at common-lisp.net (Marco Baringer) Date: Mon, 15 Aug 2005 10:57:54 +0200 (CEST) Subject: [slime-cvs] CVS update: /slime/swank-clisp.lisp Message-ID: <20050815085754.8201588544@common-lisp.net> Update of /project/slime/cvsroot//slime In directory common-lisp.net:/tmp/cvs-serv10293 Modified Files: swank-clisp.lisp Log Message: Date: Mon Aug 15 10:57:53 2005 Author: mbaringer From aruttenberg at common-lisp.net Mon Aug 15 18:15:09 2005 From: aruttenberg at common-lisp.net (Alan Ruttenberg) Date: Mon, 15 Aug 2005 20:15:09 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050815181509.28CC288546@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv15804/slime Modified Files: ChangeLog Log Message: Date: Mon Aug 15 20:15:07 2005 Author: aruttenberg Index: slime/ChangeLog diff -u slime/ChangeLog:1.745 slime/ChangeLog:1.746 --- slime/ChangeLog:1.745 Sun Aug 14 19:37:50 2005 +++ slime/ChangeLog Mon Aug 15 20:15:06 2005 @@ -1,3 +1,9 @@ +2005-08-15 Alan Ruttenberg + + * slime.el (slime-goto-location-position) fix so the :method locator + regexp so that it can find eql specializers, (setf foo) methods, and to + allow (a single) newline between arguments in the arglist. + 2005-08-14 Matthias Koeppe * slime.el (slime-mark-presentation-end): Really remove the From aruttenberg at common-lisp.net Mon Aug 15 18:15:51 2005 From: aruttenberg at common-lisp.net (Alan Ruttenberg) Date: Mon, 15 Aug 2005 20:15:51 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050815181551.3341B88546@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv16211/slime Modified Files: slime.el Log Message: Date: Mon Aug 15 20:15:50 2005 Author: aruttenberg Index: slime/slime.el diff -u slime/slime.el:1.525 slime/slime.el:1.526 --- slime/slime.el:1.525 Sun Aug 14 19:36:37 2005 +++ slime/slime.el Mon Aug 15 20:15:50 2005 @@ -4551,9 +4551,15 @@ (name (regexp-quote name)) (qualifiers (mapconcat (lambda (el) (concat ".+?\\<" el "\\>")) qualifiers "")) - (specializers (mapconcat (lambda (el) (concat ".+?\\<" el "\\>")) + (specializers (mapconcat (lambda (el) + (if (eql (aref el 0) 40) + (let ((spec (read el))) + (if (eq (car spec) 'EQL) + (concat ".*?\\n\\{0,1\\}.*?(EQL.*?'\\{0,1\\}" (format "%s" (second spec)) ")") + (error "don't understand specializer: %s,%s" el (car spec)))) + (concat ".+?\n\\{0,1\\}.+?\\<" el "\\>"))) (remove "T" specializers) "")) - (regexp (format "\\s *(def\\(\\s_\\|\\sw\\)*\\s +%s\\>%s%s" name + (regexp (format "\\s *(def\\(\\s_\\|\\sw\\)*\\s +%s\\s +%s%s" name qualifiers specializers))) (or (and (re-search-forward regexp nil t) (goto-char (match-beginning 0))) From aruttenberg at common-lisp.net Mon Aug 15 20:13:16 2005 From: aruttenberg at common-lisp.net (Alan Ruttenberg) Date: Mon, 15 Aug 2005 22:13:16 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-openmcl.lisp Message-ID: <20050815201316.C939A88546@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv24092/slime Modified Files: swank-openmcl.lisp Log Message: Date: Mon Aug 15 22:13:15 2005 Author: aruttenberg Index: slime/swank-openmcl.lisp diff -u slime/swank-openmcl.lisp:1.95 slime/swank-openmcl.lisp:1.96 --- slime/swank-openmcl.lisp:1.95 Fri Jul 22 12:52:32 2005 +++ slime/swank-openmcl.lisp Mon Aug 15 22:13:15 2005 @@ -118,9 +118,10 @@ (defun specializer-name (spec) (etypecase spec (cons spec) - ((or structure-class swank-mop:standard-class built-in-class) (swank-mop:class-name spec)) - (swank-mop:eql-specializer `(eql ,(swank-mop:eql-specializer-object spec))) - )) + (class (swank-mop:class-name spec)) + (swank-mop:eql-specializer `(eql ,(swank-mop:eql-specializer-object spec)))) + ) + ;;; TCP Server From aruttenberg at common-lisp.net Mon Aug 15 20:14:03 2005 From: aruttenberg at common-lisp.net (Alan Ruttenberg) Date: Mon, 15 Aug 2005 22:14:03 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050815201403.383E588546@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv24123/slime Modified Files: ChangeLog Log Message: Date: Mon Aug 15 22:14:02 2005 Author: aruttenberg Index: slime/ChangeLog diff -u slime/ChangeLog:1.746 slime/ChangeLog:1.747 --- slime/ChangeLog:1.746 Mon Aug 15 20:15:06 2005 +++ slime/ChangeLog Mon Aug 15 22:14:02 2005 @@ -3,6 +3,10 @@ * slime.el (slime-goto-location-position) fix so the :method locator regexp so that it can find eql specializers, (setf foo) methods, and to allow (a single) newline between arguments in the arglist. + + * swank-openmcl.lisp (specializer-name) patch from Gary Byers and + Bryan O'Conner to fix complaint about certain classes slipping + through the etypecase 2005-08-14 Matthias Koeppe From mkoeppe at common-lisp.net Sat Aug 20 15:43:50 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sat, 20 Aug 2005 17:43:50 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050820154350.08B5E880DD@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6485 Modified Files: slime.el Log Message: * slime.el (slime-presentation): Remove slots start-p, stop-p. (slime-add-presentation-properties): Use a new text property layout. Also add an overlay to enable nested highlighting. (slime-remove-presentation-properties): New. (slime-presentation-whole-p): Changed interface. (slime-presentations-around-point): New. (slime-same-presentation-p): Removed. (slime-presentation-start-p, slime-presentation-stop-p): New. (slime-presentation-start, slime-presentation-end): Changed to use new text property layout. (slime-presentation-bounds): New. (slime-presentation-around-point): Reimplemented to handle nested presentations. (slime-for-each-presentation-in-region): New. (slime-after-change-function): Use slime-remove-presentation-properties and slime-for-each-presentation-in-region. (slime-copy-presentation-at-point): Complain if no presentation. (slime-repl-insert-prompt): Don't put rear-nonsticky text property. (slime-reify-old-output): Handle nested presentations. (slime-repl-return): Use slime-presentation-around-or-before-point. * slime.el (slime-buffer-substring-with-reified-output): New, factored out from slime-repl-current-input. (slime-repl-current-input): Use it here. (slime-last-expression): Use it here. Date: Sat Aug 20 17:43:49 2005 Author: mkoeppe Index: slime/slime.el diff -u slime/slime.el:1.526 slime/slime.el:1.527 --- slime/slime.el:1.526 Mon Aug 15 20:15:50 2005 +++ slime/slime.el Sat Aug 20 17:43:48 2005 @@ -2602,42 +2602,60 @@ (defstruct (slime-presentation) (text) - (id) - (start-p) - (stop-p)) + (id)) (defun slime-add-presentation-properties (start end id result-p) "Make the text between START and END a presentation with ID. RESULT-P decides whether a face for a return value or output text is used." - (add-text-properties start end - `(face slime-repl-inputed-output-face - mouse-face slime-repl-output-mouseover-face - keymap ,slime-presentation-map - rear-nonsticky (slime-repl-presentation - face mouse-face))) - (let ((text (buffer-substring-no-properties start end))) - (case (- end start) - (0) - (1 - (add-text-properties start end - `(slime-repl-presentation - ,(make-slime-presentation :text text :id id - :start-p t :stop-p t)))) - (t - (let ((inhibit-modification-hooks t)) + (let* ((text (buffer-substring-no-properties start end)) + (presentation (make-slime-presentation :text text :id id))) + (let ((inhibit-modification-hooks t)) + (add-text-properties start end + `(face slime-repl-inputed-output-face + mouse-face slime-repl-output-mouseover-face + keymap ,slime-presentation-map + modification-hooks (slime-after-change-function) + insert-in-front-hooks (slime-after-change-function) + insert-behind-hooks (slime-after-change-function) + rear-nonsticky t)) + ;; Use the presentation as the key of a text property + (case (- end start) + (0) + (1 + (add-text-properties start end + `(slime-repl-presentation ,presentation + ,presentation :start-and-end))) + (t (add-text-properties start (1+ start) - `(slime-repl-presentation - ,(make-slime-presentation :text text :id id - :start-p t :stop-p nil))) + `(slime-repl-presentation ,presentation + ,presentation :start)) (when (> (- end start) 2) (add-text-properties (1+ start) (1- end) - `(slime-repl-presentation - ,(make-slime-presentation :text text :id id - :start-p nil :stop-p nil)))) + `(,presentation :interior))) (add-text-properties (1- end) end - `(slime-repl-presentation - ,(make-slime-presentation :text text :id id - :start-p nil :stop-p t)))))))) + `(slime-repl-presentation ,presentation + ,presentation :end)))) + ;; Also put an overlay for the face and the mouse-face. This enables + ;; highlighting of nested presentations. However, overlays get lost + ;; when we copy a presentation; their removal is also not undoable. + ;; In these cases the mouse-face text properties need to take over --- + ;; but they do not give nested highlighting. + (let ((overlay (make-overlay start end))) + (overlay-put overlay 'mouse-face 'slime-repl-output-mouseover-face) + (overlay-put overlay 'face 'slime-repl-inputed-output-face))))) + +(defun slime-remove-presentation-properties (from to presentation) + (remove-text-properties from to + `(,presentation t + slime-repl-inputed-output-face t + face t mouse-face t rear-nonsticky t)) + (when (eq (get-text-property from 'slime-repl-presentation) presentation) + (remove-text-properties from (1+ from) `(slime-repl-presentation t))) + (when (eq (get-text-property (1- to) 'slime-repl-presentation) presentation) + (remove-text-properties (1- to) to `(slime-repl-presentation t))) + (dolist (overlay (overlays-at from)) + (when (eq (overlay-get overlay 'mouse-face) 'slime-repl-output-mouseover-face) + (delete-overlay overlay)))) (defun slime-insert-presentation (result output-id) (let ((start (point))) @@ -2796,57 +2814,52 @@ (slime-setup-command-hooks) (run-hooks 'slime-repl-mode-hook)) -(defun* slime-presentation-whole-p (start end &optional (object (current-buffer))) - (let ((presentation (get-text-property start 'slime-repl-presentation object))) - (and presentation - (string= (etypecase object - (buffer (with-current-buffer object - (buffer-substring-no-properties start end))) - (string (substring-no-properties object start end))) - (slime-presentation-text presentation))))) - -(defun slime-same-presentation-p (a b) - (and (string= (slime-presentation-text a) (slime-presentation-text b)) - (equal (slime-presentation-id a) (slime-presentation-id b)))) - -(defun* slime-presentation-start (point &optional (object (current-buffer))) - "Find start of presentation at `point' in `object'. Return buffer index and - whether a start-tag was found. When there is no presentation at - point, return nil and nil." - (let* ((presentation (get-text-property point 'slime-repl-presentation object)) - (this-presentation presentation)) - (unless presentation - (return-from slime-presentation-start - (values nil nil))) +(defun* slime-presentation-whole-p (presentation start end &optional (object (current-buffer))) + (string= (etypecase object + (buffer (with-current-buffer object + (buffer-substring-no-properties start end))) + (string (substring-no-properties object start end))) + (slime-presentation-text presentation))) + +(defun* slime-presentations-around-point (point &optional (object (current-buffer))) + (loop for (key value . rest) on (text-properties-at point object) by 'cddr + when (slime-presentation-p key) + collect key)) + +(defun slime-presentation-start-p (tag) + (member tag '(:start :start-and-end))) + +(defun slime-presentation-stop-p (tag) + (member tag '(:end :start-and-end))) + +(defun* slime-presentation-start (point presentation + &optional (object (current-buffer))) + "Find start of `presentation' at `point' in `object'. Return buffer index and + whether a start-tag was found." + (let* ((this-presentation (get-text-property point presentation object))) (while (not (slime-presentation-start-p this-presentation)) - (let ((change-point (previous-single-property-change point 'slime-repl-presentation object))) + (let ((change-point (previous-single-property-change point presentation object))) (unless change-point (return-from slime-presentation-start (values (etypecase object - (buffer (with-current-buffer object (point-min))) + (buffer (with-current-buffer object 1)) (string 0)) nil))) - (setq this-presentation (get-text-property change-point 'slime-repl-presentation object)) - (unless (and this-presentation - (slime-same-presentation-p presentation this-presentation)) + (setq this-presentation (get-text-property change-point presentation object)) + (unless this-presentation (return-from slime-presentation-start (values point nil))) (setq point change-point))) (values point t))) -(defun* slime-presentation-end (point &optional (object (current-buffer))) +(defun* slime-presentation-end (point presentation + &optional (object (current-buffer))) "Find end of presentation at `point' in `object'. Return buffer index (after last character of the presentation) and whether an end-tag was found." - (let* ((presentation (get-text-property point 'slime-repl-presentation object)) - (this-presentation presentation)) - (unless presentation - (return-from slime-presentation-end - (values nil nil))) - (while (and this-presentation - (slime-same-presentation-p presentation this-presentation) - (not (slime-presentation-stop-p this-presentation))) - (let ((change-point (next-single-property-change point 'slime-repl-presentation object))) + (let* ((this-presentation (get-text-property point presentation object))) + (while (not (slime-presentation-stop-p this-presentation)) + (let ((change-point (next-single-property-change point presentation object))) (unless change-point (return-from slime-presentation-end (values (etypecase object @@ -2854,10 +2867,9 @@ (string (length object))) nil))) (setq point change-point) - (setq this-presentation (get-text-property point 'slime-repl-presentation object)))) - (if (and this-presentation - (slime-same-presentation-p presentation this-presentation)) - (let ((after-end (next-single-property-change point 'slime-repl-presentation object))) + (setq this-presentation (get-text-property point presentation object)))) + (if this-presentation + (let ((after-end (next-single-property-change point presentation object))) (if (not after-end) (values (etypecase object (buffer (with-current-buffer object (point-max))) @@ -2866,16 +2878,34 @@ (values after-end t))) (values point nil)))) -(defun* slime-presentation-around-point (point &optional (object (current-buffer))) - "Return presentation, start index, end index, and whether the presentation is complete." +(defun* slime-presentation-bounds (point presentation + &optional (object (current-buffer))) + "Return start index and end index of `presentation' around `point' +in `object', and whether the presentation is complete." (multiple-value-bind (start good-start) - (slime-presentation-start point object) + (slime-presentation-start point presentation object) (multiple-value-bind (end good-end) - (slime-presentation-end point object) - (values (get-text-property point 'slime-repl-presentation object) - start end + (slime-presentation-end point presentation object) + (values start end (and good-start good-end - (slime-presentation-whole-p start end object)))))) + (slime-presentation-whole-p presentation start end object)))))) + +(defun* slime-presentation-around-point (point &optional (object (current-buffer))) + "Return presentation, start index, end index, and whether the +presentation is complete." + (let ((innermost-presentation nil) + (innermost-start 0) + (innermost-end most-positive-fixnum)) + (dolist (presentation (slime-presentations-around-point point object)) + (multiple-value-bind (start end whole-p) + (slime-presentation-bounds point presentation object) + (when whole-p + (when (< (- end start) (- innermost-end innermost-start)) + (setq innermost-start start + innermost-end end + innermost-presentation presentation))))) + (values innermost-presentation + innermost-start innermost-end))) (defun* slime-presentation-around-or-before-point (point &optional (object (current-buffer))) (multiple-value-bind (presentation start end whole-p) @@ -2884,6 +2914,26 @@ (values presentation start end whole-p) (slime-presentation-around-point (1- point) object)))) +(defun* slime-for-each-presentation-in-region (from to function &optional (object (current-buffer))) + "Call `function' with arguments `presentation', `start', `end', +`whole-p' for every presentation in the region `from'--`to' in the +string or buffer `object'." + (flet ((handle-presentation (presentation point) + (multiple-value-bind (start end whole-p) + (slime-presentation-bounds point presentation object) + (funcall function presentation start end whole-p)))) + ;; Handle presentations active at `from'. + (dolist (presentation (slime-presentations-around-point from object)) + (handle-presentation presentation from)) + ;; Use the `slime-repl-presentation' property to search for new presentations. + (let ((point from)) + (while (< point to) + (setq point (next-single-property-change point 'slime-repl-presentation object to)) + (let* ((presentation (get-text-property point 'slime-repl-presentation object)) + (status (get-text-property point presentation object))) + (when (slime-presentation-start-p status) + (handle-presentation presentation point))))))) + ;; XEmacs compatibility hack, from message by Stephen J. Turnbull on ;; xemacs-beta at xemacs.org of 18 Mar 2002 (unless (boundp 'undo-in-progress) @@ -2892,35 +2942,23 @@ (defadvice undo-more (around slime activate) (let ((undo-in-progress t)) ad-do-it))) -(defun slime-after-change-function (start end old-len) +(defun slime-after-change-function (start end &rest ignore) "Check all presentations within and adjacent to the change. When a presentation has been altered, change it to plain text." (unless undo-in-progress - (let ((real-start (max (point-min) (1- start))) - (real-end (min (point-max) (1+ end))) - (any-change nil)) - ;; positions around the change - (save-excursion - (goto-char real-start) - (while (< (point) real-end) - (let ((presentation (get-text-property (point) 'slime-repl-presentation))) - (when presentation - (multiple-value-bind (presentation from to whole) - (slime-presentation-around-point (point)) - ;;(message "presentation %s whole-p %s" (buffer-substring from to) whole) - (unless whole - (setq any-change t) - (remove-text-properties from to - '(slime-repl-inputed-output-face t - face t mouse-face t rear-nonsticky t - slime-repl-presentation t)))))) - (let ((next-change - (next-single-property-change (point) 'slime-repl-presentation nil - real-end))) - (if next-change - (goto-char next-change) - (undo-boundary) - (return)))))))) + (let ((inhibit-modification-hooks t)) + (let ((real-start (max 1 (1- start))) + (real-end (min (1+ (buffer-size)) (1+ end))) + (any-change nil)) + ;; positions around the change + (slime-for-each-presentation-in-region real-start real-end + (lambda (presentation from to whole-p) + (unless whole-p + (slime-remove-presentation-properties from to + presentation) + (setq any-change t)))) + (when any-change + (undo-boundary)))))) (defun slime-copy-presentation-at-point (event) (interactive "e") @@ -2930,6 +2968,8 @@ (with-current-buffer (window-buffer window) (multiple-value-bind (presentation start end) (slime-presentation-around-point point) + (unless presentation + (error "No presentation at click")) (flet ((do-insertion () (when (not (string-match "\\s-" (buffer-substring (1- (point)) (point)))) @@ -3002,11 +3042,7 @@ (slime-insert-presentation result id) (slime-propertize-region `(face slime-repl-result-face) (insert result))) - (unless (bolp) (insert "\n")) - (let ((inhibit-read-only t)) - (put-text-property (- (point) 2) (point) - 'rear-nonsticky - '(slime-repl-presentation face mouse-face read-only))))) + (unless (bolp) (insert "\n")))) (etypecase result (list (loop @@ -3063,11 +3099,8 @@ "Return the current input as string. The input is the region from after the last prompt to the end of buffer. Presentations of old results are expanded into code." - (let ((str-props (buffer-substring slime-repl-input-start-mark - slime-repl-input-end-mark)) - (str-no-props (buffer-substring-no-properties slime-repl-input-start-mark - slime-repl-input-end-mark))) - (reify-old-output str-props str-no-props))) + (slime-buffer-substring-with-reified-output slime-repl-input-start-mark + slime-repl-input-end-mark)) (defun slime-presentation-expression (presentation) "Return a string that contains a CL s-expression accessing @@ -3083,18 +3116,25 @@ (slime-prin1-to-string `(swank:get-repl-result ',id)))))) -(defun reify-old-output (str-props str-no-props) +(defun slime-buffer-substring-with-reified-output (start end) + (let ((str-props (buffer-substring start end)) + (str-no-props (buffer-substring-no-properties start end))) + (slime-reify-old-output str-props str-no-props))) + +(defun slime-reify-old-output (str-props str-no-props) (let ((pos (slime-property-position 'slime-repl-presentation str-props))) (if (null pos) str-no-props (multiple-value-bind (presentation start-pos end-pos whole-p) (slime-presentation-around-point pos str-props) - (concat (substring str-no-props 0 pos) - ;; Eval in the reader so that we play nice with quote. - ;; -luke (19/May/2005) - "#." (slime-presentation-expression presentation) - (reify-old-output (substring str-props end-pos) - (substring str-no-props end-pos))))))) + (if (not presentation) + str-no-props + (concat (substring str-no-props 0 pos) + ;; Eval in the reader so that we play nice with quote. + ;; -luke (19/May/2005) + "#." (slime-presentation-expression presentation) + (slime-reify-old-output (substring str-props end-pos) + (substring str-no-props end-pos)))))))) (defun slime-property-position (text-property &optional object) "Return the first position of TEXT-PROPERTY, or nil." @@ -3243,9 +3283,8 @@ (save-excursion (goto-char slime-repl-input-end-mark) (recenter -1)))) - ((and (or (get-text-property (point) 'slime-repl-presentation) - (get-text-property (1- (point)) 'slime-repl-presentation)) - (< (point) slime-repl-input-start-mark)) + ((and (< (point) slime-repl-input-start-mark) + (nth-value 0 (slime-presentation-around-or-before-point (point)))) (slime-repl-grab-old-output end-of-input) (unless (pos-visible-in-window-p slime-repl-input-end-mark) (save-excursion @@ -3313,8 +3352,7 @@ (defun slime-repl-grab-old-output (replace) "Resend the old REPL output at point. If replace it non-nil the current input is replaced with the old -output; otherwise the new input is appended. The old output has the -text property `slime-repl-presentation'." +output; otherwise the new input is appended." (multiple-value-bind (presentation beg end) (slime-presentation-around-or-before-point (point)) (unless presentation @@ -5901,8 +5939,8 @@ window)))))) (defun slime-last-expression () - (buffer-substring-no-properties (save-excursion (backward-sexp) (point)) - (point))) + (slime-buffer-substring-with-reified-output (save-excursion (backward-sexp) (point)) + (point))) (defun slime-eval-last-expression () "Evaluate the expression preceding point." From mkoeppe at common-lisp.net Sat Aug 20 15:44:28 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sat, 20 Aug 2005 17:44:28 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050820154428.BF98E8815C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6518 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sat Aug 20 17:44:27 2005 Author: mkoeppe Index: slime/ChangeLog diff -u slime/ChangeLog:1.747 slime/ChangeLog:1.748 --- slime/ChangeLog:1.747 Mon Aug 15 22:14:02 2005 +++ slime/ChangeLog Sat Aug 20 17:44:27 2005 @@ -1,3 +1,40 @@ +2005-08-20 Matthias Koeppe + + Enable nested presentations. + + * slime.el (slime-presentation): Remove slots start-p, stop-p. + (slime-add-presentation-properties): Use a new text property + layout. Also add an overlay to enable nested highlighting. + (slime-remove-presentation-properties): New. + (slime-presentation-whole-p): Changed interface. + (slime-presentations-around-point): New. + (slime-same-presentation-p): Removed. + (slime-presentation-start-p, slime-presentation-stop-p): New. + (slime-presentation-start, slime-presentation-end): Changed to use + new text property layout. + (slime-presentation-bounds): New. + (slime-presentation-around-point): Reimplemented to handle nested + presentations. + (slime-for-each-presentation-in-region): New. + (slime-after-change-function): Use + slime-remove-presentation-properties and + slime-for-each-presentation-in-region. + (slime-copy-presentation-at-point): Complain if no presentation. + (slime-repl-insert-prompt): Don't put rear-nonsticky text property. + (slime-reify-old-output): Handle nested presentations. + (slime-repl-return): Use slime-presentation-around-or-before-point. + + Enable reification of presentations in non-REPL buffers. + + * slime.el (slime-buffer-substring-with-reified-output): New, + factored out from slime-repl-current-input. + (slime-repl-current-input): Use it here. + (slime-last-expression): Use it here. + + (slime-add-presentation-properties): Add text properties + modification-hooks et al. to enable self-destruction of incomplete + or edited presentations in non-REPL buffers. + 2005-08-15 Alan Ruttenberg * slime.el (slime-goto-location-position) fix so the :method locator From crhodes at common-lisp.net Sat Aug 20 19:36:19 2005 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Sat, 20 Aug 2005 21:36:19 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog slime/swank-sbcl.lisp Message-ID: <20050820193619.8F7E388548@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv22585 Modified Files: ChangeLog swank-sbcl.lisp Log Message: (noted by Brian Mastenbrook) non-Linux non-linkage-table sbcls try to get the address of linux_no_threads_p at fasl-load time, and complain vigorously if it's not available. Guard with #+linux. Date: Sat Aug 20 21:36:18 2005 Author: crhodes Index: slime/ChangeLog diff -u slime/ChangeLog:1.748 slime/ChangeLog:1.749 --- slime/ChangeLog:1.748 Sat Aug 20 17:44:27 2005 +++ slime/ChangeLog Sat Aug 20 21:36:13 2005 @@ -1,3 +1,9 @@ +2005-08-20 Christophe Rhodes + + * swank-sbcl.lisp (preferred-communication-style): guard against + non-Linux non-linkage-table platforms (and assume that they won't + have dodgy threads) with #+linux. + 2005-08-20 Matthias Koeppe Enable nested presentations. Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.139 slime/swank-sbcl.lisp:1.140 --- slime/swank-sbcl.lisp:1.139 Thu Aug 4 02:03:41 2005 +++ slime/swank-sbcl.lisp Sat Aug 20 21:36:15 2005 @@ -43,6 +43,7 @@ (defimplementation preferred-communication-style () (if (and (member :sb-thread *features*) + #+linux (not (sb-alien:extern-alien "linux_no_threads_p" sb-alien:boolean))) :spawn :fd-handler)) From mkoeppe at common-lisp.net Sun Aug 21 16:28:50 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sun, 21 Aug 2005 18:28:50 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/present.lisp Message-ID: <20050821162850.33CE0884CB@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv9061 Modified Files: present.lisp Log Message: (menu-choices-for-presentation-id): Check against the gensym in *not-present* instead of :non-present. Date: Sun Aug 21 18:28:49 2005 Author: mkoeppe Index: slime/present.lisp diff -u slime/present.lisp:1.11 slime/present.lisp:1.12 --- slime/present.lisp:1.11 Sun Aug 14 17:43:33 2005 +++ slime/present.lisp Sun Aug 21 18:28:48 2005 @@ -167,7 +167,7 @@ (defun menu-choices-for-presentation-id (id) (let ((ob (lookup-presented-object id))) - (if (eq ob :not-present) + (if (eq ob *not-present*) 'not-present (let ((menu-and-actions (menu-choices-for-presentation ob))) (setq *presentation-active-menu* (cons id menu-and-actions)) From mkoeppe at common-lisp.net Sun Aug 21 16:29:06 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sun, 21 Aug 2005 18:29:06 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050821162906.C9176884CB@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv9091 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sun Aug 21 18:29:06 2005 Author: mkoeppe Index: slime/ChangeLog diff -u slime/ChangeLog:1.749 slime/ChangeLog:1.750 --- slime/ChangeLog:1.749 Sat Aug 20 21:36:13 2005 +++ slime/ChangeLog Sun Aug 21 18:29:05 2005 @@ -1,3 +1,8 @@ +2005-08-21 Matthias Koeppe + + * present.lisp (menu-choices-for-presentation-id): Check against + the gensym in *not-present* instead of :non-present. + 2005-08-20 Christophe Rhodes * swank-sbcl.lisp (preferred-communication-style): guard against From wjenkner at common-lisp.net Mon Aug 22 04:30:36 2005 From: wjenkner at common-lisp.net (Wolfgang Jenkner) Date: Mon, 22 Aug 2005 06:30:36 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-clisp.lisp Message-ID: <20050822043036.8B5EF884C2@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25126 Modified Files: swank-clisp.lisp Log Message: (fspec-pathname): Cope with CVS CLISP's (documentation symbol 'sys::file) returning a list. Return either a list of start and end line positions or nil as second value. (fspec-location): Use it. Also, if we have to guess the name of a source file make sure that it actually exists. (with-blocked-signals, call-without-interrupts): Don't add :linux to *features* since this changes the return value of unique-directory-name in swank-loader.lisp. Comment out with-blocked-signals. Update some comments at the top of the file. State the licence in the same terms as slime.el does. Date: Mon Aug 22 06:30:35 2005 Author: wjenkner Index: slime/swank-clisp.lisp diff -u slime/swank-clisp.lisp:1.53 slime/swank-clisp.lisp:1.54 --- slime/swank-clisp.lisp:1.53 Mon Aug 15 10:57:51 2005 +++ slime/swank-clisp.lisp Mon Aug 22 06:30:30 2005 @@ -2,24 +2,34 @@ ;;;; Copyright (C) 2003, 2004 W. Jenkner, V. Sedach -;;;; swank-clisp.lisp is free software; you can redistribute it and/or +;;;; This program is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU General Public License as -;;;; published by the Free Software Foundation; either version 2, or -;;;; (at your option) any later version. +;;;; published by the Free Software Foundation; either version 2 of +;;;; the License, or (at your option) any later version. + +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. + +;;;; You should have received a copy of the GNU General Public +;;;; License along with this program; if not, write to the Free +;;;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, +;;;; MA 02111-1307, USA. ;;; This is work in progress, but it's already usable. Many things ;;; are adapted from other swank-*.lisp, in particular from ;;; swank-allegro (I don't use allegro at all, but it's the shortest ;;; one and I found Helmut Eller's code there enlightening). -;;; This code is developed using the current CVS version of CLISP and -;;; CLISP 2.32 on Linux. Older versions may not work (2.29 and below -;;; are confirmed non-working; please upgrade). You need an image -;;; containing the "SOCKET", "REGEXP", and "LINUX" packages. The -;;; portable xref from the CMU AI repository and metering.lisp from -;;; CLOCC [1] are also required (alternatively, you have to manually -;;; comment out some code below). -;;; +;;; This code will work better with recent versions of CLISP (say, the +;;; last release or CVS HEAD) while it may not work at all with older +;;; versions. It is reasonable to expect it to work on platforms with +;;; a "SOCKET" package, in particular on GNU/Linux or Unix-like +;;; systems, but also on Win32. This backend uses the portable xref +;;; from the CMU AI repository and metering.lisp from CLOCC [1], which +;;; are conveniently included in SLIME. + ;;; [1] http://cvs.sourceforge.net/viewcvs.py/clocc/clocc/src/tools/metering/ (in-package :swank-backend) @@ -28,10 +38,6 @@ ;;(use-package "SOCKET") (use-package "GRAY")) -(eval-when (:compile-toplevel :execute) - (when (find-package "LINUX") - (pushnew :linux *features*))) - ;;;; if this lisp has the complete CLOS then we use it, otherwise we ;;;; build up a "fake" swank-mop and then override the methods in the ;;;; inspector. @@ -57,26 +63,25 @@ (:documentation "Dummy class created so that swank.lisp will compile and load.")) -#+linux -(defmacro with-blocked-signals ((&rest signals) &body body) - (ext:with-gensyms ("SIGPROCMASK" ret mask) - `(multiple-value-bind (,ret ,mask) - (linux:sigprocmask-set-n-save - ,linux:SIG_BLOCK - ,(do ((sigset (linux:sigset-empty) - (linux:sigset-add sigset (the fixnum (pop signals))))) - ((null signals) sigset))) - (linux:check-res ,ret 'linux:sigprocmask-set-n-save) - (unwind-protect - (progn , at body) - (linux:sigprocmask-set ,linux:SIG_SETMASK ,mask nil))))) - -;; XXX currently only works in CVS version. 2.32 breaks. -;; #+linux -;; (defimplementation call-without-interrupts (fn) -;; (with-blocked-signals (#.linux:SIGINT) (funcall fn))) -;; -;; #-linux +;; #+#.(cl:if (cl:find-package "LINUX") '(and) '(or)) +;; (progn +;; (defmacro with-blocked-signals ((&rest signals) &body body) +;; (ext:with-gensyms ("SIGPROCMASK" ret mask) +;; `(multiple-value-bind (,ret ,mask) +;; (linux:sigprocmask-set-n-save +;; ,linux:SIG_BLOCK +;; ,(do ((sigset (linux:sigset-empty) +;; (linux:sigset-add sigset (the fixnum (pop signals))))) +;; ((null signals) sigset))) +;; (linux:check-res ,ret 'linux:sigprocmask-set-n-save) +;; (unwind-protect +;; (progn , at body) +;; (linux:sigprocmask-set ,linux:SIG_SETMASK ,mask nil))))) + +;; (defimplementation call-without-interrupts (fn) +;; (with-blocked-signals (#.linux:SIGINT) (funcall fn)))) + +;; #+#.(cl:if (cl:find-package "LINUX") '(or) '(and)) (defimplementation call-without-interrupts (fn) (funcall fn)) @@ -188,21 +193,30 @@ (:class (describe (find-class symbol))))) (defun fspec-pathname (symbol) - (let ((path (documentation symbol 'sys::file))) - (if (and path - (member (pathname-type path) - custom:*compiled-file-types* :test #'string=)) - (loop for suffix in custom:*source-file-types* - thereis (make-pathname :defaults path :type suffix)) - path))) + (let ((path (documentation symbol 'sys::file)) + lines) + (when (consp path) + (psetq path (car path) + lines (cdr path))) + (when (and path + (member (pathname-type path) + custom:*compiled-file-types* :test #'equal)) + (setq path + (loop for suffix in custom:*source-file-types* + thereis (probe-file (make-pathname :defaults path + :type suffix))))) + (values path lines))) (defun fspec-location (fspec) - (let ((file (fspec-pathname fspec))) + (multiple-value-bind (file lines) + (fspec-pathname fspec) (cond (file (multiple-value-bind (truename c) (ignore-errors (truename file)) - (cond (truename + (cond (truename (make-location (list :file (namestring truename)) - (list :function-name (string fspec)))) + (if (consp lines) + (list* :line lines) + (list :function-name (string fspec))))) (t (list :error (princ-to-string c)))))) (t (list :error (format nil "No source information available for: ~S" fspec)))))) From wjenkner at common-lisp.net Mon Aug 22 04:32:35 2005 From: wjenkner at common-lisp.net (Wolfgang Jenkner) Date: Mon, 22 Aug 2005 06:32:35 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050822043235.B8C6F884C2@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25669 Modified Files: ChangeLog Log Message: Date: Mon Aug 22 06:32:35 2005 Author: wjenkner Index: slime/ChangeLog diff -u slime/ChangeLog:1.750 slime/ChangeLog:1.751 --- slime/ChangeLog:1.750 Sun Aug 21 18:29:05 2005 +++ slime/ChangeLog Mon Aug 22 06:32:34 2005 @@ -1,3 +1,19 @@ +2005-08-22 Wolfgang Jenkner + + * swank-clisp.lisp (fspec-pathname): Cope with CVS CLISP's + (documentation symbol 'sys::file) returning a list. Return either + a list of start and end line positions or nil as second value. + (fspec-location): Use it. Also, if we have to guess the name of a + source file make sure that it actually exists. + + (with-blocked-signals, call-without-interrupts): Don't add + :linux to *features* since this changes the return value of + unique-directory-name in swank-loader.lisp. + Comment out with-blocked-signals. + + Update some comments at the top of the file. + State the licence in the same terms as slime.el does. + 2005-08-21 Matthias Koeppe * present.lisp (menu-choices-for-presentation-id): Check against From mbaringer at common-lisp.net Tue Aug 23 06:39:10 2005 From: mbaringer at common-lisp.net (Marco Baringer) Date: Tue, 23 Aug 2005 08:39:10 +0200 (CEST) Subject: [slime-cvs] CVS update: /slime/ChangeLog Message-ID: <20050823063910.AC99C8802E@common-lisp.net> Update of /project/slime/cvsroot//slime In directory common-lisp.net:/tmp/cvs-serv1185 Modified Files: ChangeLog Log Message: Date: Tue Aug 23 08:39:06 2005 Author: mbaringer From mbaringer at common-lisp.net Tue Aug 23 06:39:33 2005 From: mbaringer at common-lisp.net (Marco Baringer) Date: Tue, 23 Aug 2005 08:39:33 +0200 (CEST) Subject: [slime-cvs] CVS update: /slime/slime.el Message-ID: <20050823063933.2C7978802E@common-lisp.net> Update of /project/slime/cvsroot//slime In directory common-lisp.net:/tmp/cvs-serv1224 Modified Files: slime.el Log Message: (slime-goto-location-position): Added a second regexp for the :function-name case which matches "(def... ((function-name ..." (with N opening parens preceding the function name). This is to allow scheme48 style function names and definitions. Date: Tue Aug 23 08:39:32 2005 Author: mbaringer From crhodes at common-lisp.net Wed Aug 24 15:09:52 2005 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Wed, 24 Aug 2005 17:09:52 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog slime/swank-sbcl.lisp Message-ID: <20050824150952.55BF388542@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv3549 Modified Files: ChangeLog swank-sbcl.lisp Log Message: Present qualifiers in method definitions for sbcl Date: Wed Aug 24 17:09:47 2005 Author: crhodes Index: slime/ChangeLog diff -u slime/ChangeLog:1.752 slime/ChangeLog:1.753 --- slime/ChangeLog:1.752 Tue Aug 23 08:39:06 2005 +++ slime/ChangeLog Wed Aug 24 17:09:32 2005 @@ -1,3 +1,8 @@ +2005-08-24 Christophe Rhodes + + * swank-sbcl.lisp (method-definitions): present qualifiers (if + any). + 2005-08-23 Taylor R. Campbell * slime.el (slime-goto-location-position): Added a second regexp Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.140 slime/swank-sbcl.lisp:1.141 --- slime/swank-sbcl.lisp:1.140 Sat Aug 20 21:36:15 2005 +++ slime/swank-sbcl.lisp Wed Aug 24 17:09:33 2005 @@ -519,7 +519,8 @@ (let ((methods (sb-mop:generic-function-methods gf)) (name (sb-mop:generic-function-name gf))) (loop for method in methods - collect (list `(method ,name ,(sb-pcl::unparse-specializers method)) + collect (list `(method ,name ,@(method-qualifiers method) + ,(sb-pcl::unparse-specializers method)) (method-source-location method))))) (defun method-source-location (method) From mbaringer at common-lisp.net Wed Aug 24 17:38:33 2005 From: mbaringer at common-lisp.net (Marco Baringer) Date: Wed, 24 Aug 2005 19:38:33 +0200 (CEST) Subject: [slime-cvs] CVS update: /slime/ChangeLog Message-ID: <20050824173833.9414A88544@common-lisp.net> Update of /project/slime/cvsroot//slime In directory common-lisp.net:/tmp/cvs-serv13876 Modified Files: ChangeLog Log Message: Date: Wed Aug 24 19:38:32 2005 Author: mbaringer From mbaringer at common-lisp.net Wed Aug 24 17:40:48 2005 From: mbaringer at common-lisp.net (Marco Baringer) Date: Wed, 24 Aug 2005 19:40:48 +0200 (CEST) Subject: [slime-cvs] CVS update: /slime/swank.lisp Message-ID: <20050824174048.478C488544@common-lisp.net> Update of /project/slime/cvsroot//slime In directory common-lisp.net:/tmp/cvs-serv13916 Modified Files: swank.lisp Log Message: (fuzzy-find-matching-symbols): When completing the string "package:" present a list of all the external symbols in package (completing "package::" lists internal symbols as well). (inspect-for-emacs standard-class): List all the slots in the class (as per standard-object). The previous method of hard coding the slots in the inspector's code made inspecting custom meta-classes useless. Date: Wed Aug 24 19:40:47 2005 Author: mbaringer From aruttenberg at common-lisp.net Fri Aug 26 17:59:57 2005 From: aruttenberg at common-lisp.net (Alan Ruttenberg) Date: Fri, 26 Aug 2005 19:59:57 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050826175957.52F0E88545@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv21158/slime Modified Files: ChangeLog Log Message: Date: Fri Aug 26 19:59:51 2005 Author: aruttenberg Index: slime/ChangeLog diff -u slime/ChangeLog:1.754 slime/ChangeLog:1.755 --- slime/ChangeLog:1.754 Wed Aug 24 19:38:31 2005 +++ slime/ChangeLog Fri Aug 26 19:59:50 2005 @@ -1,3 +1,11 @@ +2005-08-15 Alan Ruttenberg + + * swank-openmcl.lisp (condition-source-position) + ccl::compiler-warning-stream-position is sometimes nil, so placate + this function by making it (or .. 0). Wrong but I don't have + enough time now to figure out what the right thing is. + + 2005-08-24 Marco Baringer * swank.lisp (fuzzy-find-matching-symbols): When completing the From aruttenberg at common-lisp.net Fri Aug 26 18:00:31 2005 From: aruttenberg at common-lisp.net (Alan Ruttenberg) Date: Fri, 26 Aug 2005 20:00:31 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-openmcl.lisp Message-ID: <20050826180031.98FE788545@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv21249/slime Modified Files: swank-openmcl.lisp Log Message: Date: Fri Aug 26 20:00:29 2005 Author: aruttenberg Index: slime/swank-openmcl.lisp diff -u slime/swank-openmcl.lisp:1.96 slime/swank-openmcl.lisp:1.97 --- slime/swank-openmcl.lisp:1.96 Mon Aug 15 22:13:15 2005 +++ slime/swank-openmcl.lisp Fri Aug 26 20:00:29 2005 @@ -235,7 +235,9 @@ "Return the position in the source file of a compiler condition." (+ 1 (or *buffer-offset* 0) - (ccl::compiler-warning-stream-position condition))) + ;; alanr sometimes returned stream position nil. + (or (ccl::compiler-warning-stream-position condition) 0))) + (defun handle-compiler-warning (condition) "Construct a compiler note for Emacs from a compiler warning From mkoeppe at common-lisp.net Sat Aug 27 16:37:36 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sat, 27 Aug 2005 18:37:36 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050827163736.4A9C28855A@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv19948 Modified Files: slime.el Log Message: (slime-presentation-menu): When an object is no longer recorded, remove text properties from the presentation. Date: Sat Aug 27 18:37:35 2005 Author: mkoeppe Index: slime/slime.el diff -u slime/slime.el:1.528 slime/slime.el:1.529 --- slime/slime.el:1.528 Tue Aug 23 08:39:30 2005 +++ slime/slime.el Sat Aug 27 18:37:35 2005 @@ -3004,28 +3004,32 @@ (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) + (multiple-value-bind (presentation from to whole-p) (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)))))))))))))) + (etypecase choices + (null) + (symbol ; not-present + (slime-remove-presentation-properties from to presentation) + (sit-for 0) ; allow redisplay + (x-popup-menu event `("Object no longer recorded" ("sorry" . ,(if (featurep 'xemacs) nil '(nil)))))) + (list + (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) From mkoeppe at common-lisp.net Sat Aug 27 16:38:08 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sat, 27 Aug 2005 18:38:08 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050827163808.D95E588567@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv19979 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sat Aug 27 18:37:57 2005 Author: mkoeppe Index: slime/ChangeLog diff -u slime/ChangeLog:1.755 slime/ChangeLog:1.756 --- slime/ChangeLog:1.755 Fri Aug 26 19:59:50 2005 +++ slime/ChangeLog Sat Aug 27 18:37:56 2005 @@ -1,3 +1,8 @@ +2005-08-27 Matthias Koeppe + + * slime.el (slime-presentation-menu): When an object is no longer + recorded, remove text properties from the presentation. + 2005-08-15 Alan Ruttenberg * swank-openmcl.lisp (condition-source-position) From mkoeppe at common-lisp.net Sun Aug 28 12:23:36 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sun, 28 Aug 2005 14:23:36 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050828122336.63963880DD@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv3138 Modified Files: slime.el Log Message: (slime-enable-evaluate-in-emacs): New variable. (evaluate-in-emacs): Security improvement: If slime-enable-evaluate-in-emacs is nil (the default), don't evaluate forms sent by the Lisp. Date: Sun Aug 28 14:23:35 2005 Author: mkoeppe Index: slime/slime.el diff -u slime/slime.el:1.529 slime/slime.el:1.530 --- slime/slime.el:1.529 Sat Aug 27 18:37:35 2005 +++ slime/slime.el Sun Aug 28 14:23:35 2005 @@ -3618,10 +3618,21 @@ (slime-mark-input-start) (slime-repl-read-mode 1)) +(defcustom slime-enable-evaluate-in-emacs nil + "If non-nil, the inferior Lisp can evaluate arbitrary forms in Emacs. +The default is nil, as this feature can be a security risk." + :type '(boolean) + :group 'slime-lisp) + (defun evaluate-in-emacs (expr thread tag) - (push thread slime-read-string-threads) - (push tag slime-read-string-tags) - (slime-repl-return-string (eval expr))) + (cond + (slime-enable-evaluate-in-emacs + (push thread slime-read-string-threads) + (push tag slime-read-string-tags) + (slime-repl-return-string (eval expr))) + (t + (slime-eval-async `(cl:error "Cannot evaluate in Emacs because slime-enable-evaluate-in-emacs is nil")) + nil))) (defun slime-repl-return-string (string) (slime-dispatch-event `(:emacs-return-string From mkoeppe at common-lisp.net Sun Aug 28 12:25:41 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sun, 28 Aug 2005 14:25:41 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050828122541.374B3880DD@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv3186 Modified Files: swank.lisp Log Message: (send-to-socket-io): Handle :evaluate-in-emacs. Date: Sun Aug 28 14:25:40 2005 Author: mkoeppe Index: slime/swank.lisp diff -u slime/swank.lisp:1.324 slime/swank.lisp:1.325 --- slime/swank.lisp:1.324 Wed Aug 24 19:40:47 2005 +++ slime/swank.lisp Sun Aug 28 14:25:40 2005 @@ -719,6 +719,8 @@ ((:return thread &rest args) (declare (ignore thread)) (send `(:return , at args))) + ((:evaluate-in-emacs string thread &rest args) + (send `(:evaluate-in-emacs ,string 0 , at args))) (((:read-output :new-package :new-features :debug-condition :presentation-start :presentation-end :indentation-update :ed :%apply :eval-no-wait) From mkoeppe at common-lisp.net Sun Aug 28 12:26:37 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sun, 28 Aug 2005 14:26:37 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050828122637.2B18A880DD@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv3216 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sun Aug 28 14:26:36 2005 Author: mkoeppe Index: slime/ChangeLog diff -u slime/ChangeLog:1.756 slime/ChangeLog:1.757 --- slime/ChangeLog:1.756 Sat Aug 27 18:37:56 2005 +++ slime/ChangeLog Sun Aug 28 14:26:36 2005 @@ -1,3 +1,12 @@ +2005-08-28 Matthias Koeppe + + * slime.el (slime-enable-evaluate-in-emacs): New variable. + (evaluate-in-emacs): Security improvement: If + slime-enable-evaluate-in-emacs is nil (the default), don't + evaluate forms sent by the Lisp. + + * swank.lisp (send-to-socket-io): Handle :evaluate-in-emacs. + 2005-08-27 Matthias Koeppe * slime.el (slime-presentation-menu): When an object is no longer From mkoeppe at common-lisp.net Sun Aug 28 14:47:12 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sun, 28 Aug 2005 16:47:12 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-backend.lisp Message-ID: <20050828144712.95427880DD@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv13102 Modified Files: swank-backend.lisp Log Message: (make-weak-key-hash-table) (make-weak-value-hash-table): New interfaces. Date: Sun Aug 28 16:47:11 2005 Author: mkoeppe Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.86 slime/swank-backend.lisp:1.87 --- slime/swank-backend.lisp:1.86 Tue Jul 5 22:30:59 2005 +++ slime/swank-backend.lisp Sun Aug 28 16:47:11 2005 @@ -806,3 +806,14 @@ (:call CALLER CALLEE) ; trace calls from CALLER to CALLEE. (:labels TOPLEVEL LOCAL) (:flet TOPLEVEL LOCAL) ") + + +;;;; Weak datastructures + +(definterface make-weak-key-hash-table (&rest args) + "Like MAKE-HASH-TABLE, but weak w.r.t. the keys." + (apply #'make-hash-table args)) + +(definterface make-weak-value-hash-table (&rest args) + "Like MAKE-HASH-TABLE, but weak w.r.t. the values." + (apply #'make-hash-table args)) From mkoeppe at common-lisp.net Sun Aug 28 14:47:54 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sun, 28 Aug 2005 16:47:54 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp Message-ID: <20050828144754.43B46880DD@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv13132 Modified Files: swank-cmucl.lisp Log Message: (make-weak-key-hash-table): Implement it. Date: Sun Aug 28 16:47:51 2005 Author: mkoeppe Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.150 slime/swank-cmucl.lisp:1.151 --- slime/swank-cmucl.lisp:1.150 Tue Jul 5 22:30:58 2005 +++ slime/swank-cmucl.lisp Sun Aug 28 16:47:51 2005 @@ -2181,6 +2181,11 @@ (t fspec))) +;;; Weak datastructures + +(defimplementation make-weak-key-hash-table (&rest args) + (apply #'make-hash-table :weak-p t args)) + ;; Local Variables: ;; pbook-heading-regexp: "^;;;\\(;+\\)" ;; pbook-commentary-regexp: "^;;;\\($\\|[^;]\\)" From mkoeppe at common-lisp.net Sun Aug 28 14:48:21 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sun, 28 Aug 2005 16:48:21 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: <20050828144821.A9F69880DD@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv13148 Modified Files: swank-sbcl.lisp Log Message: (make-weak-key-hash-table): Implement it. Date: Sun Aug 28 16:48:20 2005 Author: mkoeppe Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.141 slime/swank-sbcl.lisp:1.142 --- slime/swank-sbcl.lisp:1.141 Wed Aug 24 17:09:33 2005 +++ slime/swank-sbcl.lisp Sun Aug 28 16:48:20 2005 @@ -1219,3 +1219,9 @@ ((:call) (destructuring-bind (caller callee) (cdr spec) (toggle-trace-aux callee :wherein (list (process-fspec caller))))))) + +;;; Weak datastructures + +(defimplementation make-weak-key-hash-table (&rest args) + (apply #'make-hash-table :weak-p t args)) + From mkoeppe at common-lisp.net Sun Aug 28 14:48:49 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sun, 28 Aug 2005 16:48:49 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-openmcl.lisp Message-ID: <20050828144849.4DA8F880DD@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv13171 Modified Files: swank-openmcl.lisp Log Message: (make-weak-key-hash-table) (make-weak-value-hash-table): Implement it. Date: Sun Aug 28 16:48:48 2005 Author: mkoeppe Index: slime/swank-openmcl.lisp diff -u slime/swank-openmcl.lisp:1.97 slime/swank-openmcl.lisp:1.98 --- slime/swank-openmcl.lisp:1.97 Fri Aug 26 20:00:29 2005 +++ slime/swank-openmcl.lisp Sun Aug 28 16:48:47 2005 @@ -831,3 +831,12 @@ (defimplementation quit-lisp () (ccl::quit)) + +;;; Weak datastructures + +(defimplementation make-weak-key-hash-table (&rest args) + (apply #'make-hash-table :weak :key args)) + +(defimplementation make-weak-value-hash-table (&rest args) + (apply #'make-hash-table :weak :value args)) + From mkoeppe at common-lisp.net Sun Aug 28 14:50:04 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sun, 28 Aug 2005 16:50:04 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050828145004.40C9C880DD@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv13191 Modified Files: swank.lisp Log Message: (*object-to-presentation-id*, *presentation-id-to-object*): Use new functions make-weak-key-hash-table, make-weak-value-hash-table. Date: Sun Aug 28 16:50:03 2005 Author: mkoeppe Index: slime/swank.lisp diff -u slime/swank.lisp:1.325 slime/swank.lisp:1.326 --- slime/swank.lisp:1.325 Sun Aug 28 14:25:40 2005 +++ slime/swank.lisp Sun Aug 28 16:50:03 2005 @@ -1684,13 +1684,11 @@ "Non-nil means that REPL results are saved for later lookup.") (defvar *object-to-presentation-id* - (make-hash-table :test 'eq - #+openmcl :weak #+openmcl :key) + (make-weak-key-hash-table :test 'eq) "Store the mapping of objects to numeric identifiers") (defvar *presentation-id-to-object* - (make-hash-table :test 'eq - #+openmcl :weak #+openmcl :value) + (make-weak-value-hash-table :test 'eq) "Store the mapping of numeric identifiers to objects") (defun clear-presentation-tables () From mkoeppe at common-lisp.net Sun Aug 28 14:52:59 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sun, 28 Aug 2005 16:52:59 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050828145259.69077880DD@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv13232 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sun Aug 28 16:52:59 2005 Author: mkoeppe Index: slime/ChangeLog diff -u slime/ChangeLog:1.757 slime/ChangeLog:1.758 --- slime/ChangeLog:1.757 Sun Aug 28 14:26:36 2005 +++ slime/ChangeLog Sun Aug 28 16:52:59 2005 @@ -1,5 +1,16 @@ 2005-08-28 Matthias Koeppe + * swank-backend.lisp (make-weak-key-hash-table) + (make-weak-value-hash-table): New interfaces. + * swank-cmucl.lisp (make-weak-key-hash-table): Implement it. + * swank-sbcl.lisp (make-weak-key-hash-table): Implement it. + * swank-openmcl.lisp (make-weak-key-hash-table) + (make-weak-value-hash-table): Implement it. + + * swank.lisp (*object-to-presentation-id*) + (*presentation-id-to-object*): Use new functions + make-weak-key-hash-table, make-weak-value-hash-table. + * slime.el (slime-enable-evaluate-in-emacs): New variable. (evaluate-in-emacs): Security improvement: If slime-enable-evaluate-in-emacs is nil (the default), don't From mkoeppe at common-lisp.net Sun Aug 28 15:09:26 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sun, 28 Aug 2005 17:09:26 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050828150926.5B9DA880DD@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14267 Modified Files: slime.el Log Message: (slime-repl-kill-input): New command. (slime-repl-mode-map): Bind it to C-c C-u, like in comint. (slime-repl-easy-menu): Include it in the REPL menu. Date: Sun Aug 28 17:09:25 2005 Author: mkoeppe Index: slime/slime.el diff -u slime/slime.el:1.530 slime/slime.el:1.531 --- slime/slime.el:1.530 Sun Aug 28 14:23:35 2005 +++ slime/slime.el Sun Aug 28 17:09:22 2005 @@ -808,7 +808,8 @@ [ "Goto Previous Prompt " slime-repl-previous-prompt t ] [ "Goto Next Prompt " slime-repl-next-prompt t ] [ "Clear Last Output" slime-repl-clear-output t ] - [ "Clear Buffer " slime-repl-clear-buffer t ]))) + [ "Clear Buffer " slime-repl-clear-buffer t ] + [ "Kill Current Input" slime-repl-kill-input t ]))) (defvar slime-sldb-easy-menu (let ((C '(slime-connected-p))) @@ -3420,6 +3421,12 @@ (defun slime-repl-delete-current-input () (delete-region slime-repl-input-start-mark slime-repl-input-end-mark)) +(defun slime-repl-kill-input () + "Kill all text from last stuff output by the Lisp process to point." + (interactive) + (when (> (point) (marker-position slime-repl-input-start-mark)) + (kill-region slime-repl-input-start-mark (point)))) + (defun slime-repl-replace-input (string) (slime-repl-delete-current-input) (insert-and-inherit string)) @@ -3583,6 +3590,7 @@ ("\C-\M-x" 'slime-eval-defun) ("\C-c\C-o" 'slime-repl-clear-output) ("\C-c\C-t" 'slime-repl-clear-buffer) + ("\C-c\C-u" 'slime-repl-kill-input) ("\C-c\C-n" 'slime-repl-next-prompt) ("\C-c\C-p" 'slime-repl-previous-prompt) ("\M-\C-a" 'slime-repl-beginning-of-defun) From mkoeppe at common-lisp.net Sun Aug 28 15:09:47 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sun, 28 Aug 2005 17:09:47 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050828150947.C8D6B880DD@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14288 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sun Aug 28 17:09:47 2005 Author: mkoeppe Index: slime/ChangeLog diff -u slime/ChangeLog:1.758 slime/ChangeLog:1.759 --- slime/ChangeLog:1.758 Sun Aug 28 16:52:59 2005 +++ slime/ChangeLog Sun Aug 28 17:09:46 2005 @@ -1,5 +1,9 @@ 2005-08-28 Matthias Koeppe + * slime.el (slime-repl-kill-input): New command. + (slime-repl-mode-map): Bind it to C-c C-u, like in comint. + (slime-repl-easy-menu): Include it in the REPL menu. + * swank-backend.lisp (make-weak-key-hash-table) (make-weak-value-hash-table): New interfaces. * swank-cmucl.lisp (make-weak-key-hash-table): Implement it. From mkoeppe at common-lisp.net Sun Aug 28 15:37:51 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Sun, 28 Aug 2005 17:37:51 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050828153751.3C7B9880DD@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv16353 Modified Files: slime.el Log Message: (slime-repl-mode-hook): Show the SLIME menu in the REPL too. Date: Sun Aug 28 17:37:50 2005 Author: mkoeppe Index: slime/slime.el diff -u slime/slime.el:1.531 slime/slime.el:1.532 --- slime/slime.el:1.531 Sun Aug 28 17:09:22 2005 +++ slime/slime.el Sun Aug 28 17:37:50 2005 @@ -849,6 +849,8 @@ (defun slime-repl-add-easy-menu () (easy-menu-define menubar-slime-repl slime-repl-mode-map "REPL" slime-repl-easy-menu) + (easy-menu-define menubar-slime slime-repl-mode-map + "SLIME" slime-easy-menu) (easy-menu-add slime-repl-easy-menu 'slime-repl-mode-map))) (add-hook 'sldb-mode-hook From jsnellman at common-lisp.net Mon Aug 29 11:24:32 2005 From: jsnellman at common-lisp.net (Juho Snellman) Date: Mon, 29 Aug 2005 13:24:32 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog slime/swank-sbcl.lisp Message-ID: <20050829112432.7F40188549@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv32734 Modified Files: ChangeLog swank-sbcl.lisp Log Message: swank-sbcl.lisp (make-weak-key-hash-table): Remove the implementation; SBCL doesn't actually support weak hash-tables. Date: Mon Aug 29 13:24:18 2005 Author: jsnellman Index: slime/ChangeLog diff -u slime/ChangeLog:1.759 slime/ChangeLog:1.760 --- slime/ChangeLog:1.759 Sun Aug 28 17:09:46 2005 +++ slime/ChangeLog Mon Aug 29 13:23:55 2005 @@ -1,3 +1,8 @@ +2005-08-29 Juho Snellman + + * swank-sbcl.lisp (make-weak-key-hash-table): Remove the + implementation; SBCL doesn't actually support weak hash-tables. + 2005-08-28 Matthias Koeppe * slime.el (slime-repl-kill-input): New command. Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.142 slime/swank-sbcl.lisp:1.143 --- slime/swank-sbcl.lisp:1.142 Sun Aug 28 16:48:20 2005 +++ slime/swank-sbcl.lisp Mon Aug 29 13:23:55 2005 @@ -1222,6 +1222,11 @@ ;;; Weak datastructures + +;; SBCL doesn't actually implement weak hash-tables, the WEAK-P +;; keyword is just a decoy. Leave this here, but commented out, +;; so that no-one tries adding it back. +#+(or) (defimplementation make-weak-key-hash-table (&rest args) (apply #'make-hash-table :weak-p t args)) From mkoeppe at common-lisp.net Mon Aug 29 18:34:01 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Mon, 29 Aug 2005 20:34:01 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050829183401.951EB88549@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv30063 Modified Files: ChangeLog Log Message: Date: Mon Aug 29 20:34:00 2005 Author: mkoeppe Index: slime/ChangeLog diff -u slime/ChangeLog:1.760 slime/ChangeLog:1.761 --- slime/ChangeLog:1.760 Mon Aug 29 13:23:55 2005 +++ slime/ChangeLog Mon Aug 29 20:33:59 2005 @@ -8,6 +8,7 @@ * slime.el (slime-repl-kill-input): New command. (slime-repl-mode-map): Bind it to C-c C-u, like in comint. (slime-repl-easy-menu): Include it in the REPL menu. + (slime-repl-mode-hook): Show the SLIME menu in the REPL too. * swank-backend.lisp (make-weak-key-hash-table) (make-weak-value-hash-table): New interfaces. From aruttenberg at common-lisp.net Mon Aug 29 19:23:54 2005 From: aruttenberg at common-lisp.net (Alan Ruttenberg) Date: Mon, 29 Aug 2005 21:23:54 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog slime/slime.el Message-ID: <20050829192354.6AC3E88542@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv707/slime Modified Files: ChangeLog slime.el Log Message: Date: Mon Aug 29 21:23:53 2005 Author: aruttenberg Index: slime/ChangeLog diff -u slime/ChangeLog:1.761 slime/ChangeLog:1.762 --- slime/ChangeLog:1.761 Mon Aug 29 20:33:59 2005 +++ slime/ChangeLog Mon Aug 29 21:23:52 2005 @@ -1,3 +1,7 @@ +2005-08-29 Alan Ruttenberg + * slime.el (sldb-insert-condition) - Add tooltip for long + condition string which otherwise falls off the right of the screen + 2005-08-29 Juho Snellman * swank-sbcl.lisp (make-weak-key-hash-table): Remove the Index: slime/slime.el diff -u slime/slime.el:1.532 slime/slime.el:1.533 --- slime/slime.el:1.532 Sun Aug 28 17:37:50 2005 +++ slime/slime.el Mon Aug 29 21:23:52 2005 @@ -7055,6 +7055,8 @@ (defun sldb-insert-condition (condition) (destructuring-bind (message type references extras) condition + (when (> (length message) 70) + (add-text-properties 0 (length message) (list 'help-echo message) message)) (slime-insert-propertized '(sldb-default-action sldb-inspect-condition) (in-sldb-face topline message) "\n" From mkoeppe at common-lisp.net Mon Aug 29 19:27:52 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Mon, 29 Aug 2005 21:27:52 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050829192752.7AF2788542@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv795 Modified Files: slime.el Log Message: (slime-dispatch-event): Handle new messages :y-or-n-p, :background-message. (slime-y-or-n-p): New. Date: Mon Aug 29 21:27:52 2005 Author: mkoeppe Index: slime/slime.el diff -u slime/slime.el:1.533 slime/slime.el:1.534 --- slime/slime.el:1.533 Mon Aug 29 21:23:52 2005 +++ slime/slime.el Mon Aug 29 21:27:51 2005 @@ -2325,6 +2325,8 @@ ((:read-string thread tag) (assert thread) (slime-repl-read-string thread tag)) + ((:y-or-n-p thread tag question) + (slime-y-or-n-p thread tag question)) ((:evaluate-in-emacs string thread tag) (assert thread) (evaluate-in-emacs (car (read-from-string string)) thread tag)) @@ -2351,6 +2353,8 @@ (slime-send `(:emacs-return ,thread ,tag ,value))) ((:ed what) (slime-ed what)) + ((:background-message message) + (slime-background-message "%s" message)) ((:debug-condition thread message) (assert thread) (message "%s" message))))) @@ -3627,6 +3631,11 @@ (slime-mark-output-end) (slime-mark-input-start) (slime-repl-read-mode 1)) + +(defun slime-y-or-n-p (thread tag question) + (push thread slime-read-string-threads) + (push tag slime-read-string-tags) + (slime-repl-return-string (y-or-n-p question))) (defcustom slime-enable-evaluate-in-emacs nil "If non-nil, the inferior Lisp can evaluate arbitrary forms in Emacs. From mkoeppe at common-lisp.net Mon Aug 29 19:31:37 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Mon, 29 Aug 2005 21:31:37 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050829193137.5C40988542@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv1712 Modified Files: swank.lisp Log Message: (dispatch-event, send-to-socket-io): Handle new messages :y-or-n-p, :background-message. (y-or-n-p-in-emacs): New function. Date: Mon Aug 29 21:31:36 2005 Author: mkoeppe Index: slime/swank.lisp diff -u slime/swank.lisp:1.326 slime/swank.lisp:1.327 --- slime/swank.lisp:1.326 Sun Aug 28 16:50:03 2005 +++ slime/swank.lisp Mon Aug 29 21:31:35 2005 @@ -588,6 +588,8 @@ (encode-message `(,(car event) ,(thread-id thread) , at args) socket-io)) ((:read-string thread &rest args) (encode-message `(:read-string ,(thread-id thread) , at args) socket-io)) + ((:y-or-n-p thread &rest args) + (encode-message `(:y-or-n-p ,(thread-id thread) , at args) socket-io)) ((:evaluate-in-emacs string thread &rest args) (encode-message `(:evaluate-in-emacs ,string ,(thread-id thread) , at args) socket-io)) @@ -601,7 +603,7 @@ (send (find-thread thread-id) `(take-input ,tag ,value))) (((:read-output :presentation-start :presentation-end :new-package :new-features :ed :%apply :indentation-update - :eval-no-wait) + :eval-no-wait :background-message) &rest _) (declare (ignore _)) (encode-message event socket-io)))) @@ -712,7 +714,7 @@ (encode-message o (current-socket-io))))) (destructure-case event (((:debug-activate :debug :debug-return :read-string :read-aborted - :eval) + :y-or-n-p :eval) thread &rest args) (declare (ignore thread)) (send `(,(car event) 0 , at args))) @@ -723,7 +725,8 @@ (send `(:evaluate-in-emacs ,string 0 , at args))) (((:read-output :new-package :new-features :debug-condition :presentation-start :presentation-end - :indentation-update :ed :%apply :eval-no-wait) + :indentation-update :ed :%apply :eval-no-wait + :background-message) &rest _) (declare (ignore _)) (send event))))) @@ -1015,6 +1018,18 @@ (setq ok t)) (unless ok (send-to-emacs `(:read-aborted ,(current-thread) ,tag))))))) + +(defun y-or-n-p-in-emacs (&optional format-string &rest arguments) + "Like y-or-n-p, but ask in the Emacs minibuffer." + (let ((tag (incf *read-input-catch-tag*)) + (question (if format-string + (apply #'format nil format-string arguments) + ""))) + (force-output) + (send-to-emacs `(:y-or-n-p ,(current-thread) ,tag ,question)) + (unwind-protect + (catch (intern-catch-tag tag) + (loop (read-from-emacs)))))) (defslimefun take-input (tag input) "Return the string INPUT to the continuation TAG." From mkoeppe at common-lisp.net Mon Aug 29 19:33:27 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Mon, 29 Aug 2005 21:33:27 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp Message-ID: <20050829193327.52CB688542@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv1804 Modified Files: swank-cmucl.lisp Log Message: (eval-in-emacs): Removed. (send-to-emacs): New. (pre-gc-hook, post-gc-hook): Use new protocol message :background-message rather than eval-in-emacs. Date: Mon Aug 29 21:33:26 2005 Author: mkoeppe Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.151 slime/swank-cmucl.lisp:1.152 --- slime/swank-cmucl.lisp:1.151 Sun Aug 28 16:47:51 2005 +++ slime/swank-cmucl.lisp Mon Aug 29 21:33:26 2005 @@ -2065,8 +2065,8 @@ (defun sending-safe-p () (symbol-value (swank-sym :*emacs-connection*))) ;; this should probably not be here, but where else? -(defun eval-in-emacs (form nowait) - (funcall (swank-sym :eval-in-emacs) form nowait)) +(defun send-to-emacs (message) + (funcall (swank-sym :send-to-emacs) message)) (defun print-bytes (nbytes &optional stream) "Print the number NBYTES to STREAM in KB, MB, or GB units." @@ -2100,7 +2100,7 @@ (let ((msg (format nil "[Commencing GC with ~A in use.]" (print-bytes bytes-in-use)))) (when (sending-safe-p) - (eval-in-emacs `(slime-background-message "%s" ,msg) t)))) + (send-to-emacs `(:background-message ,msg))))) (defun post-gc-hook (bytes-retained bytes-freed trigger) (declare (ignore trigger)) @@ -2113,7 +2113,7 @@ #-gencgc"" seconds))) (when (sending-safe-p) - (eval-in-emacs `(slime-background-message "%s" ,msg) t)))) + (send-to-emacs `(:background-message ,msg))))) (defun install-gc-hooks () (setq ext:*gc-notify-before* #'pre-gc-hook) From mkoeppe at common-lisp.net Mon Aug 29 19:35:00 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Mon, 29 Aug 2005 21:35:00 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-lispworks.lisp Message-ID: <20050829193500.5D29288542@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv1838 Modified Files: swank-lispworks.lisp Log Message: (env-internals:confirm-p): Use new function y-or-n-p-in-emacs rather than eval-in-emacs. Date: Mon Aug 29 21:34:59 2005 Author: mkoeppe Index: slime/swank-lispworks.lisp diff -u slime/swank-lispworks.lisp:1.75 slime/swank-lispworks.lisp:1.76 --- slime/swank-lispworks.lisp:1.75 Wed Aug 10 17:46:43 2005 +++ slime/swank-lispworks.lisp Mon Aug 29 21:34:59 2005 @@ -777,7 +777,5 @@ (defmethod stream:stream-soft-force-output ((o (eql stream))) (force-output o))))) -(defmethod env-internals:confirm-p ((e slime-env) &optional msg &rest args) - (let ((prompt (cond (msg (apply #'format nil msg args)) - (t "")))) - (funcall (swank-sym :eval-in-emacs) `(y-or-n-p ,prompt)))) +(defmethod env-internals:confirm-p ((e slime-env) &rest msg-and-args) + (apply (swank-sym :y-or-n-p-in-emacs) msg-and-args)) From mkoeppe at common-lisp.net Mon Aug 29 19:36:36 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Mon, 29 Aug 2005 21:36:36 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050829193636.DB34388542@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv1873 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Mon Aug 29 21:36:35 2005 Author: mkoeppe Index: slime/ChangeLog diff -u slime/ChangeLog:1.762 slime/ChangeLog:1.763 --- slime/ChangeLog:1.762 Mon Aug 29 21:23:52 2005 +++ slime/ChangeLog Mon Aug 29 21:36:35 2005 @@ -1,3 +1,21 @@ +2005-08-29 Matthias Koeppe + + * swank-lispworks.lisp (env-internals:confirm-p): Use new function + y-or-n-p-in-emacs rather than eval-in-emacs. + + * swank-cmucl.lisp (eval-in-emacs): Removed. + (send-to-emacs): New. + (pre-gc-hook, post-gc-hook): Use new protocol message + :background-message rather than eval-in-emacs. + + * swank.lisp (dispatch-event, send-to-socket-io): Handle new + messages :y-or-n-p, :background-message. + (y-or-n-p-in-emacs): New function. + + * slime.el (slime-dispatch-event): Handle new messages :y-or-n-p, + :background-message. + (slime-y-or-n-p): New. + 2005-08-29 Alan Ruttenberg * slime.el (sldb-insert-condition) - Add tooltip for long condition string which otherwise falls off the right of the screen From lgorrie at common-lisp.net Mon Aug 29 20:03:02 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Mon, 29 Aug 2005 22:03:02 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/test.sh slime/test-all.sh slime/swank.asd slime/swank-source-path-parser.lisp slime/swank-source-file-cache.lisp slime/mkdist.sh Message-ID: <20050829200302.C63ED88549@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv4115 Modified Files: test.sh test-all.sh swank.asd swank-source-path-parser.lisp swank-source-file-cache.lisp mkdist.sh Log Message: Added public domain dedication. Date: Mon Aug 29 22:02:58 2005 Author: lgorrie Index: slime/test.sh diff -u slime/test.sh:1.6 slime/test.sh:1.7 --- slime/test.sh:1.6 Sat Jan 31 12:50:25 2004 +++ slime/test.sh Mon Aug 29 22:02:58 2005 @@ -9,6 +9,9 @@ # If something unexpected fails, you might get an exit code like 127 # or 255 instead. Sorry. +# This code has been placed in the Public Domain. All warranties +# are disclaimed. + if [ $# != 4 ]; then echo "Usage: $0 " exit 1 Index: slime/test-all.sh diff -u slime/test-all.sh:1.1 slime/test-all.sh:1.2 --- slime/test-all.sh:1.1 Tue Mar 9 21:12:43 2004 +++ slime/test-all.sh Mon Aug 29 22:02:58 2005 @@ -1,5 +1,8 @@ #!/bin/sh +# This code has been placed in the Public Domain. All warranties +# are disclaimed. + trap EXIT for emacs in xemacs ; do # emacs-20.7 emacs-21.3.50 xemacs ; do Index: slime/swank.asd diff -u slime/swank.asd:1.2 slime/swank.asd:1.3 --- slime/swank.asd:1.2 Thu Jan 22 01:10:39 2004 +++ slime/swank.asd Mon Aug 29 22:02:58 2005 @@ -15,6 +15,9 @@ ;; (PORT can be zero to mean "any available port".) ;; Then the Swank server is running on localhost:ACTUAL-PORT. You can ;; use `M-x slime-connect' to connect Emacs to it. +;; +;; This code has been placed in the Public Domain. All warranties +;; are disclaimed. (asdf:defsystem :swank :components ((:file "swank-loader"))) Index: slime/swank-source-path-parser.lisp diff -u slime/swank-source-path-parser.lisp:1.14 slime/swank-source-path-parser.lisp:1.15 --- slime/swank-source-path-parser.lisp:1.14 Wed May 11 16:45:20 2005 +++ slime/swank-source-path-parser.lisp Mon Aug 29 22:02:58 2005 @@ -17,6 +17,9 @@ ;;; We use a special readtable to get the positions of the subforms. ;;; The readtable stores the start and end position for each subform in ;;; hashtable for later retrieval. +;;; +;;; This code has been placed in the Public Domain. All warranties +;;; are disclaimed. ;;; Taken from swank-cmucl.lisp, by Helmut Eller Index: slime/swank-source-file-cache.lisp diff -u slime/swank-source-file-cache.lisp:1.3 slime/swank-source-file-cache.lisp:1.4 --- slime/swank-source-file-cache.lisp:1.3 Mon Mar 21 18:40:10 2005 +++ slime/swank-source-file-cache.lisp Mon Aug 29 22:02:58 2005 @@ -16,6 +16,9 @@ ;;; whole file inside Lisp. That way we will still have the matching ;;; version even if the file is later modified on disk. If the file is ;;; later recompiled and reloaded then we replace our cache entry. +;;; +;;; This code has been placed in the Public Domain. All warranties +;;; are disclaimed. (in-package :swank-backend) Index: slime/mkdist.sh diff -u slime/mkdist.sh:1.6 slime/mkdist.sh:1.7 --- slime/mkdist.sh:1.6 Mon Apr 18 20:59:49 2005 +++ slime/mkdist.sh Mon Aug 29 22:02:58 2005 @@ -1,4 +1,8 @@ #!/bin/sh + +# This code has been placed in the Public Domain. All warranties +# are disclaimed. + version="1.2" dist="slime-$version" From lgorrie at common-lisp.net Mon Aug 29 20:02:58 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Mon, 29 Aug 2005 22:02:58 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/doc/texinfo-tabulate.awk Message-ID: <20050829200258.F200F88542@common-lisp.net> Update of /project/slime/cvsroot/slime/doc In directory common-lisp.net:/tmp/cvs-serv4115/doc Modified Files: texinfo-tabulate.awk Log Message: Added public domain dedication. Date: Mon Aug 29 22:02:57 2005 Author: lgorrie Index: slime/doc/texinfo-tabulate.awk diff -u slime/doc/texinfo-tabulate.awk:1.1 slime/doc/texinfo-tabulate.awk:1.2 --- slime/doc/texinfo-tabulate.awk:1.1 Mon Mar 22 14:55:31 2004 +++ slime/doc/texinfo-tabulate.awk Mon Aug 29 22:02:57 2005 @@ -3,6 +3,9 @@ # Format input lines into a multi-column texinfo table. # Note: does not do texinfo-escaping of the input. +# This code has been placed in the Public Domain. All warranties +# are disclaimed. + BEGIN { columns = 3; printf("@multitable @columnfractions"); From mkoeppe at common-lisp.net Mon Aug 29 21:29:27 2005 From: mkoeppe at common-lisp.net (Matthias Koeppe) Date: Mon, 29 Aug 2005 23:29:27 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-lispworks.lisp Message-ID: <20050829212927.B720988542@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv9631 Modified Files: swank-lispworks.lisp Log Message: (env-internals:confirm-p): Fix last change (hopefully). Date: Mon Aug 29 23:29:26 2005 Author: mkoeppe Index: slime/swank-lispworks.lisp diff -u slime/swank-lispworks.lisp:1.76 slime/swank-lispworks.lisp:1.77 --- slime/swank-lispworks.lisp:1.76 Mon Aug 29 21:34:59 2005 +++ slime/swank-lispworks.lisp Mon Aug 29 23:29:24 2005 @@ -777,5 +777,6 @@ (defmethod stream:stream-soft-force-output ((o (eql stream))) (force-output o))))) -(defmethod env-internals:confirm-p ((e slime-env) &rest msg-and-args) - (apply (swank-sym :y-or-n-p-in-emacs) msg-and-args)) +(defmethod env-internals:confirm-p ((e slime-env) &optional msg &rest args) + (apply (swank-sym :y-or-n-p-in-emacs) msg args)) + From lgorrie at common-lisp.net Tue Aug 30 13:03:11 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 30 Aug 2005 15:03:11 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/present.lisp Message-ID: <20050830130311.714298815C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv10867 Modified Files: present.lisp Log Message: Added public domain dedication (OK'd by Alanr and Matthias on the list). Date: Tue Aug 30 15:03:10 2005 Author: lgorrie Index: slime/present.lisp diff -u slime/present.lisp:1.12 slime/present.lisp:1.13 --- slime/present.lisp:1.12 Sun Aug 21 18:28:48 2005 +++ slime/present.lisp Tue Aug 30 15:03:10 2005 @@ -1,5 +1,8 @@ (in-package :swank) +;;; This code has been placed in the Public Domain. All warranties +;;; are disclaimed. + ;; A mechanism for printing to the slime repl so that the printed ;; result remembers what object it is associated with. Depends on the ;; ilisp bridge code being installed and ready to intercept messages From lgorrie at common-lisp.net Tue Aug 30 13:03:29 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 30 Aug 2005 15:03:29 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050830130329.A86E08815C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv10919 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Tue Aug 30 15:03:29 2005 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.763 slime/ChangeLog:1.764 --- slime/ChangeLog:1.763 Mon Aug 29 21:36:35 2005 +++ slime/ChangeLog Tue Aug 30 15:03:28 2005 @@ -1,3 +1,8 @@ +2005-08-30 Luke Gorrie + + * present.lisp: Added public domain dedication (OK'd by Alanr and + Matthias on the list). + 2005-08-29 Matthias Koeppe * swank-lispworks.lisp (env-internals:confirm-p): Use new function From aruttenberg at common-lisp.net Tue Aug 30 23:57:27 2005 From: aruttenberg at common-lisp.net (Alan Ruttenberg) Date: Wed, 31 Aug 2005 01:57:27 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog slime/slime.el slime/swank.lisp Message-ID: <20050830235727.2A5C8880DA@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25528/slime Modified Files: ChangeLog slime.el swank.lisp Log Message: Date: Wed Aug 31 01:57:26 2005 Author: aruttenberg Index: slime/ChangeLog diff -u slime/ChangeLog:1.764 slime/ChangeLog:1.765 --- slime/ChangeLog:1.764 Tue Aug 30 15:03:28 2005 +++ slime/ChangeLog Wed Aug 31 01:57:25 2005 @@ -1,3 +1,8 @@ +2005-08-30 Alan Ruttenberg + * slime.el (slime-mark-presentation-start/end-handler) modify + regexp to recognize negative presentation ids to make + presenting-object work with bridge mode. + 2005-08-30 Luke Gorrie * present.lisp: Added public domain dedication (OK'd by Alanr and @@ -24,6 +29,8 @@ 2005-08-29 Alan Ruttenberg * slime.el (sldb-insert-condition) - Add tooltip for long condition string which otherwise falls off the right of the screen + * swank.lisp (list-threads) - thread name might be a symbol - pass + the symbol name when that happens 2005-08-29 Juho Snellman Index: slime/slime.el diff -u slime/slime.el:1.534 slime/slime.el:1.535 --- slime/slime.el:1.534 Mon Aug 29 21:27:51 2005 +++ slime/slime.el Wed Aug 31 01:57:26 2005 @@ -2588,7 +2588,7 @@ (marker-position (symbol-value 'slime-output-end))))) (defun slime-mark-presentation-start-handler (process string) - (if (and string (string-match "<\\([0-9]+\\)" string)) + (if (and string (string-match "<\\([-0-9]+\\)" string)) (let* ((match (substring string (match-beginning 1) (match-end 1))) (id (car (read-from-string match)))) (slime-mark-presentation-start id)))) @@ -2602,7 +2602,7 @@ id nil))))) (defun slime-mark-presentation-end-handler (process string) - (if (and string (string-match ">\\([0-9]+\\)" string)) + (if (and string (string-match ">\\([-0-9]+\\)" string)) (let* ((match (substring string (match-beginning 1) (match-end 1))) (id (car (read-from-string match)))) (slime-mark-presentation-end id)))) Index: slime/swank.lisp diff -u slime/swank.lisp:1.327 slime/swank.lisp:1.328 --- slime/swank.lisp:1.327 Mon Aug 29 21:31:35 2005 +++ slime/swank.lisp Wed Aug 31 01:57:26 2005 @@ -3996,7 +3996,8 @@ "Return a list ((NAME DESCRIPTION) ...) of all threads." (setq *thread-list* (all-threads)) (loop for thread in *thread-list* - collect (list (thread-name thread) + for name = (thread-name thread) + collect (list (if (symbolp name) (symbol-name name) name) (thread-status thread) (thread-id thread)))) From mbaringer at common-lisp.net Wed Aug 31 11:27:49 2005 From: mbaringer at common-lisp.net (Marco Baringer) Date: Wed, 31 Aug 2005 13:27:49 +0200 (CEST) Subject: [slime-cvs] CVS update: /slime/swank.lisp Message-ID: <20050831112749.A00828853C@common-lisp.net> Update of /project/slime/cvsroot//slime In directory common-lisp.net:/tmp/cvs-serv8074 Modified Files: swank.lisp Log Message: (to-string): Handle errors during printing of objects. Date: Wed Aug 31 13:27:47 2005 Author: mbaringer From mbaringer at common-lisp.net Wed Aug 31 11:28:09 2005 From: mbaringer at common-lisp.net (Marco Baringer) Date: Wed, 31 Aug 2005 13:28:09 +0200 (CEST) Subject: [slime-cvs] CVS update: /slime/ChangeLog Message-ID: <20050831112809.4A50F8853C@common-lisp.net> Update of /project/slime/cvsroot//slime In directory common-lisp.net:/tmp/cvs-serv8096 Modified Files: ChangeLog Log Message: Date: Wed Aug 31 13:28:08 2005 Author: mbaringer