[slime-cvs] CVS slime/contrib

[CVS User sboukarev]

Update of /project/slime/cvsroot/slime/contrib
In directory tiger.common-lisp.net:/tmp/cvs-serv12856

Modified Files:
	ChangeLog slime-repl.el swank-repl.lisp 
Log Message:
* slime-repl.el (slime-repl-print-right-margin-follows-window):
New variable, defaults to NIL.
(slime-repl-eval-string): Respect the above variable.
* swank-repl.lisp (listener-eval): New keyword parameter,
window-width, if supplied binds *print-right-margin* to its
value.
Based on a patch by Marco Baringer.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2012/11/22 12:41:26	1.554
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2012/11/23 11:28:27	1.555
@@ -1,3 +1,13 @@
+2012-11-23  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-repl.el (slime-repl-print-right-margin-follows-window):
+	New variable, defaults to NIL.
+	(slime-repl-eval-string): Respect the above variable.
+	* swank-repl.lisp (listener-eval): New keyword parameter,
+	window-width, if supplied binds *print-right-margin* to its
+	value.
+	Based on a patch by Marco Baringer.
+
 2012-11-22  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-package-fu.el (slime-determine-symbol-style): Fix the
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2011/12/23 20:03:15	1.63
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2012/11/23 11:28:27	1.64
@@ -52,6 +52,12 @@
   :type '(boolean)
   :group 'slime-repl)
 
+(defcustom slime-repl-print-right-margin-follows-window nil
+  "When T we bind CL:*PRINT-RIGHT-MARGIN* to the width of the
+current repl's (as per slime-output-buffer) window."
+  :type '(boolean)
+  :group 'slime-repl)
+
 (defface slime-repl-prompt-face
   (if (slime-face-inheritance-possible-p)
       '((t (:inherit font-lock-keyword-face)))
@@ -524,7 +530,13 @@
 
 (defun slime-repl-eval-string (string)
   (slime-rex ()
-      ((list 'swank:listener-eval string) (slime-lisp-package))
+      ((if slime-repl-print-right-margin-follows-window
+           `(swank:listener-eval ,string
+                                 :window-width
+                                 ,(with-current-buffer (slime-output-buffer)
+                                    (window-width)))
+           `(swank:listener-eval ,string))
+       (slime-lisp-package))
     ((:ok result)
      (slime-repl-insert-result result))
     ((:abort condition)
@@ -550,7 +562,8 @@
       (slime-save-marker slime-output-start
         (slime-save-marker slime-output-end
           (goto-char slime-output-end)
-          (insert-before-markers (format "; Evaluation aborted on %s.\n" condition))
+          (insert-before-markers (format "; Evaluation aborted on %s.\n"
+                                         condition))
           (slime-repl-insert-prompt))))
     (slime-repl-show-maximum-output)))
 
@@ -574,7 +587,8 @@
               '(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)
+                     rear-nonsticky (slime-repl-prompt read-only face
+                                     intangible)
                      ;; xemacs stuff
                      start-open t end-open t)
             (insert-before-markers prompt))
@@ -1511,7 +1525,8 @@
                               name))
                   (qualified-symbol-name (slime-qualify-cl-symbol-name symbol))
                   (symbol-name (slime-cl-symbol-name qualified-symbol-name))
-                  (symbol-package (slime-cl-symbol-package qualified-symbol-name))
+                  (symbol-package (slime-cl-symbol-package
+                                   qualified-symbol-name))
                   (call (if (equalp (slime-lisp-package) symbol-package)
                             symbol-name
                             qualified-symbol-name)))
@@ -1585,7 +1600,8 @@
   (interactive)
   (let* ((package (slime-current-package))
          (exists-p (or (null package)
-                       (slime-eval `(cl:packagep (swank::guess-package ,package)))))
+                       (slime-eval `(cl:packagep
+                                     (swank::guess-package ,package)))))
          (directory default-directory))
     (when (and package exists-p)
       (slime-repl-set-package package))
@@ -1717,12 +1733,14 @@
 (defun slime-repl-add-hooks ()
   (add-hook 'slime-event-hooks 'slime-repl-event-hook-function)
   (add-hook 'slime-connected-hook 'slime-repl-connected-hook-function)
-  (add-hook 'slime-cycle-connections-hook 'slime-change-repl-to-default-connection))
+  (add-hook 'slime-cycle-connections-hook
+            'slime-change-repl-to-default-connection))
 
 (defun slime-repl-remove-hooks ()
   (remove-hook 'slime-event-hooks 'slime-repl-event-hook-function)
   (remove-hook 'slime-connected-hook 'slime-repl-connected-hook-function)
-  (remove-hook 'slime-cycle-connections-hook 'slime-change-repl-to-default-connection))
+  (remove-hook 'slime-cycle-connections-hook
+               'slime-change-repl-to-default-connection))
 
 (let ((byte-compile-warnings '()))
   (mapc #'byte-compile
@@ -1989,7 +2007,8 @@
     (slime-wait-condition "Debugger visible" 
                           (lambda () 
                             (and (slime-sldb-level= 1)
-                                 (get-buffer-window (sldb-get-default-buffer))))
+                                 (get-buffer-window
+                                  (sldb-get-default-buffer))))
                           5)
     (with-current-buffer (sldb-get-default-buffer)
       (sldb-continue))
--- /project/slime/cvsroot/slime/contrib/swank-repl.lisp	2012/03/06 20:55:13	1.5
+++ /project/slime/cvsroot/slime/contrib/swank-repl.lisp	2012/11/23 11:28:27	1.6
@@ -156,8 +156,11 @@
 
 (defvar *listener-eval-function* 'repl-eval)
 
-(defslimefun listener-eval (string)
-  (funcall *listener-eval-function* string))
+(defslimefun listener-eval (string &key (window-width nil window-width-p))
+  (if window-width-p
+      (let ((*print-right-margin* window-width))
+        (funcall *listener-eval-function* string))
+      (funcall *listener-eval-function* string)))
 
 (defvar *send-repl-results-function* 'send-repl-results-to-emacs)