[climacs-cvs] CVS climacs

thenriksen thenriksen at common-lisp.net
Tue Nov 20 12:59:54 UTC 2007


Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv6934

Modified Files:
	c-syntax-commands.lisp climacs-lisp-syntax-commands.lisp 
	climacs-lisp-syntax.lisp core.lisp file-commands.lisp gui.lisp 
	java-syntax-commands.lisp misc-commands.lisp 
Log Message:
Fixed Climacs to adapt to changes in Drei.


--- /project/climacs/cvsroot/climacs/c-syntax-commands.lisp	2007/05/01 20:54:53	1.2
+++ /project/climacs/cvsroot/climacs/c-syntax-commands.lisp	2007/11/20 12:59:53	1.3
@@ -57,7 +57,7 @@
     ()
   "Fill paragraph at point. Will have no effect unless there is a
 string at point."
-  (let* ((pane *current-window*)
+  (let* ((pane (current-window))
          (buffer (buffer pane))
          (implementation (implementation buffer))
          (syntax (syntax buffer))
@@ -82,7 +82,7 @@
 
 (define-command (com-indent-expression :name t :command-table c-table)
     ((count 'integer :prompt "Number of expressions"))
-  (let* ((pane *current-window*)
+  (let* ((pane (current-window))
          (point (point pane))
          (mark (clone-mark point))
          (syntax (syntax (buffer pane))))
--- /project/climacs/cvsroot/climacs/climacs-lisp-syntax-commands.lisp	2007/02/19 16:23:49	1.4
+++ /project/climacs/cvsroot/climacs/climacs-lisp-syntax-commands.lisp	2007/11/20 12:59:53	1.5
@@ -37,7 +37,7 @@
   '(climacs-lisp-table))
 
 (define-command (com-package :name t :command-table climacs-lisp-table) ()
-  (let ((package (package-at-mark *current-syntax* *current-point*)))
+  (let ((package (package-at-mark (current-syntax) (point))))
     (esa:display-message (format nil "~A" (if (packagep package)
                                               (package-name package)
                                               package)))))
@@ -45,12 +45,12 @@
 (define-command (com-set-base :name t :command-table climacs-lisp-table)
     ((base '(integer 2 36)))
   "Set the base for the current buffer."
-  (setf (base *current-syntax*) base))
+  (setf (base (current-syntax)) base))
 
 (define-command (com-set-package :name t :command-table climacs-lisp-table)
     ((package 'package))
   "Set the package for the current buffer."
-  (setf (option-specified-package *current-syntax*) package))
+  (setf (option-specified-package (current-syntax)) package))
 
 (define-command (com-macroexpand-1 :name t :command-table climacs-lisp-table)
     ()
@@ -58,9 +58,9 @@
 
 The expanded expression will be displayed in a
 \"*Macroexpansion*\"-buffer."
-  (let*((token (expression-at-mark *current-point* *current-syntax*)))
+  (let*((token (expression-at-mark (point) (current-syntax))))
     (if token
-        (macroexpand-token *current-syntax* token)
+        (macroexpand-token (current-syntax) token)
         (esa:display-message "Nothing to expand at point."))))
 
 (define-command (com-macroexpand-all :name t :command-table climacs-lisp-table)
@@ -69,9 +69,9 @@
 
 The expanded expression will be displayed in a
 \"*Macroexpansion*\"-buffer."
-  (let ((token (expression-at-mark *current-point* *current-syntax*)))
+  (let ((token (expression-at-mark (point) (current-syntax))))
     (if token
-        (macroexpand-token *current-syntax* token t)
+        (macroexpand-token (current-syntax) token t)
         (esa:display-message "Nothing to expand at point."))))
 
 (define-command (com-compile-and-load-file :name t :command-table climacs-lisp-table)
@@ -79,14 +79,14 @@
   "Compile and load the current file.
 
 Compiler notes will be displayed in a seperate buffer."
-  (compile-file-interactively *current-buffer* t))
+  (compile-file-interactively (current-buffer) t))
 
 (define-command (com-compile-file :name t :command-table climacs-lisp-table)
     ()
   "Compile the file open in the current buffer.
 
 This command does not load the file after it has been compiled."
-  (compile-file-interactively *current-buffer* nil))
+  (compile-file-interactively (current-buffer) nil))
 
 (define-command (com-goto-location :name t :command-table climacs-lisp-table)
     ((note 'compiler-note))
@@ -116,8 +116,8 @@
     ()
   "Edit definition of the symbol at point.
 If there is no symbol at point, this is a no-op."
-  (let* ((token (this-form *current-syntax* *current-point*))
-         (this-symbol (form-to-object *current-syntax* token)))
+  (let* ((token (this-form (current-syntax) (point)))
+         (this-symbol (form-to-object (current-syntax) token)))
     (when (and this-symbol (symbolp this-symbol))
       (edit-definition this-symbol))))
 
@@ -131,7 +131,7 @@
     ()
   "Compile and load definition at point."
   (evaluating-interactively
-    (compile-definition-interactively *current-point* *current-syntax*)))
+    (compile-definition-interactively (point) (current-syntax))))
 
 (esa:set-key 'com-eval-defun
              'climacs-lisp-table
--- /project/climacs/cvsroot/climacs/climacs-lisp-syntax.lisp	2007/08/13 21:58:57	1.4
+++ /project/climacs/cvsroot/climacs/climacs-lisp-syntax.lisp	2007/11/20 12:59:53	1.5
@@ -170,7 +170,7 @@
                                    :fill-pointer 0)
      when (char= (char string count) #\Newline)
      do (loop while (and (< count (length string))
-                         (whitespacep *current-syntax* (char string count)))
+                         (whitespacep (current-syntax) (char string count)))
            do (incf count)
            ;; Just ignore whitespace if it is last in the
            ;; string.
@@ -241,7 +241,7 @@
                                                  (when path
                                                    (namestring path)))))))
     (if buffer
-        (climacs-core:switch-to-buffer *current-window* buffer)
+        (climacs-core:switch-to-buffer (current-window) buffer)
         (find-file (file-name location)))
     (goto-position (point (current-window))
                    (char-position (source-position location)))))
@@ -259,7 +259,7 @@
                                                all))
            (expansion-string (with-output-to-string (s)
                                (pprint expansion s))))
-      (let ((buffer (climacs-core:switch-to-buffer *current-window* "*Macroexpansion*")))
+      (let ((buffer (climacs-core:switch-to-buffer (current-window) "*Macroexpansion*")))
         (set-syntax buffer "Lisp"))
       (let ((point (point (current-window)))
             (header-string (one-line-ify (subseq string 0
@@ -322,7 +322,7 @@
            (offset (first offset+buffer))
            (buffer (second offset+buffer)))
       (if (find buffer (buffers *application-frame*))
-          (progn (climacs-core:switch-to-buffer *current-window* buffer)
+          (progn (climacs-core:switch-to-buffer (current-window) buffer)
                  (goto-position (point (current-window)) offset))
           (pop-find-definition-stack)))))
 
--- /project/climacs/cvsroot/climacs/core.lisp	2007/11/16 09:25:03	1.13
+++ /project/climacs/cvsroot/climacs/core.lisp	2007/11/20 12:59:54	1.14
@@ -104,9 +104,9 @@
      ;; Always need one buffer.
      (when (null buffers)
        (make-new-buffer :name "*scratch*"))
-     (setf (buffer (current-window)) (car buffers))
+     (setf (current-buffer) (car buffers))
      (full-redisplay (current-window))
-     (buffer (current-window))))
+     (current-buffer)))
 
 (defmethod kill-buffer ((name string))
   (let ((buffer (find name (buffers *application-frame*)
@@ -114,7 +114,7 @@
     (when buffer (kill-buffer buffer))))
 
 (defmethod kill-buffer ((symbol (eql 'nil)))
-  (kill-buffer (buffer (current-window))))
+  (kill-buffer (current-buffer)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
@@ -311,7 +311,7 @@
         (t
          (let ((existing-buffer (find-buffer-with-pathname filepath)))
            (if (and existing-buffer (if readonlyp (read-only-p existing-buffer) t))
-               (switch-to-buffer *current-window* existing-buffer)
+               (switch-to-buffer (current-window) existing-buffer)
                (progn
                  (when readonlyp
                    (unless (probe-file filepath)
@@ -324,7 +324,7 @@
                                    (make-new-buffer)))
                        (pane (current-window)))
                    (setf (offset (point (buffer pane))) (offset (point pane))
-                         (buffer (current-window)) buffer
+                         (current-buffer) buffer
                          (syntax buffer) (make-instance (syntax-class-name-for-filepath filepath)
                                                         :buffer buffer)
                          (file-write-time buffer) (file-write-date filepath))
--- /project/climacs/cvsroot/climacs/file-commands.lisp	2006/12/18 17:54:40	1.27
+++ /project/climacs/cvsroot/climacs/file-commands.lisp	2007/11/20 12:59:54	1.28
@@ -43,7 +43,7 @@
 An example attribute-list is:
 
 ;; -*- Syntax: Lisp; Base: 10 -*- "
-  (evaluate-attribute-line (buffer (current-window))))
+  (evaluate-attribute-line (current-buffer)))
 
 (define-command (com-update-attribute-list :name t :command-table buffer-table)
     ()
@@ -65,26 +65,25 @@
 
 This command automatically comments the attribute line as
 appropriate for the syntax of the buffer."
-  (update-attribute-line (buffer (current-window)))
-  (evaluate-attribute-line (buffer (current-window))))
+  (update-attribute-line (current-buffer))
+  (evaluate-attribute-line (current-buffer)))
 
 (define-command (com-insert-file :name t :command-table buffer-table)
     ((filename 'pathname :prompt "Insert File"
-	       :default (directory-of-buffer (buffer (current-window)))
-	       :default-type 'pathname
-	       :insert-default t))
+                         :default (directory-of-buffer (current-buffer))
+                         :default-type 'pathname
+                         :insert-default t))
   "Prompt for a filename and insert its contents at point.
 Leaves mark after the inserted contents."
-  (let ((pane (current-window)))
-    (when (probe-file filename)
-      (setf (mark pane) (clone-mark (point pane) :left))
-      (with-open-file (stream filename :direction :input)
-	(input-from-stream stream
-			   (buffer pane)
-			   (offset (point pane))))
-      (psetf (offset (mark pane)) (offset (point pane))
-	     (offset (point pane)) (offset (mark pane))))
-    (redisplay-frame-panes *application-frame*)))
+  (when (probe-file filename)
+    (setf (mark) (clone-mark (point) :left))
+    (with-open-file (stream filename :direction :input)
+      (input-from-stream stream
+                         (current-buffer)
+                         (offset (point))))
+    (psetf (offset (mark)) (offset (point))
+           (offset (point)) (offset (mark))))
+  (redisplay-frame-panes *application-frame*))
 
 (set-key `(com-insert-file ,*unsupplied-argument-marker*)
 	 'buffer-table
@@ -93,23 +92,21 @@
 (define-command (com-revert-buffer :name t :command-table buffer-table) ()
   "Replace the contents of the current buffer with the visited file.
 Signals an error if the file does not exist."
-  (let* ((pane (current-window))
-	 (buffer (buffer pane))
-	 (filepath (filepath buffer))
-	 (save (offset (point pane))))
+  (let* ((save (offset (point)))
+         (filepath (filepath (current-buffer))))
     (when (accept 'boolean :prompt (format nil "Revert buffer from file ~A?"
-					   (filepath buffer)))
+					   filepath))
       (cond ((directory-pathname-p filepath)
 	   (display-message "~A is a directory name." filepath)
 	   (beep))
 	  ((probe-file filepath)
-	   (unless (check-file-times buffer filepath "Revert" "reverted")
+	   (unless (check-file-times (current-buffer) filepath "Revert" "reverted")
 	     (return-from com-revert-buffer))
-	   (erase-buffer buffer)
+	   (erase-buffer (current-buffer))
 	   (with-open-file (stream filepath :direction :input)
-	     (input-from-stream stream buffer 0))
-	   (setf (offset (point pane)) (min (size buffer) save)
-		 (file-saved-p buffer) nil))
+	     (input-from-stream stream (current-buffer) 0))
+	   (setf (offset (point)) (min (size (current-buffer)) save)
+		 (file-saved-p (current-buffer)) nil))
 	  (t
 	   (display-message "No file ~A" filepath)
 	   (beep))))))
@@ -154,7 +151,7 @@
 (define-command (com-kill-buffer :name t :command-table pane-table)
     ((buffer 'buffer
              :prompt "Kill buffer"
-             :default (buffer (current-window))))
+             :default (current-buffer)))
   "Prompt for a buffer name and kill that buffer.
 If the buffer needs saving, will prompt you to do so before killing it. Uses the current buffer as a default."
   (kill-buffer buffer))
--- /project/climacs/cvsroot/climacs/gui.lisp	2007/11/16 09:29:47	1.238
+++ /project/climacs/cvsroot/climacs/gui.lisp	2007/11/20 12:59:54	1.239
@@ -83,9 +83,9 @@
 
 (defmethod buffer ((pane typeout-pane)))
 
-(defmethod point ((pane typeout-pane)))
+(defmethod point-of ((pane typeout-pane)))
 
-(defmethod mark ((pane typeout-pane)))
+(defmethod mark-of ((pane typeout-pane)))
 
 (defmethod full-redisplay ((pane typeout-pane)))
 
@@ -168,7 +168,7 @@
   ())
 
 (defmethod command-table-inherit-from ((table climacs-command-table))
-  (append (when *current-syntax* (list (command-table *current-syntax*)))
+  (append (when (current-syntax) (list (command-table (current-syntax))))
           '(global-climacs-table)
           (call-next-method)))
 
@@ -223,19 +223,15 @@
                        command-unparser
                        partial-command-parser
                        prompt)
-    :bindings ((*current-point* (current-point))
-               (*current-mark* (current-mark))
-               (*previous-command* (previous-command *current-window*))
-               (*current-syntax* (and *current-buffer*
-                                      (syntax *current-buffer*)))
-               (*default-target-creator* *climacs-target-creator*)))
+ :bindings ((*previous-command* (previous-command (current-window)))
+            (*default-target-creator* *climacs-target-creator*)))
 
 (defmethod frame-standard-input ((frame climacs))
   (get-frame-pane frame 'minibuffer))
 
-(defmethod frame-current-buffer ((application-frame climacs))
+(defmethod esa-current-buffer ((application-frame climacs))
   "Return the current buffer."
-  (buffer (frame-current-window application-frame)))
+  (buffer (esa-current-window application-frame)))
 
 (defun any-buffer ()
   "Return some buffer, any buffer, as long as it is a buffer!"
@@ -313,15 +309,16 @@
   (display-drei drei))
 
 (defmethod execute-frame-command :around ((frame climacs) command)
-  (if (eq frame *application-frame*)
-      (progn
-        (handling-drei-conditions
-          (with-undo ((buffers frame))
-            (call-next-method)))
-        (loop for buffer in (buffers frame)
-           do (when (modified-p buffer)
-                (clear-modify buffer))))
-      (call-next-method)))
+  (let ((*drei-instance* (esa-current-window frame)))
+    (if (eq frame *application-frame*)
+        (progn
+          (handling-drei-conditions
+            (with-undo ((buffers frame))
+              (call-next-method)))
+          (loop for buffer in (buffers frame)
+             do (when (modified-p buffer)
+                  (clear-modify buffer))))
+        (call-next-method))))
 
 (defmethod execute-frame-command :after ((frame climacs) command)
   (when (eq frame *application-frame*)
--- /project/climacs/cvsroot/climacs/java-syntax-commands.lisp	2007/05/01 17:46:38	1.1
+++ /project/climacs/cvsroot/climacs/java-syntax-commands.lisp	2007/11/20 12:59:54	1.2
@@ -58,7 +58,7 @@
     ()
   "Fill paragraph at point. Will have no effect unless there is a
 string at point."
-  (let* ((pane *current-window*)
+  (let* ((pane (current-window))
          (buffer (buffer pane))
          (implementation (implementation buffer))
          (syntax (syntax buffer))
@@ -83,14 +83,11 @@
 
 (define-command (com-indent-expression :name t :command-table java-table)
     ((count 'integer :prompt "Number of expressions"))
-  (let* ((pane *current-window*)
-         (point (point pane))
-         (mark (clone-mark point))
-         (syntax (syntax (buffer pane))))
+  (let* ((mark (clone-mark (point))))
     (if (plusp count)
-        (loop repeat count do (forward-expression mark syntax))
-        (loop repeat (- count) do (backward-expression mark syntax)))
-    (indent-region pane (clone-mark point) mark)))
+        (loop repeat count do (forward-expression mark (current-syntax)))
+        (loop repeat (- count) do (backward-expression mark (current-syntax))))
+    (indent-region *drei-instance* (point) mark)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
--- /project/climacs/cvsroot/climacs/misc-commands.lisp	2007/11/16 09:29:47	1.27
+++ /project/climacs/cvsroot/climacs/misc-commands.lisp	2007/11/20 12:59:54	1.28
@@ -46,18 +46,16 @@
 and the percentage of the buffers objects before point.
 
 FIXME: gives no information at end of buffer."
-  (let* ((pane (current-window))
-	 (point (point pane))
-	 (buffer (buffer pane))
-	 (offset (offset point))
-	 (size (size buffer))
-	 (char (or (end-of-buffer-p point) (object-after point)))
-	 (column (column-number point)))
+  (let* ((char (or (end-of-buffer-p (point)) (object-after (point))))
+	 (column (column-number (point))))
     (display-message "Char: ~:[none~*~;~:*~:C (#o~O ~:*~D ~:*#x~X)~] point=~D of ~D (~D%) column ~D"
 		     (and (characterp char) char)
 		     (and (characterp char) (char-code char))
-		     offset size
-		     (if size (round (* 100 (/ offset size))) 100)
+		     (offset (point)) (size (current-buffer))
+		     (if (size (current-buffer))
+                         (round (* 100 (/ (offset (point))
+                                          (size (current-buffer)))))
+                         100)
 		     column)))
 
 (set-key 'com-what-cursor-position
@@ -77,7 +75,7 @@
       :prompt "Name of syntax"))
   "Prompts for a syntax to set for the current buffer.
    Setting a syntax will cause the buffer to be reparsed using the new syntax."
-  (set-syntax *current-buffer* syntax))
+  (set-syntax (current-buffer) syntax))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 




More information about the Climacs-cvs mailing list