From thenriksen at common-lisp.net  Wed Mar  1 19:32:08 2006
From: thenriksen at common-lisp.net (thenriksen)
Date: Wed,  1 Mar 2006 14:32:08 -0500 (EST)
Subject: [climacs-cvs] CVS climacs
Message-ID: <20060301193208.14F3223010@common-lisp.net>

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

Modified Files:
	lisp-syntax.lisp 
Log Message:
Removed *climacs-features* since it wasn't used for its intended
purpose and got out of sync with *features*. 

Also added +'s to the name of a symbol naming a constant.


--- /project/climacs/cvsroot/climacs/lisp-syntax.lisp	2006/02/09 15:26:08	1.45
+++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp	2006/03/01 19:32:07	1.46
@@ -1388,8 +1388,6 @@
 	    (call-next-method)))
 	(call-next-method))))
 
-(defparameter climacs-gui::*climacs-features* (copy-list *features*))
-
 (defgeneric eval-feature-conditional (conditional-form syntax))
 
 (defmethod eval-feature-conditional (conditional-form (syntax lisp-syntax))
@@ -1397,7 +1395,7 @@
 
 ;; Adapted from slime.el
 
-(defconstant keyword-package (find-package :keyword)
+(defconstant +keyword-package+ (find-package :keyword)
   "The KEYWORD package.")
 
 (defmethod eval-feature-conditional ((conditional token-mixin) (syntax lisp-syntax))
@@ -1405,8 +1403,8 @@
 					 (start-offset conditional)
 					 (end-offset conditional))
 		  'string))
-	 (symbol (parse-symbol string keyword-package)))
-    (member symbol climacs-gui::*climacs-features*)))
+	 (symbol (parse-symbol string +keyword-package+)))
+    (member symbol *features*)))
 
 (defmethod eval-feature-conditional ((conditional list-form) (syntax lisp-syntax))
   (let ((children (children conditional)))
@@ -1424,7 +1422,7 @@
 						     (start-offset type)
 						     (end-offset type))
 				    'string))
-	       (type-symbol (parse-symbol type-string keyword-package)))
+	       (type-symbol (parse-symbol type-string +keyword-package+)))
 	  (case type-symbol
 	    (:and (funcall #'every #'eval-fc conditionals))
 	    (:or (funcall #'some #'eval-fc conditionals))
@@ -1795,7 +1793,7 @@
   "Find the symbol named STRING.
 Return the symbol and a flag indicating whether the symbol was found."
   (multiple-value-bind (symbol-name package-name) (parse-token string)
-    (let ((package (cond ((string= package-name "") keyword-package)
+    (let ((package (cond ((string= package-name "") +keyword-package+)
                          (package-name              (find-package package-name))
                          (t                         package))))
       (if package



From tmoore at common-lisp.net  Fri Mar  3 19:38:58 2006
From: tmoore at common-lisp.net (tmoore)
Date: Fri,  3 Mar 2006 14:38:58 -0500 (EST)
Subject: [climacs-cvs] CVS climacs
Message-ID: <20060303193858.2116F6A05E@common-lisp.net>

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

Modified Files:
	cl-syntax.lisp climacs.asd developer-commands.lisp esa.lisp 
	file-commands.lisp gui.lisp io.lisp kill-ring.lisp 
	misc-commands.lisp packages.lisp pane.lisp prolog-syntax.lisp 
	slidemacs-gui.lisp slidemacs.lisp ttcn3-syntax.lisp 
	window-commands.lisp 
Added Files:
	colors.lisp 
Log Message:
Changes for running climacs in Allegro Common Lisp with Classic CLIM (tm). This includes a bunch of modern mode-related changes to symbol names and creating symbols and reordering of syntax rules definitions due to different compile-time behavior of defclass. The CLIM changes are suprisingly small

--- /project/climacs/cvsroot/climacs/cl-syntax.lisp	2005/11/12 09:34:34	1.16
+++ /project/climacs/cvsroot/climacs/cl-syntax.lisp	2006/03/03 19:38:57	1.17
@@ -401,6 +401,17 @@
 						    item) 2))))
 			  :start start :item item))
 
+(defclass simple-number (cl-item) ())
+
+(add-cl-rule (simple-number -> ((item default-item (radix-is
+						      (coerce
+						       (item-sequence  item) 'string) 10)))
+			    :item item))
+
+(defmethod display-parse-tree ((entity simple-number) (syntax cl-syntax) pane)
+  (with-slots (item) entity
+    (display-parse-tree item syntax pane)))
+
 (defclass radix-n-expr (cl-entry)
   ((start :initarg :start)
    (radix :initarg :radix)
@@ -426,18 +437,6 @@
     (display-parse-tree radix syntax pane)
     (display-parse-tree item syntax pane)))
 
-(defclass simple-number (cl-item) ())
-
-(add-cl-rule (simple-number -> ((item default-item (radix-is
-						      (coerce
-						       (item-sequence  item) 'string) 10)))
-			    :item item))
-
-(defmethod display-parse-tree ((entity simple-number) (syntax cl-syntax) pane)
-  (with-slots (item) entity
-    (display-parse-tree item syntax pane)))
-
-
 (defclass real-number (cl-entry)
   ((primary :initarg :primary)
    (separator :initarg :separator)
@@ -587,6 +586,10 @@
       (display-parse-tree item syntax pane))))
 
 
+
+(define-list cl-terminals empty-cl-terminals
+  nonempty-cl-terminals cl-terminal)
+
 ;;;;;;;;;;;;; list-expression
 
 (defclass list-expr (cl-entry)
@@ -716,6 +719,11 @@
 					      (expr cl-terminal (/= (end-offset test) (start-offset expr))))
 					  :start start :test test :expr expr))
 
+;;; Avoid forward definition
+
+(defclass quoted-expr (cl-entry)
+  ((start :initarg :start)
+   (item :initarg :item)))
 
 ;;;;;;;;;;;;; function-expression
 
@@ -775,10 +783,6 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Quoted expr
 
-(defclass quoted-expr (cl-entry)
-  ((start :initarg :start)
-   (item :initarg :item)))
-
 (add-cl-rule (quoted-expr -> ((start quote-symbol) 
 			      (item cl-terminal))
 			  :start start :item item))
@@ -884,6 +888,11 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Backquoted expr
 
+;;; Avoid forward definition
+(defclass unquoted-expr (cl-entry)
+  ((start :initarg :start)
+   (item :initarg :item)))
+
 (defclass backquoted-expr (cl-entry)
   ((start :initarg :start)
    (item :initarg :item)))
@@ -917,10 +926,6 @@
     (display-parse-tree start syntax pane)
     (display-parse-tree end syntax pane))) 
 
-(defclass unquoted-expr (cl-entry)
-  ((start :initarg :start)
-   (item :initarg :item)))
-
 (add-cl-rule (unquoted-expr -> ((start comma)
 				(item identifier))
 			    :start start :item item))
@@ -965,9 +970,6 @@
 (add-cl-rule (cl-terminal -> (read-time-evaluation) :item read-time-evaluation))
 (add-cl-rule (cl-terminal -> (line-comment) :item line-comment))
 
-(define-list cl-terminals empty-cl-terminals
-  nonempty-cl-terminals cl-terminal)
-
 (defmethod display-parse-tree ((entity cl-terminal) (syntax cl-syntax) pane)
   (with-slots (item) entity
       (display-parse-tree item syntax pane)))
@@ -1048,11 +1050,25 @@
     (when (and (end-offset entity) (mark> (end-offset entity) top))
       (call-next-method))))
 
+(defun color-equal (c1 c2)
+  (when (eq c1 c2)
+    (return-from color-equal t))
+  (when (or (eq c1 +foreground-ink+)
+	    (eq c2 +foreground-ink+)
+	    (eq c1 +background-ink+)
+	    (eq c2 +background-ink+))
+    (return-from color-equal nil))
+  (multiple-value-bind (r1 g1 b1)
+      (color-rgb c1)
+    (multiple-value-bind (r2 g2 b2)
+	(color-rgb c2)
+      (and (= r1 r2) (= g1 g2) (= b1 b2)))))
+
 (defmethod display-parse-tree ((entity cl-entry) (syntax cl-syntax) pane)
   (flet ((cache-test (t1 t2)
 	   (and (eq t1 t2)
-		(eq (slot-value t1 'ink)
-		    (medium-ink (sheet-medium pane)))
+		(color-equal (slot-value t1 'ink)
+			     (medium-ink (sheet-medium pane)))
 		(eq (slot-value t1 'face)
 		    (text-style-face (medium-text-style (sheet-medium pane)))))))
     (updating-output (pane :unique-id entity
--- /project/climacs/cvsroot/climacs/climacs.asd	2006/02/07 15:21:30	1.41
+++ /project/climacs/cvsroot/climacs/climacs.asd	2006/03/03 19:38:57	1.42
@@ -68,12 +68,16 @@
    (:file "html-syntax" :depends-on ("packages" "buffer" "syntax" "base" "pane"))
    (:file "prolog-syntax" :depends-on ("packages" "base" "syntax" "pane" "buffer"))
    (:file "prolog2paiprolog" :depends-on ("prolog-syntax"))
-   (:file "ttcn3-syntax" :depends-on ("packages" "buffer" "syntax" "base" "pane"))
-   (:file "lisp-syntax" :depends-on ("packages" "syntax" "buffer" "base" "pane" "gui"))
+   (:file "ttcn3-syntax" :depends-on ("packages" "buffer" "syntax" "base"
+						 "pane"))
+   (:file "colors" :depends-on ("packages"))
+   (:file "lisp-syntax" :depends-on ("packages" "syntax" "buffer" "base" "pane"
+						"gui" "colors"))
    (:file "lisp-syntax-commands" :depends-on ("lisp-syntax"))
-   (:file "esa" :depends-on ("packages"))
+   (:file "esa" :depends-on ("packages" "colors"))
    (:file "gui" :depends-on ("packages" "syntax" "base" "buffer" "undo" "pane"
-                                        "esa" "kill-ring" "io" "text-syntax" "abbrev"))
+                                        "esa" "kill-ring" "io" "text-syntax"
+					"abbrev" "colors"))
 ;;    (:file "buffer-commands" :depends-on ("gui"))
    (:file "developer-commands" :depends-on ("gui" "lisp-syntax"))
    (:file "file-commands" :depends-on ("gui"))
@@ -81,7 +85,7 @@
    (:file "search-commands" :depends-on ("gui"))
    (:file "window-commands" :depends-on ("gui"))
    (:file "unicode-commands" :depends-on ("gui"))
-   (:file "slidemacs" :depends-on ("packages" "buffer" "syntax" "base" "pane"))
+   (:file "slidemacs" :depends-on ("packages" "buffer" "syntax" "base" "pane" "colors"))
    (:file "slidemacs-gui" :depends-on ("packages" "slidemacs" "pane" "buffer" "syntax" "gui"))))
 
 (defsystem :climacs.tests
--- /project/climacs/cvsroot/climacs/developer-commands.lisp	2005/11/12 09:38:32	1.1
+++ /project/climacs/cvsroot/climacs/developer-commands.lisp	2006/03/03 19:38:57	1.2
@@ -40,7 +40,7 @@
   (asdf:operate 'asdf:load-op :climacs))
 
 
-(define-gesture-name :select-other :pointer-button-press (:left :meta) :unique nil)
+(define-gesture-name :select-other #+mcclim :pointer-button-press #-mcclim :pointer-button (:left :meta) :unique nil)
 
 (define-presentation-translator lisp-string-to-string
     (climacs-lisp-syntax::lisp-string string development-table
--- /project/climacs/cvsroot/climacs/esa.lisp	2006/02/25 10:19:24	1.26
+++ /project/climacs/cvsroot/climacs/esa.lisp	2006/03/03 19:38:57	1.27
@@ -103,6 +103,19 @@
 	    (command-table-inherit-from
 	     (find-command-table start-table)))))
 
+;;; In Classic CLIM event-matches-gesture-name-p doesn't accept characters.
+#+mcclim
+(defun gesture-matches-gesture-name-p (gesture gesture-name)
+  (event-matches-gesture-name-p gesture gesture-name))
+
+#-mcclim
+(defun gesture-matches-gesture-name-p (gesture gesture-name)
+  (etypecase gesture
+    (event
+     (event-matches-gesture-name-p gesture gesture-name))
+    (character
+     (clim-internals::keyboard-event-matches-gesture-name-p gesture
+							    gesture-name))))
 (defparameter *current-gesture* nil)
 
 (defparameter *meta-digit-table*
@@ -111,7 +124,7 @@
 
 (defun meta-digit (gesture)
   (position gesture *meta-digit-table*
-	    :test #'event-matches-gesture-name-p))
+	    :test #'gesture-matches-gesture-name-p))
 
 (defun esa-read-gesture ()
   (unless (null (remaining-keys *application-frame*))
@@ -159,11 +172,11 @@
 M-1 M-2 = 12. M-- M-1 M-2 = -12. As a special case, C-u - and M-- = -1.
 In the absence of a prefix arg returns 1 (and nil)."
   (let ((gesture (esa-read-gesture)))
-    (cond ((event-matches-gesture-name-p
+    (cond ((gesture-matches-gesture-name-p
 	    gesture 'universal-argument)
 	   (let ((numarg 4))
 	     (loop for gesture = (esa-read-gesture)
-		   while (event-matches-gesture-name-p
+		   while (gesture-matches-gesture-name-p
 			  gesture 'universal-argument)
 		   do (setf numarg (* 4 numarg))
 		   finally (esa-unread-gesture gesture stream))
@@ -187,7 +200,7 @@
 		      (esa-unread-gesture gesture stream)
 		      (values (if (minusp sign) -1 numarg) t))))))
 	  ((or (meta-digit gesture)
-	       (event-matches-gesture-name-p
+	       (gesture-matches-gesture-name-p
 		gesture 'meta-minus))
 	   (let ((numarg 0)
 		 (sign +1))
@@ -281,6 +294,8 @@
 	  (*standard-input* (frame-standard-input frame))
 	  (*print-pretty* nil)
 	  (*abort-gestures* `((:keyboard #\g ,(make-modifier-state :control)))))
+      (unless (eq (frame-state frame) :enabled)
+	(enable-frame frame))
       (redisplay-frame-panes frame :force-p t)
       (loop
        do (restart-case
@@ -327,6 +342,35 @@
 ;;; 
 ;;; command table manipulation
 
+;;; Helper to avoid calling find-keystroke-item at load time. In Classic CLIM
+;;; that function doesn't work if not connected to a port.
+
+(defun compare-gestures (g1 g2)
+  (and (eql (car g1) (car g2))
+       (eql (apply #'make-modifier-state (cdr g1))
+	    (apply #'make-modifier-state (cdr g2)))))
+
+(defun find-gesture-item (table gesture)
+  (map-over-command-table-keystrokes
+     (lambda (name gest item)
+       (declare (ignore name))
+       (when (compare-gestures gesture gest)
+	 (return-from find-gesture-item item)))
+     table)
+  nil)
+
+#-mcclim
+(defun ensure-subtable (table gesture)
+  (let ((item (find-gesture-item table gesture)))
+    (when (or (null item) (not (eq (command-menu-item-type item) :menu)))
+      (let ((name (gensym)))
+	(make-command-table name :errorp nil)
+	(add-menu-item-to-command-table table (symbol-name name)
+					:menu name
+					:keystroke gesture)))
+    (command-menu-item-value (find-gesture-item table gesture))))
+
+#+mcclim
 (defun ensure-subtable (table gesture)
   (let* ((event (make-instance
 		'key-press-event
@@ -342,14 +386,16 @@
 					:keystroke gesture)))
     (command-menu-item-value
      (find-keystroke-item event table :errorp nil))))
-    
+
 (defun set-key (command table gestures)
+  ;; WTF?
+  #-(and)
   (unless (consp command)
     (setf command (list command)))
   (let ((gesture (car gestures)))
     (cond ((null (cdr gestures))
-	   (add-command-to-command-table
-	    command table :keystroke gesture :errorp nil)
+	   (add-keystroke-to-command-table
+	    table gesture :command command :errorp nil)
 	   (when (and (listp gesture)
 		      (find :meta gesture))
              ;; KLUDGE: this is a workaround for poor McCLIM
@@ -587,7 +633,9 @@
   (let* ((window (car (windows *application-frame*))) 
 	 (stream (open-window-stream
 		  :label (format nil "Help: Describe Bindings")
-		  :input-buffer (climi::frame-event-queue *application-frame*)
+		  :input-buffer (#+mcclim climi::frame-event-queue
+				 #-mcclim silica:frame-input-buffer
+				 *application-frame*)
 		  :width 400))
 	 (command-table (command-table window)))
     (describe-bindings stream command-table
@@ -700,3 +748,4 @@
 (define-command-table global-example-table
     :inherit-from (global-esa-table keyboard-macro-table))
 
+
--- /project/climacs/cvsroot/climacs/file-commands.lisp	2006/01/21 20:38:50	1.2
+++ /project/climacs/cvsroot/climacs/file-commands.lisp	2006/03/03 19:38:57	1.3
@@ -107,7 +107,7 @@
 		      #'filename-completer
 		      :allow-any-input t)
     (cond (success
-	   (values pathname type))
+	   (values (or pathname (parse-namestring string)) type))
 	  ((and (zerop (length string))
 		defaultp)
 	   (values default default-type))
@@ -328,7 +328,7 @@
 	 'buffer-table
 	 '((#\x :control) (#\s :control)))
 
-(defmethod frame-exit :around ((frame climacs))
+(defmethod frame-exit :around ((frame climacs) #-mcclim &key)
   (loop for buffer in (buffers frame)
 	when (and (needs-saving buffer)
 		  (filepath buffer)
--- /project/climacs/cvsroot/climacs/gui.lisp	2006/02/25 10:19:09	1.203
+++ /project/climacs/cvsroot/climacs/gui.lisp	2006/03/03 19:38:57	1.204
@@ -45,7 +45,7 @@
   nil)
 
 (defmethod buffer-pane-p ((pane extended-pane))
-  T)
+  t)
 
 (defclass climacs-info-pane (info-pane)
   ()
@@ -163,7 +163,10 @@
 	      extended-pane)
 	    extended-pane)
 	info-pane)))
-   (minibuffer (make-pane 'climacs-minibuffer-pane :background *mini-bg-color* :foreground *mini-fg-color* :width 900)))
+   (minibuffer (make-pane 'climacs-minibuffer-pane
+			  :background *mini-bg-color*
+			  :foreground *mini-fg-color*
+			  :width 900)))
   (:layouts
    (default
        (vertically (:scroll-bars nil)
@@ -171,6 +174,9 @@
 	 minibuffer)))
   (:top-level (esa-top-level)))
 
+(defmethod frame-standard-input ((frame climacs))
+  (get-frame-pane frame 'minibuffer))
+
 (defun current-window ()
   (car (windows *application-frame*)))
 
--- /project/climacs/cvsroot/climacs/io.lisp	2004/12/28 06:58:36	1.3
+++ /project/climacs/cvsroot/climacs/io.lisp	2006/03/03 19:38:57	1.4
@@ -24,7 +24,8 @@
 
 (defun input-from-stream (stream buffer offset)
   (loop with vec = (make-array 10000 :element-type 'character)
-	for count = (read-sequence vec stream)
+	for count = (#+mcclim read-sequence #-mcclim cl:read-sequence
+			      vec stream)
 	while (plusp count)
 	do (if (= count (length vec))
 	       (insert-buffer-sequence buffer offset vec)
--- /project/climacs/cvsroot/climacs/kill-ring.lisp	2005/08/14 18:09:42	1.8
+++ /project/climacs/cvsroot/climacs/kill-ring.lisp	2006/03/03 19:38:57	1.9
@@ -148,6 +148,6 @@
 				 vector
 				 (pop-start chain))))))
 
-(defmethod kill-ring-yank ((kr kill-ring) &optional (reset NIL))
+(defmethod kill-ring-yank ((kr kill-ring) &optional (reset nil))
   (if reset (reset-yank-position kr))
   (element> (kill-ring-cursor kr)))
\ No newline at end of file
--- /project/climacs/cvsroot/climacs/misc-commands.lisp	2006/02/07 15:21:30	1.3
+++ /project/climacs/cvsroot/climacs/misc-commands.lisp	2006/03/03 19:38:57	1.4
@@ -205,7 +205,7 @@
 
 (set-key `(com-backward-object ,*numeric-argument-marker*)
 	 'movement-table
-	 '((:left)))
+	 '((#+mcclim :left #-mcclim :left-arrow)))
 
 (define-command (com-forward-object :name t :command-table movement-table)
     ((count 'integer :prompt "Number of Objects"))
@@ -217,7 +217,7 @@
 
 (set-key `(com-forward-object ,*numeric-argument-marker*)
 	 'movement-table
-	 '((:right)))
+	 '((#+mcclim :right #-mcclim :right-arrow)))
 
 (defun transpose-words (mark)
   (let (bw1 bw2 ew1 ew2)
@@ -295,7 +295,7 @@
 
 (set-key `(com-previous-line ,*numeric-argument-marker*)
 	 'movement-table
-	 '((:up)))
+	 '((#+mcclim :up #-mcclim :up-arrow)))
 
 (define-command (com-next-line :name t :command-table movement-table)
     ((numarg 'integer :prompt "How many lines?"))
@@ -314,7 +314,7 @@
 
 (set-key `(com-next-line ,*numeric-argument-marker*)
 	 'movement-table
-	 '((:down)))
+	 '((#+mcclim :down #-mcclim :down-arrow)))
 
 (define-command (com-open-line :name t :command-table editing-table)
     ((numarg 'integer :prompt "How many lines?"))
@@ -376,7 +376,7 @@
 
 (set-key `(com-forward-word ,*numeric-argument-marker*)
 	 'movement-table
-	 '((:right :control)))
+	 '((#+mcclim :right #-mcclim :right-arrow :control)))
 
 (define-command (com-backward-word :name t :command-table movement-table)
     ((count 'integer :prompt "Number of words"))
@@ -388,7 +388,7 @@
 
 (set-key `(com-backward-word ,*numeric-argument-marker*)
 	 'movement-table
-	 '((:left :control)))
+	 '((#+mcclim :left #-mcclim :left-arrow :control)))
 
 (define-command (com-delete-word :name t :command-table deletion-table)
     ((count 'integer :prompt "Number of words"))
--- /project/climacs/cvsroot/climacs/packages.lisp	2006/02/07 15:21:30	1.84
+++ /project/climacs/cvsroot/climacs/packages.lisp	2006/03/03 19:38:57	1.85
@@ -161,8 +161,21 @@
 	   #:url
 	   #:climacs-textual-view #:+climacs-textual-view+))
 
-(defpackage :esa
+#-mcclim
+(defpackage :clim-extensions
   (:use :clim-lisp :clim)
+  (:export
+   #:+blue-violet+
+   #:+dark-blue+
+   #:+dark-green+
+   #:+dark-violet+
+   #:+gray50+
+   #:+gray85+
+   #:+maroon+
+   #:+purple+))
+
+(defpackage :esa
+  (:use :clim-lisp :clim :clim-extensions)
   (:export #:minibuffer-pane #:display-message
 	   #:esa-pane-mixin #:previous-command
 	   #:info-pane #:master-pane
@@ -175,7 +188,8 @@
 	   #:find-applicable-command-table))
 
 (defpackage :climacs-gui
-  (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax
+  (:use :clim-lisp :clim :climacs-buffer :climacs-base
+	:climacs-abbrev :climacs-syntax 
 	:climacs-kill-ring :climacs-pane :clim-extensions :undo :esa)
   ;;(:import-from :lisp-string)
   (:export :climacs ; Main entry point.
@@ -198,7 +212,7 @@
 (defpackage :climacs-prolog-syntax
   (:use :clim-lisp :clim :climacs-buffer :climacs-base
 	:climacs-syntax :flexichain :climacs-pane)
-  (:shadow "ATOM" "CLOSE" "EXP" "INTEGER" "OPEN" "VARIABLE"))
+  (:shadow #:atom #:close #:exp #:integer #:open #:variable))
 
 (defpackage :climacs-cl-syntax
   (:use :clim-lisp :clim :climacs-buffer :climacs-base 
@@ -206,7 +220,7 @@
   (:export))
 
 (defpackage :climacs-lisp-syntax
-  (:use :clim-lisp :clim :climacs-buffer :climacs-base 
+  (:use :clim-lisp :clim :clim-extensions :climacs-buffer :climacs-base 
 	:climacs-syntax :flexichain :climacs-pane :climacs-gui)
   (:export :lisp-string))
 
--- /project/climacs/cvsroot/climacs/pane.lisp	2005/12/05 09:55:18	1.34
+++ /project/climacs/cvsroot/climacs/pane.lisp	2006/03/03 19:38:57	1.35
@@ -300,12 +300,23 @@
   (with-slots (buffer top bot scan) pane
      (setf top (clone-mark (low-mark buffer) :left)
 	   bot (clone-mark (high-mark buffer) :right)))
+  #-(and)
   (with-slots (space-width tab-width) (stream-default-view pane)
      (let* ((medium (sheet-medium pane))
 	    (style (medium-text-style medium)))
        (setf space-width (text-style-width style medium)
 	     tab-width (* 8 space-width)))))
 
+(defmethod note-sheet-grafted :around ((pane climacs-pane))
+  (call-next-method)
+  (with-slots (space-width tab-width) (stream-default-view pane)
+     (let ((medium (sheet-medium pane)))
+       (setf (medium-text-style medium) (medium-default-text-style medium))
+       (let ((style (medium-text-style medium)))
+	 (setf space-width (text-style-width style medium)
+	       tab-width (* 8 space-width))))))
+
+
 (defmethod (setf buffer) :after (buffer (pane climacs-pane))
   (with-slots (point mark top bot) pane
        (setf point (clone-mark (point buffer))
--- /project/climacs/cvsroot/climacs/prolog-syntax.lisp	2005/11/01 12:31:52	1.25
+++ /project/climacs/cvsroot/climacs/prolog-syntax.lisp	2006/03/03 19:38:57	1.26
@@ -21,7 +21,7 @@
 
 ;;; Syntax for analysing ISO Prolog
 
-(in-package "CLIMACS-PROLOG-SYNTAX")
+(in-package #:climacs-prolog-syntax)
 
 (defclass prolog-parse-tree (parse-tree)
   ())
@@ -94,7 +94,7 @@
 (defmethod syntactic-lexeme ((lexeme prolog-lexeme))
   lexeme)
 (macrolet ((def ((name &optional tokenp) &rest subs)
-	     (flet ((f (x) (intern (format nil "~A-LEXEME" x))))
+	     (flet ((f (x) (intern (format nil "~A-~A" x '#:lexeme))))
 	       `(progn
 		  (defclass ,(f name) (prolog-lexeme) ())
 
--- /project/climacs/cvsroot/climacs/slidemacs-gui.lisp	2005/10/31 13:42:31	1.21
+++ /project/climacs/cvsroot/climacs/slidemacs-gui.lisp	2006/03/03 19:38:57	1.22
@@ -403,7 +403,7 @@
 (defparameter *picture-cache*
   (make-hash-table :test #'equal))
 
-#+(or)
+#+mcclim
 (defun load-and-cache-xpm (pathname)
   nil
   (let ((hash-key (cons pathname (file-write-date pathname))))
@@ -412,7 +412,7 @@
           (setf (gethash hash-key *picture-cache*)
                 (climi::xpm-parse-file pathname))))))
 
-#+(or)
+#+mcclim
 (defmethod display-parse-tree ((entity picture-node) (syntax slidemacs-gui-syntax) pane)
   (with-slots (picture-pathname) entity
     (let ((real-pathname (slidemacs-entity-string picture-pathname)))
--- /project/climacs/cvsroot/climacs/slidemacs.lisp	2005/08/15 23:31:22	1.7
+++ /project/climacs/cvsroot/climacs/slidemacs.lisp	2006/03/03 19:38:57	1.8
@@ -21,7 +21,7 @@
 ;;; Boston, MA  02111-1307  USA.
 
 (defpackage :climacs-slidemacs-editor
-  (:use :clim-lisp :clim :climacs-buffer :climacs-base 
+  (:use :clim-lisp :clim :clim-extensions :climacs-buffer :climacs-base 
 	:climacs-syntax :flexichain :climacs-pane)
   (:export))
 
@@ -168,6 +168,23 @@
   (string-equal (coerce (buffer-sequence (buffer word) (start-offset word) (end-offset word)) 'string)
 		string))
 
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun sort-definitions (forms)
+    (loop for form in forms
+	  for name = (and (consp form) (car form))
+	  if (eq name 'defclass)
+	  collect form into defclasses
+	  else if (eq name 'define-simple-list)
+	  collect form into simple-lists
+	  else if (eq name 'define-simple-nonempty-list)
+	  collect form into nonempty-lists
+	  else collect form into others
+	  end
+	  finally (return `(, at defclasses
+			    , at simple-lists
+			    , at nonempty-lists
+			    , at others)))))
+
 (defmacro define-parsing-rules ((grammar entry terminal syntax) &body rules)
   (let (already-processed-rules)
     (flet
@@ -220,17 +237,10 @@
                     entity
 		    ,@(loop for component in rule-body collect
                             `(display-parse-tree ,component syntax pane))))))
-	     (t (error "Unrecognized rule body ~S for rule ~S~%" rule-body name))))
-	 (shake-up-defclasses (forms)
-	   (append
-	    (remove-if #'(lambda (e)
-			   (and (consp e)
-				(not (eq (car e) 'defclass)))) forms)
-	    (remove-if #'(lambda (e)
-			   (and (consp e)
-				(eq (car e) 'defclass))) forms))))
+	     (t (error "Unrecognized rule body ~S for rule ~S~%" rule-body
+		       name)))))
       `(progn
-        ,@(shake-up-defclasses
+        ,@(sort-definitions
            (loop for rule in rules
                  appending (destructuring-bind (=-thingy rule-name &body rule-body)
                                rule
--- /project/climacs/cvsroot/climacs/ttcn3-syntax.lisp	2005/08/15 23:31:22	1.3
+++ /project/climacs/cvsroot/climacs/ttcn3-syntax.lisp	2006/03/03 19:38:57	1.4
@@ -21,7 +21,7 @@
 ;;; Boston, MA  02111-1307  USA.
 
 (defpackage :climacs-ttcn3-syntax
-  (:use :clim-lisp :clim :climacs-buffer :climacs-base 
+  (:use :clim-lisp :clim :clim-extensions :climacs-buffer :climacs-base 
 	:climacs-syntax :flexichain :climacs-pane)
   (:export))
 (in-package :climacs-ttcn3-syntax)
@@ -183,6 +183,23 @@
   (string-equal (coerce (buffer-sequence (buffer word) (start-offset word) (end-offset word)) 'string)
 		string))
 
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun sort-definitions (forms)
+    (loop for form in forms
+	  for name = (and (consp form) (car form))
+	  if (eq name 'defclass)
+	  collect form into defclasses
+	  else if (eq name 'define-simple-list)
+	  collect form into simple-lists
+	  else if (eq name 'define-simple-nonempty-list)
+	  collect form into nonempty-lists
+	  else collect form into others
+	  end
+	  finally (return `(, at defclasses
+			    , at simple-lists
+			    , at nonempty-lists
+			    , at others)))))
+
 (defmacro define-parsing-rules ((grammar entry terminal syntax) &body rules)
   (let (already-processed-rules)
     (flet
@@ -235,17 +252,10 @@
 		      entity
 		    ,@(loop for component in rule-body collect
 			   `(display-parse-tree ,component syntax pane))))))
-	     (t (error "Unrecognized rule body ~S for rule ~S~%" rule-body name))))
-	 (shake-up-defclasses (forms)
-	   (append
-	    (remove-if #'(lambda (e)
-			   (and (consp e)
-				(not (eq (car e) 'defclass)))) forms)
-	    (remove-if #'(lambda (e)
-			   (and (consp e)
-				(eq (car e) 'defclass))) forms))))
+	     (t (error "Unrecognized rule body ~S for rule ~S~%" rule-body
+		       name)))))
       `(progn
-	 ,@(shake-up-defclasses
+	 ,@(sort-definitions
 	    (loop for rule in rules
 	       appending (destructuring-bind (=-thingy rule-name &body rule-body)
 			     rule
--- /project/climacs/cvsroot/climacs/window-commands.lisp	2006/01/09 04:15:12	1.4
+++ /project/climacs/cvsroot/climacs/window-commands.lisp	2006/03/03 19:38:57	1.5
@@ -43,7 +43,7 @@
 	 (parent-height (rectangle-height parent-region))
 	 (parent-width (rectangle-width parent-region))
 	 (filler (when first-split-p (make-pane 'basic-pane))) ;Prevents resizing.
-         (adjust (make-pane 'clim-extensions:box-adjuster-gadget)))
+         (adjust #+mcclim (make-pane 'clim-extensions:box-adjuster-gadget)))
     (assert (member constellation children))
     
     (when first-split-p (setf (sheet-region filler) (sheet-region parent)) 

--- /project/climacs/cvsroot/climacs/colors.lisp	2006/03/03 19:38:58	NONE
+++ /project/climacs/cvsroot/climacs/colors.lisp	2006/03/03 19:38:58	1.1
;;; -*- Mode: Lisp; Package: clim-extensions -*-

;;;  (c) copyright 2006 by
;;;           Tim Moore (moore at bricoworks.com)

;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Library General Public
;;; License as published by the Free Software Foundation; either
;;; version 2 of the License, or (at your option) any later version.
;;;
;;; This library 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
;;; Library General Public License for more details.
;;;
;;; You should have received a copy of the GNU Library General Public
;;; License along with this library; if not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA  02111-1307  USA.

;;; Color definitions from McCLIM that don't exist in Classic CLIM

(in-package :clim-extensions)

#-mcclim
(progn
  (defparameter +blue-violet+ (make-rgb-color  0.5412 0.1686 0.8863))
  (defparameter +gray50+ (make-gray-color 0.4980))
  (defparameter +gray85+ (make-gray-color 0.8510))
  (defparameter +dark-blue+ (make-rgb-color 0.0 0.0 0.5451))
  (defparameter +dark-green+ (make-rgb-color 0.0000 0.3922 0.0000))
  (defparameter +dark-violet+ (make-rgb-color 0.5804 0.0000 0.8275))
  (defparameter +maroon+ (make-rgb-color 0.6902 0.1882 0.3765))
  (defparameter +purple+  (make-rgb-color 0.6275 0.1255 0.9412)))


From tmoore at common-lisp.net  Fri Mar  3 21:01:44 2006
From: tmoore at common-lisp.net (tmoore)
Date: Fri,  3 Mar 2006 16:01:44 -0500 (EST)
Subject: [climacs-cvs] CVS climacs/cl-automaton
Message-ID: <20060303210144.D505E46115@common-lisp.net>

Update of /project/climacs/cvsroot/climacs/cl-automaton
In directory clnet:/tmp/cvs-serv1782/cl-automaton

Modified Files:
	state-and-transition.lisp 
Log Message:
A straggler from the ACL/CLIM check in

--- /project/climacs/cvsroot/climacs/cl-automaton/state-and-transition.lisp	2005/09/25 20:06:26	1.2
+++ /project/climacs/cvsroot/climacs/cl-automaton/state-and-transition.lisp	2006/03/03 21:01:44	1.3
@@ -9,7 +9,9 @@
 
 (defconstant +min-char-code+ 0)
 (defconstant +max-char-code+ (1- char-code-limit))
-(deftype char-code-type () `(integer ,+min-char-code+ ,+max-char-code+))
+;;; In Allegro (for one), defconstants aren't available as values at compile
+;;; time. 
+(deftype char-code-type () `(integer 0 ,(1- char-code-limit)))
 
 (defclass state ()
   ((accept :initform nil :accessor accept :type boolean)



From crhodes at common-lisp.net  Tue Mar 14 14:45:43 2006
From: crhodes at common-lisp.net (crhodes)
Date: Tue, 14 Mar 2006 09:45:43 -0500 (EST)
Subject: [climacs-cvs] CVS climacs
Message-ID: <20060314144543.01559650A1@common-lisp.net>

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

Modified Files:
	unicode-commands.lisp 
Log Message:
Make unicode-commands (really "latin1-commands") more useful.

:dead--acute and friends were apparently from an older, typoed version 
of mcclim; those keysyms had long since been replaced by :dead-acute.  
Rewrite the implementation of the dead-diacritic commands anyway, so 
that the next change is easier to make.  Now some of these dead commands 
work for me and others don't; this is the usual shifted/unshifted 
problem -- I get dead-circumflex by typing AltGr+', which is unshifted, 
whereas the implementation presumably works on those keyboards where you 
get dead-circumflex by hitting ^ (which is Shift+6?).

Bleeding-edge SBCL/CLX users can also type latin1 characters directly 
(depending on what they've got in their keymap); for instance, for 
me, AltGr+1 gives me a superscript 1; Shift+3 gives me a pound sign.


--- /project/climacs/cvsroot/climacs/unicode-commands.lisp	2005/11/12 09:38:32	1.1
+++ /project/climacs/cvsroot/climacs/unicode-commands.lisp	2006/03/14 14:45:43	1.2
@@ -28,79 +28,101 @@
 
 (in-package :climacs-gui)
 
-(define-command (com-insert-charcode :name t :command-table self-insert-table)
-    ((code 'integer :prompt "Code point"))
-  (insert-object (point (current-window)) (code-char code)))
+(do ((i 160 (+ i 1)))
+    ((> i 255))
+  (set-key `(com-self-insert ,*numeric-argument-marker*) 
+           'self-insert-table (list (code-char i))))
 
-(set-key '(com-insert-charcode 193) 'self-insert-table '((:dead--acute)(#\A)))
-(set-key '(com-insert-charcode 201) 'self-insert-table '((:dead--acute)(#\E)))
-(set-key '(com-insert-charcode 205) 'self-insert-table '((:dead--acute)(#\I)))
-(set-key '(com-insert-charcode 211) 'self-insert-table '((:dead--acute)(#\O)))
-(set-key '(com-insert-charcode 218) 'self-insert-table '((:dead--acute)(#\U)))
-(set-key '(com-insert-charcode 221) 'self-insert-table '((:dead--acute)(#\Y)))
-(set-key '(com-insert-charcode 225) 'self-insert-table '((:dead--acute)(#\a)))
-(set-key '(com-insert-charcode 233) 'self-insert-table '((:dead--acute)(#\e)))
-(set-key '(com-insert-charcode 237) 'self-insert-table '((:dead--acute)(#\i)))
-(set-key '(com-insert-charcode 243) 'self-insert-table '((:dead--acute)(#\o)))
-(set-key '(com-insert-charcode 250) 'self-insert-table '((:dead--acute)(#\u)))
-(set-key '(com-insert-charcode 253) 'self-insert-table '((:dead--acute)(#\y)))
-(set-key '(com-insert-charcode 199) 'self-insert-table '((:dead--acute)(#\C)))
-(set-key '(com-insert-charcode 231) 'self-insert-table '((:dead--acute)(#\c)))
-(set-key '(com-insert-charcode 215) 'self-insert-table '((:dead--acute)(#\x)))
-(set-key '(com-insert-charcode 247) 'self-insert-table '((:dead--acute)(#\-)))
-(set-key '(com-insert-charcode 222) 'self-insert-table '((:dead--acute)(#\T)))
-(set-key '(com-insert-charcode 254) 'self-insert-table '((:dead--acute)(#\t)))
-(set-key '(com-insert-charcode 223) 'self-insert-table '((:dead--acute)(#\s)))
-(set-key '(com-insert-charcode 39) 'self-insert-table '((:dead--acute)(#\Space)))
-
-(set-key '(com-insert-charcode 197) 'self-insert-table '((:dead--acute)(:dead--acute)(#\A)))
-(set-key '(com-insert-charcode 229) 'self-insert-table '((:dead--acute)(:dead--acute)(#\a)))
-
-(set-key '(com-insert-charcode 192) 'self-insert-table '((:dead--grave)(#\A)))
-(set-key '(com-insert-charcode 200) 'self-insert-table '((:dead--grave)(#\E)))
-(set-key '(com-insert-charcode 204) 'self-insert-table '((:dead--grave)(#\I)))
-(set-key '(com-insert-charcode 210) 'self-insert-table '((:dead--grave)(#\O)))
-(set-key '(com-insert-charcode 217) 'self-insert-table '((:dead--grave)(#\U)))
-(set-key '(com-insert-charcode 224) 'self-insert-table '((:dead--grave)(#\a)))
-(set-key '(com-insert-charcode 232) 'self-insert-table '((:dead--grave)(#\e)))
-(set-key '(com-insert-charcode 236) 'self-insert-table '((:dead--grave)(#\i)))
-(set-key '(com-insert-charcode 242) 'self-insert-table '((:dead--grave)(#\o)))
-(set-key '(com-insert-charcode 249) 'self-insert-table '((:dead--grave)(#\u)))
-(set-key '(com-insert-charcode 96) 'self-insert-table '((:dead--grave)(#\Space)))
-
-(set-key '(com-insert-charcode 196) 'self-insert-table '((:dead--diaeresis :shift)(#\A)))
-(set-key '(com-insert-charcode 203) 'self-insert-table '((:dead--diaeresis :shift)(#\E)))
-(set-key '(com-insert-charcode 207) 'self-insert-table '((:dead--diaeresis :shift)(#\I)))
-(set-key '(com-insert-charcode 214) 'self-insert-table '((:dead--diaeresis :shift)(#\O)))
-(set-key '(com-insert-charcode 220) 'self-insert-table '((:dead--diaeresis :shift)(#\U)))
-(set-key '(com-insert-charcode 228) 'self-insert-table '((:dead--diaeresis :shift)(#\a)))
-(set-key '(com-insert-charcode 235) 'self-insert-table '((:dead--diaeresis :shift)(#\e)))
-(set-key '(com-insert-charcode 239) 'self-insert-table '((:dead--diaeresis :shift)(#\i)))
-(set-key '(com-insert-charcode 246) 'self-insert-table '((:dead--diaeresis :shift)(#\o)))
-(set-key '(com-insert-charcode 252) 'self-insert-table '((:dead--diaeresis :shift)(#\u)))
-(set-key '(com-insert-charcode 255) 'self-insert-table '((:dead--diaeresis :shift)(#\y)))
-(set-key '(com-insert-charcode 34) 'self-insert-table '((:dead--diaeresis :shift)(#\Space)))
-
-(set-key '(com-insert-charcode 195) 'self-insert-table '((:dead--tilde :shift)(#\A)))
-(set-key '(com-insert-charcode 209) 'self-insert-table '((:dead--tilde :shift)(#\N)))
-(set-key '(com-insert-charcode 227) 'self-insert-table '((:dead--tilde :shift)(#\a)))
-(set-key '(com-insert-charcode 241) 'self-insert-table '((:dead--tilde :shift)(#\n)))
-(set-key '(com-insert-charcode 198) 'self-insert-table '((:dead--tilde :shift)(#\E)))
-(set-key '(com-insert-charcode 230) 'self-insert-table '((:dead--tilde :shift)(#\e)))
-(set-key '(com-insert-charcode 208) 'self-insert-table '((:dead--tilde :shift)(#\D)))
-(set-key '(com-insert-charcode 240) 'self-insert-table '((:dead--tilde :shift)(#\d)))
-(set-key '(com-insert-charcode 216) 'self-insert-table '((:dead--tilde :shift)(#\O)))
-(set-key '(com-insert-charcode 248) 'self-insert-table '((:dead--tilde :shift)(#\o)))
-(set-key '(com-insert-charcode 126) 'self-insert-table '((:dead--tilde :shift)(#\Space)))
-
-(set-key '(com-insert-charcode 194) 'self-insert-table '((:dead--circumflex :shift)(#\A)))
-(set-key '(com-insert-charcode 202) 'self-insert-table '((:dead--circumflex :shift)(#\E)))
-(set-key '(com-insert-charcode 206) 'self-insert-table '((:dead--circumflex :shift)(#\I)))
-(set-key '(com-insert-charcode 212) 'self-insert-table '((:dead--circumflex :shift)(#\O)))
-(set-key '(com-insert-charcode 219) 'self-insert-table '((:dead--circumflex :shift)(#\U)))
-(set-key '(com-insert-charcode 226) 'self-insert-table '((:dead--circumflex :shift)(#\a)))
-(set-key '(com-insert-charcode 234) 'self-insert-table '((:dead--circumflex :shift)(#\e)))
-(set-key '(com-insert-charcode 238) 'self-insert-table '((:dead--circumflex :shift)(#\i)))
-(set-key '(com-insert-charcode 244) 'self-insert-table '((:dead--circumflex :shift)(#\o)))
-(set-key '(com-insert-charcode 251) 'self-insert-table '((:dead--circumflex :shift)(#\u)))
-(set-key '(com-insert-charcode 94) 'self-insert-table '((:dead--circumflex :shift)(#\Space)))
+(define-command (com-insert-charcode :name t :command-table self-insert-table)
+    ((code 'integer :prompt "Code point") (count 'integer))
+  (let ((char (code-char code)))
+    (loop repeat count do (insert-character char))))
+
+(macrolet 
+    ((set-charcode-key (code sequence)
+       `(set-key 
+         `(com-insert-charcode ,',code ,*numeric-argument-marker*)
+         'self-insert-table
+         ',sequence))
+     (set-dead-acute-key (code &rest sequence)
+       `(set-charcode-key ,code ((:dead-acute) , at sequence)))
+     (set-dead-grave-key (code &rest sequence)
+       `(set-charcode-key ,code ((:dead-grave) , at sequence)))
+     (set-dead-diaresis-key (code &rest sequence)
+       `(set-charcode-key ,code ((:dead-diaresis :shift) , at sequence)))
+     (set-dead-tilde-key (code &rest sequence)
+       `(set-charcode-key ,code ((:dead-tilde :shift) , at sequence)))
+     (set-dead-circumflex-key (code &rest sequence)
+       `(set-charcode-key ,code ((:dead-circumflex :shift) , at sequence))))
+  (set-dead-acute-key 193 (#\A))
+  (set-dead-acute-key 201 (#\E)) 
+  (set-dead-acute-key 205 (#\I))
+  (set-dead-acute-key 211 (#\O))
+  (set-dead-acute-key 218 (#\U))
+  (set-dead-acute-key 221 (#\Y))
+  (set-dead-acute-key 225 (#\a))
+  (set-dead-acute-key 233 (#\e))
+  (set-dead-acute-key 237 (#\i))
+  (set-dead-acute-key 243 (#\o))
+  (set-dead-acute-key 250 (#\u))
+  (set-dead-acute-key 253 (#\y))
+  (set-dead-acute-key 199 (#\C))
+  (set-dead-acute-key 231 (#\c))
+  (set-dead-acute-key 215 (#\x))
+  (set-dead-acute-key 247 (#\-))
+  (set-dead-acute-key 222 (#\T))
+  (set-dead-acute-key 254 (#\t))
+  (set-dead-acute-key 223 (#\s))
+  (set-dead-acute-key 39 (#\Space))
+
+  (set-dead-acute-key 197 (:dead-acute) (#\A))
+  (set-dead-acute-key 229 (:dead-acute) (#\a))
+
+  (set-dead-grave-key 192 (#\A))
+  (set-dead-grave-key 200 (#\E))
+  (set-dead-grave-key 204 (#\I))
+  (set-dead-grave-key 210 (#\O))
+  (set-dead-grave-key 217 (#\U))
+  (set-dead-grave-key 224 (#\a))
+  (set-dead-grave-key 232 (#\e))
+  (set-dead-grave-key 236 (#\i))
+  (set-dead-grave-key 242 (#\o))
+  (set-dead-grave-key 249 (#\u))
+  (set-dead-grave-key 96 (#\Space))
+
+  (set-dead-diaresis-key 196 (#\A))
+  (set-dead-diaresis-key 203 (#\E))
+  (set-dead-diaresis-key 207 (#\I))
+  (set-dead-diaresis-key 214 (#\O))
+  (set-dead-diaresis-key 220 (#\U))
+  (set-dead-diaresis-key 228 (#\a))
+  (set-dead-diaresis-key 235 (#\e))
+  (set-dead-diaresis-key 239 (#\i))
+  (set-dead-diaresis-key 246 (#\o))
+  (set-dead-diaresis-key 252 (#\u))
+  (set-dead-diaresis-key 255 (#\y))
+  (set-dead-diaresis-key 34  (#\Space))
+
+  (set-dead-tilde-key 195 (#\A))
+  (set-dead-tilde-key 209 (#\N))
+  (set-dead-tilde-key 227 (#\a))
+  (set-dead-tilde-key 241 (#\n))
+
+  (set-dead-tilde-key 198 (#\E))
+  (set-dead-tilde-key 230 (#\e))
+  (set-dead-tilde-key 208 (#\D))
+  (set-dead-tilde-key 240 (#\d))
+  (set-dead-tilde-key 248 (#\o))
+  (set-dead-tilde-key 126 (#\Space))
+
+  (set-dead-circumflex-key 194 (#\A))
+  (set-dead-circumflex-key 202 (#\E))
+  (set-dead-circumflex-key 206 (#\I))
+  (set-dead-circumflex-key 212 (#\O))
+  (set-dead-circumflex-key 219 (#\U))
+  (set-dead-circumflex-key 226 (#\a))
+  (set-dead-circumflex-key 234 (#\e))
+  (set-dead-circumflex-key 238 (#\i))
+  (set-dead-circumflex-key 244 (#\o))
+  (set-dead-circumflex-key 251 (#\u))
+  (set-dead-circumflex-key 94 (#\Space)))



From thenriksen at common-lisp.net  Wed Mar 15 12:14:22 2006
From: thenriksen at common-lisp.net (thenriksen)
Date: Wed, 15 Mar 2006 07:14:22 -0500 (EST)
Subject: [climacs-cvs] CVS climacs
Message-ID: <20060315121422.A0BF87A000@common-lisp.net>

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

Modified Files:
	lisp-syntax-commands.lisp 
Log Message:
Fix `com-package'.


--- /project/climacs/cvsroot/climacs/lisp-syntax-commands.lisp	2006/02/07 15:27:50	1.1
+++ /project/climacs/cvsroot/climacs/lisp-syntax-commands.lisp	2006/03/15 12:14:22	1.2
@@ -44,7 +44,7 @@
   (let* ((pane (current-window))
 	 (syntax (syntax (buffer pane)))
 	 (package (climacs-lisp-syntax::package-of syntax)))
-    (display-message (format nil "~s" package))))
+    (esa:display-message (format nil "~A" (package-name package)))))
 
 (define-command (com-fill-paragraph :name t :command-table lisp-table) ()
   )



From thenriksen at common-lisp.net  Wed Mar 15 17:17:49 2006
From: thenriksen at common-lisp.net (thenriksen)
Date: Wed, 15 Mar 2006 12:17:49 -0500 (EST)
Subject: [climacs-cvs] CVS climacs
Message-ID: <20060315171749.0D26D2F000@common-lisp.net>

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

Modified Files:
	lisp-syntax-commands.lisp 
Log Message:
`com-package' assumed `package-of' would always return a valid package
object. Fixed.


--- /project/climacs/cvsroot/climacs/lisp-syntax-commands.lisp	2006/03/15 12:14:22	1.2
+++ /project/climacs/cvsroot/climacs/lisp-syntax-commands.lisp	2006/03/15 17:17:48	1.3
@@ -44,7 +44,9 @@
   (let* ((pane (current-window))
 	 (syntax (syntax (buffer pane)))
 	 (package (climacs-lisp-syntax::package-of syntax)))
-    (esa:display-message (format nil "~A" (package-name package)))))
+    (esa:display-message (format nil "~A" (if (packagep package)
+					      (package-name package)
+					      package)))))
 
 (define-command (com-fill-paragraph :name t :command-table lisp-table) ()
   )



From thenriksen at common-lisp.net  Sat Mar 25 00:08:07 2006
From: thenriksen at common-lisp.net (thenriksen)
Date: Fri, 24 Mar 2006 19:08:07 -0500 (EST)
Subject: [climacs-cvs] CVS esa
Message-ID: <20060325000807.CB5BA15003@common-lisp.net>

Update of /project/climacs/cvsroot/esa
In directory clnet:/home/thenriksen/esa

Log Message:
Initial import.

Status:

Vendor Tag:	esa
Release Tags:	start
		
N esa/colors.lisp
N esa/esa-buffer.lisp
N esa/esa-io.lisp
N esa/esa.asd
N esa/esa.lisp
N esa/packages.lisp

No conflicts created by this import





From crhodes at common-lisp.net  Sat Mar 25 20:58:41 2006
From: crhodes at common-lisp.net (crhodes)
Date: Sat, 25 Mar 2006 15:58:41 -0500 (EST)
Subject: [climacs-cvs] CVS climacs
Message-ID: <20060325205841.4061544029@common-lisp.net>

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

Modified Files:
	file-commands.lisp 
Log Message:
Make the buffer of a syntax be the buffer created by MAKE-BUFFER rather 
than the buffer of (point pane).  (In practice, this means the 
climacs-buffer (delegating) rather than the implementation buffer).  

(This is largely to facilitate the ability to print tablature along with 
the buffer name; there are probably other reasons to allow this.)


--- /project/climacs/cvsroot/climacs/file-commands.lisp	2006/03/03 19:38:57	1.3
+++ /project/climacs/cvsroot/climacs/file-commands.lisp	2006/03/25 20:58:41	1.4
@@ -155,7 +155,7 @@
 		 (setf (buffer (current-window)) buffer)
 		 (setf (syntax buffer)
 		       (make-instance (syntax-class-name-for-filepath filepath)
-			  :buffer (buffer (point pane))))
+			  :buffer buffer))
 		 ;; Don't want to create the file if it doesn't exist.
 		 (when (probe-file filepath)
 		   (with-open-file (stream filepath :direction :input)



From thenriksen at common-lisp.net  Sat Mar 25 21:15:21 2006
From: thenriksen at common-lisp.net (thenriksen)
Date: Sat, 25 Mar 2006 16:15:21 -0500 (EST)
Subject: [climacs-cvs] CVS climacs
Message-ID: <20060325211521.36D44550D0@common-lisp.net>

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

Modified Files:
	packages.lisp climacs.asd 
Log Message:
Changed package and system definitions to use external :esa system.


--- /project/climacs/cvsroot/climacs/packages.lisp	2006/03/03 19:38:57	1.85
+++ /project/climacs/cvsroot/climacs/packages.lisp	2006/03/25 21:15:21	1.86
@@ -161,32 +161,6 @@
 	   #:url
 	   #:climacs-textual-view #:+climacs-textual-view+))
 
-#-mcclim
-(defpackage :clim-extensions
-  (:use :clim-lisp :clim)
-  (:export
-   #:+blue-violet+
-   #:+dark-blue+
-   #:+dark-green+
-   #:+dark-violet+
-   #:+gray50+
-   #:+gray85+
-   #:+maroon+
-   #:+purple+))
-
-(defpackage :esa
-  (:use :clim-lisp :clim :clim-extensions)
-  (:export #:minibuffer-pane #:display-message
-	   #:esa-pane-mixin #:previous-command
-	   #:info-pane #:master-pane
-	   #:esa-frame-mixin #:windows #:recordingp #:executingp
-	   #:*numeric-argument-p* #:*current-gesture*
-	   #:esa-top-level #:simple-command-loop
-	   #:global-esa-table #:keyboard-macro-table
-	   #:help-table
-	   #:set-key
-	   #:find-applicable-command-table))
-
 (defpackage :climacs-gui
   (:use :clim-lisp :clim :climacs-buffer :climacs-base
 	:climacs-abbrev :climacs-syntax 
--- /project/climacs/cvsroot/climacs/climacs.asd	2006/03/03 19:38:57	1.42
+++ /project/climacs/cvsroot/climacs/climacs.asd	2006/03/25 21:15:21	1.43
@@ -28,7 +28,7 @@
 (defparameter *climacs-directory* (directory-namestring *load-truename*))
 
 (defsystem :climacs
-  :depends-on (:mcclim :flexichain)
+  :depends-on (:mcclim :flexichain :esa)
   :components
   ((:module "cl-automaton"
 	    :components ((:file "automaton-package")
@@ -70,14 +70,12 @@
    (:file "prolog2paiprolog" :depends-on ("prolog-syntax"))
    (:file "ttcn3-syntax" :depends-on ("packages" "buffer" "syntax" "base"
 						 "pane"))
-   (:file "colors" :depends-on ("packages"))
    (:file "lisp-syntax" :depends-on ("packages" "syntax" "buffer" "base" "pane"
-						"gui" "colors"))
+						"gui"))
    (:file "lisp-syntax-commands" :depends-on ("lisp-syntax"))
-   (:file "esa" :depends-on ("packages" "colors"))
    (:file "gui" :depends-on ("packages" "syntax" "base" "buffer" "undo" "pane"
-                                        "esa" "kill-ring" "io" "text-syntax"
-					"abbrev" "colors"))
+                                        "kill-ring" "io" "text-syntax"
+					"abbrev" ))
 ;;    (:file "buffer-commands" :depends-on ("gui"))
    (:file "developer-commands" :depends-on ("gui" "lisp-syntax"))
    (:file "file-commands" :depends-on ("gui"))
@@ -85,7 +83,7 @@
    (:file "search-commands" :depends-on ("gui"))
    (:file "window-commands" :depends-on ("gui"))
    (:file "unicode-commands" :depends-on ("gui"))
-   (:file "slidemacs" :depends-on ("packages" "buffer" "syntax" "base" "pane" "colors"))
+   (:file "slidemacs" :depends-on ("packages" "buffer" "syntax" "base" "pane" ))
    (:file "slidemacs-gui" :depends-on ("packages" "slidemacs" "pane" "buffer" "syntax" "gui"))))
 
 (defsystem :climacs.tests



From crhodes at common-lisp.net  Sat Mar 25 22:24:15 2006
From: crhodes at common-lisp.net (crhodes)
Date: Sat, 25 Mar 2006 17:24:15 -0500 (EST)
Subject: [climacs-cvs] CVS esa
Message-ID: <20060325222415.ABF8530000@common-lisp.net>

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

Modified Files:
	esa.lisp 
Log Message:
Rearrange the esa loop a tiny bit: run redisplay-frame-panes from 
execute-frame-command if (eq frame *application-frame*), and from the 
abort-gesture handler too.

Make sure that the ESA methods on redisplay-frame-panes and 
execute-frame-command use the frame argument rather than 
*application-frame*.


--- /project/climacs/cvsroot/esa/esa.lisp	2006/03/25 00:08:07	1.1.1.1
+++ /project/climacs/cvsroot/esa/esa.lisp	2006/03/25 22:24:15	1.2
@@ -266,15 +266,20 @@
 
 (defmethod redisplay-frame-panes :around ((frame esa-frame-mixin) &key force-p)
   (declare (ignore force-p))
-  (when (null (remaining-keys *application-frame*))
-    (setf (executingp *application-frame*) nil)
+  (when (null (remaining-keys frame))
+    (setf (executingp frame) nil)
     (call-next-method)))
 
 (defmethod execute-frame-command :after ((frame esa-frame-mixin) command)
-  (setf (previous-command *standard-output*)
+  ;; FIXME: I'm not sure that we want to do this for commands sent
+  ;; from other threads; we almost certainly don't want to do it twice
+  ;; in such cases...
+  (setf (previous-command (car (windows frame)))
 	(if (consp command)
 	    (car command)
-	    command)))
+	    command))
+  (when (eq frame *application-frame*)
+    (redisplay-frame-panes frame)))
 
 (defgeneric find-applicable-command-table (frame))
 
@@ -299,16 +304,16 @@
       (redisplay-frame-panes frame :force-p t)
       (loop
        do (restart-case
-              (progn
-                (handler-case
-                    (let ((command-table (find-applicable-command-table frame)))
-                      ;; for presentation-to-command-translators,
-                      ;; which are searched for in
-                      ;; (frame-command-table *application-frame*)
-                      (setf (frame-command-table frame) command-table)
-                      (process-gestures-or-command frame command-table))
-                  (abort-gesture () (display-message "Quit")))
-                (redisplay-frame-panes frame))
+              (handler-case
+                  (let ((command-table (find-applicable-command-table frame)))
+                    ;; for presentation-to-command-translators,
+                    ;; which are searched for in
+                    ;; (frame-command-table *application-frame*)
+                    (setf (frame-command-table frame) command-table)
+                    (process-gestures-or-command frame command-table))
+                (abort-gesture () 
+                  (display-message "Quit")
+                  (redisplay-frame-panes frame)))
 	   (return-to-esa () nil)
            (reset-esa ()
              ;; This restart is used to jump out of deadlocks where



From crhodes at common-lisp.net  Sat Mar 25 22:29:12 2006
From: crhodes at common-lisp.net (crhodes)
Date: Sat, 25 Mar 2006 17:29:12 -0500 (EST)
Subject: [climacs-cvs] CVS climacs
Message-ID: <20060325222912.2AF5534014@common-lisp.net>

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

Modified Files:
	INSTALL gui.lisp 
Removed Files:
	esa.lisp 
Log Message:
Modify gui.lisp to use frame arguments where applicable, as redisplay 
methods need not be run in the application thread.

Document the need for external flexichain and esa checkouts, and remove 
esa.lisp.


--- /project/climacs/cvsroot/climacs/INSTALL	2005/09/25 20:06:25	1.7
+++ /project/climacs/cvsroot/climacs/INSTALL	2006/03/25 22:29:12	1.8
@@ -7,21 +7,15 @@
 Install instructions for Climacs.  We assume that if you have gotten
 this far, it means that you have either extracted a tar file with
 everything in it, or checked out the files from some CVS repository.
-If your directory contains a Flexichain subdirectory, skip directly to
-paragraph 1 below.  Otherwise start at paragraph 0.
 
-0. You need to check out the Flexichain module from the Gsharp project
-   on common-lisp.net.  If you are a member of that project, you can
-   do this:  
+0. You need to check out the flexichain and esa projects from
+   common-lisp.net. If you are not a member of those projects, here is
+   how you do it:
 
-    export CVS_RSH=ssh
-    cvs -z3 -d :ext:<username>@common-lisp.net:/project/gsharp/cvsroot co Flexichain
+    cvs -z3 -d :pserver:anonymous:anonymous at common-lisp.net:/project/flexichain/cvsroot co flexichain
+    cvs -z3 -d :pserver:anonymous:anonymous at common-lisp.net:/project/climacs/cvsroot co esa
 
-   If you are not a member, here is how you do it:
-
-    cvs -d :pserver:anonymous at common-lisp.net:/project/gsharp/cvsroot login
-    <enter anonymous as password>
-    cvs -z3 -d :pserver:anonymous at common-lisp.net:/project/gsharp/cvsroot co Flexichain
+   Ensure that asdf can find the .asd files for these projects.
       
 1. Start Lisp either from the shell or from Emacs
 
@@ -46,5 +40,3 @@
 For that reason, Climacs often depends on very fresh CVS versions of
 McCLIM.  If you discover a bug, please try to install a new version of
 McCLIM before looking too hard for any other reasons.
-
-
--- /project/climacs/cvsroot/climacs/gui.lisp	2006/03/03 19:38:57	1.204
+++ /project/climacs/cvsroot/climacs/gui.lisp	2006/03/25 22:29:12	1.205
@@ -225,7 +225,6 @@
 	(climacs :new-process new-process :process-name process-name :width width :height height))))
 
 (defun display-info (frame pane)
-  (declare (ignore frame))
   (let* ((master-pane (master-pane pane))
 	 (buffer (buffer master-pane))
 	 (size (size buffer))
@@ -265,15 +264,14 @@
 				       "Isearch"))
       (princ #\) pane))
     (with-text-family (pane :sans-serif)
-      (princ (if (recordingp *application-frame*)
+      (princ (if (recordingp frame)
 		 "Def"
 		 "")
 	     pane))))
 
 (defun display-window (frame pane)
   "The display function used by the climacs application frame."
-  (declare (ignore frame))
-  (redisplay-pane pane (eq pane (current-window))))
+  (redisplay-pane pane (eq pane (car (windows frame)))))
 
 (defmethod handle-repaint :before ((pane extended-pane) region)
   (declare (ignore region))
@@ -282,25 +280,26 @@
 (defvar *kill-ring* (make-instance 'kill-ring :max-size 7))
 
 (defmethod execute-frame-command :around ((frame climacs) command)
-  (handler-case
-      (if (buffer-pane-p (current-window))
-	  (with-undo ((buffer (current-window)))
-	    (call-next-method))
-	  (call-next-method))
-    (offset-before-beginning ()
-      (beep) (display-message "Beginning of buffer"))
-    (offset-after-end ()
-      (beep) (display-message "End of buffer"))
-    (motion-before-beginning ()
-      (beep) (display-message "Beginning of buffer"))
-    (motion-after-end ()
-      (beep) (display-message "End of buffer"))
-    (no-expression ()
-      (beep) (display-message "No expression around point"))
-    (no-such-operation ()
-      (beep) (display-message "Operation unavailable for syntax"))
-    (buffer-read-only ()
-      (beep) (display-message "Buffer is read only"))))  
+  (let ((current-window (car (windows frame))))
+    (handler-case
+        (if (buffer-pane-p current-window)
+            (with-undo ((buffer current-window))
+              (call-next-method))
+            (call-next-method))
+      (offset-before-beginning ()
+        (beep) (display-message "Beginning of buffer"))
+      (offset-after-end ()
+        (beep) (display-message "End of buffer"))
+      (motion-before-beginning ()
+        (beep) (display-message "Beginning of buffer"))
+      (motion-after-end ()
+        (beep) (display-message "End of buffer"))
+      (no-expression ()
+        (beep) (display-message "No expression around point"))
+      (no-such-operation ()
+        (beep) (display-message "Operation unavailable for syntax"))
+      (buffer-read-only ()
+        (beep) (display-message "Buffer is read only")))))
 
 (defmethod execute-frame-command :after ((frame climacs) command)
   (loop for buffer in (buffers frame)



From thenriksen at common-lisp.net  Sun Mar 26 14:14:48 2006
From: thenriksen at common-lisp.net (thenriksen)
Date: Sun, 26 Mar 2006 09:14:48 -0500 (EST)
Subject: [climacs-cvs] CVS climacs
Message-ID: <20060326141448.C889120016@common-lisp.net>

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

Modified Files:
	packages.lisp misc-commands.lisp lisp-syntax-commands.lisp 
	base.lisp 
Log Message:
Added region- and expression-indentation commands.


--- /project/climacs/cvsroot/climacs/packages.lisp	2006/03/25 21:15:21	1.86
+++ /project/climacs/cvsroot/climacs/packages.lisp	2006/03/26 14:14:48	1.87
@@ -57,6 +57,7 @@
 (defpackage :climacs-base
   (:use :clim-lisp :climacs-buffer)
   (:export #:do-buffer-region
+           #:do-buffer-region-lines
 	   #:previous-line #:next-line
 	   #:open-line #:kill-line
            #:empty-line-p
@@ -73,6 +74,7 @@
            #:upcase-word #:downcase-word #:capitalize-word
            #:tabify-region #:untabify-region
            #:indent-line
+           #:indent-region
            #:delete-indentation
            #:fill-line
 	   #:input-from-stream #:output-to-stream
--- /project/climacs/cvsroot/climacs/misc-commands.lisp	2006/03/03 19:38:57	1.4
+++ /project/climacs/cvsroot/climacs/misc-commands.lisp	2006/03/26 14:14:48	1.5
@@ -531,6 +531,30 @@
 	 'indent-table
 	 '((#\j :control)))
 
+(defun indent-region (pane mark1 mark2)
+  "Indent all lines in the region delimited by `mark1' and `mark2'
+   according to the rules of the active syntax in `pane'."
+  (let* ((buffer (buffer pane))
+         (view (stream-default-view pane))
+         (tab-space-count (tab-space-count view))
+         (tab-width (and (climacs-pane:indent-tabs-mode buffer)
+                         tab-space-count))
+         (syntax (climacs-syntax:syntax buffer)))
+    (do-buffer-region-lines (line mark1 mark2)
+      (let ((indentation (climacs-syntax:syntax-line-indentation  
+                          line
+                          tab-space-count
+                          syntax)))
+        (indent-line line indentation tab-width)))))
+
+(define-command (com-indent-region :name t :command-table indent-table) ()
+  "Indent every line of the current region as specified by the
+syntax for the buffer."
+  (let* ((pane (current-window))
+         (point (point pane))
+         (mark (mark pane)))
+    (indent-region pane point mark)))
+
 (define-command (com-delete-indentation :name t :command-table indent-table) ()
   (delete-indentation (point (current-window))))
 
--- /project/climacs/cvsroot/climacs/lisp-syntax-commands.lisp	2006/03/15 17:17:48	1.3
+++ /project/climacs/cvsroot/climacs/lisp-syntax-commands.lisp	2006/03/26 14:14:48	1.4
@@ -32,25 +32,42 @@
 
 (define-command (com-eval-defun :name t :command-table lisp-table) ()
   (let* ((pane (current-window))
-	 (point (point pane))
-	 (syntax (syntax (buffer pane))))
+         (point (point pane))
+         (syntax (syntax (buffer pane))))
     (eval-defun point syntax)))
 
 (esa:set-key 'com-eval-defun
-	 'lisp-table
-	 '((#\x :control :meta)))
+             'lisp-table
+             '((#\x :control :meta)))
 
 (define-command (com-package :name t :command-table lisp-table) ()
   (let* ((pane (current-window))
-	 (syntax (syntax (buffer pane)))
-	 (package (climacs-lisp-syntax::package-of syntax)))
+         (syntax (syntax (buffer pane)))
+         (package (climacs-lisp-syntax::package-of syntax)))
     (esa:display-message (format nil "~A" (if (packagep package)
-					      (package-name package)
-					      package)))))
+                                              (package-name package)
+                                              package)))))
 
 (define-command (com-fill-paragraph :name t :command-table lisp-table) ()
   )
 
 (esa:set-key 'com-fill-paragraph
-	     'lisp-table
-	     '((#\q :meta)))
\ No newline at end of file
+             'lisp-table
+             '((#\q :meta)))
+
+(define-command (com-indent-expression :name t :command-table lisp-table)
+    ((count 'integer :prompt "Number of expressions"))
+  (let* ((pane (current-window))
+         (point (point pane))
+         (mark (clone-mark point))
+         (syntax (syntax (buffer pane)))
+         (view (stream-default-view pane))
+         (tab-space-count (tab-space-count view)))
+    (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)))
+
+(esa:set-key `(com-indent-expression ,*numeric-argument-marker*)
+             'lisp-table
+             '((#\q :meta :control)))
\ No newline at end of file
--- /project/climacs/cvsroot/climacs/base.lisp	2005/08/27 22:07:45	1.45
+++ /project/climacs/cvsroot/climacs/base.lisp	2006/03/26 14:14:48	1.46
@@ -41,6 +41,27 @@
      (loop for ,offset from ,offset1 below ,offset2
            do , at body)))
 
+(defmacro do-buffer-region-lines ((line-var mark1 mark2) &body body)
+  "Iterate over the lines in the region delimited by `mark1' and `mark2'.
+   For each line, `line-var' will be bound to a mark positioned
+   at the beginning of the line and `body' will be executed. Note
+   that the iteration will always start from the mark specifying
+   the earliest position in the buffer."
+  (let ((mark-sym (gensym))
+        (mark2-sym (gensym)))
+    `(progn
+       (when (mark< ,mark2 ,mark1)
+         (rotatef ,mark1 ,mark2))
+       (let ((,mark-sym (clone-mark ,mark1))
+             (,mark2-sym (clone-mark ,mark2)))
+         (loop while (mark<= ,mark-sym ,mark2-sym)
+            do
+            (let ((,line-var (clone-mark ,mark-sym)))
+              , at body)
+            (end-of-line ,mark-sym)
+            (unless (end-of-buffer-p ,mark-sym)
+              (forward-object ,mark-sym)))))))
+
 (defmethod previous-line (mark &optional column (count 1))
   "Move a mark up COUNT lines conserving horizontal position."
   (unless column



From thenriksen at common-lisp.net  Sun Mar 26 14:17:04 2006
From: thenriksen at common-lisp.net (thenriksen)
Date: Sun, 26 Mar 2006 09:17:04 -0500 (EST)
Subject: [climacs-cvs] CVS climacs
Message-ID: <20060326141704.AF2EC23005@common-lisp.net>

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

Modified Files:
	gui.lisp 
Log Message:
Added `current-point' and `current-buffer' convenience functions.


--- /project/climacs/cvsroot/climacs/gui.lisp	2006/03/25 22:29:12	1.205
+++ /project/climacs/cvsroot/climacs/gui.lisp	2006/03/26 14:17:04	1.206
@@ -180,6 +180,14 @@
 (defun current-window ()
   (car (windows *application-frame*)))
 
+(defun current-point ()
+  "Return the current panes point."
+  (point (current-window)))
+
+(defun current-buffer ()
+  "Return the current buffer."
+  (buffer (current-window)))
+
 (defmethod redisplay-frame-panes :around ((frame climacs) &rest args)
   (declare (ignore args))
   (let ((buffers (remove-duplicates (loop for pane in (windows frame)



From thenriksen at common-lisp.net  Sun Mar 26 14:29:42 2006
From: thenriksen at common-lisp.net (thenriksen)
Date: Sun, 26 Mar 2006 09:29:42 -0500 (EST)
Subject: [climacs-cvs] CVS esa
Message-ID: <20060326142942.39B8042007@common-lisp.net>

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

Modified Files:
	esa.lisp 
Log Message:
Added pointer-documentation-stream handling to `esa-top-level'.


--- /project/climacs/cvsroot/esa/esa.lisp	2006/03/25 22:24:15	1.2
+++ /project/climacs/cvsroot/esa/esa.lisp	2006/03/26 14:29:42	1.3
@@ -298,7 +298,9 @@
     (let ((*standard-output* (car windows))
 	  (*standard-input* (frame-standard-input frame))
 	  (*print-pretty* nil)
-	  (*abort-gestures* `((:keyboard #\g ,(make-modifier-state :control)))))
+	  (*abort-gestures* `((:keyboard #\g ,(make-modifier-state :control))))
+          (*pointer-documentation-output*
+           (frame-pointer-documentation-output frame)))
       (unless (eq (frame-state frame) :enabled)
 	(enable-frame frame))
       (redisplay-frame-panes frame :force-p t)



From thenriksen at common-lisp.net  Sun Mar 26 16:40:00 2006
From: thenriksen at common-lisp.net (thenriksen)
Date: Sun, 26 Mar 2006 11:40:00 -0500 (EST)
Subject: [climacs-cvs] CVS climacs/Doc
Message-ID: <20060326164000.BD93561032@common-lisp.net>

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

Modified Files:
	climacs-internals.texi 
Log Message:
Fix minor typo.


--- /project/climacs/cvsroot/climacs/Doc/climacs-internals.texi	2005/09/13 23:45:39	1.19
+++ /project/climacs/cvsroot/climacs/Doc/climacs-internals.texi	2006/03/26 16:40:00	1.20
@@ -703,7 +703,7 @@
 
 Inform the syntax module that it must update its syntactic analysis to
 cover the region between the two marks from and to.  It is acceptable
-to pass and offset instead of a mark for either or both of the last
+to pass an offset instead of a mark for either or both of the last
 two arguments. 
 @end deffn
 



From thenriksen at common-lisp.net  Sun Mar 26 20:59:36 2006
From: thenriksen at common-lisp.net (thenriksen)
Date: Sun, 26 Mar 2006 15:59:36 -0500 (EST)
Subject: [climacs-cvs] CVS esa
Message-ID: <20060326205936.8085E12034@common-lisp.net>

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

Modified Files:
	esa.lisp 
Log Message:
Added minimum display time for minibuffer messages.


--- /project/climacs/cvsroot/esa/esa.lisp	2006/03/26 14:29:42	1.3
+++ /project/climacs/cvsroot/esa/esa.lisp	2006/03/26 20:59:36	1.4
@@ -37,8 +37,13 @@
 ;;; 
 ;;; Minibuffer pane
 
+(defvar *minimum-message-time* 1
+  "The minimum number of seconds a minibuffer message will be
+  displayed." )
+
 (defclass minibuffer-pane (application-pane)
-  ((message :initform nil :accessor message))
+  ((message :initform nil :accessor message)
+   (message-time :initform 0 :accessor message-time))
   (:default-initargs
       :scroll-bars nil
       :display-function 'display-minibuffer))
@@ -48,7 +53,9 @@
   (with-slots (message) pane
     (unless (null message)
     (princ message pane)
-    (setf message nil))))
+    (when (> (get-universal-time)
+             (+ *minimum-message-time* (message-time pane)))
+      (setf message nil)))))
 
 (defmethod stream-accept :before ((pane minibuffer-pane) type &rest args)
   (declare (ignore type args))
@@ -56,7 +63,9 @@
 
 (defun display-message (format-string &rest format-args)
   (setf (message *standard-input*)
-	(apply #'format nil format-string format-args)))
+	(apply #'format nil format-string format-args))
+  (setf (message-time *standard-input*)
+        (get-universal-time)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 



From crhodes at common-lisp.net  Mon Mar 27 14:10:24 2006
From: crhodes at common-lisp.net (crhodes)
Date: Mon, 27 Mar 2006 09:10:24 -0500 (EST)
Subject: [climacs-cvs] CVS climacs
Message-ID: <20060327141024.94BBF34014@common-lisp.net>

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

Modified Files:
	gui.lisp 
Log Message:
Argh.  Now that EXECUTE-FRAME-COMMAND calls REDISPLAY-FRAME-PANES, we 
mustn't clear-modify in REDISPLAY-FRAME-PANES because otherwise we never 
notice that we have to save anything.  Band-aid fix because I need to 
produce binaries this afternoon.


--- /project/climacs/cvsroot/climacs/gui.lisp	2006/03/26 14:17:04	1.206
+++ /project/climacs/cvsroot/climacs/gui.lisp	2006/03/27 14:10:24	1.207
@@ -195,9 +195,7 @@
 					    collect (buffer pane)))))
     (loop for buffer in buffers
 	  do (update-syntax buffer (syntax buffer)))
-    (call-next-method)
-    (loop for buffer in buffers
-	  do (clear-modify buffer))))
+    (call-next-method)))
 
 (defun climacs (&key new-process (process-name "Climacs")
                 (width 900) (height 400))
@@ -312,7 +310,8 @@
 (defmethod execute-frame-command :after ((frame climacs) command)
   (loop for buffer in (buffers frame)
 	do (when (modified-p buffer)
-	     (setf (needs-saving buffer) t))))	
+	     (setf (needs-saving buffer) t)
+             (clear-modify buffer))))
 
 (defmethod find-applicable-command-table ((frame climacs))
   (or



From crhodes at common-lisp.net  Mon Mar 27 15:38:19 2006
From: crhodes at common-lisp.net (crhodes)
Date: Mon, 27 Mar 2006 10:38:19 -0500 (EST)
Subject: [climacs-cvs] CVS esa
Message-ID: <20060327153819.D11236A129@common-lisp.net>

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

Modified Files:
	esa.lisp 
Log Message:
This protocol makes the Baby Jesus cry.

If we call REDISPLAY-FRAME-PANES from EXECUTE-FRAME-COMMAND, we must 
absolutely make sure that it's called at a defined time, so that ESAs 
can make sure that their state is up to date when the redisplay occurs.

Call REDISPLAY-FRAME-PANES from 
  EXECUTE-FRAME-COMMAND :AROUND (ESA-FRAME-MIXIN T)
so that application bookkeeping can happen in primary/:before/:after 
methods (before redisplay-frame-panes) and in :AROUND (APP T) methods
(for stuff to occur /after/ redisplay-frame-panes).  See upcoming commit 
in climacs CVS for use of this.


--- /project/climacs/cvsroot/esa/esa.lisp	2006/03/26 20:59:36	1.4
+++ /project/climacs/cvsroot/esa/esa.lisp	2006/03/27 15:38:19	1.5
@@ -286,7 +286,10 @@
   (setf (previous-command (car (windows frame)))
 	(if (consp command)
 	    (car command)
-	    command))
+	    command)))
+
+(defmethod execute-frame-command :around ((frame esa-frame-mixin) command)
+  (call-next-method)
   (when (eq frame *application-frame*)
     (redisplay-frame-panes frame)))
 



From crhodes at common-lisp.net  Mon Mar 27 15:43:17 2006
From: crhodes at common-lisp.net (crhodes)
Date: Mon, 27 Mar 2006 10:43:17 -0500 (EST)
Subject: [climacs-cvs] CVS climacs
Message-ID: <20060327154317.B366B72034@common-lisp.net>

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

Modified Files:
	file-commands.lisp gui.lisp 
Log Message:
The order of events when executing a command must go:

1. execute the command
2. (a) update-syntax;
   (b) update needs-saving;
3. redisplay panes
4. clear-modify

Put 1. and 2. in execute-frame-command :after and 4. in 
execute-frame-command :around; 3. happens in execute-frame-command 
:around ESA.  It's not the tidiest implementation right now but it sort 
of works.

Make sure that a loaded file has an up-to-date syntax and a cleared 
modified flag.


--- /project/climacs/cvsroot/climacs/file-commands.lisp	2006/03/25 20:58:41	1.4
+++ /project/climacs/cvsroot/climacs/file-commands.lisp	2006/03/27 15:43:17	1.5
@@ -164,9 +164,8 @@
 		       (name buffer) (filepath-filename filepath)
 		       (needs-saving buffer) nil)
 		 (beginning-of-buffer (point pane))
-		 ;; this one is needed so that the buffer modification protocol
-		 ;; resets the low and high marks after redisplay
-		 (redisplay-frame-panes *application-frame*)
+                 (update-syntax buffer (syntax buffer))
+                 (clear-modify buffer)
 		 buffer))))))
 
 (defun directory-of-buffer (buffer)
--- /project/climacs/cvsroot/climacs/gui.lisp	2006/03/27 14:10:24	1.207
+++ /project/climacs/cvsroot/climacs/gui.lisp	2006/03/27 15:43:17	1.208
@@ -188,15 +188,6 @@
   "Return the current buffer."
   (buffer (current-window)))
 
-(defmethod redisplay-frame-panes :around ((frame climacs) &rest args)
-  (declare (ignore args))
-  (let ((buffers (remove-duplicates (loop for pane in (windows frame)
-					  when (buffer-pane-p pane)
-					    collect (buffer pane)))))
-    (loop for buffer in buffers
-	  do (update-syntax buffer (syntax buffer)))
-    (call-next-method)))
-
 (defun climacs (&key new-process (process-name "Climacs")
                 (width 900) (height 400))
   "Starts up a climacs session"
@@ -288,10 +279,14 @@
 (defmethod execute-frame-command :around ((frame climacs) command)
   (let ((current-window (car (windows frame))))
     (handler-case
-        (if (buffer-pane-p current-window)
-            (with-undo ((buffer current-window))
+        (progn
+          (if (buffer-pane-p current-window)
+              (with-undo ((buffer current-window))
+                (call-next-method))
               (call-next-method))
-            (call-next-method))
+          (loop for buffer in (buffers frame)
+                do (when (modified-p buffer)
+                     (clear-modify buffer))))
       (offset-before-beginning ()
         (beep) (display-message "Beginning of buffer"))
       (offset-after-end ()
@@ -309,9 +304,9 @@
 
 (defmethod execute-frame-command :after ((frame climacs) command)
   (loop for buffer in (buffers frame)
+        do (update-syntax buffer (syntax buffer))
 	do (when (modified-p buffer)
-	     (setf (needs-saving buffer) t)
-             (clear-modify buffer))))
+	     (setf (needs-saving buffer) t))))
 
 (defmethod find-applicable-command-table ((frame climacs))
   (or



From crhodes at common-lisp.net  Mon Mar 27 15:54:31 2006
From: crhodes at common-lisp.net (crhodes)
Date: Mon, 27 Mar 2006 10:54:31 -0500 (EST)
Subject: [climacs-cvs] CVS climacs
Message-ID: <20060327155431.562E224006@common-lisp.net>

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

Modified Files:
	gui.lisp 
Log Message:
Make kill-buffer do a full redisplay of the replacement buffer.


--- /project/climacs/cvsroot/climacs/gui.lisp	2006/03/27 15:43:17	1.208
+++ /project/climacs/cvsroot/climacs/gui.lisp	2006/03/27 15:54:31	1.209
@@ -462,7 +462,9 @@
      ;; Always need one buffer.
      (when (null buffers)
        (make-buffer "*scratch*"))
-     (setf (buffer (current-window)) (car buffers))))
+     (setf (buffer (current-window)) (car buffers))
+     (full-redisplay (current-window))
+     (buffer (current-window))))
 
 (defmethod kill-buffer ((name string))
   (let ((buffer (find name (buffers *application-frame*)



From thenriksen at common-lisp.net  Mon Mar 27 19:24:07 2006
From: thenriksen at common-lisp.net (thenriksen)
Date: Mon, 27 Mar 2006 14:24:07 -0500 (EST)
Subject: [climacs-cvs] CVS climacs
Message-ID: <20060327192407.5A36152080@common-lisp.net>

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

Modified Files:
	pane.lisp 
Log Message:
Change to using spaces for indentation by default, added parameter to
change back to using tabs.


--- /project/climacs/cvsroot/climacs/pane.lisp	2006/03/03 19:38:57	1.35
+++ /project/climacs/cvsroot/climacs/pane.lisp	2006/03/27 19:24:07	1.36
@@ -30,6 +30,9 @@
 ;;;
 ;;; Tabify
 
+(defvar *use-tabs-for-indentation* nil
+  "If non-NIL, use tabs when indenting lines. Otherwise, use spaces.")
+
 (defgeneric space-width (tabify))
 (defgeneric tab-width (tabify))
 (defgeneric tab-space-count (tabify))
@@ -239,7 +242,8 @@
   ((needs-saving :initform nil :accessor needs-saving)
    (syntax :accessor syntax)
    (point :initform nil :initarg :point :accessor point)
-   (indent-tabs-mode :initarg indent-tabs-mode :initform t
+   (indent-tabs-mode :initarg indent-tabs-mode
+                     :initform *use-tabs-for-indentation*
                      :accessor indent-tabs-mode))
   (:default-initargs
    :name "*scratch*"



From thenriksen at common-lisp.net  Thu Mar 30 16:10:19 2006
From: thenriksen at common-lisp.net (thenriksen)
Date: Thu, 30 Mar 2006 11:10:19 -0500 (EST)
Subject: [climacs-cvs] CVS climacs
Message-ID: <20060330161019.1AB8E5E08E@common-lisp.net>

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

Modified Files:
	window-commands.lisp 
Log Message:
Added checks to make sure point is not placed in typeout panes.


--- /project/climacs/cvsroot/climacs/window-commands.lisp	2006/03/03 19:38:57	1.5
+++ /project/climacs/cvsroot/climacs/window-commands.lisp	2006/03/30 16:10:18	1.6
@@ -180,12 +180,16 @@
 (defun other-window (&optional pane)
   (if (and pane (find pane (windows *application-frame*)))
       (setf (windows *application-frame*)
-	    (append (list pane)
-		    (remove pane (windows *application-frame*))))
+            (append (list pane)
+                    (remove pane (windows *application-frame*))))
       (setf (windows *application-frame*)
-	    (append (cdr (windows *application-frame*))
-		    (list (car (windows *application-frame*))))))
-  (setf *standard-output* (car (windows *application-frame*))))
+            (append (cdr (windows *application-frame*))
+                    (list (car (windows *application-frame*))))))
+  ;; Try to avoid setting the point in a typeout pane. FIXME: This is a kludge.
+  (if (and (subtypep 'typeout-pane (type-of (car (windows *application-frame*))))
+           (> (length (windows *application-frame*)) 1))
+      (other-window)
+      (setf *standard-output* (car (windows *application-frame*)))))
   
 (define-command (com-other-window :name t :command-table window-table) ()
   (other-window))
@@ -220,7 +224,12 @@
 	  (click-to-offset window x y))))
 
 (define-presentation-to-command-translator blank-area-to-switch-to-this-window
-    (blank-area com-switch-to-this-window window-table :echo nil)
+    (blank-area com-switch-to-this-window window-table
+                :echo nil
+                ;; Putting the point in typeout-panes can cause errors.
+                :tester ((object presentation)
+                         (declare (ignore presentation))
+                         (not (typep object 'typeout-pane))))
     (window x y)
   (list window x y))