December 2004 - climacs-cvs@common-lisp.net

[climacs-cvs] CVS update: climacs/gui.lisp climacs/packages.lisp climacs/syntax.lisp
by rstrandh＠common-lisp.net 31 Dec '04

31 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv22282 Modified Files: gui.lisp packages.lisp syntax.lisp Log Message: Simplified the redisplay routine. Introduced a cache of lines in the form of a flexichain. The ultra-fast redisplay is not yet in place, because I thought the bottle neck was in Climacs, whereas it is in McCLIM. I know how to fix that, though, by using :cache-test #'eq for cached lines. The only problem with that is that the line has to be traversed (despite being cached) in order that we can compute the position of the cursor. This might involve either invalidating the line with the cursor on it, so that it will be rescanned, or else rescanning it anyway, despite it being cached. Date: Fri Dec 31 14:33:07 2004 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.36 climacs/gui.lisp:1.37 --- climacs/gui.lisp:1.36 Fri Dec 31 07:39:21 2004 +++ climacs/gui.lisp Fri Dec 31 14:33:06 2004 @@ -354,10 +354,10 @@ (setf (filename buffer) filename (name buffer) (pathname-filename filename) (needs-saving buffer) nil) + (beginning-of-buffer point) ;; this one is needed so that the buffer modification protocol ;; resets the low and high marks after redisplay - (redisplay-frame-panes *application-frame*) - (beginning-of-buffer point)))) + (redisplay-frame-panes *application-frame*)))) (define-named-command com-save-buffer () (let* ((buffer (buffer (win *application-frame*))) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.15 climacs/packages.lisp:1.16 --- climacs/packages.lisp:1.15 Wed Dec 29 17:03:21 2004 +++ climacs/packages.lisp Fri Dec 31 14:33:06 2004 @@ -56,7 +56,7 @@ #:expand-abbrev #:abbrev-mixin #:possibly-expand-abbrev)) (defpackage :climacs-syntax - (:use :clim-lisp :clim :climacs-buffer :climacs-base) + (:use :clim-lisp :clim :climacs-buffer :climacs-base :flexichain) (:export #:syntax #:basic-syntax #:texinfo-syntax #:redisplay-pane #:redisplay-with-syntax #:full-redisplay #:url)) Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.12 climacs/syntax.lisp:1.13 --- climacs/syntax.lisp:1.12 Wed Dec 29 12:38:34 2004 +++ climacs/syntax.lisp Fri Dec 31 14:33:06 2004 @@ -38,11 +38,11 @@ ((top :reader top) (bot :reader bot) (scan :reader scan) - (saved-offset :initform nil :accessor saved-offset) - (cursor-x :initform nil) - (cursor-y :initform nil) + (cursor-x :initform 2) + (cursor-y :initform 2) (space-width :initform nil) - (tab-width :initform nil))) + (tab-width :initform nil) + (cache :initform nil))) (defmethod initialize-instance :after ((syntax basic-syntax) &rest args &key pane) (declare (ignore args)) @@ -66,72 +66,97 @@ 'string) :stream pane))) -;;(defmacro maybe-updating-output (stuff &body body) -;; `(progn ,@body)) - - (defmacro maybe-updating-output (stuff &body body) - `(updating-output ,stuff ,@body)) - -(defmethod display-line (pane (syntax basic-syntax)) - (with-slots (saved-offset bot scan cursor-x cursor-y space-width tab-width) syntax - (flet ((compute-contents () - (unless (null saved-offset) - (prog1 (coerce (buffer-sequence (buffer pane) saved-offset scan) 'string) - (setf saved-offset nil))))) - (macrolet ((output-word (&body body) - `(let ((contents (compute-contents))) - (if (null contents) - ,(if body - `(maybe-updating-output (pane :unique-id (incf id)) - ,@body) - `(progn)) - (progn - (maybe-updating-output (pane :unique-id (incf id) - :cache-value contents - :cache-test #'string=) - (present-contents contents pane syntax)) - ,(when body - `(maybe-updating-output (pane :unique-id (incf id)) - ,@body))))))) - (loop with id = 0 +(defmethod display-line (pane (syntax basic-syntax) line) + (let ((saved-index nil) + (id 0)) + (flet ((output-word (index) + (unless (null saved-index) + (let ((contents (coerce (subseq line saved-index index) 'string))) + (updating-output (pane :unique-id (incf id) + :cache-value contents + :cache-test #'string=) + (present-contents contents pane syntax))) + (setf saved-index nil)))) + (with-slots (bot scan cursor-x cursor-y space-width tab-width) syntax + (loop for index from 0 + for obj across line when (mark= scan (point pane)) do (multiple-value-bind (x y) (stream-cursor-position pane) - (setf cursor-x (+ x (if (null saved-offset) + (setf cursor-x (+ x (if (null saved-index) 0 - (* space-width (- scan saved-offset)))) + (* space-width (- index saved-index)))) cursor-y y)) - when (mark= scan bot) - do (output-word) - (return) - until (eql (buffer-object (buffer pane) scan) #\Newline) - do (let ((obj (buffer-object (buffer pane) scan))) - (cond ((eql obj #\Space) - (output-word) - (stream-increment-cursor-position pane space-width 0)) - ((eql obj #\Tab) - (output-word) - (let ((x (stream-cursor-position pane))) - (stream-increment-cursor-position - pane (- tab-width (mod x tab-width)) 0))) - ((constituentp obj) - (when (null saved-offset) - (setf saved-offset scan))) - (t - (output-word (princ obj pane))))) + do (cond ((eql obj #\Space) + (output-word index) + (stream-increment-cursor-position pane space-width 0)) + ((eql obj #\Tab) + (output-word index) + (let ((x (stream-cursor-position pane))) + (stream-increment-cursor-position + pane (- tab-width (mod x tab-width)) 0))) + ((constituentp obj) + (when (null saved-index) + (setf saved-index index))) + ((characterp obj) + (output-word index) + (updating-output (pane :unique-id (incf id) + :cache-value obj) + (present obj))) + (t + (output-word index) + (updating-output (pane :unique-id (incf id) + :cache-value obj + :cache-test #'eq) + (present obj)))) (incf scan) - finally (output-word (terpri pane)) + finally (output-word index) + (when (mark= scan (point pane)) + (multiple-value-bind (x y) (stream-cursor-position pane) + (setf cursor-x x + cursor-y y))) + (terpri pane) (incf scan)))))) -(defun round-up (x) - (cond ((zerop x) 2) - ((evenp x) x) - (t (1+ x)))) +(defmethod compute-cache (pane (syntax basic-syntax)) + (with-slots (top bot cache) syntax + (let* ((buffer (buffer pane)) + (high-mark (high-mark buffer)) + (low-mark (low-mark buffer))) + (when (or (mark< low-mark top) (mark> high-mark bot)) + (setf cache nil)) + (if (null cache) + (let ((nb-lines-on-display (1+ (number-of-lines-in-region top bot))) + (mark1 (clone-mark top)) + (mark2 (clone-mark top))) + (setf cache (make-instance 'standard-flexichain)) + (loop for line from 0 below nb-lines-on-display + do (beginning-of-line mark1) + (end-of-line mark2) + (insert* cache line (region-to-sequence mark1 mark2)) + unless (end-of-buffer-p mark2) + do (setf (offset mark1) (1+ (offset mark2)) + (offset mark2) (offset mark1)))) + (let ((nb-lines-on-display (1+ (number-of-lines-in-region top bot))) + (mark1 (clone-mark low-mark)) + (mark2 (clone-mark low-mark)) + (size1 (number-of-lines-in-region top low-mark)) + (size2 (number-of-lines-in-region high-mark bot))) + (loop repeat (- (nb-elements cache) size1 size2) + do (delete* cache size1)) + (loop for line from size1 + repeat (- nb-lines-on-display (nb-elements cache)) + do (beginning-of-line mark1) + (end-of-line mark2) + (insert* cache line (region-to-sequence mark1 mark2)) + unless (end-of-buffer-p mark2) + do (setf (offset mark1) (1+ (offset mark2)) + (offset mark2) (offset mark1)))))))) -(defmethod redisplay-with-syntax (pane (syntax basic-syntax)) +(defun position-window (pane syntax) (let* ((medium (sheet-medium pane)) (style (medium-text-style medium)) (height (text-style-height style medium))) - (with-slots (top bot scan cursor-x cursor-y) syntax + (with-slots (top bot cache) syntax (beginning-of-line top) (end-of-line bot) (multiple-value-bind (x y w h) (bounding-rectangle* pane) @@ -141,13 +166,17 @@ ;; adjust the region on display to fit the pane (loop repeat (- nb-lines-on-display nb-lines-in-pane) do (beginning-of-line bot) - (decf (offset bot))) + (decf (offset bot)) + (unless (null cache) + (pop-end cache))) (loop until (end-of-buffer-p bot) repeat (- nb-lines-in-pane nb-lines-on-display) do (incf (offset bot)) - (end-of-line bot)) + (end-of-line bot) + (setf cache nil)) ;; move region on display if point is outside the current region (when (or (mark< (point pane) top) (mark> (point pane) bot)) + (setf cache nil) (setf (offset top) (offset (point pane))) (loop do (beginning-of-line top) repeat (floor nb-lines-in-pane 2) @@ -159,24 +188,38 @@ repeat (1- nb-lines-in-pane) until (end-of-buffer-p bot) do (incf (offset bot)) - (end-of-line bot))) - (setf scan (offset top)) - (loop for id from 0 - until (mark= scan bot) - do (maybe-updating-output (pane :unique-id id) - (display-line pane syntax))) - (when (mark= scan (point pane)) - (multiple-value-bind (x y) (stream-cursor-position pane) - (setf cursor-x x - cursor-y y))) - (maybe-updating-output (pane :all-new t :fixed-position t) - (draw-line* pane - ;; cursors with odd x-positions were invisible - ;; so we strip off the low bit to make them even. - - (round-up cursor-x) (- cursor-y (* 0.2 height)) - (round-up cursor-x) (+ cursor-y (* 0.8 height)) - :ink +red+))))))) + (end-of-line bot)))))))) + + +;;; this one should not be necessary. +(defun round-up (x) + (cond ((zerop x) 2) + ((evenp x) x) + (t (1+ x)))) + +(defmethod redisplay-with-syntax (pane (syntax basic-syntax)) + (let* ((medium (sheet-medium pane)) + (style (medium-text-style medium)) + (height (text-style-height style medium))) + (with-slots (top bot scan cache cursor-x cursor-y) syntax + (position-window pane syntax) + (compute-cache pane syntax) + (setf scan (offset top)) + (loop for id from 0 below (nb-elements cache) + do (updating-output (pane :unique-id id) + (display-line pane syntax (element* cache id)))) + (when (mark= scan (point pane)) + (multiple-value-bind (x y) (stream-cursor-position pane) + (setf cursor-x x + cursor-y y))) + (updating-output (pane :unique-id -1) + (draw-line* pane + ;; cursors with odd or zero x-positions were invisible + ;; so we round them up to even. + ;; We don't know why, though. + (round-up cursor-x) (- cursor-y (* 0.2 height)) + (round-up cursor-x) (+ cursor-y (* 0.8 height)) + :ink +red+))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[climacs-cvs] CVS update: climacs/abbrev.lisp climacs/gui.lisp
by rstrandh＠common-lisp.net 31 Dec '04

31 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv2151 Modified Files: abbrev.lisp gui.lisp Log Message: Prelimary code for reading numeric argument. However, I suspect a bug in McCLIM with respect to unread-gesture, so waiting for a fix for that before actually using the code. Date: Fri Dec 31 07:39:22 2004 Author: rstrandh Index: climacs/abbrev.lisp diff -u climacs/abbrev.lisp:1.4 climacs/abbrev.lisp:1.5 --- climacs/abbrev.lisp:1.4 Thu Dec 23 09:00:33 2004 +++ climacs/abbrev.lisp Fri Dec 31 07:39:21 2004 @@ -52,10 +52,7 @@ (defun string-upper-case-p (string) "A predicate testing if each character of a string is uppercase." - (loop for c across string - unless (upper-case-p c) - do (return nil) - finally (return t))) + (every #'upper-case-p string)) (defmethod expand-abbrev (word (expander dictionary-abbrev-expander)) "Expands an abbrevated word by attempting to assocate it with a member of Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.35 climacs/gui.lisp:1.36 --- climacs/gui.lisp:1.35 Thu Dec 30 11:42:45 2004 +++ climacs/gui.lisp Fri Dec 31 07:39:21 2004 @@ -117,6 +117,43 @@ (defvar *kill-ring* (initialize-kill-ring 7)) (defparameter *current-gesture* nil) +(defun meta-digit (gesture) + (position gesture + '((#\0 :meta) (#\1 :meta) (#\2 :meta) (#\3 :meta) (#\4 :meta) + (#\5 :meta) (#\6 :meta) (#\7 :meta) (#\8 :meta) (#\9 :meta)) + :test #'event-matches-gesture-name-p)) + +(defun read-numeric-argument (&key (stream *standard-input*)) + (let ((gesture (read-gesture :stream stream))) + (cond ((event-matches-gesture-name-p gesture '(#\u :control)) + (let ((numarg 4)) + (loop for gesture = (read-gesture :stream stream) + while (event-matches-gesture-name-p gesture '(#\u :control)) + do (setf numarg (* 4 numarg)) + finally (unread-gesture gesture :stream stream)) + (let ((gesture (read-gesture :stream stream))) + (cond ((and (characterp gesture) + (digit-char-p gesture 10)) + (setf numarg (- (char-code gesture) (char-code #\0))) + (loop for gesture = (read-gesture :stream stream) + while (and (characterp gesture) + (digit-char-p gesture 10)) + do (setf gesture (+ (* 10 numarg) + (- (char-code gesture) (char-code #\0)))) + finally (unread-gesture gesture :stream stream) + (return (values numarg t)))) + (t + (values numarg t)))))) + ((meta-digit gesture) + (let ((numarg (meta-digit gesture))) + (loop for gesture = (read-gesture :stream stream) + while (meta-digit gesture) + do (setf numarg (+ (* 10 numarg) (meta-digit gesture))) + finally (unread-gesture gesture :stream stream) + (return (values numarg t))))) + (t (unread-gesture gesture :stream stream) + (values 1 nil))))) + (defun climacs-top-level (frame &key command-parser command-unparser partial-command-parser prompt) @@ -128,6 +165,7 @@ (*abort-gestures* nil)) (redisplay-frame-panes frame :force-p t) (loop with gestures = '() + with numarg = 1 ; FIXME (read-numeric-argument :stream *standard-input*) do (setf *current-gesture* (read-gesture :stream *standard-input*)) (when (or (characterp *current-gesture*) (and (typep *current-gesture* 'keyboard-event) @@ -145,12 +183,16 @@ (cond ((not item) (beep) (setf gestures '())) ((eq (command-menu-item-type item) :command) - (handler-case - (funcall (command-menu-item-value item)) - (error (condition) - (beep) - (format *error-output* "~a~%" condition))) - (setf gestures '())) + (let ((command (command-menu-item-value item))) + (unless (consp command) + (setf command (list command))) + (setf command (substitute-numeric-argument-marker command numarg)) + (handler-case + (execute-frame-command frame command) + (error (condition) + (beep) + (format *error-output* "~a~%" condition))) + (setf gestures '()))) (t nil)))) (let ((buffer (buffer (win frame)))) (when (modified-p buffer)

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by ejohnson＠common-lisp.net 30 Dec '04

30 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv6045 Modified Files: gui.lisp Log Message: Wrapped an (EVAL-WHEN (:compile-toplevel) ...) around COMPLETABLE-PATHNAME to rid us of an asdf style warning Date: Thu Dec 30 11:42:46 2004 Author: ejohnson Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.34 climacs/gui.lisp:1.35 --- climacs/gui.lisp:1.34 Thu Dec 30 06:37:34 2004 +++ climacs/gui.lisp Thu Dec 30 11:42:45 2004 @@ -220,8 +220,9 @@ (let ((item (accept 'command :prompt "Extended Command"))) (execute-frame-command *application-frame* item))) -(define-presentation-type completable-pathname () - :inherit-from 'pathname) +(eval-when (:compile-toplevel) + (define-presentation-type completable-pathname () + :inherit-from 'pathname)) (defun filename-completer (so-far mode) (flet ((remove-trail (s)

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by abridgewater＠common-lisp.net 30 Dec '04

30 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv23923 Modified Files: gui.lisp Log Message: Added DEFINE-NAMED-COMMAND and converted most commands to use it. Date: Thu Dec 30 06:37:34 2004 Author: abridgewater Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.33 climacs/gui.lisp:1.34 --- climacs/gui.lisp:1.33 Thu Dec 30 06:28:21 2004 +++ climacs/gui.lisp Thu Dec 30 06:37:34 2004 @@ -157,7 +157,10 @@ (setf (needs-saving buffer) t))) (redisplay-frame-panes frame)))) -(define-climacs-command (com-quit :name t) () +(defmacro define-named-command (command-name args &body body) + `(define-climacs-command ,(if (listp command-name) `(,@command-name :name t) `(,command-name :name t)) ,args ,@body)) + +(define-named-command (com-quit) () (frame-exit *application-frame*)) (define-command com-self-insert () @@ -165,49 +168,49 @@ (possibly-expand-abbrev (point (win *application-frame*)))) (insert-object (point (win *application-frame*)) *current-gesture*)) -(define-command com-backward-object () +(define-named-command com-backward-object () (decf (offset (point (win *application-frame*))))) -(define-command com-forward-object () +(define-named-command com-forward-object () (incf (offset (point (win *application-frame*))))) -(define-command com-beginning-of-line () +(define-named-command com-beginning-of-line () (beginning-of-line (point (win *application-frame*)))) -(define-command com-end-of-line () +(define-named-command com-end-of-line () (end-of-line (point (win *application-frame*)))) -(define-command com-delete-object () +(define-named-command com-delete-object () (delete-range (point (win *application-frame*)))) -(define-command com-backward-delete-object () +(define-named-command com-backward-delete-object () (delete-range (point (win *application-frame*)) -1)) -(define-command com-previous-line () +(define-named-command com-previous-line () (previous-line (point (win *application-frame*)))) -(define-command com-next-line () +(define-named-command com-next-line () (next-line (point (win *application-frame*)))) -(define-command com-open-line () +(define-named-command com-open-line () (open-line (point (win *application-frame*)))) -(define-command com-kill-line () +(define-named-command com-kill-line () (kill-line (point (win *application-frame*)))) -(define-command com-forward-word () +(define-named-command com-forward-word () (forward-word (point (win *application-frame*)))) -(define-command com-backward-word () +(define-named-command com-backward-word () (backward-word (point (win *application-frame*)))) -(define-command com-delete-word () +(define-named-command com-delete-word () (delete-word (point (win *application-frame*)))) -(define-command com-backward-delete-word () +(define-named-command com-backward-delete-word () (backward-delete-word (point (win *application-frame*)))) -(define-command com-toggle-layout () +(define-named-command com-toggle-layout () (setf (frame-current-layout *application-frame*) (if (eq (frame-current-layout *application-frame*) 'default) 'with-interactor @@ -296,7 +299,7 @@ (concatenate 'string (pathname-name pathname) "." (pathname-type pathname)))) -(define-climacs-command (com-find-file :name t) () +(define-named-command com-find-file () (let ((filename (accept 'completable-pathname :prompt "Find File"))) (with-slots (buffer point syntax) (win *application-frame*) @@ -313,7 +316,7 @@ (redisplay-frame-panes *application-frame*) (beginning-of-buffer point)))) -(define-command com-save-buffer () +(define-named-command com-save-buffer () (let* ((buffer (buffer (win *application-frame*))) (filename (or (filename buffer) (accept 'completable-pathname @@ -328,7 +331,7 @@ (display-message "No changes need to be saved from ~a" (name buffer))) (setf (needs-saving buffer) nil))) -(define-command com-write-buffer () +(define-named-command com-write-buffer () (let ((filename (accept 'completable-pathname :prompt "Write Buffer to File")) (buffer (buffer (win *application-frame*)))) @@ -339,24 +342,24 @@ (needs-saving buffer) nil) (display-message "Wrote: ~a" (filename buffer)))) -(define-command com-beginning-of-buffer () +(define-named-command com-beginning-of-buffer () (beginning-of-buffer (point (win *application-frame*)))) -(define-command com-end-of-buffer () +(define-named-command com-end-of-buffer () (end-of-buffer (point (win *application-frame*)))) -(define-command com-back-to-indentation () +(define-named-command com-back-to-indentation () (let ((point (point (win *application-frame*)))) (beginning-of-line point) (loop until (end-of-line-p point) while (whitespacep (object-after point)) do (incf (offset point))))) -(define-climacs-command (com-goto-position :name t) () +(define-named-command com-goto-position () (setf (offset (point (win *application-frame*))) (accept 'integer :prompt "Goto Position"))) -(define-climacs-command (com-goto-line :name t) () +(define-named-command com-goto-line () (loop with mark = (make-instance 'standard-right-sticky-mark :buffer (buffer (win *application-frame*))) do (end-of-line mark) @@ -368,10 +371,10 @@ (setf (offset (point (win *application-frame*))) (offset mark)))) -(define-climacs-command (com-browse-url :name t) () +(define-named-command com-browse-url () (accept 'url :prompt "Browse URL")) -(define-command com-set-mark () +(define-named-command com-set-mark () (with-slots (point mark) (win *application-frame*) (setf mark (clone-mark point)))) @@ -379,15 +382,15 @@ ;; Kill ring commands ;; Copies an element from a kill-ring to a buffer at the given offset -(define-command com-copy-in () +(define-named-command com-copy-in () (insert-sequence (point (win *application-frame*)) (kr-copy *kill-ring*))) ;; Cuts an element from a kill-ring out to a buffer at a given offset -(define-command com-cut-in () +(define-named-command com-cut-in () (insert-sequence (point (win *application-frame*)) (kr-pop *kill-ring*))) ;; Destructively cut a given buffer region into the kill-ring -(define-command com-cut-out () +(define-named-command com-cut-out () (with-slots (buffer point mark)(win *application-frame*) (if (< (offset point) (offset mark)) ((lambda (b o1 o2) @@ -401,7 +404,7 @@ ;; Non destructively copies in buffer region to the kill ring -(define-command com-copy-out () +(define-named-command com-copy-out () (with-slots (buffer point mark)(win *application-frame*) (let ((off1 (offset point)) (off2 (offset mark))) @@ -410,11 +413,11 @@ (kr-push *kill-ring* (buffer-sequence buffer off2 off1)))))) ;; Needs adjustment to be like emacs M-y -(define-command com-kr-rotate () +(define-named-command com-kr-rotate () (kr-rotate *kill-ring* -1)) ;; Not bound to a key yet -(define-command com-kr-resize () +(define-named-command com-kr-resize () (let ((size (accept 'fixnum :prompt "New kill ring size: "))) (kr-resize *kill-ring* size)))

1 0

[climacs-cvs] CVS update: climacs/base.lisp climacs/gui.lisp
by rstrandh＠common-lisp.net 30 Dec '04

30 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv23174 Modified Files: base.lisp gui.lisp Log Message: fixed some problems with word delete commands. Used define-climacs-command instead of :command-table climacs, and :name t when appropriate (as of now: always). Date: Thu Dec 30 06:28:23 2004 Author: rstrandh Index: climacs/base.lisp diff -u climacs/base.lisp:1.7 climacs/base.lisp:1.8 --- climacs/base.lisp:1.7 Wed Dec 29 17:03:21 2004 +++ climacs/base.lisp Thu Dec 30 06:28:21 2004 @@ -121,7 +121,7 @@ "Delete until the end of the word" (loop until (end-of-buffer-p mark) until (constituentp (object-after mark)) - do (incf (offset mark))) + do (delete-range mark)) (loop until (end-of-buffer-p mark) while (constituentp (object-after mark)) do (delete-range mark))) @@ -130,7 +130,7 @@ "Delete until the beginning of the word" (loop until (beginning-of-buffer-p mark) until (constituentp (object-before mark)) - do (decf (offset mark))) + do (delete-range mark -1)) (loop until (beginning-of-buffer-p mark) while (constituentp (object-before mark)) do (delete-range mark -1))) Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.32 climacs/gui.lisp:1.33 --- climacs/gui.lisp:1.32 Wed Dec 29 17:03:21 2004 +++ climacs/gui.lisp Thu Dec 30 06:28:21 2004 @@ -157,7 +157,7 @@ (setf (needs-saving buffer) t))) (redisplay-frame-panes frame)))) -(define-command (com-quit :name t :command-table climacs) () +(define-climacs-command (com-quit :name t) () (frame-exit *application-frame*)) (define-command com-self-insert () @@ -296,7 +296,7 @@ (concatenate 'string (pathname-name pathname) "." (pathname-type pathname)))) -(define-command (com-find-file :name t :command-table climacs) () +(define-climacs-command (com-find-file :name t) () (let ((filename (accept 'completable-pathname :prompt "Find File"))) (with-slots (buffer point syntax) (win *application-frame*) @@ -352,11 +352,11 @@ while (whitespacep (object-after point)) do (incf (offset point))))) -(define-command (com-goto-position :name t :command-table climacs) () +(define-climacs-command (com-goto-position :name t) () (setf (offset (point (win *application-frame*))) (accept 'integer :prompt "Goto Position"))) -(define-command (com-goto-line :name t :command-table climacs) () +(define-climacs-command (com-goto-line :name t) () (loop with mark = (make-instance 'standard-right-sticky-mark :buffer (buffer (win *application-frame*))) do (end-of-line mark) @@ -368,7 +368,7 @@ (setf (offset (point (win *application-frame*))) (offset mark)))) -(define-command com-browse-url () +(define-climacs-command (com-browse-url :name t) () (accept 'url :prompt "Browse URL")) (define-command com-set-mark ()

1 0

[climacs-cvs] CVS update: climacs/kill-ring.lisp
by ejohnson＠common-lisp.net 30 Dec '04

30 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv18458 Modified Files: kill-ring.lisp Log Message: Changed fixnum limit of kill ring to unsigned-byte Date: Thu Dec 30 04:55:14 2004 Author: ejohnson Index: climacs/kill-ring.lisp diff -u climacs/kill-ring.lisp:1.2 climacs/kill-ring.lisp:1.3 --- climacs/kill-ring.lisp:1.2 Wed Dec 29 08:06:46 2004 +++ climacs/kill-ring.lisp Thu Dec 30 04:55:14 2004 @@ -25,7 +25,7 @@ (in-package :climacs-kill-ring) (defclass kill-ring () - ((max-size :type 'fixnum + ((max-size :type unsigned-byte :initarg :max-size :accessor kr-max-size) (flexichain :type standard-flexichain

1 0

[climacs-cvs] CVS update: climacs/base.lisp climacs/gui.lisp climacs/packages.lisp
by rstrandh＠common-lisp.net 29 Dec '04

29 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv14833 Modified Files: base.lisp gui.lisp packages.lisp Log Message: New commands: M-m (back to indentation) M-d (delete word) M-backspace (backward delete word) M-x goto-position M-x goto-line New function whitespacep. Used `:name t' instead of repeating the command name in define-command. Date: Wed Dec 29 17:03:22 2004 Author: rstrandh Index: climacs/base.lisp diff -u climacs/base.lisp:1.6 climacs/base.lisp:1.7 --- climacs/base.lisp:1.6 Mon Dec 27 12:32:46 2004 +++ climacs/base.lisp Wed Dec 29 17:03:21 2004 @@ -93,6 +93,12 @@ #+sbcl (sb-impl::constituentp obj) #-sbcl (alphanumericp obj))) +(defun whitespacep (obj) + "A predicate to ensure that an object is a whitespace character." + (and (characterp obj) + #+sbcl (sb-impl::whitespacep obj) + #-sbcl (member obj '(#\Space #\Tab)))) + (defun forward-word (mark) "Forward the mark to the next word." (loop until (end-of-buffer-p mark) @@ -110,4 +116,22 @@ (loop until (beginning-of-buffer-p mark) while (constituentp (object-before mark)) do (decf (offset mark)))) + +(defun delete-word (mark) + "Delete until the end of the word" + (loop until (end-of-buffer-p mark) + until (constituentp (object-after mark)) + do (incf (offset mark))) + (loop until (end-of-buffer-p mark) + while (constituentp (object-after mark)) + do (delete-range mark))) + +(defun backward-delete-word (mark) + "Delete until the beginning of the word" + (loop until (beginning-of-buffer-p mark) + until (constituentp (object-before mark)) + do (decf (offset mark))) + (loop until (beginning-of-buffer-p mark) + while (constituentp (object-before mark)) + do (delete-range mark -1))) Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.31 climacs/gui.lisp:1.32 --- climacs/gui.lisp:1.31 Wed Dec 29 09:02:45 2004 +++ climacs/gui.lisp Wed Dec 29 17:03:21 2004 @@ -157,7 +157,7 @@ (setf (needs-saving buffer) t))) (redisplay-frame-panes frame)))) -(define-command (com-quit :name "Quit" :command-table climacs) () +(define-command (com-quit :name t :command-table climacs) () (frame-exit *application-frame*)) (define-command com-self-insert () @@ -201,6 +201,12 @@ (define-command com-backward-word () (backward-word (point (win *application-frame*)))) +(define-command com-delete-word () + (delete-word (point (win *application-frame*)))) + +(define-command com-backward-delete-word () + (backward-delete-word (point (win *application-frame*)))) + (define-command com-toggle-layout () (setf (frame-current-layout *application-frame*) (if (eq (frame-current-layout *application-frame*) 'default) @@ -290,7 +296,7 @@ (concatenate 'string (pathname-name pathname) "." (pathname-type pathname)))) -(define-command (com-find-file :name "Find File" :command-table climacs) () +(define-command (com-find-file :name t :command-table climacs) () (let ((filename (accept 'completable-pathname :prompt "Find File"))) (with-slots (buffer point syntax) (win *application-frame*) @@ -339,6 +345,29 @@ (define-command com-end-of-buffer () (end-of-buffer (point (win *application-frame*)))) +(define-command com-back-to-indentation () + (let ((point (point (win *application-frame*)))) + (beginning-of-line point) + (loop until (end-of-line-p point) + while (whitespacep (object-after point)) + do (incf (offset point))))) + +(define-command (com-goto-position :name t :command-table climacs) () + (setf (offset (point (win *application-frame*))) + (accept 'integer :prompt "Goto Position"))) + +(define-command (com-goto-line :name t :command-table climacs) () + (loop with mark = (make-instance 'standard-right-sticky-mark + :buffer (buffer (win *application-frame*))) + do (end-of-line mark) + until (end-of-buffer-p mark) + repeat (accept 'integer :prompt "Goto Line") + do (incf (offset mark)) + (end-of-line mark) + finally (beginning-of-line mark) + (setf (offset (point (win *application-frame*))) + (offset mark)))) + (define-command com-browse-url () (accept 'url :prompt "Browse URL")) @@ -424,6 +453,9 @@ (global-set-key '(#\< :shift :meta) 'com-beginning-of-buffer) (global-set-key '(#\> :shift :meta) 'com-end-of-buffer) (global-set-key '(#\u :meta) 'com-browse-url) +(global-set-key '(#\m :meta) 'com-back-to-indentation) +(global-set-key '(#\d :meta) 'com-delete-word) +(global-set-key '(#\Backspace :meta) 'com-backward-delete-word) (global-set-key '(:up) 'com-previous-line) (global-set-key '(:down) 'com-next-line) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.14 climacs/packages.lisp:1.15 --- climacs/packages.lisp:1.14 Wed Dec 29 08:06:46 2004 +++ climacs/packages.lisp Wed Dec 29 17:03:21 2004 @@ -45,8 +45,9 @@ (:export #:previous-line #:next-line #:open-line #:kill-line #:number-of-lines-in-region - #:constituentp + #:constituentp #:whitespacep #:forward-word #:backward-word + #:delete-word #:backward-delete-word #:input-from-stream #:output-to-stream)) (defpackage :climacs-abbrev

1 0

[climacs-cvs] CVS update: climacs/syntax.lisp
by rstrandh＠common-lisp.net 29 Dec '04

29 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv579 Modified Files: syntax.lisp Log Message: Fixed the invisible cursor problem. Still don't know why even positions are required, though. Date: Wed Dec 29 12:38:34 2004 Author: rstrandh Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.11 climacs/syntax.lisp:1.12 --- climacs/syntax.lisp:1.11 Tue Dec 28 23:41:14 2004 +++ climacs/syntax.lisp Wed Dec 29 12:38:34 2004 @@ -122,6 +122,11 @@ finally (output-word (terpri pane)) (incf scan)))))) +(defun round-up (x) + (cond ((zerop x) 2) + ((evenp x) x) + (t (1+ x)))) + (defmethod redisplay-with-syntax (pane (syntax basic-syntax)) (let* ((medium (sheet-medium pane)) (style (medium-text-style medium)) @@ -168,8 +173,9 @@ (draw-line* pane ;; cursors with odd x-positions were invisible ;; so we strip off the low bit to make them even. - (logand -2 cursor-x) (- cursor-y (* 0.2 height)) - (logand -2 cursor-x) (+ cursor-y (* 0.8 height)) + + (round-up cursor-x) (- cursor-y (* 0.2 height)) + (round-up cursor-x) (+ cursor-y (* 0.8 height)) :ink +red+))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by ejohnson＠common-lisp.net 29 Dec '04

29 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv22317 Modified Files: gui.lisp Log Message: factored out kr generic functions in gui.lisp for define-commands Date: Wed Dec 29 09:02:45 2004 Author: ejohnson Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.30 climacs/gui.lisp:1.31 --- climacs/gui.lisp:1.30 Wed Dec 29 08:26:02 2004 +++ climacs/gui.lisp Wed Dec 29 09:02:45 2004 @@ -349,56 +349,36 @@ ;;;;;;;;;;;;;;;;;;;; ;; Kill ring commands -;; The naming may sound odd here, but think of electronic wireing: -;; outputs to inputs and inputs to outputs. Copying into a buffer -;; first requires coping out of the kill ring. - -(defgeneric kr-copy-in (buffer kr offset1 offset2) - (:documentation "Non destructively copies in buffer region to the kill ring")) - -(defmethod kr-copy-in ((buffer standard-buffer) (kr kill-ring) offset1 offset2) - (kr-push kr (buffer-sequence buffer offset1 offset2))) - -(defgeneric kr-cut-in (buffer kr offset1 offset2) - (:documentation "Destructively cut a given buffer region into the kill-ring")) - -(defmethod kr-cut-in ((buffer standard-buffer) (kr kill-ring) offset1 offset2) - (kr-copy-in buffer kr offset1 offset2) - (climacs-buffer::delete-buffer-range buffer offset1 (- offset2 offset1))) - -(defgeneric kr-copy-out (mark kr) - (:documentation "Copies an element from a kill-ring to a buffer at the given offset")) - -(defmethod kr-copy-out ((mark standard-right-sticky-mark)(kr kill-ring)) - (insert-sequence mark (kr-copy kr))) - -(defgeneric kr-cut-out (mark kr) - (:documentation "Cuts an element from a kill-ring out to a buffer at a given offset")) - -(defmethod kr-cut-out ((mark standard-right-sticky-mark) (kr kill-ring)) - (insert-sequence mark (kr-pop kr))) - +;; Copies an element from a kill-ring to a buffer at the given offset (define-command com-copy-in () - (kr-copy-out (point (win *application-frame*)) *kill-ring*)) + (insert-sequence (point (win *application-frame*)) (kr-copy *kill-ring*))) +;; Cuts an element from a kill-ring out to a buffer at a given offset (define-command com-cut-in () - (kr-cut-out (point (win *application-frame*)) *kill-ring*)) + (insert-sequence (point (win *application-frame*)) (kr-pop *kill-ring*))) +;; Destructively cut a given buffer region into the kill-ring (define-command com-cut-out () (with-slots (buffer point mark)(win *application-frame*) - (let ((off1 (offset point)) - (off2 (offset mark))) - (if (< off1 off2) - (kr-cut-in buffer *kill-ring* off1 off2) - (kr-cut-in buffer *kill-ring* off2 off1))))) + (if (< (offset point) (offset mark)) + ((lambda (b o1 o2) + (kr-push *kill-ring* (buffer-sequence b o1 o2)) + (delete-buffer-range b o1 (- o2 o1))) + buffer (offset point) (offset mark)) + ((lambda (b o1 o2) + (kr-push *kill-ring* (buffer-sequence b o2 o1)) + (delete-buffer-range b o1 (- o2 o1))) + buffer (offset mark) (offset point))))) + +;; Non destructively copies in buffer region to the kill ring (define-command com-copy-out () (with-slots (buffer point mark)(win *application-frame*) (let ((off1 (offset point)) (off2 (offset mark))) (if (< off1 off2) - (kr-copy-in buffer *kill-ring* off1 off2) - (kr-copy-in buffer *kill-ring* off2 off1))))) + (kr-push *kill-ring* (buffer-sequence buffer off1 off2)) + (kr-push *kill-ring* (buffer-sequence buffer off2 off1)))))) ;; Needs adjustment to be like emacs M-y (define-command com-kr-rotate ()

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by rstrandh＠common-lisp.net 29 Dec '04

29 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv20099 Modified Files: gui.lisp Log Message: Implemented a suggestion from Lawrence Mitchell to avoid saving a buffer that has not need to be saved. Date: Wed Dec 29 08:26:02 2004 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.29 climacs/gui.lisp:1.30 --- climacs/gui.lisp:1.29 Wed Dec 29 08:06:46 2004 +++ climacs/gui.lisp Wed Dec 29 08:26:02 2004 @@ -88,6 +88,9 @@ (let ((frame (make-application-frame 'climacs))) (run-frame-top-level frame))) +(defun display-message (format-string &rest format-args) + (apply #'format *standard-input* format-string format-args)) + (defun display-info (frame pane) (let* ((win (win frame)) (buf (buffer win)) @@ -305,15 +308,19 @@ (beginning-of-buffer point)))) (define-command com-save-buffer () - (let ((filename (or (filename (buffer (win *application-frame*))) - (accept 'completable-pathname - :prompt "Save Buffer to File"))) - (buffer (buffer (win *application-frame*)))) - (with-open-file (stream filename :direction :output :if-exists :supersede) - (output-to-stream stream buffer 0 (size buffer))) - (setf (filename buffer) filename - (name buffer) (pathname-filename filename) - (needs-saving buffer) nil))) + (let* ((buffer (buffer (win *application-frame*))) + (filename (or (filename buffer) + (accept 'completable-pathname + :prompt "Save Buffer to File")))) + (if (or (null (filename buffer)) + (needs-saving buffer)) + (progn (with-open-file (stream filename :direction :output :if-exists :supersede) + (output-to-stream stream buffer 0 (size buffer))) + (setf (filename buffer) filename + (name buffer) (pathname-filename filename)) + (display-message "Wrote: ~a" (filename buffer))) + (display-message "No changes need to be saved from ~a" (name buffer))) + (setf (needs-saving buffer) nil))) (define-command com-write-buffer () (let ((filename (accept 'completable-pathname @@ -323,7 +330,8 @@ (output-to-stream stream buffer 0 (size buffer))) (setf (filename buffer) filename (name buffer) (pathname-filename filename) - (needs-saving buffer) nil))) + (needs-saving buffer) nil) + (display-message "Wrote: ~a" (filename buffer)))) (define-command com-beginning-of-buffer () (beginning-of-buffer (point (win *application-frame*))))

1 0

[climacs-cvs] CVS update: climacs/gui.lisp climacs/kill-ring.lisp climacs/packages.lisp
by ejohnson＠common-lisp.net 29 Dec '04

29 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv19301 Modified Files: gui.lisp kill-ring.lisp packages.lisp Log Message: Tiding up a kill ring warning and move buffer related material to gui.lisp Date: Wed Dec 29 08:06:46 2004 Author: ejohnson Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.28 climacs/gui.lisp:1.29 --- climacs/gui.lisp:1.28 Wed Dec 29 07:58:53 2004 +++ climacs/gui.lisp Wed Dec 29 08:06:46 2004 @@ -345,6 +345,31 @@ ;; outputs to inputs and inputs to outputs. Copying into a buffer ;; first requires coping out of the kill ring. +(defgeneric kr-copy-in (buffer kr offset1 offset2) + (:documentation "Non destructively copies in buffer region to the kill ring")) + +(defmethod kr-copy-in ((buffer standard-buffer) (kr kill-ring) offset1 offset2) + (kr-push kr (buffer-sequence buffer offset1 offset2))) + +(defgeneric kr-cut-in (buffer kr offset1 offset2) + (:documentation "Destructively cut a given buffer region into the kill-ring")) + +(defmethod kr-cut-in ((buffer standard-buffer) (kr kill-ring) offset1 offset2) + (kr-copy-in buffer kr offset1 offset2) + (climacs-buffer::delete-buffer-range buffer offset1 (- offset2 offset1))) + +(defgeneric kr-copy-out (mark kr) + (:documentation "Copies an element from a kill-ring to a buffer at the given offset")) + +(defmethod kr-copy-out ((mark standard-right-sticky-mark)(kr kill-ring)) + (insert-sequence mark (kr-copy kr))) + +(defgeneric kr-cut-out (mark kr) + (:documentation "Cuts an element from a kill-ring out to a buffer at a given offset")) + +(defmethod kr-cut-out ((mark standard-right-sticky-mark) (kr kill-ring)) + (insert-sequence mark (kr-pop kr))) + (define-command com-copy-in () (kr-copy-out (point (win *application-frame*)) *kill-ring*)) @@ -375,7 +400,6 @@ (define-command com-kr-resize () (let ((size (accept 'fixnum :prompt "New kill ring size: "))) (kr-resize *kill-ring* size))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Index: climacs/kill-ring.lisp diff -u climacs/kill-ring.lisp:1.1 climacs/kill-ring.lisp:1.2 --- climacs/kill-ring.lisp:1.1 Wed Dec 29 06:45:37 2004 +++ climacs/kill-ring.lisp Wed Dec 29 08:06:46 2004 @@ -39,23 +39,27 @@ :max-size size :flexichain (make-instance 'standard-flexichain))) -;; Didn't see a real reason to make gf's for these. -(defun kr-length (kr) - "Returns the length of a kill-rings flexichain" +(defgeneric kr-length (kr) + (:documentation "Returns the length of a kill-ring's flexichain")) + +(defmethod kr-length ((kr kill-ring)) (nb-elements (kr-flexi kr))) -(defun kr-resize (kr size) - "Resize a kill-ring to the value of size" - (kr-p kr) +(defgeneric kr-resize (kr size) + (:documentation "Resize a kill ring to the value of SIZE")) + +(defmethod kr-resize ((kr kill-ring) size) (setf (slot-value kr 'max-size) size) (let ((len (kr-length kr))) (if (> len size) (loop for n from 1 to (- len size) do (pop-end (kr-flexi kr)))))) -(defun kr-push (kr object) - "Push an object onto a kill-ring with size considerations" +(defgeneric kr-push (kr object) + (:documentation "Push an object onto a kill ring with size considerations")) + +(defmethod kr-push ((kr kill-ring) object) (let ((flexi (kr-flexi kr))) (if (>= (kr-length kr)(kr-max-size kr)) ((lambda (flex obj) @@ -64,37 +68,27 @@ flexi object) (push-start flexi object)))) -(defun kr-pop (kr) - "Pops an object off of a kill-ring" +(defgeneric kr-pop (kr) + (:documentation "Pops an object off of a kill ring")) + +(defmethod kr-pop ((kr kill-ring)) (if (> (nb-elements (kr-flexi kr)) 0) (pop-start (kr-flexi kr)) nil)) -(defun kr-rotate (kr &optional (n -1)) - "Rotates the kill-ring either once forward or an optional amount +/-" +(defgeneric kr-rotate (kr &optional n) + (:documentation "Rotates the kill ring either once forward or an optional amound +/-")) + +(defmethod kr-rotate ((kr kill-ring) &optional (n -1)) (assert (typep n 'fixnum)(n) "Can not rotate the kill ring ~S positions" n) (let ((flexi (kr-flexi kr))) (rotate flexi n))) -(defun kr-copy (kr) - "Copies out a member of a kill-ring without deleting it" +(defgeneric kr-copy (kr) + (:documentation "Copies out a member of a kill ring without deleting it")) + +(defmethod kr-copy ((kr kill-ring)) (let ((object (kr-pop kr))) (kr-push kr object) object)) -(defun kr-copy-in (buffer kr offset1 offset2) - "Non destructively copies in buffer region to the kill-ring" - (kr-push kr (buffer-sequence buffer offset1 offset2))) - -(defun kr-cut-in (buffer kr offset1 offset2) - "Destructively cuts a given buffer region into the kill-ring" - (kr-copy-in buffer kr offset1 offset2) - (climacs-buffer::delete-buffer-range buffer offset1 (- offset2 offset1))) - -(defun kr-copy-out (mark kr) - "Copies an element from a kill-ring to a buffer at the given offset" - (insert-sequence mark (kr-copy kr))) - -(defun kr-cut-out (mark kr) - "Cuts an element from a kill-ring out to a buffer at a given offset" - (insert-sequence mark (kr-pop kr))) \ No newline at end of file Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.13 climacs/packages.lisp:1.14 --- climacs/packages.lisp:1.13 Wed Dec 29 07:58:53 2004 +++ climacs/packages.lisp Wed Dec 29 08:06:46 2004 @@ -62,9 +62,9 @@ (defpackage :climacs-kill-ring (:use :clim-lisp :climacs-buffer :flexichain) - (:export #:initialize-kill-ring #:kr-length #:kr-resize - #:kr-rotate #:kr-copy-in #:kr-cut-in #:kr-copy-out - #:kr-cut-out)) + (:export #:initialize-kill-ring #:kr-length + #:kr-resize #:kr-rotate #:kill-ring + #:kr-copy #:kr-push #:kr-pop)) (defpackage :climacs-gui (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax :climacs-kill-ring))

1 0

[climacs-cvs] CVS update: climacs/Doc/climacs-internals.texi
by rstrandh＠common-lisp.net 29 Dec '04

29 Dec '04

Update of /project/climacs/cvsroot/climacs/Doc In directory common-lisp.net:/tmp/cvs-serv18511/Doc Modified Files: climacs-internals.texi Log Message: Modified the buffer protocol to contain a modification flag, and implemented the modification. Updated the documentation. Added a flag to the climacs-buffer indicating whether the buffer needs saving. This is different from the modification flag, which is only valid during one iteration of the command loop. The needs-saving flag checks the modification flag, though, after each command execution. Date: Wed Dec 29 07:58:57 2004 Author: rstrandh Index: climacs/Doc/climacs-internals.texi diff -u climacs/Doc/climacs-internals.texi:1.4 climacs/Doc/climacs-internals.texi:1.5 --- climacs/Doc/climacs-internals.texi:1.4 Sun Dec 26 07:14:51 2004 +++ climacs/Doc/climacs-internals.texi Wed Dec 29 07:58:55 2004 @@ -432,10 +432,20 @@ update information about syntax highlighting and other cached information. -@deffn {Generic Function} {reset-low-high-marks} buffer +In addition to these marks, the buffer maintains a modification flag +that determines. Whether the buffer has been modified since the last +call to clear-modify. + +@deffn {Generic Function} {modified-p} buffer + +Return true if and only if the buffer has beeen modified. +@end deffn + +@deffn {Generic Function} {clear-modify} buffer Set the high-mark to the beginning of the beginning of the buffer and -the low-mark to the end of the buffer. +the low-mark to the end of the buffer, and clear the modification +flag. @end deffn This function is used by the redisplay module after all of the panes

1 0

[climacs-cvs] CVS update: climacs/buffer.lisp climacs/gui.lisp climacs/packages.lisp
by rstrandh＠common-lisp.net 29 Dec '04

29 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv18511 Modified Files: buffer.lisp gui.lisp packages.lisp Log Message: Modified the buffer protocol to contain a modification flag, and implemented the modification. Updated the documentation. Added a flag to the climacs-buffer indicating whether the buffer needs saving. This is different from the modification flag, which is only valid during one iteration of the command loop. The needs-saving flag checks the modification flag, though, after each command execution. Date: Wed Dec 29 07:58:53 2004 Author: rstrandh Index: climacs/buffer.lisp diff -u climacs/buffer.lisp:1.12 climacs/buffer.lisp:1.13 --- climacs/buffer.lisp:1.12 Tue Dec 28 07:58:36 2004 +++ climacs/buffer.lisp Wed Dec 29 07:58:53 2004 @@ -38,10 +38,13 @@ (defgeneric high-mark (buffer)) +(defgeneric modified-p (buffer)) + (defclass standard-buffer (buffer) ((contents :initform (make-instance 'standard-cursorchain)) (low-mark :reader low-mark) - (high-mark :reader high-mark)) + (high-mark :reader high-mark) + (modified :initform nil :reader modified-p)) (:documentation "The Climacs standard buffer [an instantable subclass of buffer].")) (defgeneric buffer (mark) @@ -463,23 +466,27 @@ (setf (offset (low-mark buffer)) (min (offset (low-mark buffer)) offset)) (setf (offset (high-mark buffer)) - (max (offset (high-mark buffer)) offset))) + (max (offset (high-mark buffer)) offset)) + (setf (slot-value buffer 'modified) t)) (defmethod insert-buffer-sequence :before ((buffer standard-buffer) offset sequence) (declare (ignore sequence)) (setf (offset (low-mark buffer)) (min (offset (low-mark buffer)) offset)) (setf (offset (high-mark buffer)) - (max (offset (high-mark buffer)) offset))) + (max (offset (high-mark buffer)) offset)) + (setf (slot-value buffer 'modified) t)) (defmethod delete-buffer-range :before ((buffer standard-buffer) offset n) (setf (offset (low-mark buffer)) (min (offset (low-mark buffer)) offset)) (setf (offset (high-mark buffer)) - (max (offset (high-mark buffer)) (+ offset n)))) + (max (offset (high-mark buffer)) (+ offset n))) +(setf (slot-value buffer 'modified) t)) -(defgeneric reset-low-high-marks (buffer)) +(defgeneric clear-modify (buffer)) -(defmethod reset-low-high-marks ((buffer standard-buffer)) +(defmethod clear-modify ((buffer standard-buffer)) (beginning-of-buffer (high-mark buffer)) - (end-of-buffer (low-mark buffer))) + (end-of-buffer (low-mark buffer)) + (setf (slot-value buffer 'modified) nil)) Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.27 climacs/gui.lisp:1.28 --- climacs/gui.lisp:1.27 Wed Dec 29 06:55:26 2004 +++ climacs/gui.lisp Wed Dec 29 07:58:53 2004 @@ -29,7 +29,7 @@ (defclass climacs-buffer (standard-buffer abbrev-mixin filename-mixin) ((name :initform "*scratch*" :accessor name) - (modified :initform nil :accessor modified-p))) + (needs-saving :initform nil :accessor needs-saving))) (defclass climacs-pane (application-pane) ((buffer :initform (make-instance 'climacs-buffer) :accessor buffer) @@ -48,6 +48,12 @@ :buffer buffer))) (setf syntax (make-instance 'texinfo-syntax :pane pane)))) +(defclass minibuffer-pane (application-pane) ()) + +(defmethod stream-accept :before ((pane minibuffer-pane) type &rest args) + (declare (ignore type args)) + (window-clear pane)) + (define-application-frame climacs () ((win :reader win)) (:panes @@ -57,13 +63,14 @@ :incremental-redisplay t :display-function 'display-win)) (info :application - :width 900 :height 20 :max-height 20 - :name 'info :background +light-gray+ - :scroll-bars nil - :incremental-redisplay t - :display-function 'display-info) - (int :application :width 900 :height 20 :max-height 20 - :scroll-bars nil)) + :width 900 :height 20 :max-height 20 + :name 'info :background +light-gray+ + :scroll-bars nil + :incremental-redisplay t + :display-function 'display-info) + (int (make-pane 'minibuffer-pane + :width 900 :height 20 :max-height 20 :min-height 20 + :scroll-bars nil))) (:layouts (default (vertically (:scroll-bars nil) @@ -72,6 +79,10 @@ int))) (:top-level (climacs-top-level))) +(defmethod redisplay-frame-panes :after ((frame climacs) &rest args) + (declare (ignore args)) + (clear-modify (buffer (win frame)))) + (defun climacs () "Starts up a climacs session" (let ((frame (make-application-frame 'climacs))) @@ -81,7 +92,7 @@ (let* ((win (win frame)) (buf (buffer win)) (name-info (format nil " ~a ~a" - (if (modified-p buf) "**" "--") + (if (needs-saving buf) "**" "--") (name buf)))) (princ name-info pane))) @@ -108,8 +119,6 @@ partial-command-parser prompt) (declare (ignore command-parser command-unparser partial-command-parser prompt)) (setf (slot-value frame 'win) (find-pane-named frame 'win)) -;; (let ((*standard-output* (frame-standard-output frame)) -;; (*standard-input* (frame-standard-input frame)) (let ((*standard-output* (find-pane-named frame 'win)) (*standard-input* (find-pane-named frame 'int)) (*print-pretty* nil) @@ -140,6 +149,9 @@ (format *error-output* "~a~%" condition))) (setf gestures '())) (t nil)))) + (let ((buffer (buffer (win frame)))) + (when (modified-p buffer) + (setf (needs-saving buffer) t))) (redisplay-frame-panes frame)))) (define-command (com-quit :name "Quit" :command-table climacs) () @@ -148,8 +160,7 @@ (define-command com-self-insert () (unless (constituentp *current-gesture*) (possibly-expand-abbrev (point (win *application-frame*)))) - (insert-object (point (win *application-frame*)) *current-gesture*) - (setf (modified-p (buffer (win *application-frame*))) t)) + (insert-object (point (win *application-frame*)) *current-gesture*)) (define-command com-backward-object () (decf (offset (point (win *application-frame*))))) @@ -164,12 +175,10 @@ (end-of-line (point (win *application-frame*)))) (define-command com-delete-object () - (delete-range (point (win *application-frame*))) - (setf (modified-p (buffer (win *application-frame*))) t)) + (delete-range (point (win *application-frame*)))) (define-command com-backward-delete-object () - (delete-range (point (win *application-frame*)) -1) - (setf (modified-p (buffer (win *application-frame*))) t)) + (delete-range (point (win *application-frame*)) -1)) (define-command com-previous-line () (previous-line (point (win *application-frame*)))) @@ -178,12 +187,10 @@ (next-line (point (win *application-frame*)))) (define-command com-open-line () - (open-line (point (win *application-frame*))) - (setf (modified-p (buffer (win *application-frame*))) t)) + (open-line (point (win *application-frame*)))) (define-command com-kill-line () - (kill-line (point (win *application-frame*))) - (setf (modified-p (buffer (win *application-frame*))) t)) + (kill-line (point (win *application-frame*)))) (define-command com-forward-word () (forward-word (point (win *application-frame*)))) @@ -199,21 +206,8 @@ (define-command com-extended-command () (let ((item (accept 'command :prompt "Extended Command"))) - (window-clear *standard-input*) (execute-frame-command *application-frame* item))) -(defclass weird () () - (:documentation "An open ended class.")) - -(define-command com-insert-weird-stuff () - (insert-object (point (win *application-frame*)) (make-instance 'weird)) - (setf (modified-p (buffer (win *application-frame*))) t)) - -(define-command com-insert-reversed-string () - (insert-sequence (point (win *application-frame*)) - (reverse (accept 'string))) - (setf (modified-p (buffer (win *application-frame*))) t)) - (define-presentation-type completable-pathname () :inherit-from 'pathname) @@ -303,7 +297,11 @@ (with-open-file (stream filename :direction :input :if-does-not-exist :create) (input-from-stream stream buffer 0)) (setf (filename buffer) filename - (name buffer) (pathname-filename filename)) + (name buffer) (pathname-filename filename) + (needs-saving buffer) nil) + ;; this one is needed so that the buffer modification protocol + ;; resets the low and high marks after redisplay + (redisplay-frame-panes *application-frame*) (beginning-of-buffer point)))) (define-command com-save-buffer () @@ -314,8 +312,8 @@ (with-open-file (stream filename :direction :output :if-exists :supersede) (output-to-stream stream buffer 0 (size buffer))) (setf (filename buffer) filename - (name buffer) (pathname-filename filename)) - (setf (modified-p (buffer (win *application-frame*))) nil))) + (name buffer) (pathname-filename filename) + (needs-saving buffer) nil))) (define-command com-write-buffer () (let ((filename (accept 'completable-pathname @@ -324,8 +322,8 @@ (with-open-file (stream filename :direction :output :if-exists :supersede) (output-to-stream stream buffer 0 (size buffer))) (setf (filename buffer) filename - (name buffer) (pathname-filename filename)) - (setf (modified-p (buffer (win *application-frame*))) nil))) + (name buffer) (pathname-filename filename) + (needs-saving buffer) nil))) (define-command com-beginning-of-buffer () (beginning-of-buffer (point (win *application-frame*)))) @@ -409,8 +407,6 @@ (global-set-key '(#\f :meta) 'com-forward-word) (global-set-key '(#\b :meta) 'com-backward-word) (global-set-key '(#\x :meta) 'com-extended-command) -(global-set-key '(#\a :meta) 'com-insert-weird-stuff) -(global-set-key '(#\c :meta) 'com-insert-reversed-string) (global-set-key '(#\y :meta) 'com-kr-rotate) ;currently rotates only (global-set-key '(#\w :meta) 'com-copy-out) (global-set-key '(#\< :shift :meta) 'com-beginning-of-buffer) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.12 climacs/packages.lisp:1.13 --- climacs/packages.lisp:1.12 Wed Dec 29 06:45:37 2004 +++ climacs/packages.lisp Wed Dec 29 07:58:53 2004 @@ -38,7 +38,7 @@ #:delete-region #:buffer-object #:buffer-sequence #:object-before #:object-after #:region-to-sequence - #:low-mark #:high-mark #:reset-low-high-marks)) + #:low-mark #:high-mark #:modified-p #:clear-modify)) (defpackage :climacs-base (:use :clim-lisp :climacs-buffer)

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by ejohnson＠common-lisp.net 29 Dec '04

29 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv15566 Modified Files: gui.lisp Log Message: An error on my part. Sorry about that. Date: Wed Dec 29 06:55:27 2004 Author: ejohnson Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.26 climacs/gui.lisp:1.27 --- climacs/gui.lisp:1.26 Wed Dec 29 06:49:04 2004 +++ climacs/gui.lisp Wed Dec 29 06:55:26 2004 @@ -1,1893 +1,450 @@ -; SLIME 2004-12-13 -CL-USER> (load "cvs-dir/mcclim/system") -; in: LAMBDA NIL -; (OR "Lisp-Dep/mp-nil") -; ==> -; "Lisp-Dep/mp-nil" -; -; note: deleting unreachable code -; compilation unit finished -; printed 1 note -T -CL-USER> (require 'clim-clx-user) -; loading system definition from #P"/usr/local/lib/sbcl/site-systems/clx.asd" -; into #<PACKAGE "ASDF4627"> -; registering #<SYSTEM CLX {9811989}> as CLX -; in: LAMBDA (#:G5429 #:G5430 #:G5431 #:G5432 #:G5437 #:G5438) -; (EQL SB-PCL::.CASE-ARG. #:G5429) -; -; note: unable to -; optimize -; due to type uncertainty: -; The first argument is a T, not a SINGLE-FLOAT. -; The second argument is a T, not a SINGLE-FLOAT. -; -; note: unable to -; optimize -; due to type uncertainty: -; The first argument is a T, not a DOUBLE-FLOAT. -; The second argument is a T, not a DOUBLE-FLOAT. -; -; note: forced to do GENERIC-EQL (cost 10) -; unable to do inline fixnum comparison (cost 4) because: -; The first argument is a T, not a FIXNUM. -; The second argument is a T, not a FIXNUM. -; in: -; LAMBDA (#:G5443 #:G5444 -; #:G5445 -; #:G5446 -; #:G5447 -; #:G5448 -; #:G5449 -; #:G5454 -; #:G5455) -; (EQL SB-PCL::.CASE-ARG. #:G5443) -; -; note: unable to -; optimize -; due to type uncertainty: -; The first argument is a T, not a SINGLE-FLOAT. -; The second argument is a T, not a SINGLE-FLOAT. -; -; note: unable to -; optimize -; due to type uncertainty: -; The first argument is a T, not a DOUBLE-FLOAT. -; The second argument is a T, not a DOUBLE-FLOAT. - -; (EQL SB-PCL::.CASE-ARG. #:G5446) -; -; note: unable to -; optimize -; due to type uncertainty: -; The first argument is a T, not a SINGLE-FLOAT. -; The second argument is a T, not a SINGLE-FLOAT. -; -; note: unable to -; optimize -; due to type uncertainty: -; The first argument is a T, not a DOUBLE-FLOAT. -; The second argument is a T, not a DOUBLE-FLOAT. - -; (EQL SB-PCL::.CASE-ARG. #:G5443) -; -; note: forced to do GENERIC-EQL (cost 10) -; unable to do inline fixnum comparison (cost 4) because: -; The first argument is a T, not a FIXNUM. -; The second argument is a T, not a FIXNUM. - -; (EQL SB-PCL::.CASE-ARG. #:G5446) -; -; note: forced to do GENERIC-EQL (cost 10) -; unable to do inline fixnum comparison (cost 4) because: -; The first argument is a T, not a FIXNUM. -; The second argument is a T, not a FIXNUM. -; compilation unit finished -; printed 9 notes -NIL -CL-USER> (load "cvs-dir/climacs/climacs.asd") -T -CL-USER> (require 'climacs) -; compiling file "/home/ejohnson/cvs-dir/climacs/Flexichain/skiplist-package.lisp" (written 16 AUG 2004 01:12:45 AM): -; compiling top level form: - -; /home/ejohnson/cvs-dir/climacs/Flexichain/skiplist-package.fasl written -; compilation finished in 0:00:00 -; compiling file "/home/ejohnson/cvs-dir/climacs/Flexichain/skiplist.lisp" (written 16 AUG 2004 01:12:45 AM): -; compiling top level form: -; compiling DEFCLASS SKIPLIST: -; compiling DEFCLASS SKIPLIST: -; compiling DEFCLASS SKIPLIST: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD INITIALIZE-INSTANCE :AFTER (SKIPLIST): -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD PRINT-OBJECT (SKIPLIST T): -; compiling top level form: -; recognizing DEFUN ENTRY-OBJ -; compiling DEFUN ENTRY-OBJ: -; compiling top level form: -; recognizing DEFUN (SETF ENTRY-OBJ) -; compiling DEFUN (SETF ENTRY-OBJ): -; compiling top level form: -; recognizing DEFUN ENTRY-KEY -; compiling DEFUN ENTRY-KEY: -; compiling top level form: -; recognizing DEFUN (SETF ENTRY-KEY) -; compiling DEFUN (SETF ENTRY-KEY): -; compiling top level form: -; recognizing DEFUN ENTRY-NEXT -; compiling DEFUN ENTRY-NEXT: -; compiling top level form: -; recognizing DEFUN (SETF ENTRY-NEXT) -; compiling DEFUN (SETF ENTRY-NEXT): -; compiling top level form: -; recognizing DEFUN KEY-< -; compiling DEFUN KEY-<: -; compiling top level form: -; recognizing DEFUN KEY-<= -; compiling DEFUN KEY-<=: -; compiling top level form: -; recognizing DEFUN KEY-= -; compiling DEFUN KEY-=: -; compiling top level form: -; recognizing DEFUN KEY-> -; compiling DEFUN KEY->: -; compiling top level form: -; recognizing DEFUN KEY->= -; compiling DEFUN KEY->=: -; compiling top level form: -; recognizing DEFUN LAST-ENTRY-P -; compiling DEFUN LAST-ENTRY-P: -; compiling top level form: -; recognizing DEFUN SKIPLIST-EMPTY-P -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN SKIPLIST-EMPTY-P: -; compiling top level form: -; recognizing DEFUN FIND-ENTRY-LEVEL -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN FIND-ENTRY-LEVEL: -; compiling top level form: -; recognizing DEFUN SKIPLIST-FIND -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN SKIPLIST-FIND: -; compiling top level form: -; recognizing DEFUN SKIPLIST-FIND-FIRST -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN SKIPLIST-FIND-FIRST: -; compiling top level form: -; recognizing DEFUN PICK-A-LEVEL -; compiling DEFUN PICK-A-LEVEL: -; compiling top level form: -; recognizing DEFUN MAKE-ENTRY -; compiling DEFUN MAKE-ENTRY: -; compiling top level form: -; recognizing DEFUN (SETF SKIPLIST-FIND) -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN (SETF SKIPLIST-FIND): -; compiling top level form: -; recognizing DEFUN SKIPLIST-DELETE -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN SKIPLIST-DELETE: -; compiling top level form: -; recognizing DEFUN UPDATE-INTERVAL -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN UPDATE-INTERVAL: -; compiling top level form: -; recognizing DEFUN SKIPLIST-SLIDE-KEYS -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN SKIPLIST-SLIDE-KEYS: -; compiling top level form: -; recognizing DEFUN SKIPLIST-ROTATE-PREFIX -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN SKIPLIST-ROTATE-PREFIX: -; compiling top level form: -; recognizing DEFUN UPDATE-INTERVAL-TO-END -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN UPDATE-INTERVAL-TO-END: -; compiling top level form: -; recognizing DEFUN SKIPLIST-ROTATE-SUFFIX -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN SKIPLIST-ROTATE-SUFFIX: -; compiling top level form: - -; /home/ejohnson/cvs-dir/climacs/Flexichain/skiplist.fasl written -; compilation finished in 0:00:02 -; compiling file "/home/ejohnson/cvs-dir/climacs/Flexichain/flexichain-package.lisp" (written 27 DEC 2004 10:57:00 PM): -; compiling top level form: - -; /home/ejohnson/cvs-dir/climacs/Flexichain/flexichain-package.fasl written -; compilation finished in 0:00:00 -; compiling file "/home/ejohnson/cvs-dir/climacs/Flexichain/utilities.lisp" (written 01 AUG 2004 08:27:19 AM): -; compiling top level form: -; recognizing DEFUN SQUARE -; compiling DEFUN SQUARE: -; compiling top level form: -; recognizing DEFUN FIND-IF-2 -; compiling DEFUN FIND-IF-2: -; compiling top level form: -; recognizing DEFUN MAKE-WEAK-POINTER -; compiling DEFUN MAKE-WEAK-POINTER: -; compiling top level form: -; recognizing DEFUN WEAK-POINTER-VALUE -; compiling DEFUN WEAK-POINTER-VALUE: -; compiling top level form: - -; /home/ejohnson/cvs-dir/climacs/Flexichain/utilities.fasl written -; compilation finished in 0:00:00 -; compiling file "/home/ejohnson/cvs-dir/climacs/Flexichain/flexichain.lisp" (written 27 DEC 2004 10:57:00 PM): -; compiling top level form: -; compiling DEFCLASS FLEXICHAIN: -; compiling DEFCLASS FLEXICHAIN: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD INITIALIZE-INSTANCE :AFTER (FLEXICHAIN): -; compiling top level form: -; compiling top level form: -; compiling DEFINE-CONDITION FLEXI-INITIALIZATION-ERROR: -; compiling top level form: -; compiling DEFINE-CONDITION FLEXI-POSITION-ERROR: -; compiling top level form: -; compiling DEFINE-CONDITION FLEXI-INCOMPATIBLE-TYPE-ERROR: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN REQUIRED-SPACE -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN REQUIRED-SPACE: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD INITIALIZE-INSTANCE :AFTER (STANDARD-FLEXICHAIN): -; compiling top level form: -; compiling DEFMACRO WITH-VIRTUAL-GAP: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD NB-ELEMENTS (STANDARD-FLEXICHAIN): -; compiling top level form: -; compiling DEFMETHOD FLEXI-EMPTY-P (STANDARD-FLEXICHAIN): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN POSITION-INDEX -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN POSITION-INDEX: -; compiling top level form: -; recognizing DEFUN INDEX-POSITION -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN INDEX-POSITION: -; compiling top level form: -; recognizing DEFUN ENSURE-GAP-POSITION -; compiling DEFUN ENSURE-GAP-POSITION: -; compiling top level form: -; recognizing DEFUN ENSURE-ROOM -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN ENSURE-ROOM: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD INSERT* (STANDARD-FLEXICHAIN T T): -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD INSERT-VECTOR* (STANDARD-FLEXICHAIN T T): -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD DELETE* (STANDARD-FLEXICHAIN T): -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD ELEMENT* (STANDARD-FLEXICHAIN T): -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD (SETF ELEMENT*) (T STANDARD-FLEXICHAIN T): -; compiling top level form: -; compiling DEFMETHOD PUSH-START (STANDARD-FLEXICHAIN T): -; compiling top level form: -; compiling DEFMETHOD PUSH-END (STANDARD-FLEXICHAIN T): -; compiling top level form: -; compiling DEFMETHOD POP-START (STANDARD-FLEXICHAIN): -; compiling top level form: -; compiling DEFMETHOD POP-END (STANDARD-FLEXICHAIN): -; compiling top level form: -; compiling DEFMETHOD ROTATE (STANDARD-FLEXICHAIN): -; compiling top level form: -; recognizing DEFUN MOVE-GAP -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN MOVE-GAP: -; compiling top level form: -; recognizing DEFUN MOVE-EMPTY-GAP -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN MOVE-EMPTY-GAP: -; compiling top level form: -; recognizing DEFUN MOVE-LEFT-GAP -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN MOVE-LEFT-GAP: -; compiling top level form: -; recognizing DEFUN MOVE-RIGHT-GAP -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN MOVE-RIGHT-GAP: -; compiling top level form: -; recognizing DEFUN MOVE-MIDDLE-GAP -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN MOVE-MIDDLE-GAP: -; compiling top level form: -; recognizing DEFUN MOVE-NON-CONTIGUOUS-GAP -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN MOVE-NON-CONTIGUOUS-GAP: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD MOVE-ELEMENTS (STANDARD-FLEXICHAIN T T T T T): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD FILL-GAP (STANDARD-FLEXICHAIN T T): -; compiling top level form: -; recognizing DEFUN PUSH-ELEMENTS-LEFT -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN PUSH-ELEMENTS-LEFT: -; compiling top level form: -; recognizing DEFUN PUSH-ELEMENTS-RIGHT -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN PUSH-ELEMENTS-RIGHT: -; compiling top level form: -; recognizing DEFUN HOP-ELEMENTS-LEFT -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN HOP-ELEMENTS-LEFT: -; compiling top level form: -; recognizing DEFUN HOP-ELEMENTS-RIGHT -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN HOP-ELEMENTS-RIGHT: -; compiling top level form: -; recognizing DEFUN INCREASE-BUFFER-SIZE -; compiling DEFUN INCREASE-BUFFER-SIZE: -; compiling top level form: -; recognizing DEFUN DECREASE-BUFFER-SIZE -; compiling DEFUN DECREASE-BUFFER-SIZE: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD RESIZE-BUFFER (STANDARD-FLEXICHAIN T): -; compiling top level form: -; recognizing DEFUN NORMALIZE-INDICES -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN NORMALIZE-INDICES: -; compiling top level form: -; recognizing DEFUN GAP-LOCATION -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN GAP-LOCATION: -; compiling top level form: - -; /home/ejohnson/cvs-dir/climacs/Flexichain/flexichain.fasl written -; compilation finished in 0:00:04 -; compiling file "/home/ejohnson/cvs-dir/climacs/Flexichain/flexicursor.lisp" (written 06 SEP 2004 04:25:52 AM): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFINE-CONDITION AT-BEGINNING-ERROR: -; compiling top level form: -; compiling DEFINE-CONDITION AT-END-ERROR: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling DEFCLASS STANDARD-CURSORCHAIN: -; compiling top level form: -; recognizing DEFUN MAKE-WP -; compiling DEFUN MAKE-WP: -; compiling top level form: -; recognizing DEFUN WP-VALUE -; compiling DEFUN WP-VALUE: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD MOVE-ELEMENTS :AFTER (STANDARD-CURSORCHAIN T T T T T): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD INITIALIZE-INSTANCE :AFTER (LEFT-STICKY-FLEXICURSOR): -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD INITIALIZE-INSTANCE :AFTER (RIGHT-STICKY-FLEXICURSOR): -; compiling top level form: -; compiling DEFMETHOD CLONE-CURSOR (STANDARD-FLEXICURSOR): -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD CURSOR-POS (LEFT-STICKY-FLEXICURSOR): -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD (SETF CURSOR-POS) (T LEFT-STICKY-FLEXICURSOR): -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD CURSOR-POS (RIGHT-STICKY-FLEXICURSOR): -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD (SETF CURSOR-POS) (T RIGHT-STICKY-FLEXICURSOR): -; compiling top level form: -; compiling DEFMETHOD AT-BEGINNING-P (STANDARD-FLEXICURSOR): -; compiling top level form: -; compiling DEFMETHOD AT-END-P (STANDARD-FLEXICURSOR): -; compiling top level form: -; compiling DEFMETHOD INSERT (STANDARD-FLEXICURSOR T): -; compiling top level form: -; compiling DEFMETHOD INSERT-SEQUENCE (STANDARD-FLEXICURSOR T): -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD DELETE* :BEFORE (STANDARD-CURSORCHAIN T): -; compiling top level form: -; compiling DEFMETHOD DELETE> (STANDARD-FLEXICURSOR): -; compiling top level form: -; compiling DEFMETHOD DELETE< (STANDARD-FLEXICURSOR): -; compiling top level form: -; compiling DEFMETHOD ELEMENT> (STANDARD-FLEXICURSOR): -; compiling top level form: -; compiling DEFMETHOD (SETF ELEMENT>) (T STANDARD-FLEXICURSOR): -; compiling top level form: -; compiling DEFMETHOD ELEMENT< (STANDARD-FLEXICURSOR): -; compiling top level form: -; compiling DEFMETHOD (SETF ELEMENT<) (T STANDARD-FLEXICURSOR): -; compiling top level form: - -; /home/ejohnson/cvs-dir/climacs/Flexichain/flexicursor.fasl written -; compilation finished in 0:00:02 -; compiling file "/home/ejohnson/cvs-dir/climacs/packages.lisp" (written 28 DEC 2004 09:38:37 PM): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: - -; /home/ejohnson/cvs-dir/climacs/packages.fasl written -; compilation finished in 0:00:00 -; compiling file "/home/ejohnson/cvs-dir/climacs/buffer.lisp" (written 27 DEC 2004 10:58:36 PM): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling DEFCLASS STANDARD-BUFFER: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD OFFSET (T): -; compiling top level form: -; compiling DEFMETHOD (SETF OFFSET) (T T): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling DEFMETHOD INITIALIZE-INSTANCE :AFTER (LEFT-STICKY-MARK): -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling DEFMETHOD INITIALIZE-INSTANCE :AFTER (RIGHT-STICKY-MARK): -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling DEFMETHOD INITIALIZE-INSTANCE :AFTER (STANDARD-BUFFER): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD CLONE-MARK (STANDARD-LEFT-STICKY-MARK): -; compiling top level form: -; compiling DEFMETHOD CLONE-MARK (STANDARD-RIGHT-STICKY-MARK): -; compiling top level form: -; compiling DEFINE-CONDITION NO-SUCH-OFFSET: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD SIZE (STANDARD-BUFFER): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD NUMBER-OF-LINES (STANDARD-BUFFER): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD MARK< (MARK-MIXIN MARK-MIXIN): -; compiling top level form: -; compiling DEFMETHOD MARK< (MARK-MIXIN INTEGER): -; compiling top level form: -; compiling DEFMETHOD MARK< (INTEGER MARK-MIXIN): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD MARK<= (MARK-MIXIN MARK-MIXIN): -; compiling top level form: -; compiling DEFMETHOD MARK<= (MARK-MIXIN INTEGER): -; compiling top level form: -; compiling DEFMETHOD MARK<= (INTEGER MARK-MIXIN): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD MARK= (MARK-MIXIN MARK-MIXIN): -; compiling top level form: -; compiling DEFMETHOD MARK= (MARK-MIXIN INTEGER): -; compiling top level form: -; compiling DEFMETHOD MARK= (INTEGER MARK-MIXIN): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD MARK> (MARK-MIXIN MARK-MIXIN): -; compiling top level form: -; compiling DEFMETHOD MARK> (MARK-MIXIN INTEGER): -; compiling top level form: -; compiling DEFMETHOD MARK> (INTEGER MARK-MIXIN): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD MARK>= (MARK-MIXIN MARK-MIXIN): -; compiling top level form: -; compiling DEFMETHOD MARK>= (MARK-MIXIN INTEGER): -; compiling top level form: -; compiling DEFMETHOD MARK>= (INTEGER MARK-MIXIN): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD BEGINNING-OF-BUFFER (MARK-MIXIN): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD END-OF-BUFFER (MARK-MIXIN): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD BEGINNING-OF-BUFFER-P (MARK-MIXIN): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD END-OF-BUFFER-P (MARK-MIXIN): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD BEGINNING-OF-LINE-P (MARK-MIXIN): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD END-OF-LINE-P (MARK-MIXIN): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD BEGINNING-OF-LINE (MARK-MIXIN): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD END-OF-LINE (MARK-MIXIN): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD LINE-NUMBER (MARK-MIXIN): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD COLUMN-NUMBER (MARK-MIXIN): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD INSERT-BUFFER-OBJECT (STANDARD-BUFFER T T): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD INSERT-BUFFER-SEQUENCE (STANDARD-BUFFER T T): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD INSERT-OBJECT (MARK-MIXIN T): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD INSERT-SEQUENCE (MARK-MIXIN T): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD DELETE-BUFFER-RANGE (STANDARD-BUFFER T T): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD DELETE-RANGE (MARK-MIXIN): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD DELETE-REGION (MARK-MIXIN MARK-MIXIN): -; compiling top level form: -; compiling DEFMETHOD DELETE-REGION (MARK-MIXIN T): -; compiling top level form: -; compiling DEFMETHOD DELETE-REGION (T MARK-MIXIN): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD BUFFER-OBJECT (STANDARD-BUFFER T): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD BUFFER-SEQUENCE (STANDARD-BUFFER T T): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD OBJECT-BEFORE (MARK-MIXIN): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD OBJECT-AFTER (MARK-MIXIN): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD REGION-TO-SEQUENCE (MARK-MIXIN MARK-MIXIN): -; compiling top level form: -; compiling DEFMETHOD REGION-TO-SEQUENCE (INTEGER MARK-MIXIN): -; compiling top level form: -; compiling DEFMETHOD REGION-TO-SEQUENCE (MARK-MIXIN INTEGER): -; compiling top level form: -; compiling DEFMETHOD INSERT-BUFFER-OBJECT :BEFORE (STANDARD-BUFFER T T): -; compiling top level form: -; compiling DEFMETHOD INSERT-BUFFER-SEQUENCE :BEFORE (STANDARD-BUFFER T T): -; compiling top level form: -; compiling DEFMETHOD DELETE-BUFFER-RANGE :BEFORE (STANDARD-BUFFER T T): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD RESET-LOW-HIGH-MARKS (STANDARD-BUFFER): -; compiling top level form: - -; /home/ejohnson/cvs-dir/climacs/buffer.fasl written -; compilation finished in 0:00:04 -; compiling file "/home/ejohnson/cvs-dir/climacs/base.lisp" (written 27 DEC 2004 03:32:46 AM): -; compiling top level form: -; recognizing DEFUN PREVIOUS-LINE -; compiling DEFUN PREVIOUS-LINE: -; compiling top level form: -; recognizing DEFUN NEXT-LINE -; compiling DEFUN NEXT-LINE: -; compiling top level form: -; recognizing DEFUN OPEN-LINE -; compiling DEFUN OPEN-LINE: -; compiling top level form: -; recognizing DEFUN KILL-LINE -; compiling DEFUN KILL-LINE: -; compiling top level form: -; recognizing DEFUN BUFFER-NUMBER-OF-LINES-IN-REGION -; compiling DEFUN BUFFER-NUMBER-OF-LINES-IN-REGION: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling DEFMETHOD NUMBER-OF-LINES-IN-REGION (MARK MARK): -; compiling top level form (SB-KERNEL:FIND-CLASSOID-CELL (QUOTE CLIMACS-BUFFER:MARK)): -; compiling top level form: -; compiling DEFMETHOD NUMBER-OF-LINES-IN-REGION (INTEGER MARK): -; compiling top level form: -; compiling DEFMETHOD NUMBER-OF-LINES-IN-REGION (MARK INTEGER): -; compiling top level form: -; recognizing DEFUN CONSTITUENTP -; compiling DEFUN CONSTITUENTP: -; compiling top level form: -; recognizing DEFUN FORWARD-WORD -; compiling DEFUN FORWARD-WORD: -; compiling top level form: -; recognizing DEFUN BACKWARD-WORD -; compiling DEFUN BACKWARD-WORD: -; compiling top level form: - -; /home/ejohnson/cvs-dir/climacs/base.fasl written -; compilation finished in 0:00:01 -; compiling file "/home/ejohnson/cvs-dir/climacs/io.lisp" (written 27 DEC 2004 10:58:36 PM): -; compiling top level form: -; recognizing DEFUN INPUT-FROM-STREAM -; compiling DEFUN INPUT-FROM-STREAM: -; compiling top level form: -; recognizing DEFUN OUTPUT-TO-STREAM -; compiling DEFUN OUTPUT-TO-STREAM: -; compiling top level form: - -; /home/ejohnson/cvs-dir/climacs/io.fasl written -; compilation finished in 0:00:00 -; compiling file "/home/ejohnson/cvs-dir/climacs/abbrev.lisp" (written 23 DEC 2004 12:00:33 AM): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN STRING-UPPER-CASE-P -; compiling DEFUN STRING-UPPER-CASE-P: -; compiling top level form: -; compiling DEFMETHOD EXPAND-ABBREV (T DICTIONARY-ABBREV-EXPANDER): -; compiling top level form: -; recognizing DEFUN POSSIBLY-EXPAND-ABBREV -; compiling DEFUN POSSIBLY-EXPAND-ABBREV: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling DEFCLASS ABBREV-MIXIN: -; compiling top level form: - -; /home/ejohnson/cvs-dir/climacs/abbrev.fasl written -; compilation finished in 0:00:00 -; compiling file "/home/ejohnson/cvs-dir/climacs/syntax.lisp" (written 28 DEC 2004 02:41:14 PM): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN REDISPLAY-PANE -; compiling DEFUN REDISPLAY-PANE: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD INITIALIZE-INSTANCE :AFTER (BASIC-SYNTAX): -; compiling top level form: -; compiling DEFINE-PRESENTATION-TYPE URL: -; compiling DEFINE-PRESENTATION-TYPE URL: -; compiling top level form: -; compiling DEFINE-PRESENTATION-TYPE URL: -; compiling top level form: -; compiling DEFMETHOD PRESENT-CONTENTS (T T BASIC-SYNTAX): -; compiling top level form: -; compiling DEFMACRO MAYBE-UPDATING-OUTPUT: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD DISPLAY-LINE (T BASIC-SYNTAX): -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFMETHOD REDISPLAY-WITH-SYNTAX (T BASIC-SYNTAX): -; compiling top level form: -; compiling top level form: -; compiling DEFINE-PRESENTATION-TYPE TEXINFO-COMMAND: -; compiling DEFINE-PRESENTATION-TYPE TEXINFO-COMMAND: -; compiling top level form: -; compiling DEFINE-PRESENTATION-TYPE TEXINFO-COMMAND: -; compiling top level form: -; compiling DEFMETHOD PRESENT-CONTENTS (T T TEXINFO-SYNTAX): -; compiling top level form: - -; /home/ejohnson/cvs-dir/climacs/syntax.fasl written -; compilation finished in 0:00:02 -; compiling file "/home/ejohnson/cvs-dir/climacs/kill-ring.lisp" (written 28 DEC 2004 09:28:25 PM): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN INITIALIZE-KILL-RING -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling DEFUN INITIALIZE-KILL-RING: -; compiling top level form: -; recognizing DEFUN KR-LENGTH -; compiling DEFUN KR-LENGTH: -; compiling top level form: -; recognizing DEFUN KR-RESIZE -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN KR-RESIZE: -; compiling top level form: -; recognizing DEFUN KR-PUSH -; compiling DEFUN KR-PUSH: -; compiling top level form: -; recognizing DEFUN KR-POP -; compiling DEFUN KR-POP: -; compiling top level form: -; recognizing DEFUN KR-ROTATE -; compiling DEFUN KR-ROTATE: -; compiling top level form: -; recognizing DEFUN KR-COPY -; compiling DEFUN KR-COPY: -; compiling top level form: -; recognizing DEFUN KR-COPY-IN -; compiling DEFUN KR-COPY-IN: -; compiling top level form: -; recognizing DEFUN KR-CUT-IN -; compiling DEFUN KR-CUT-IN: -; compiling top level form: -; recognizing DEFUN KR-COPY-OUT -; compiling DEFUN KR-COPY-OUT: -; compiling top level form: -; recognizing DEFUN KR-CUT-OUT -; compiling DEFUN KR-CUT-OUT: -; compiling top level form: - -; /home/ejohnson/cvs-dir/climacs/kill-ring.fasl written -; compilation finished in 0:00:00 -; compiling file "/home/ejohnson/cvs-dir/climacs/gui.lisp" (written 28 DEC 2004 09:26:34 PM): -; compiling top level form: -; compiling top level form: -; compiling DEFCLASS CLIMACS-BUFFER: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling DEFCLASS CLIMACS-PANE: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling DEFMETHOD INITIALIZE-INSTANCE :AFTER (CLIMACS-PANE): -; compiling top level form: -; compiling DEFINE-APPLICATION-FRAME CLIMACS: -; compiling DEFINE-APPLICATION-FRAME CLIMACS: -; compiling DEFINE-APPLICATION-FRAME CLIMACS: -; compiling DEFINE-APPLICATION-FRAME CLIMACS: -; compiling DEFINE-APPLICATION-FRAME CLIMACS: -; compiling DEFINE-APPLICATION-FRAME CLIMACS: -; compiling DEFINE-APPLICATION-FRAME CLIMACS: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFINE-APPLICATION-FRAME CLIMACS: -; compiling top level form (SB-KERNEL:FIND-CLASSOID-CELL (QUOTE CLIM:FRAME-MANAGER)): -; compiling top level form: -; compiling DEFINE-APPLICATION-FRAME CLIMACS: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form: -; compiling DEFINE-APPLICATION-FRAME CLIMACS: -; compiling top level form: -; recognizing DEFUN CLIMACS -; compiling DEFUN CLIMACS: -; compiling top level form: -; recognizing DEFUN DISPLAY-INFO -; compiling DEFUN DISPLAY-INFO: -; compiling top level form: -; recognizing DEFUN DISPLAY-WIN -; compiling DEFUN DISPLAY-WIN: -; compiling top level form: -; recognizing DEFUN FIND-GESTURES -; compiling DEFUN FIND-GESTURES: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN CLIMACS-TOP-LEVEL -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFUN CLIMACS-TOP-LEVEL: -; compiling top level form (SB-KERNEL:FIND-CLASSOID-CELL (QUOTE CLIM:KEYBOARD-EVENT)): -; compiling top level form: -; recognizing DEFUN COM-QUIT -; compiling DEFINE-COMMAND (COM-QUIT :NAME "Quit" :COMMAND-TABLE CLIMACS): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-QUIT%ACCEPTOR%1 -; compiling DEFINE-COMMAND (COM-QUIT :NAME "Quit" :COMMAND-TABLE CLIMACS): -; compiling top level form: -; recognizing DEFUN COM-QUIT%PARTIAL%2 -; compiling DEFINE-COMMAND (COM-QUIT :NAME "Quit" :COMMAND-TABLE CLIMACS): -; compiling top level form: -; recognizing DEFUN |COM-QUIT%unparser%3| -; compiling DEFINE-COMMAND (COM-QUIT :NAME "Quit" :COMMAND-TABLE CLIMACS): -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-SELF-INSERT -; compiling DEFINE-COMMAND COM-SELF-INSERT: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-SELF-INSERT%ACCEPTOR%4 -; compiling DEFINE-COMMAND COM-SELF-INSERT: -; compiling top level form: -; recognizing DEFUN COM-SELF-INSERT%PARTIAL%5 -; compiling DEFINE-COMMAND COM-SELF-INSERT: -; compiling top level form: -; recognizing DEFUN |COM-SELF-INSERT%unparser%6| -; compiling DEFINE-COMMAND COM-SELF-INSERT: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-BACKWARD-OBJECT -; compiling DEFINE-COMMAND COM-BACKWARD-OBJECT: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-BACKWARD-OBJECT%ACCEPTOR%7 -; compiling DEFINE-COMMAND COM-BACKWARD-OBJECT: -; compiling top level form: -; recognizing DEFUN COM-BACKWARD-OBJECT%PARTIAL%8 -; compiling DEFINE-COMMAND COM-BACKWARD-OBJECT: -; compiling top level form: -; recognizing DEFUN |COM-BACKWARD-OBJECT%unparser%9| -; compiling DEFINE-COMMAND COM-BACKWARD-OBJECT: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-FORWARD-OBJECT -; compiling DEFINE-COMMAND COM-FORWARD-OBJECT: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-FORWARD-OBJECT%ACCEPTOR%10 -; compiling DEFINE-COMMAND COM-FORWARD-OBJECT: -; compiling top level form: -; recognizing DEFUN COM-FORWARD-OBJECT%PARTIAL%11 -; compiling DEFINE-COMMAND COM-FORWARD-OBJECT: -; compiling top level form: -; recognizing DEFUN |COM-FORWARD-OBJECT%unparser%12| -; compiling DEFINE-COMMAND COM-FORWARD-OBJECT: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-BEGINNING-OF-LINE -; compiling DEFINE-COMMAND COM-BEGINNING-OF-LINE: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-BEGINNING-OF-LINE%ACCEPTOR%13 -; compiling DEFINE-COMMAND COM-BEGINNING-OF-LINE: -; compiling top level form: -; recognizing DEFUN COM-BEGINNING-OF-LINE%PARTIAL%14 -; compiling DEFINE-COMMAND COM-BEGINNING-OF-LINE: -; compiling top level form: -; recognizing DEFUN |COM-BEGINNING-OF-LINE%unparser%15| -; compiling DEFINE-COMMAND COM-BEGINNING-OF-LINE: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-END-OF-LINE -; compiling DEFINE-COMMAND COM-END-OF-LINE: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-END-OF-LINE%ACCEPTOR%16 -; compiling DEFINE-COMMAND COM-END-OF-LINE: -; compiling top level form: -; recognizing DEFUN COM-END-OF-LINE%PARTIAL%17 -; compiling DEFINE-COMMAND COM-END-OF-LINE: -; compiling top level form: -; recognizing DEFUN |COM-END-OF-LINE%unparser%18| -; compiling DEFINE-COMMAND COM-END-OF-LINE: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-DELETE-OBJECT -; compiling DEFINE-COMMAND COM-DELETE-OBJECT: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-DELETE-OBJECT%ACCEPTOR%19 -; compiling DEFINE-COMMAND COM-DELETE-OBJECT: -; compiling top level form: -; recognizing DEFUN COM-DELETE-OBJECT%PARTIAL%20 -; compiling DEFINE-COMMAND COM-DELETE-OBJECT: -; compiling top level form: -; recognizing DEFUN |COM-DELETE-OBJECT%unparser%21| -; compiling DEFINE-COMMAND COM-DELETE-OBJECT: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-BACKWARD-DELETE-OBJECT -; compiling DEFINE-COMMAND COM-BACKWARD-DELETE-OBJECT: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-BACKWARD-DELETE-OBJECT%ACCEPTOR%22 -; compiling DEFINE-COMMAND COM-BACKWARD-DELETE-OBJECT: -; compiling top level form: -; recognizing DEFUN COM-BACKWARD-DELETE-OBJECT%PARTIAL%23 -; compiling DEFINE-COMMAND COM-BACKWARD-DELETE-OBJECT: -; compiling top level form: -; recognizing DEFUN |COM-BACKWARD-DELETE-OBJECT%unparser%24| -; compiling DEFINE-COMMAND COM-BACKWARD-DELETE-OBJECT: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-PREVIOUS-LINE -; compiling DEFINE-COMMAND COM-PREVIOUS-LINE: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-PREVIOUS-LINE%ACCEPTOR%25 -; compiling DEFINE-COMMAND COM-PREVIOUS-LINE: -; compiling top level form: -; recognizing DEFUN COM-PREVIOUS-LINE%PARTIAL%26 -; compiling DEFINE-COMMAND COM-PREVIOUS-LINE: -; compiling top level form: -; recognizing DEFUN |COM-PREVIOUS-LINE%unparser%27| -; compiling DEFINE-COMMAND COM-PREVIOUS-LINE: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-NEXT-LINE -; compiling DEFINE-COMMAND COM-NEXT-LINE: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-NEXT-LINE%ACCEPTOR%28 -; compiling DEFINE-COMMAND COM-NEXT-LINE: -; compiling top level form: -; recognizing DEFUN COM-NEXT-LINE%PARTIAL%29 -; compiling DEFINE-COMMAND COM-NEXT-LINE: -; compiling top level form: -; recognizing DEFUN |COM-NEXT-LINE%unparser%30| -; compiling DEFINE-COMMAND COM-NEXT-LINE: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-OPEN-LINE -; compiling DEFINE-COMMAND COM-OPEN-LINE: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-OPEN-LINE%ACCEPTOR%31 -; compiling DEFINE-COMMAND COM-OPEN-LINE: -; compiling top level form: -; recognizing DEFUN COM-OPEN-LINE%PARTIAL%32 -; compiling DEFINE-COMMAND COM-OPEN-LINE: -; compiling top level form: -; recognizing DEFUN |COM-OPEN-LINE%unparser%33| -; compiling DEFINE-COMMAND COM-OPEN-LINE: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-KILL-LINE -; compiling DEFINE-COMMAND COM-KILL-LINE: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-KILL-LINE%ACCEPTOR%34 -; compiling DEFINE-COMMAND COM-KILL-LINE: -; compiling top level form: -; recognizing DEFUN COM-KILL-LINE%PARTIAL%35 -; compiling DEFINE-COMMAND COM-KILL-LINE: -; compiling top level form: -; recognizing DEFUN |COM-KILL-LINE%unparser%36| -; compiling DEFINE-COMMAND COM-KILL-LINE: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-FORWARD-WORD -; compiling DEFINE-COMMAND COM-FORWARD-WORD: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-FORWARD-WORD%ACCEPTOR%37 -; compiling DEFINE-COMMAND COM-FORWARD-WORD: -; compiling top level form: -; recognizing DEFUN COM-FORWARD-WORD%PARTIAL%38 -; compiling DEFINE-COMMAND COM-FORWARD-WORD: -; compiling top level form: -; recognizing DEFUN |COM-FORWARD-WORD%unparser%39| -; compiling DEFINE-COMMAND COM-FORWARD-WORD: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-BACKWARD-WORD -; compiling DEFINE-COMMAND COM-BACKWARD-WORD: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-BACKWARD-WORD%ACCEPTOR%40 -; compiling DEFINE-COMMAND COM-BACKWARD-WORD: -; compiling top level form: -; recognizing DEFUN COM-BACKWARD-WORD%PARTIAL%41 -; compiling DEFINE-COMMAND COM-BACKWARD-WORD: -; compiling top level form: -; recognizing DEFUN |COM-BACKWARD-WORD%unparser%42| -; compiling DEFINE-COMMAND COM-BACKWARD-WORD: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-TOGGLE-LAYOUT -; compiling DEFINE-COMMAND COM-TOGGLE-LAYOUT: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-TOGGLE-LAYOUT%ACCEPTOR%43 -; compiling DEFINE-COMMAND COM-TOGGLE-LAYOUT: -; compiling top level form: -; recognizing DEFUN COM-TOGGLE-LAYOUT%PARTIAL%44 -; compiling DEFINE-COMMAND COM-TOGGLE-LAYOUT: -; compiling top level form: -; recognizing DEFUN |COM-TOGGLE-LAYOUT%unparser%45| -; compiling DEFINE-COMMAND COM-TOGGLE-LAYOUT: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-EXTENDED-COMMAND -; compiling DEFINE-COMMAND COM-EXTENDED-COMMAND: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-EXTENDED-COMMAND%ACCEPTOR%46 -; compiling DEFINE-COMMAND COM-EXTENDED-COMMAND: -; compiling top level form: -; recognizing DEFUN COM-EXTENDED-COMMAND%PARTIAL%47 -; compiling DEFINE-COMMAND COM-EXTENDED-COMMAND: -; compiling top level form: -; recognizing DEFUN |COM-EXTENDED-COMMAND%unparser%48| -; compiling DEFINE-COMMAND COM-EXTENDED-COMMAND: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-INSERT-WEIRD-STUFF -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling DEFINE-COMMAND COM-INSERT-WEIRD-STUFF: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-INSERT-WEIRD-STUFF%ACCEPTOR%49 -; compiling DEFINE-COMMAND COM-INSERT-WEIRD-STUFF: -; compiling top level form: -; recognizing DEFUN COM-INSERT-WEIRD-STUFF%PARTIAL%50 -; compiling DEFINE-COMMAND COM-INSERT-WEIRD-STUFF: -; compiling top level form: -; recognizing DEFUN |COM-INSERT-WEIRD-STUFF%unparser%51| -; compiling DEFINE-COMMAND COM-INSERT-WEIRD-STUFF: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-INSERT-REVERSED-STRING -; compiling DEFINE-COMMAND COM-INSERT-REVERSED-STRING: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-INSERT-REVERSED-STRING%ACCEPTOR%52 -; compiling DEFINE-COMMAND COM-INSERT-REVERSED-STRING: -; compiling top level form: -; recognizing DEFUN COM-INSERT-REVERSED-STRING%PARTIAL%53 -; compiling DEFINE-COMMAND COM-INSERT-REVERSED-STRING: -; compiling top level form: -; recognizing DEFUN |COM-INSERT-REVERSED-STRING%unparser%54| -; compiling DEFINE-COMMAND COM-INSERT-REVERSED-STRING: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; compiling DEFINE-PRESENTATION-TYPE COMPLETABLE-PATHNAME: -; compiling DEFINE-PRESENTATION-TYPE COMPLETABLE-PATHNAME: -; compiling top level form: -; compiling DEFINE-PRESENTATION-TYPE COMPLETABLE-PATHNAME: -; compiling top level form: -; recognizing DEFUN FILENAME-COMPLETER -; compiling DEFUN FILENAME-COMPLETER: -; compiling top level form: -; compiling DEFINE-PRESENTATION-METHOD ACCEPT: -; compiling top level form (SB-KERNEL:FIND-CLASSOID-CELL (QUOTE CLIM:TEXTUAL-VIEW)): -; compiling top level form: -; recognizing DEFUN PATHNAME-FILENAME -; compiling DEFUN PATHNAME-FILENAME: -; compiling top level form: -; recognizing DEFUN COM-FIND-FILE -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFINE-COMMAND (COM-FIND-FILE :NAME "Find File" :COMMAND-TABLE CLIMACS): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-FIND-FILE%ACCEPTOR%55 -; compiling DEFINE-COMMAND (COM-FIND-FILE :NAME "Find File" :COMMAND-TABLE CLIMACS): -; compiling top level form: -; recognizing DEFUN COM-FIND-FILE%PARTIAL%56 -; compiling DEFINE-COMMAND (COM-FIND-FILE :NAME "Find File" :COMMAND-TABLE CLIMACS): -; compiling top level form: -; recognizing DEFUN |COM-FIND-FILE%unparser%57| -; compiling DEFINE-COMMAND (COM-FIND-FILE :NAME "Find File" :COMMAND-TABLE CLIMACS): -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-SAVE-BUFFER -; compiling DEFINE-COMMAND COM-SAVE-BUFFER: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-SAVE-BUFFER%ACCEPTOR%58 -; compiling DEFINE-COMMAND COM-SAVE-BUFFER: -; compiling top level form: -; recognizing DEFUN COM-SAVE-BUFFER%PARTIAL%59 -; compiling DEFINE-COMMAND COM-SAVE-BUFFER: -; compiling top level form: -; recognizing DEFUN |COM-SAVE-BUFFER%unparser%60| -; compiling DEFINE-COMMAND COM-SAVE-BUFFER: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-WRITE-BUFFER -; compiling DEFINE-COMMAND COM-WRITE-BUFFER: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-WRITE-BUFFER%ACCEPTOR%61 -; compiling DEFINE-COMMAND COM-WRITE-BUFFER: -; compiling top level form: -; recognizing DEFUN COM-WRITE-BUFFER%PARTIAL%62 -; compiling DEFINE-COMMAND COM-WRITE-BUFFER: -; compiling top level form: -; recognizing DEFUN |COM-WRITE-BUFFER%unparser%63| -; compiling DEFINE-COMMAND COM-WRITE-BUFFER: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-BEGINNING-OF-BUFFER -; compiling DEFINE-COMMAND COM-BEGINNING-OF-BUFFER: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-BEGINNING-OF-BUFFER%ACCEPTOR%64 -; compiling DEFINE-COMMAND COM-BEGINNING-OF-BUFFER: -; compiling top level form: -; recognizing DEFUN COM-BEGINNING-OF-BUFFER%PARTIAL%65 -; compiling DEFINE-COMMAND COM-BEGINNING-OF-BUFFER: -; compiling top level form: -; recognizing DEFUN |COM-BEGINNING-OF-BUFFER%unparser%66| -; compiling DEFINE-COMMAND COM-BEGINNING-OF-BUFFER: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-END-OF-BUFFER -; compiling DEFINE-COMMAND COM-END-OF-BUFFER: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-END-OF-BUFFER%ACCEPTOR%67 -; compiling DEFINE-COMMAND COM-END-OF-BUFFER: -; compiling top level form: -; recognizing DEFUN COM-END-OF-BUFFER%PARTIAL%68 -; compiling DEFINE-COMMAND COM-END-OF-BUFFER: -; compiling top level form: -; recognizing DEFUN |COM-END-OF-BUFFER%unparser%69| -; compiling DEFINE-COMMAND COM-END-OF-BUFFER: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-BROWSE-URL -; compiling DEFINE-COMMAND COM-BROWSE-URL: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-BROWSE-URL%ACCEPTOR%70 -; compiling DEFINE-COMMAND COM-BROWSE-URL: -; compiling top level form: -; recognizing DEFUN COM-BROWSE-URL%PARTIAL%71 -; compiling DEFINE-COMMAND COM-BROWSE-URL: -; compiling top level form: -; recognizing DEFUN |COM-BROWSE-URL%unparser%72| -; compiling DEFINE-COMMAND COM-BROWSE-URL: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-SET-MARK -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFINE-COMMAND COM-SET-MARK: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-SET-MARK%ACCEPTOR%73 -; compiling DEFINE-COMMAND COM-SET-MARK: -; compiling top level form: -; recognizing DEFUN COM-SET-MARK%PARTIAL%74 -; compiling DEFINE-COMMAND COM-SET-MARK: -; compiling top level form: -; recognizing DEFUN |COM-SET-MARK%unparser%75| -; compiling DEFINE-COMMAND COM-SET-MARK: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-COPY-IN -; compiling DEFINE-COMMAND COM-COPY-IN: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-COPY-IN%ACCEPTOR%76 -; compiling DEFINE-COMMAND COM-COPY-IN: -; compiling top level form: -; recognizing DEFUN COM-COPY-IN%PARTIAL%77 -; compiling DEFINE-COMMAND COM-COPY-IN: -; compiling top level form: -; recognizing DEFUN |COM-COPY-IN%unparser%78| -; compiling DEFINE-COMMAND COM-COPY-IN: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-CUT-IN -; compiling DEFINE-COMMAND COM-CUT-IN: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-CUT-IN%ACCEPTOR%79 -; compiling DEFINE-COMMAND COM-CUT-IN: -; compiling top level form: -; recognizing DEFUN COM-CUT-IN%PARTIAL%80 -; compiling DEFINE-COMMAND COM-CUT-IN: -; compiling top level form: -; recognizing DEFUN |COM-CUT-IN%unparser%81| -; compiling DEFINE-COMMAND COM-CUT-IN: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-CUT-OUT -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFINE-COMMAND COM-CUT-OUT: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-CUT-OUT%ACCEPTOR%82 -; compiling DEFINE-COMMAND COM-CUT-OUT: -; compiling top level form: -; recognizing DEFUN COM-CUT-OUT%PARTIAL%83 -; compiling DEFINE-COMMAND COM-CUT-OUT: -; compiling top level form: -; recognizing DEFUN |COM-CUT-OUT%unparser%84| -; compiling DEFINE-COMMAND COM-CUT-OUT: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-COPY-OUT -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): -; compiling DEFINE-COMMAND COM-COPY-OUT: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-COPY-OUT%ACCEPTOR%85 -; compiling DEFINE-COMMAND COM-COPY-OUT: -; compiling top level form: -; recognizing DEFUN COM-COPY-OUT%PARTIAL%86 -; compiling DEFINE-COMMAND COM-COPY-OUT: -; compiling top level form: -; recognizing DEFUN |COM-COPY-OUT%unparser%87| -; compiling DEFINE-COMMAND COM-COPY-OUT: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-KR-ROTATE -; compiling DEFINE-COMMAND COM-KR-ROTATE: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-KR-ROTATE%ACCEPTOR%88 -; compiling DEFINE-COMMAND COM-KR-ROTATE: -; compiling top level form: -; recognizing DEFUN COM-KR-ROTATE%PARTIAL%89 -; compiling DEFINE-COMMAND COM-KR-ROTATE: -; compiling top level form: -; recognizing DEFUN |COM-KR-ROTATE%unparser%90| -; compiling DEFINE-COMMAND COM-KR-ROTATE: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-KR-RESIZE -; compiling DEFINE-COMMAND COM-KR-RESIZE: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN COM-KR-RESIZE%ACCEPTOR%91 -; compiling DEFINE-COMMAND COM-KR-RESIZE: -; compiling top level form: -; recognizing DEFUN COM-KR-RESIZE%PARTIAL%92 -; compiling DEFINE-COMMAND COM-KR-RESIZE: -; compiling top level form: -; recognizing DEFUN |COM-KR-RESIZE%unparser%93| -; compiling DEFINE-COMMAND COM-KR-RESIZE: -; compiling top level form: -; compiling top level form: -; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): -; compiling top level form: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN GLOBAL-SET-KEY -; compiling DEFUN GLOBAL-SET-KEY: -; compiling top level form: -; compiling LOOP FOR: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; recognizing DEFUN C-X-SET-KEY -; compiling DEFUN C-X-SET-KEY: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: -; compiling top level form: - -; /home/ejohnson/cvs-dir/climacs/gui.fasl written -; compilation finished in 0:00:05 -NIL -CL-USER> (climacs-gui::climacs) -No such offset: 11 -No such offset: 11 -NIL -CL-USER> (climacs-gui::climacs) -NIL -CL-USER> (climacs-gui::climacs) -NIL -CL-USER> \ No newline at end of file +;;; -*- Mode: Lisp; Package: CLIMACS-GUI -*- + +;;; (c) copyright 2004 by +;;; Robert Strandh (strandh(a)labri.fr) +;;; (c) copyright 2004 by +;;; Elliott Johnson (ejohnson(a)fasl.info) + +;;; 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. + +;;; GUI for the Climacs editor. + +(in-package :climacs-gui) + +(defclass filename-mixin () + ((filename :initform nil :accessor filename))) + +(defclass climacs-buffer (standard-buffer abbrev-mixin filename-mixin) + ((name :initform "*scratch*" :accessor name) + (modified :initform nil :accessor modified-p))) + +(defclass climacs-pane (application-pane) + ((buffer :initform (make-instance 'climacs-buffer) :accessor buffer) + (point :initform nil :initarg :point :reader point) + (syntax :initarg :syntax :accessor syntax) + (mark :initform nil :initarg :mark :reader mark))) + +(defmethod initialize-instance :after ((pane climacs-pane) &rest args) + (declare (ignore args)) + (with-slots (buffer point syntax mark) pane + (when (null point) + (setf point (make-instance 'standard-right-sticky-mark + :buffer buffer))) + (when (null mark) + (setf mark (make-instance 'standard-right-sticky-mark + :buffer buffer))) + (setf syntax (make-instance 'texinfo-syntax :pane pane)))) + +(define-application-frame climacs () + ((win :reader win)) + (:panes + (win (make-pane 'climacs-pane + :width 900 :height 400 + :name 'win + :incremental-redisplay t + :display-function 'display-win)) + (info :application + :width 900 :height 20 :max-height 20 + :name 'info :background +light-gray+ + :scroll-bars nil + :incremental-redisplay t + :display-function 'display-info) + (int :application :width 900 :height 20 :max-height 20 + :scroll-bars nil)) + (:layouts + (default + (vertically (:scroll-bars nil) + (scrolling (:width 900 :height 400) win) + info + int))) + (:top-level (climacs-top-level))) + +(defun climacs () + "Starts up a climacs session" + (let ((frame (make-application-frame 'climacs))) + (run-frame-top-level frame))) + +(defun display-info (frame pane) + (let* ((win (win frame)) + (buf (buffer win)) + (name-info (format nil " ~a ~a" + (if (modified-p buf) "**" "--") + (name buf)))) + (princ name-info pane))) + +(defun display-win (frame pane) + "The display function used by the climacs application frame." + (declare (ignore frame)) + (redisplay-pane pane)) + +(defun find-gestures (gestures start-table) + (loop with table = (find-command-table start-table) + for (gesture . rest) on gestures + for item = (find-keystroke-item gesture table :errorp nil) + while item + do (if (eq (command-menu-item-type item) :command) + (return (if (null rest) item nil)) + (setf table (command-menu-item-value item))) + finally (return item))) + +(defvar *kill-ring* (initialize-kill-ring 7)) +(defparameter *current-gesture* nil) + +(defun climacs-top-level (frame &key + command-parser command-unparser + partial-command-parser prompt) + (declare (ignore command-parser command-unparser partial-command-parser prompt)) + (setf (slot-value frame 'win) (find-pane-named frame 'win)) +;; (let ((*standard-output* (frame-standard-output frame)) +;; (*standard-input* (frame-standard-input frame)) + (let ((*standard-output* (find-pane-named frame 'win)) + (*standard-input* (find-pane-named frame 'int)) + (*print-pretty* nil) + (*abort-gestures* nil)) + (redisplay-frame-panes frame :force-p t) + (loop with gestures = '() + do (setf *current-gesture* (read-gesture :stream *standard-input*)) + (when (or (characterp *current-gesture*) + (and (typep *current-gesture* 'keyboard-event) + (or (keyboard-event-character *current-gesture*) + (not (member (keyboard-event-key-name + *current-gesture*) + '(:control-left :control-right + :shift-left :shift-right + :meta-left :meta-right + :super-left :super-right + :hyper-left :hyper-right + :shift-lock :caps-lock)))))) + (setf gestures (nconc gestures (list *current-gesture*))) + (let ((item (find-gestures gestures 'global-climacs-table))) + (cond ((not item) + (beep) (setf gestures '())) + ((eq (command-menu-item-type item) :command) + (handler-case + (funcall (command-menu-item-value item)) + (error (condition) + (beep) + (format *error-output* "~a~%" condition))) + (setf gestures '())) + (t nil)))) + (redisplay-frame-panes frame)))) + +(define-command (com-quit :name "Quit" :command-table climacs) () + (frame-exit *application-frame*)) + +(define-command com-self-insert () + (unless (constituentp *current-gesture*) + (possibly-expand-abbrev (point (win *application-frame*)))) + (insert-object (point (win *application-frame*)) *current-gesture*) + (setf (modified-p (buffer (win *application-frame*))) t)) + +(define-command com-backward-object () + (decf (offset (point (win *application-frame*))))) + +(define-command com-forward-object () + (incf (offset (point (win *application-frame*))))) + +(define-command com-beginning-of-line () + (beginning-of-line (point (win *application-frame*)))) + +(define-command com-end-of-line () + (end-of-line (point (win *application-frame*)))) + +(define-command com-delete-object () + (delete-range (point (win *application-frame*))) + (setf (modified-p (buffer (win *application-frame*))) t)) + +(define-command com-backward-delete-object () + (delete-range (point (win *application-frame*)) -1) + (setf (modified-p (buffer (win *application-frame*))) t)) + +(define-command com-previous-line () + (previous-line (point (win *application-frame*)))) + +(define-command com-next-line () + (next-line (point (win *application-frame*)))) + +(define-command com-open-line () + (open-line (point (win *application-frame*))) + (setf (modified-p (buffer (win *application-frame*))) t)) + +(define-command com-kill-line () + (kill-line (point (win *application-frame*))) + (setf (modified-p (buffer (win *application-frame*))) t)) + +(define-command com-forward-word () + (forward-word (point (win *application-frame*)))) + +(define-command com-backward-word () + (backward-word (point (win *application-frame*)))) + +(define-command com-toggle-layout () + (setf (frame-current-layout *application-frame*) + (if (eq (frame-current-layout *application-frame*) 'default) + 'with-interactor + 'default))) + +(define-command com-extended-command () + (let ((item (accept 'command :prompt "Extended Command"))) + (window-clear *standard-input*) + (execute-frame-command *application-frame* item))) + +(defclass weird () () + (:documentation "An open ended class.")) + +(define-command com-insert-weird-stuff () + (insert-object (point (win *application-frame*)) (make-instance 'weird)) + (setf (modified-p (buffer (win *application-frame*))) t)) + +(define-command com-insert-reversed-string () + (insert-sequence (point (win *application-frame*)) + (reverse (accept 'string))) + (setf (modified-p (buffer (win *application-frame*))) t)) + +(define-presentation-type completable-pathname () + :inherit-from 'pathname) + +(defun filename-completer (so-far mode) + (flet ((remove-trail (s) + (subseq s 0 (let ((pos (position #\/ s :from-end t))) + (if pos (1+ pos) 0))))) + (let* ((directory-prefix + (if (and (plusp (length so-far)) (eql (aref so-far 0) #\/)) + "" + (namestring #+sbcl (car (directory ".")) #+cmu (ext:default-directory)))) + (full-so-far (concatenate 'string directory-prefix so-far)) + (pathnames + (loop with length = (length full-so-far) + for path in (directory (concatenate 'string + (remove-trail so-far) + "*.*")) + when (let ((mismatch (mismatch (namestring path) full-so-far))) + (or (null mismatch) (= mismatch length))) + collect path)) + (strings (mapcar #'namestring pathnames)) + (first-string (car strings)) + (length-common-prefix nil) + (completed-string nil) + (full-completed-string nil)) + (unless (null pathnames) + (setf length-common-prefix + (loop with length = (length first-string) + for string in (cdr strings) + do (setf length (min length (or (mismatch string first-string) length))) + finally (return length)))) + (unless (null pathnames) + (setf completed-string + (subseq first-string (length directory-prefix) + (if (null (cdr pathnames)) nil length-common-prefix))) + (setf full-completed-string + (concatenate 'string directory-prefix completed-string))) + (case mode + ((:complete-limited :complete-maximal) + (cond ((null pathnames) + (values so-far nil nil 0 nil)) + ((null (cdr pathnames)) + (values completed-string t (car pathnames) 1 nil)) + (t + (values completed-string nil nil (length pathnames) nil)))) + (:complete + (cond ((null pathnames) + (values so-far t so-far 1 nil)) + ((null (cdr pathnames)) + (values completed-string t (car pathnames) 1 nil)) + ((find full-completed-string strings :test #'string-equal) + (let ((pos (position full-completed-string strings :test #'string-equal))) + (values completed-string + t (elt pathnames pos) (length pathnames) nil))) + (t + (values completed-string nil nil (length pathnames) nil)))) + (:possibilities + (values nil nil nil (length pathnames) + (loop with length = (length directory-prefix) + for name in pathnames + collect (list (subseq (namestring name) length nil) + name)))))))) + +(define-presentation-method accept + ((type completable-pathname) stream (view textual-view) &key) + (multiple-value-bind (pathname success string) + (complete-input stream + #'filename-completer + :partial-completers '(#\Space) + :allow-any-input t) + (declare (ignore success)) + (or pathname string))) + +(defun pathname-filename (pathname) + (if (null (pathname-type pathname)) + (pathname-name pathname) + (concatenate 'string (pathname-name pathname) + "." (pathname-type pathname)))) + +(define-command (com-find-file :name "Find File" :command-table climacs) () + (let ((filename (accept 'completable-pathname + :prompt "Find File"))) + (with-slots (buffer point syntax) (win *application-frame*) + (setf buffer (make-instance 'climacs-buffer) + point (make-instance 'standard-right-sticky-mark :buffer buffer) + syntax (make-instance 'texinfo-syntax :pane (win *application-frame*))) + (with-open-file (stream filename :direction :input :if-does-not-exist :create) + (input-from-stream stream buffer 0)) + (setf (filename buffer) filename + (name buffer) (pathname-filename filename)) + (beginning-of-buffer point)))) + +(define-command com-save-buffer () + (let ((filename (or (filename (buffer (win *application-frame*))) + (accept 'completable-pathname + :prompt "Save Buffer to File"))) + (buffer (buffer (win *application-frame*)))) + (with-open-file (stream filename :direction :output :if-exists :supersede) + (output-to-stream stream buffer 0 (size buffer))) + (setf (filename buffer) filename + (name buffer) (pathname-filename filename)) + (setf (modified-p (buffer (win *application-frame*))) nil))) + +(define-command com-write-buffer () + (let ((filename (accept 'completable-pathname + :prompt "Write Buffer to File")) + (buffer (buffer (win *application-frame*)))) + (with-open-file (stream filename :direction :output :if-exists :supersede) + (output-to-stream stream buffer 0 (size buffer))) + (setf (filename buffer) filename + (name buffer) (pathname-filename filename)) + (setf (modified-p (buffer (win *application-frame*))) nil))) + +(define-command com-beginning-of-buffer () + (beginning-of-buffer (point (win *application-frame*)))) + +(define-command com-end-of-buffer () + (end-of-buffer (point (win *application-frame*)))) + +(define-command com-browse-url () + (accept 'url :prompt "Browse URL")) + +(define-command com-set-mark () + (with-slots (point mark) (win *application-frame*) + (setf mark (clone-mark point)))) + +;;;;;;;;;;;;;;;;;;;; +;; Kill ring commands + +;; The naming may sound odd here, but think of electronic wireing: +;; outputs to inputs and inputs to outputs. Copying into a buffer +;; first requires coping out of the kill ring. + +(define-command com-copy-in () + (kr-copy-out (point (win *application-frame*)) *kill-ring*)) + +(define-command com-cut-in () + (kr-cut-out (point (win *application-frame*)) *kill-ring*)) + +(define-command com-cut-out () + (with-slots (buffer point mark)(win *application-frame*) + (let ((off1 (offset point)) + (off2 (offset mark))) + (if (< off1 off2) + (kr-cut-in buffer *kill-ring* off1 off2) + (kr-cut-in buffer *kill-ring* off2 off1))))) + +(define-command com-copy-out () + (with-slots (buffer point mark)(win *application-frame*) + (let ((off1 (offset point)) + (off2 (offset mark))) + (if (< off1 off2) + (kr-copy-in buffer *kill-ring* off1 off2) + (kr-copy-in buffer *kill-ring* off2 off1))))) + +;; Needs adjustment to be like emacs M-y +(define-command com-kr-rotate () + (kr-rotate *kill-ring* -1)) + +;; Not bound to a key yet +(define-command com-kr-resize () + (let ((size (accept 'fixnum :prompt "New kill ring size: "))) + (kr-resize *kill-ring* size))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Global command table + +(make-command-table 'global-climacs-table :errorp nil) + +(defun global-set-key (gesture command) + (add-command-to-command-table command 'global-climacs-table + :keystroke gesture :errorp nil)) + +(loop for code from (char-code #\space) to (char-code #\~) + do (global-set-key (code-char code) 'com-self-insert)) + +(global-set-key #\newline 'com-self-insert) +(global-set-key #\tab 'com-self-insert) +(global-set-key '(#\f :control) 'com-forward-object) +(global-set-key '(#\b :control) 'com-backward-object) +(global-set-key '(#\a :control) 'com-beginning-of-line) +(global-set-key '(#\e :control) 'com-end-of-line) +(global-set-key '(#\d :control) 'com-delete-object) +(global-set-key '(#\p :control) 'com-previous-line) +(global-set-key '(#\n :control) 'com-next-line) +(global-set-key '(#\o :control) 'com-open-line) +(global-set-key '(#\k :control) 'com-kill-line) +(global-set-key '(#\Space :control) 'com-set-mark) +(global-set-key '(#\y :control) 'com-copy-in) +(global-set-key '(#\w :control) 'com-cut-out) +(global-set-key '(#\f :meta) 'com-forward-word) +(global-set-key '(#\b :meta) 'com-backward-word) +(global-set-key '(#\x :meta) 'com-extended-command) +(global-set-key '(#\a :meta) 'com-insert-weird-stuff) +(global-set-key '(#\c :meta) 'com-insert-reversed-string) +(global-set-key '(#\y :meta) 'com-kr-rotate) ;currently rotates only +(global-set-key '(#\w :meta) 'com-copy-out) +(global-set-key '(#\< :shift :meta) 'com-beginning-of-buffer) +(global-set-key '(#\> :shift :meta) 'com-end-of-buffer) +(global-set-key '(#\u :meta) 'com-browse-url) + +(global-set-key '(:up) 'com-previous-line) +(global-set-key '(:down) 'com-next-line) +(global-set-key '(:left) 'com-backward-object) +(global-set-key '(:right) 'com-forward-object) +(global-set-key '(:left :control) 'com-backward-word) +(global-set-key '(:right :control) 'com-forward-word) +(global-set-key '(:home) 'com-beginning-of-line) +(global-set-key '(:end) 'com-end-of-line) +(global-set-key '(:home :control) 'com-beginning-of-buffer) +(global-set-key '(:end :control) 'com-end-of-buffer) +(global-set-key #\Rubout 'com-delete-object) +(global-set-key #\Backspace 'com-backward-delete-object) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; C-x command table + +(make-command-table 'c-x-climacs-table :errorp nil) + +(add-menu-item-to-command-table 'global-climacs-table "C-x" + :menu 'c-x-climacs-table + :keystroke '(#\x :control)) + +(defun c-x-set-key (gesture command) + (add-command-to-command-table command 'c-x-climacs-table + :keystroke gesture :errorp nil)) + +(c-x-set-key '(#\c :control) 'com-quit) +(c-x-set-key '(#\f :control) 'com-find-file) +(c-x-set-key '(#\s :control) 'com-save-buffer) +(c-x-set-key '(#\w :control) 'com-write-buffer)

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by ejohnson＠common-lisp.net 29 Dec '04

29 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv15509 Modified Files: gui.lisp Log Message: needed gui commands for kill ring Date: Wed Dec 29 06:49:05 2004 Author: ejohnson Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.25 climacs/gui.lisp:1.26 --- climacs/gui.lisp:1.25 Wed Dec 29 06:45:37 2004 +++ climacs/gui.lisp Wed Dec 29 06:49:04 2004 @@ -1,450 +1,1893 @@ -;;; -*- Mode: Lisp; Package: CLIMACS-GUI -*- - -;;; (c) copyright 2004 by -;;; Robert Strandh (strandh(a)labri.fr) -;;; (c) copyright 2004 by -;;; Elliott Johnson (ejohnson(a)fasl.info) - -;;; 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. - -;;; GUI for the Climacs editor. - -(in-package :climacs-gui) - -(defclass filename-mixin () - ((filename :initform nil :accessor filename))) - -(defclass climacs-buffer (standard-buffer abbrev-mixin filename-mixin) - ((name :initform "*scratch*" :accessor name) - (modified :initform nil :accessor modified-p))) - -(defclass climacs-pane (application-pane) - ((buffer :initform (make-instance 'climacs-buffer) :accessor buffer) - (point :initform nil :initarg :point :reader point) - (syntax :initarg :syntax :accessor syntax) - (mark :initform nil :initarg :mark :reader mark))) - -(defmethod initialize-instance :after ((pane climacs-pane) &rest args) - (declare (ignore args)) - (with-slots (buffer point syntax mark) pane - (when (null point) - (setf point (make-instance 'standard-right-sticky-mark - :buffer buffer))) - (when (null mark) - (setf mark (make-instance 'standard-right-sticky-mark - :buffer buffer))) - (setf syntax (make-instance 'texinfo-syntax :pane pane)))) - -(define-application-frame climacs () - ((win :reader win)) - (:panes - (win (make-pane 'climacs-pane - :width 900 :height 400 - :name 'win - :incremental-redisplay t - :display-function 'display-win)) - (info :application - :width 900 :height 20 :max-height 20 - :name 'info :background +light-gray+ - :scroll-bars nil - :incremental-redisplay t - :display-function 'display-info) - (int :application :width 900 :height 20 :max-height 20 - :scroll-bars nil)) - (:layouts - (default - (vertically (:scroll-bars nil) - (scrolling (:width 900 :height 400) win) - info - int))) - (:top-level (climacs-top-level))) - -(defun climacs () - "Starts up a climacs session" - (let ((frame (make-application-frame 'climacs))) - (run-frame-top-level frame))) - -(defun display-info (frame pane) - (let* ((win (win frame)) - (buf (buffer win)) - (name-info (format nil " ~a ~a" - (if (modified-p buf) "**" "--") - (name buf)))) - (princ name-info pane))) - -(defun display-win (frame pane) - "The display function used by the climacs application frame." - (declare (ignore frame)) - (redisplay-pane pane)) - -(defun find-gestures (gestures start-table) - (loop with table = (find-command-table start-table) - for (gesture . rest) on gestures - for item = (find-keystroke-item gesture table :errorp nil) - while item - do (if (eq (command-menu-item-type item) :command) - (return (if (null rest) item nil)) - (setf table (command-menu-item-value item))) - finally (return item))) - -(defvar *kill-ring* (initialize-kill-ring 7)) -(defparameter *current-gesture* nil) - -(defun climacs-top-level (frame &key - command-parser command-unparser - partial-command-parser prompt) - (declare (ignore command-parser command-unparser partial-command-parser prompt)) - (setf (slot-value frame 'win) (find-pane-named frame 'win)) -;; (let ((*standard-output* (frame-standard-output frame)) -;; (*standard-input* (frame-standard-input frame)) - (let ((*standard-output* (find-pane-named frame 'win)) - (*standard-input* (find-pane-named frame 'int)) - (*print-pretty* nil) - (*abort-gestures* nil)) - (redisplay-frame-panes frame :force-p t) - (loop with gestures = '() - do (setf *current-gesture* (read-gesture :stream *standard-input*)) - (when (or (characterp *current-gesture*) - (and (typep *current-gesture* 'keyboard-event) - (or (keyboard-event-character *current-gesture*) - (not (member (keyboard-event-key-name - *current-gesture*) - '(:control-left :control-right - :shift-left :shift-right - :meta-left :meta-right - :super-left :super-right - :hyper-left :hyper-right - :shift-lock :caps-lock)))))) - (setf gestures (nconc gestures (list *current-gesture*))) - (let ((item (find-gestures gestures 'global-climacs-table))) - (cond ((not item) - (beep) (setf gestures '())) - ((eq (command-menu-item-type item) :command) - (handler-case - (funcall (command-menu-item-value item)) - (error (condition) - (beep) - (format *error-output* "~a~%" condition))) - (setf gestures '())) - (t nil)))) - (redisplay-frame-panes frame)))) - -(define-command (com-quit :name "Quit" :command-table climacs) () - (frame-exit *application-frame*)) - -(define-command com-self-insert () - (unless (constituentp *current-gesture*) - (possibly-expand-abbrev (point (win *application-frame*)))) - (insert-object (point (win *application-frame*)) *current-gesture*) - (setf (modified-p (buffer (win *application-frame*))) t)) - -(define-command com-backward-object () - (decf (offset (point (win *application-frame*))))) - -(define-command com-forward-object () - (incf (offset (point (win *application-frame*))))) - -(define-command com-beginning-of-line () - (beginning-of-line (point (win *application-frame*)))) - -(define-command com-end-of-line () - (end-of-line (point (win *application-frame*)))) - -(define-command com-delete-object () - (delete-range (point (win *application-frame*))) - (setf (modified-p (buffer (win *application-frame*))) t)) - -(define-command com-backward-delete-object () - (delete-range (point (win *application-frame*)) -1) - (setf (modified-p (buffer (win *application-frame*))) t)) - -(define-command com-previous-line () - (previous-line (point (win *application-frame*)))) - -(define-command com-next-line () - (next-line (point (win *application-frame*)))) - -(define-command com-open-line () - (open-line (point (win *application-frame*))) - (setf (modified-p (buffer (win *application-frame*))) t)) - -(define-command com-kill-line () - (kill-line (point (win *application-frame*))) - (setf (modified-p (buffer (win *application-frame*))) t)) - -(define-command com-forward-word () - (forward-word (point (win *application-frame*)))) - -(define-command com-backward-word () - (backward-word (point (win *application-frame*)))) - -(define-command com-toggle-layout () - (setf (frame-current-layout *application-frame*) - (if (eq (frame-current-layout *application-frame*) 'default) - 'with-interactor - 'default))) - -(define-command com-extended-command () - (let ((item (accept 'command :prompt "Extended Command"))) - (window-clear *standard-input*) - (execute-frame-command *application-frame* item))) - -(defclass weird () () - (:documentation "An open ended class.")) - -(define-command com-insert-weird-stuff () - (insert-object (point (win *application-frame*)) (make-instance 'weird)) - (setf (modified-p (buffer (win *application-frame*))) t)) - -(define-command com-insert-reversed-string () - (insert-sequence (point (win *application-frame*)) - (reverse (accept 'string))) - (setf (modified-p (buffer (win *application-frame*))) t)) - -(define-presentation-type completable-pathname () - :inherit-from 'pathname) - -(defun filename-completer (so-far mode) - (flet ((remove-trail (s) - (subseq s 0 (let ((pos (position #\/ s :from-end t))) - (if pos (1+ pos) 0))))) - (let* ((directory-prefix - (if (and (plusp (length so-far)) (eql (aref so-far 0) #\/)) - "" - (namestring #+sbcl (car (directory ".")) #+cmu (ext:default-directory)))) - (full-so-far (concatenate 'string directory-prefix so-far)) - (pathnames - (loop with length = (length full-so-far) - for path in (directory (concatenate 'string - (remove-trail so-far) - "*.*")) - when (let ((mismatch (mismatch (namestring path) full-so-far))) - (or (null mismatch) (= mismatch length))) - collect path)) - (strings (mapcar #'namestring pathnames)) - (first-string (car strings)) - (length-common-prefix nil) - (completed-string nil) - (full-completed-string nil)) - (unless (null pathnames) - (setf length-common-prefix - (loop with length = (length first-string) - for string in (cdr strings) - do (setf length (min length (or (mismatch string first-string) length))) - finally (return length)))) - (unless (null pathnames) - (setf completed-string - (subseq first-string (length directory-prefix) - (if (null (cdr pathnames)) nil length-common-prefix))) - (setf full-completed-string - (concatenate 'string directory-prefix completed-string))) - (case mode - ((:complete-limited :complete-maximal) - (cond ((null pathnames) - (values so-far nil nil 0 nil)) - ((null (cdr pathnames)) - (values completed-string t (car pathnames) 1 nil)) - (t - (values completed-string nil nil (length pathnames) nil)))) - (:complete - (cond ((null pathnames) - (values so-far t so-far 1 nil)) - ((null (cdr pathnames)) - (values completed-string t (car pathnames) 1 nil)) - ((find full-completed-string strings :test #'string-equal) - (let ((pos (position full-completed-string strings :test #'string-equal))) - (values completed-string - t (elt pathnames pos) (length pathnames) nil))) - (t - (values completed-string nil nil (length pathnames) nil)))) - (:possibilities - (values nil nil nil (length pathnames) - (loop with length = (length directory-prefix) - for name in pathnames - collect (list (subseq (namestring name) length nil) - name)))))))) - -(define-presentation-method accept - ((type completable-pathname) stream (view textual-view) &key) - (multiple-value-bind (pathname success string) - (complete-input stream - #'filename-completer - :partial-completers '(#\Space) - :allow-any-input t) - (declare (ignore success)) - (or pathname string))) - -(defun pathname-filename (pathname) - (if (null (pathname-type pathname)) - (pathname-name pathname) - (concatenate 'string (pathname-name pathname) - "." (pathname-type pathname)))) - -(define-command (com-find-file :name "Find File" :command-table climacs) () - (let ((filename (accept 'completable-pathname - :prompt "Find File"))) - (with-slots (buffer point syntax) (win *application-frame*) - (setf buffer (make-instance 'climacs-buffer) - point (make-instance 'standard-right-sticky-mark :buffer buffer) - syntax (make-instance 'texinfo-syntax :pane (win *application-frame*))) - (with-open-file (stream filename :direction :input :if-does-not-exist :create) - (input-from-stream stream buffer 0)) - (setf (filename buffer) filename - (name buffer) (pathname-filename filename)) - (beginning-of-buffer point)))) - -(define-command com-save-buffer () - (let ((filename (or (filename (buffer (win *application-frame*))) - (accept 'completable-pathname - :prompt "Save Buffer to File"))) - (buffer (buffer (win *application-frame*)))) - (with-open-file (stream filename :direction :output :if-exists :supersede) - (output-to-stream stream buffer 0 (size buffer))) - (setf (filename buffer) filename - (name buffer) (pathname-filename filename)) - (setf (modified-p (buffer (win *application-frame*))) nil))) - -(define-command com-write-buffer () - (let ((filename (accept 'completable-pathname - :prompt "Write Buffer to File")) - (buffer (buffer (win *application-frame*)))) - (with-open-file (stream filename :direction :output :if-exists :supersede) - (output-to-stream stream buffer 0 (size buffer))) - (setf (filename buffer) filename - (name buffer) (pathname-filename filename)) - (setf (modified-p (buffer (win *application-frame*))) nil))) - -(define-command com-beginning-of-buffer () - (beginning-of-buffer (point (win *application-frame*)))) - -(define-command com-end-of-buffer () - (end-of-buffer (point (win *application-frame*)))) - -(define-command com-browse-url () - (accept 'url :prompt "Browse URL")) - -(define-command com-set-mark () - (with-slots (point mark) (win *application-frame*) - (setf mark (clone-mark point)))) - -;;;;;;;;;;;;;;;;;;;; -;; Kill ring commands - -;; The naming may sound odd here, but think of electronic wireing: -;; outputs to inputs and inputs to outputs. Copying into a buffer -;; first requires coping out of the kill ring. - -(define-command com-copy-in () - (kr-copy-out (point (win *application-frame*)) *kill-ring*)) - -(define-command com-cut-in () - (kr-cut-out (point (win *application-frame*)) *kill-ring*)) - -(define-command com-cut-out () - (with-slots (buffer point mark)(win *application-frame*) - (let ((off1 (offset point)) - (off2 (offset mark))) - (if (< off1 off2) - (kr-cut-in buffer *kill-ring* off1 off2) - (kr-cut-in buffer *kill-ring* off2 off1))))) - -(define-command com-copy-out () - (with-slots (buffer point mark)(win *application-frame*) - (let ((off1 (offset point)) - (off2 (offset mark))) - (if (< off1 off2) - (kr-copy-in buffer *kill-ring* off1 off2) - (kr-copy-in buffer *kill-ring* off2 off1))))) - -;; Needs adjustment to be like emacs M-y -(define-command com-kr-rotate () - (kr-rotate *kill-ring* -1)) - -;; Not bound to a key yet -(define-command com-kr-resize () - (let ((size (accept 'fixnum :prompt "New kill ring size: "))) - (kr-resize *kill-ring* size))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Global command table - -(make-command-table 'global-climacs-table :errorp nil) - -(defun global-set-key (gesture command) - (add-command-to-command-table command 'global-climacs-table - :keystroke gesture :errorp nil)) - -(loop for code from (char-code #\space) to (char-code #\~) - do (global-set-key (code-char code) 'com-self-insert)) - -(global-set-key #\newline 'com-self-insert) -(global-set-key #\tab 'com-self-insert) -(global-set-key '(#\f :control) 'com-forward-object) -(global-set-key '(#\b :control) 'com-backward-object) -(global-set-key '(#\a :control) 'com-beginning-of-line) -(global-set-key '(#\e :control) 'com-end-of-line) -(global-set-key '(#\d :control) 'com-delete-object) -(global-set-key '(#\p :control) 'com-previous-line) -(global-set-key '(#\n :control) 'com-next-line) -(global-set-key '(#\o :control) 'com-open-line) -(global-set-key '(#\k :control) 'com-kill-line) -(global-set-key '(#\Space :control) 'com-set-mark) -(global-set-key '(#\y :control) 'com-copy-in) -(global-set-key '(#\w :control) 'com-cut-in) -(global-set-key '(#\f :meta) 'com-forward-word) -(global-set-key '(#\b :meta) 'com-backward-word) -(global-set-key '(#\x :meta) 'com-extended-command) -(global-set-key '(#\a :meta) 'com-insert-weird-stuff) -(global-set-key '(#\c :meta) 'com-insert-reversed-string) -(global-set-key '(#\y :meta) 'com-kr-rotate) ;currently rotates only -(global-set-key '(#\w :meta) 'com-copy-out) -(global-set-key '(#\< :shift :meta) 'com-beginning-of-buffer) -(global-set-key '(#\> :shift :meta) 'com-end-of-buffer) -(global-set-key '(#\u :meta) 'com-browse-url) - -(global-set-key '(:up) 'com-previous-line) -(global-set-key '(:down) 'com-next-line) -(global-set-key '(:left) 'com-backward-object) -(global-set-key '(:right) 'com-forward-object) -(global-set-key '(:left :control) 'com-backward-word) -(global-set-key '(:right :control) 'com-forward-word) -(global-set-key '(:home) 'com-beginning-of-line) -(global-set-key '(:end) 'com-end-of-line) -(global-set-key '(:home :control) 'com-beginning-of-buffer) -(global-set-key '(:end :control) 'com-end-of-buffer) -(global-set-key #\Rubout 'com-delete-object) -(global-set-key #\Backspace 'com-backward-delete-object) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; C-x command table - -(make-command-table 'c-x-climacs-table :errorp nil) - -(add-menu-item-to-command-table 'global-climacs-table "C-x" - :menu 'c-x-climacs-table - :keystroke '(#\x :control)) - -(defun c-x-set-key (gesture command) - (add-command-to-command-table command 'c-x-climacs-table - :keystroke gesture :errorp nil)) - -(c-x-set-key '(#\c :control) 'com-quit) -(c-x-set-key '(#\f :control) 'com-find-file) -(c-x-set-key '(#\s :control) 'com-save-buffer) -(c-x-set-key '(#\w :control) 'com-write-buffer) +; SLIME 2004-12-13 +CL-USER> (load "cvs-dir/mcclim/system") +; in: LAMBDA NIL +; (OR "Lisp-Dep/mp-nil") +; ==> +; "Lisp-Dep/mp-nil" +; +; note: deleting unreachable code +; compilation unit finished +; printed 1 note +T +CL-USER> (require 'clim-clx-user) +; loading system definition from #P"/usr/local/lib/sbcl/site-systems/clx.asd" +; into #<PACKAGE "ASDF4627"> +; registering #<SYSTEM CLX {9811989}> as CLX +; in: LAMBDA (#:G5429 #:G5430 #:G5431 #:G5432 #:G5437 #:G5438) +; (EQL SB-PCL::.CASE-ARG. #:G5429) +; +; note: unable to +; optimize +; due to type uncertainty: +; The first argument is a T, not a SINGLE-FLOAT. +; The second argument is a T, not a SINGLE-FLOAT. +; +; note: unable to +; optimize +; due to type uncertainty: +; The first argument is a T, not a DOUBLE-FLOAT. +; The second argument is a T, not a DOUBLE-FLOAT. +; +; note: forced to do GENERIC-EQL (cost 10) +; unable to do inline fixnum comparison (cost 4) because: +; The first argument is a T, not a FIXNUM. +; The second argument is a T, not a FIXNUM. +; in: +; LAMBDA (#:G5443 #:G5444 +; #:G5445 +; #:G5446 +; #:G5447 +; #:G5448 +; #:G5449 +; #:G5454 +; #:G5455) +; (EQL SB-PCL::.CASE-ARG. #:G5443) +; +; note: unable to +; optimize +; due to type uncertainty: +; The first argument is a T, not a SINGLE-FLOAT. +; The second argument is a T, not a SINGLE-FLOAT. +; +; note: unable to +; optimize +; due to type uncertainty: +; The first argument is a T, not a DOUBLE-FLOAT. +; The second argument is a T, not a DOUBLE-FLOAT. + +; (EQL SB-PCL::.CASE-ARG. #:G5446) +; +; note: unable to +; optimize +; due to type uncertainty: +; The first argument is a T, not a SINGLE-FLOAT. +; The second argument is a T, not a SINGLE-FLOAT. +; +; note: unable to +; optimize +; due to type uncertainty: +; The first argument is a T, not a DOUBLE-FLOAT. +; The second argument is a T, not a DOUBLE-FLOAT. + +; (EQL SB-PCL::.CASE-ARG. #:G5443) +; +; note: forced to do GENERIC-EQL (cost 10) +; unable to do inline fixnum comparison (cost 4) because: +; The first argument is a T, not a FIXNUM. +; The second argument is a T, not a FIXNUM. + +; (EQL SB-PCL::.CASE-ARG. #:G5446) +; +; note: forced to do GENERIC-EQL (cost 10) +; unable to do inline fixnum comparison (cost 4) because: +; The first argument is a T, not a FIXNUM. +; The second argument is a T, not a FIXNUM. +; compilation unit finished +; printed 9 notes +NIL +CL-USER> (load "cvs-dir/climacs/climacs.asd") +T +CL-USER> (require 'climacs) +; compiling file "/home/ejohnson/cvs-dir/climacs/Flexichain/skiplist-package.lisp" (written 16 AUG 2004 01:12:45 AM): +; compiling top level form: + +; /home/ejohnson/cvs-dir/climacs/Flexichain/skiplist-package.fasl written +; compilation finished in 0:00:00 +; compiling file "/home/ejohnson/cvs-dir/climacs/Flexichain/skiplist.lisp" (written 16 AUG 2004 01:12:45 AM): +; compiling top level form: +; compiling DEFCLASS SKIPLIST: +; compiling DEFCLASS SKIPLIST: +; compiling DEFCLASS SKIPLIST: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD INITIALIZE-INSTANCE :AFTER (SKIPLIST): +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD PRINT-OBJECT (SKIPLIST T): +; compiling top level form: +; recognizing DEFUN ENTRY-OBJ +; compiling DEFUN ENTRY-OBJ: +; compiling top level form: +; recognizing DEFUN (SETF ENTRY-OBJ) +; compiling DEFUN (SETF ENTRY-OBJ): +; compiling top level form: +; recognizing DEFUN ENTRY-KEY +; compiling DEFUN ENTRY-KEY: +; compiling top level form: +; recognizing DEFUN (SETF ENTRY-KEY) +; compiling DEFUN (SETF ENTRY-KEY): +; compiling top level form: +; recognizing DEFUN ENTRY-NEXT +; compiling DEFUN ENTRY-NEXT: +; compiling top level form: +; recognizing DEFUN (SETF ENTRY-NEXT) +; compiling DEFUN (SETF ENTRY-NEXT): +; compiling top level form: +; recognizing DEFUN KEY-< +; compiling DEFUN KEY-<: +; compiling top level form: +; recognizing DEFUN KEY-<= +; compiling DEFUN KEY-<=: +; compiling top level form: +; recognizing DEFUN KEY-= +; compiling DEFUN KEY-=: +; compiling top level form: +; recognizing DEFUN KEY-> +; compiling DEFUN KEY->: +; compiling top level form: +; recognizing DEFUN KEY->= +; compiling DEFUN KEY->=: +; compiling top level form: +; recognizing DEFUN LAST-ENTRY-P +; compiling DEFUN LAST-ENTRY-P: +; compiling top level form: +; recognizing DEFUN SKIPLIST-EMPTY-P +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN SKIPLIST-EMPTY-P: +; compiling top level form: +; recognizing DEFUN FIND-ENTRY-LEVEL +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN FIND-ENTRY-LEVEL: +; compiling top level form: +; recognizing DEFUN SKIPLIST-FIND +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN SKIPLIST-FIND: +; compiling top level form: +; recognizing DEFUN SKIPLIST-FIND-FIRST +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN SKIPLIST-FIND-FIRST: +; compiling top level form: +; recognizing DEFUN PICK-A-LEVEL +; compiling DEFUN PICK-A-LEVEL: +; compiling top level form: +; recognizing DEFUN MAKE-ENTRY +; compiling DEFUN MAKE-ENTRY: +; compiling top level form: +; recognizing DEFUN (SETF SKIPLIST-FIND) +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN (SETF SKIPLIST-FIND): +; compiling top level form: +; recognizing DEFUN SKIPLIST-DELETE +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN SKIPLIST-DELETE: +; compiling top level form: +; recognizing DEFUN UPDATE-INTERVAL +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN UPDATE-INTERVAL: +; compiling top level form: +; recognizing DEFUN SKIPLIST-SLIDE-KEYS +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN SKIPLIST-SLIDE-KEYS: +; compiling top level form: +; recognizing DEFUN SKIPLIST-ROTATE-PREFIX +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN SKIPLIST-ROTATE-PREFIX: +; compiling top level form: +; recognizing DEFUN UPDATE-INTERVAL-TO-END +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN UPDATE-INTERVAL-TO-END: +; compiling top level form: +; recognizing DEFUN SKIPLIST-ROTATE-SUFFIX +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN SKIPLIST-ROTATE-SUFFIX: +; compiling top level form: + +; /home/ejohnson/cvs-dir/climacs/Flexichain/skiplist.fasl written +; compilation finished in 0:00:02 +; compiling file "/home/ejohnson/cvs-dir/climacs/Flexichain/flexichain-package.lisp" (written 27 DEC 2004 10:57:00 PM): +; compiling top level form: + +; /home/ejohnson/cvs-dir/climacs/Flexichain/flexichain-package.fasl written +; compilation finished in 0:00:00 +; compiling file "/home/ejohnson/cvs-dir/climacs/Flexichain/utilities.lisp" (written 01 AUG 2004 08:27:19 AM): +; compiling top level form: +; recognizing DEFUN SQUARE +; compiling DEFUN SQUARE: +; compiling top level form: +; recognizing DEFUN FIND-IF-2 +; compiling DEFUN FIND-IF-2: +; compiling top level form: +; recognizing DEFUN MAKE-WEAK-POINTER +; compiling DEFUN MAKE-WEAK-POINTER: +; compiling top level form: +; recognizing DEFUN WEAK-POINTER-VALUE +; compiling DEFUN WEAK-POINTER-VALUE: +; compiling top level form: + +; /home/ejohnson/cvs-dir/climacs/Flexichain/utilities.fasl written +; compilation finished in 0:00:00 +; compiling file "/home/ejohnson/cvs-dir/climacs/Flexichain/flexichain.lisp" (written 27 DEC 2004 10:57:00 PM): +; compiling top level form: +; compiling DEFCLASS FLEXICHAIN: +; compiling DEFCLASS FLEXICHAIN: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD INITIALIZE-INSTANCE :AFTER (FLEXICHAIN): +; compiling top level form: +; compiling top level form: +; compiling DEFINE-CONDITION FLEXI-INITIALIZATION-ERROR: +; compiling top level form: +; compiling DEFINE-CONDITION FLEXI-POSITION-ERROR: +; compiling top level form: +; compiling DEFINE-CONDITION FLEXI-INCOMPATIBLE-TYPE-ERROR: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN REQUIRED-SPACE +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN REQUIRED-SPACE: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD INITIALIZE-INSTANCE :AFTER (STANDARD-FLEXICHAIN): +; compiling top level form: +; compiling DEFMACRO WITH-VIRTUAL-GAP: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD NB-ELEMENTS (STANDARD-FLEXICHAIN): +; compiling top level form: +; compiling DEFMETHOD FLEXI-EMPTY-P (STANDARD-FLEXICHAIN): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN POSITION-INDEX +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN POSITION-INDEX: +; compiling top level form: +; recognizing DEFUN INDEX-POSITION +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN INDEX-POSITION: +; compiling top level form: +; recognizing DEFUN ENSURE-GAP-POSITION +; compiling DEFUN ENSURE-GAP-POSITION: +; compiling top level form: +; recognizing DEFUN ENSURE-ROOM +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN ENSURE-ROOM: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD INSERT* (STANDARD-FLEXICHAIN T T): +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD INSERT-VECTOR* (STANDARD-FLEXICHAIN T T): +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD DELETE* (STANDARD-FLEXICHAIN T): +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD ELEMENT* (STANDARD-FLEXICHAIN T): +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD (SETF ELEMENT*) (T STANDARD-FLEXICHAIN T): +; compiling top level form: +; compiling DEFMETHOD PUSH-START (STANDARD-FLEXICHAIN T): +; compiling top level form: +; compiling DEFMETHOD PUSH-END (STANDARD-FLEXICHAIN T): +; compiling top level form: +; compiling DEFMETHOD POP-START (STANDARD-FLEXICHAIN): +; compiling top level form: +; compiling DEFMETHOD POP-END (STANDARD-FLEXICHAIN): +; compiling top level form: +; compiling DEFMETHOD ROTATE (STANDARD-FLEXICHAIN): +; compiling top level form: +; recognizing DEFUN MOVE-GAP +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN MOVE-GAP: +; compiling top level form: +; recognizing DEFUN MOVE-EMPTY-GAP +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN MOVE-EMPTY-GAP: +; compiling top level form: +; recognizing DEFUN MOVE-LEFT-GAP +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN MOVE-LEFT-GAP: +; compiling top level form: +; recognizing DEFUN MOVE-RIGHT-GAP +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN MOVE-RIGHT-GAP: +; compiling top level form: +; recognizing DEFUN MOVE-MIDDLE-GAP +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN MOVE-MIDDLE-GAP: +; compiling top level form: +; recognizing DEFUN MOVE-NON-CONTIGUOUS-GAP +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN MOVE-NON-CONTIGUOUS-GAP: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD MOVE-ELEMENTS (STANDARD-FLEXICHAIN T T T T T): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD FILL-GAP (STANDARD-FLEXICHAIN T T): +; compiling top level form: +; recognizing DEFUN PUSH-ELEMENTS-LEFT +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN PUSH-ELEMENTS-LEFT: +; compiling top level form: +; recognizing DEFUN PUSH-ELEMENTS-RIGHT +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN PUSH-ELEMENTS-RIGHT: +; compiling top level form: +; recognizing DEFUN HOP-ELEMENTS-LEFT +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN HOP-ELEMENTS-LEFT: +; compiling top level form: +; recognizing DEFUN HOP-ELEMENTS-RIGHT +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN HOP-ELEMENTS-RIGHT: +; compiling top level form: +; recognizing DEFUN INCREASE-BUFFER-SIZE +; compiling DEFUN INCREASE-BUFFER-SIZE: +; compiling top level form: +; recognizing DEFUN DECREASE-BUFFER-SIZE +; compiling DEFUN DECREASE-BUFFER-SIZE: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD RESIZE-BUFFER (STANDARD-FLEXICHAIN T): +; compiling top level form: +; recognizing DEFUN NORMALIZE-INDICES +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN NORMALIZE-INDICES: +; compiling top level form: +; recognizing DEFUN GAP-LOCATION +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN GAP-LOCATION: +; compiling top level form: + +; /home/ejohnson/cvs-dir/climacs/Flexichain/flexichain.fasl written +; compilation finished in 0:00:04 +; compiling file "/home/ejohnson/cvs-dir/climacs/Flexichain/flexicursor.lisp" (written 06 SEP 2004 04:25:52 AM): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFINE-CONDITION AT-BEGINNING-ERROR: +; compiling top level form: +; compiling DEFINE-CONDITION AT-END-ERROR: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling DEFCLASS STANDARD-CURSORCHAIN: +; compiling top level form: +; recognizing DEFUN MAKE-WP +; compiling DEFUN MAKE-WP: +; compiling top level form: +; recognizing DEFUN WP-VALUE +; compiling DEFUN WP-VALUE: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD MOVE-ELEMENTS :AFTER (STANDARD-CURSORCHAIN T T T T T): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD INITIALIZE-INSTANCE :AFTER (LEFT-STICKY-FLEXICURSOR): +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD INITIALIZE-INSTANCE :AFTER (RIGHT-STICKY-FLEXICURSOR): +; compiling top level form: +; compiling DEFMETHOD CLONE-CURSOR (STANDARD-FLEXICURSOR): +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD CURSOR-POS (LEFT-STICKY-FLEXICURSOR): +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD (SETF CURSOR-POS) (T LEFT-STICKY-FLEXICURSOR): +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD CURSOR-POS (RIGHT-STICKY-FLEXICURSOR): +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD (SETF CURSOR-POS) (T RIGHT-STICKY-FLEXICURSOR): +; compiling top level form: +; compiling DEFMETHOD AT-BEGINNING-P (STANDARD-FLEXICURSOR): +; compiling top level form: +; compiling DEFMETHOD AT-END-P (STANDARD-FLEXICURSOR): +; compiling top level form: +; compiling DEFMETHOD INSERT (STANDARD-FLEXICURSOR T): +; compiling top level form: +; compiling DEFMETHOD INSERT-SEQUENCE (STANDARD-FLEXICURSOR T): +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD DELETE* :BEFORE (STANDARD-CURSORCHAIN T): +; compiling top level form: +; compiling DEFMETHOD DELETE> (STANDARD-FLEXICURSOR): +; compiling top level form: +; compiling DEFMETHOD DELETE< (STANDARD-FLEXICURSOR): +; compiling top level form: +; compiling DEFMETHOD ELEMENT> (STANDARD-FLEXICURSOR): +; compiling top level form: +; compiling DEFMETHOD (SETF ELEMENT>) (T STANDARD-FLEXICURSOR): +; compiling top level form: +; compiling DEFMETHOD ELEMENT< (STANDARD-FLEXICURSOR): +; compiling top level form: +; compiling DEFMETHOD (SETF ELEMENT<) (T STANDARD-FLEXICURSOR): +; compiling top level form: + +; /home/ejohnson/cvs-dir/climacs/Flexichain/flexicursor.fasl written +; compilation finished in 0:00:02 +; compiling file "/home/ejohnson/cvs-dir/climacs/packages.lisp" (written 28 DEC 2004 09:38:37 PM): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: + +; /home/ejohnson/cvs-dir/climacs/packages.fasl written +; compilation finished in 0:00:00 +; compiling file "/home/ejohnson/cvs-dir/climacs/buffer.lisp" (written 27 DEC 2004 10:58:36 PM): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling DEFCLASS STANDARD-BUFFER: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD OFFSET (T): +; compiling top level form: +; compiling DEFMETHOD (SETF OFFSET) (T T): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling DEFMETHOD INITIALIZE-INSTANCE :AFTER (LEFT-STICKY-MARK): +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling DEFMETHOD INITIALIZE-INSTANCE :AFTER (RIGHT-STICKY-MARK): +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling DEFMETHOD INITIALIZE-INSTANCE :AFTER (STANDARD-BUFFER): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD CLONE-MARK (STANDARD-LEFT-STICKY-MARK): +; compiling top level form: +; compiling DEFMETHOD CLONE-MARK (STANDARD-RIGHT-STICKY-MARK): +; compiling top level form: +; compiling DEFINE-CONDITION NO-SUCH-OFFSET: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD SIZE (STANDARD-BUFFER): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD NUMBER-OF-LINES (STANDARD-BUFFER): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD MARK< (MARK-MIXIN MARK-MIXIN): +; compiling top level form: +; compiling DEFMETHOD MARK< (MARK-MIXIN INTEGER): +; compiling top level form: +; compiling DEFMETHOD MARK< (INTEGER MARK-MIXIN): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD MARK<= (MARK-MIXIN MARK-MIXIN): +; compiling top level form: +; compiling DEFMETHOD MARK<= (MARK-MIXIN INTEGER): +; compiling top level form: +; compiling DEFMETHOD MARK<= (INTEGER MARK-MIXIN): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD MARK= (MARK-MIXIN MARK-MIXIN): +; compiling top level form: +; compiling DEFMETHOD MARK= (MARK-MIXIN INTEGER): +; compiling top level form: +; compiling DEFMETHOD MARK= (INTEGER MARK-MIXIN): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD MARK> (MARK-MIXIN MARK-MIXIN): +; compiling top level form: +; compiling DEFMETHOD MARK> (MARK-MIXIN INTEGER): +; compiling top level form: +; compiling DEFMETHOD MARK> (INTEGER MARK-MIXIN): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD MARK>= (MARK-MIXIN MARK-MIXIN): +; compiling top level form: +; compiling DEFMETHOD MARK>= (MARK-MIXIN INTEGER): +; compiling top level form: +; compiling DEFMETHOD MARK>= (INTEGER MARK-MIXIN): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD BEGINNING-OF-BUFFER (MARK-MIXIN): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD END-OF-BUFFER (MARK-MIXIN): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD BEGINNING-OF-BUFFER-P (MARK-MIXIN): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD END-OF-BUFFER-P (MARK-MIXIN): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD BEGINNING-OF-LINE-P (MARK-MIXIN): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD END-OF-LINE-P (MARK-MIXIN): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD BEGINNING-OF-LINE (MARK-MIXIN): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD END-OF-LINE (MARK-MIXIN): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD LINE-NUMBER (MARK-MIXIN): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD COLUMN-NUMBER (MARK-MIXIN): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD INSERT-BUFFER-OBJECT (STANDARD-BUFFER T T): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD INSERT-BUFFER-SEQUENCE (STANDARD-BUFFER T T): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD INSERT-OBJECT (MARK-MIXIN T): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD INSERT-SEQUENCE (MARK-MIXIN T): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD DELETE-BUFFER-RANGE (STANDARD-BUFFER T T): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD DELETE-RANGE (MARK-MIXIN): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD DELETE-REGION (MARK-MIXIN MARK-MIXIN): +; compiling top level form: +; compiling DEFMETHOD DELETE-REGION (MARK-MIXIN T): +; compiling top level form: +; compiling DEFMETHOD DELETE-REGION (T MARK-MIXIN): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD BUFFER-OBJECT (STANDARD-BUFFER T): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD BUFFER-SEQUENCE (STANDARD-BUFFER T T): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD OBJECT-BEFORE (MARK-MIXIN): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD OBJECT-AFTER (MARK-MIXIN): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD REGION-TO-SEQUENCE (MARK-MIXIN MARK-MIXIN): +; compiling top level form: +; compiling DEFMETHOD REGION-TO-SEQUENCE (INTEGER MARK-MIXIN): +; compiling top level form: +; compiling DEFMETHOD REGION-TO-SEQUENCE (MARK-MIXIN INTEGER): +; compiling top level form: +; compiling DEFMETHOD INSERT-BUFFER-OBJECT :BEFORE (STANDARD-BUFFER T T): +; compiling top level form: +; compiling DEFMETHOD INSERT-BUFFER-SEQUENCE :BEFORE (STANDARD-BUFFER T T): +; compiling top level form: +; compiling DEFMETHOD DELETE-BUFFER-RANGE :BEFORE (STANDARD-BUFFER T T): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD RESET-LOW-HIGH-MARKS (STANDARD-BUFFER): +; compiling top level form: + +; /home/ejohnson/cvs-dir/climacs/buffer.fasl written +; compilation finished in 0:00:04 +; compiling file "/home/ejohnson/cvs-dir/climacs/base.lisp" (written 27 DEC 2004 03:32:46 AM): +; compiling top level form: +; recognizing DEFUN PREVIOUS-LINE +; compiling DEFUN PREVIOUS-LINE: +; compiling top level form: +; recognizing DEFUN NEXT-LINE +; compiling DEFUN NEXT-LINE: +; compiling top level form: +; recognizing DEFUN OPEN-LINE +; compiling DEFUN OPEN-LINE: +; compiling top level form: +; recognizing DEFUN KILL-LINE +; compiling DEFUN KILL-LINE: +; compiling top level form: +; recognizing DEFUN BUFFER-NUMBER-OF-LINES-IN-REGION +; compiling DEFUN BUFFER-NUMBER-OF-LINES-IN-REGION: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling DEFMETHOD NUMBER-OF-LINES-IN-REGION (MARK MARK): +; compiling top level form (SB-KERNEL:FIND-CLASSOID-CELL (QUOTE CLIMACS-BUFFER:MARK)): +; compiling top level form: +; compiling DEFMETHOD NUMBER-OF-LINES-IN-REGION (INTEGER MARK): +; compiling top level form: +; compiling DEFMETHOD NUMBER-OF-LINES-IN-REGION (MARK INTEGER): +; compiling top level form: +; recognizing DEFUN CONSTITUENTP +; compiling DEFUN CONSTITUENTP: +; compiling top level form: +; recognizing DEFUN FORWARD-WORD +; compiling DEFUN FORWARD-WORD: +; compiling top level form: +; recognizing DEFUN BACKWARD-WORD +; compiling DEFUN BACKWARD-WORD: +; compiling top level form: + +; /home/ejohnson/cvs-dir/climacs/base.fasl written +; compilation finished in 0:00:01 +; compiling file "/home/ejohnson/cvs-dir/climacs/io.lisp" (written 27 DEC 2004 10:58:36 PM): +; compiling top level form: +; recognizing DEFUN INPUT-FROM-STREAM +; compiling DEFUN INPUT-FROM-STREAM: +; compiling top level form: +; recognizing DEFUN OUTPUT-TO-STREAM +; compiling DEFUN OUTPUT-TO-STREAM: +; compiling top level form: + +; /home/ejohnson/cvs-dir/climacs/io.fasl written +; compilation finished in 0:00:00 +; compiling file "/home/ejohnson/cvs-dir/climacs/abbrev.lisp" (written 23 DEC 2004 12:00:33 AM): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN STRING-UPPER-CASE-P +; compiling DEFUN STRING-UPPER-CASE-P: +; compiling top level form: +; compiling DEFMETHOD EXPAND-ABBREV (T DICTIONARY-ABBREV-EXPANDER): +; compiling top level form: +; recognizing DEFUN POSSIBLY-EXPAND-ABBREV +; compiling DEFUN POSSIBLY-EXPAND-ABBREV: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling DEFCLASS ABBREV-MIXIN: +; compiling top level form: + +; /home/ejohnson/cvs-dir/climacs/abbrev.fasl written +; compilation finished in 0:00:00 +; compiling file "/home/ejohnson/cvs-dir/climacs/syntax.lisp" (written 28 DEC 2004 02:41:14 PM): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN REDISPLAY-PANE +; compiling DEFUN REDISPLAY-PANE: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD INITIALIZE-INSTANCE :AFTER (BASIC-SYNTAX): +; compiling top level form: +; compiling DEFINE-PRESENTATION-TYPE URL: +; compiling DEFINE-PRESENTATION-TYPE URL: +; compiling top level form: +; compiling DEFINE-PRESENTATION-TYPE URL: +; compiling top level form: +; compiling DEFMETHOD PRESENT-CONTENTS (T T BASIC-SYNTAX): +; compiling top level form: +; compiling DEFMACRO MAYBE-UPDATING-OUTPUT: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD DISPLAY-LINE (T BASIC-SYNTAX): +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFMETHOD REDISPLAY-WITH-SYNTAX (T BASIC-SYNTAX): +; compiling top level form: +; compiling top level form: +; compiling DEFINE-PRESENTATION-TYPE TEXINFO-COMMAND: +; compiling DEFINE-PRESENTATION-TYPE TEXINFO-COMMAND: +; compiling top level form: +; compiling DEFINE-PRESENTATION-TYPE TEXINFO-COMMAND: +; compiling top level form: +; compiling DEFMETHOD PRESENT-CONTENTS (T T TEXINFO-SYNTAX): +; compiling top level form: + +; /home/ejohnson/cvs-dir/climacs/syntax.fasl written +; compilation finished in 0:00:02 +; compiling file "/home/ejohnson/cvs-dir/climacs/kill-ring.lisp" (written 28 DEC 2004 09:28:25 PM): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN INITIALIZE-KILL-RING +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling DEFUN INITIALIZE-KILL-RING: +; compiling top level form: +; recognizing DEFUN KR-LENGTH +; compiling DEFUN KR-LENGTH: +; compiling top level form: +; recognizing DEFUN KR-RESIZE +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN KR-RESIZE: +; compiling top level form: +; recognizing DEFUN KR-PUSH +; compiling DEFUN KR-PUSH: +; compiling top level form: +; recognizing DEFUN KR-POP +; compiling DEFUN KR-POP: +; compiling top level form: +; recognizing DEFUN KR-ROTATE +; compiling DEFUN KR-ROTATE: +; compiling top level form: +; recognizing DEFUN KR-COPY +; compiling DEFUN KR-COPY: +; compiling top level form: +; recognizing DEFUN KR-COPY-IN +; compiling DEFUN KR-COPY-IN: +; compiling top level form: +; recognizing DEFUN KR-CUT-IN +; compiling DEFUN KR-CUT-IN: +; compiling top level form: +; recognizing DEFUN KR-COPY-OUT +; compiling DEFUN KR-COPY-OUT: +; compiling top level form: +; recognizing DEFUN KR-CUT-OUT +; compiling DEFUN KR-CUT-OUT: +; compiling top level form: + +; /home/ejohnson/cvs-dir/climacs/kill-ring.fasl written +; compilation finished in 0:00:00 +; compiling file "/home/ejohnson/cvs-dir/climacs/gui.lisp" (written 28 DEC 2004 09:26:34 PM): +; compiling top level form: +; compiling top level form: +; compiling DEFCLASS CLIMACS-BUFFER: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling DEFCLASS CLIMACS-PANE: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling DEFMETHOD INITIALIZE-INSTANCE :AFTER (CLIMACS-PANE): +; compiling top level form: +; compiling DEFINE-APPLICATION-FRAME CLIMACS: +; compiling DEFINE-APPLICATION-FRAME CLIMACS: +; compiling DEFINE-APPLICATION-FRAME CLIMACS: +; compiling DEFINE-APPLICATION-FRAME CLIMACS: +; compiling DEFINE-APPLICATION-FRAME CLIMACS: +; compiling DEFINE-APPLICATION-FRAME CLIMACS: +; compiling DEFINE-APPLICATION-FRAME CLIMACS: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFINE-APPLICATION-FRAME CLIMACS: +; compiling top level form (SB-KERNEL:FIND-CLASSOID-CELL (QUOTE CLIM:FRAME-MANAGER)): +; compiling top level form: +; compiling DEFINE-APPLICATION-FRAME CLIMACS: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form: +; compiling DEFINE-APPLICATION-FRAME CLIMACS: +; compiling top level form: +; recognizing DEFUN CLIMACS +; compiling DEFUN CLIMACS: +; compiling top level form: +; recognizing DEFUN DISPLAY-INFO +; compiling DEFUN DISPLAY-INFO: +; compiling top level form: +; recognizing DEFUN DISPLAY-WIN +; compiling DEFUN DISPLAY-WIN: +; compiling top level form: +; recognizing DEFUN FIND-GESTURES +; compiling DEFUN FIND-GESTURES: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN CLIMACS-TOP-LEVEL +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFUN CLIMACS-TOP-LEVEL: +; compiling top level form (SB-KERNEL:FIND-CLASSOID-CELL (QUOTE CLIM:KEYBOARD-EVENT)): +; compiling top level form: +; recognizing DEFUN COM-QUIT +; compiling DEFINE-COMMAND (COM-QUIT :NAME "Quit" :COMMAND-TABLE CLIMACS): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-QUIT%ACCEPTOR%1 +; compiling DEFINE-COMMAND (COM-QUIT :NAME "Quit" :COMMAND-TABLE CLIMACS): +; compiling top level form: +; recognizing DEFUN COM-QUIT%PARTIAL%2 +; compiling DEFINE-COMMAND (COM-QUIT :NAME "Quit" :COMMAND-TABLE CLIMACS): +; compiling top level form: +; recognizing DEFUN |COM-QUIT%unparser%3| +; compiling DEFINE-COMMAND (COM-QUIT :NAME "Quit" :COMMAND-TABLE CLIMACS): +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-SELF-INSERT +; compiling DEFINE-COMMAND COM-SELF-INSERT: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-SELF-INSERT%ACCEPTOR%4 +; compiling DEFINE-COMMAND COM-SELF-INSERT: +; compiling top level form: +; recognizing DEFUN COM-SELF-INSERT%PARTIAL%5 +; compiling DEFINE-COMMAND COM-SELF-INSERT: +; compiling top level form: +; recognizing DEFUN |COM-SELF-INSERT%unparser%6| +; compiling DEFINE-COMMAND COM-SELF-INSERT: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-BACKWARD-OBJECT +; compiling DEFINE-COMMAND COM-BACKWARD-OBJECT: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-BACKWARD-OBJECT%ACCEPTOR%7 +; compiling DEFINE-COMMAND COM-BACKWARD-OBJECT: +; compiling top level form: +; recognizing DEFUN COM-BACKWARD-OBJECT%PARTIAL%8 +; compiling DEFINE-COMMAND COM-BACKWARD-OBJECT: +; compiling top level form: +; recognizing DEFUN |COM-BACKWARD-OBJECT%unparser%9| +; compiling DEFINE-COMMAND COM-BACKWARD-OBJECT: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-FORWARD-OBJECT +; compiling DEFINE-COMMAND COM-FORWARD-OBJECT: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-FORWARD-OBJECT%ACCEPTOR%10 +; compiling DEFINE-COMMAND COM-FORWARD-OBJECT: +; compiling top level form: +; recognizing DEFUN COM-FORWARD-OBJECT%PARTIAL%11 +; compiling DEFINE-COMMAND COM-FORWARD-OBJECT: +; compiling top level form: +; recognizing DEFUN |COM-FORWARD-OBJECT%unparser%12| +; compiling DEFINE-COMMAND COM-FORWARD-OBJECT: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-BEGINNING-OF-LINE +; compiling DEFINE-COMMAND COM-BEGINNING-OF-LINE: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-BEGINNING-OF-LINE%ACCEPTOR%13 +; compiling DEFINE-COMMAND COM-BEGINNING-OF-LINE: +; compiling top level form: +; recognizing DEFUN COM-BEGINNING-OF-LINE%PARTIAL%14 +; compiling DEFINE-COMMAND COM-BEGINNING-OF-LINE: +; compiling top level form: +; recognizing DEFUN |COM-BEGINNING-OF-LINE%unparser%15| +; compiling DEFINE-COMMAND COM-BEGINNING-OF-LINE: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-END-OF-LINE +; compiling DEFINE-COMMAND COM-END-OF-LINE: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-END-OF-LINE%ACCEPTOR%16 +; compiling DEFINE-COMMAND COM-END-OF-LINE: +; compiling top level form: +; recognizing DEFUN COM-END-OF-LINE%PARTIAL%17 +; compiling DEFINE-COMMAND COM-END-OF-LINE: +; compiling top level form: +; recognizing DEFUN |COM-END-OF-LINE%unparser%18| +; compiling DEFINE-COMMAND COM-END-OF-LINE: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-DELETE-OBJECT +; compiling DEFINE-COMMAND COM-DELETE-OBJECT: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-DELETE-OBJECT%ACCEPTOR%19 +; compiling DEFINE-COMMAND COM-DELETE-OBJECT: +; compiling top level form: +; recognizing DEFUN COM-DELETE-OBJECT%PARTIAL%20 +; compiling DEFINE-COMMAND COM-DELETE-OBJECT: +; compiling top level form: +; recognizing DEFUN |COM-DELETE-OBJECT%unparser%21| +; compiling DEFINE-COMMAND COM-DELETE-OBJECT: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-BACKWARD-DELETE-OBJECT +; compiling DEFINE-COMMAND COM-BACKWARD-DELETE-OBJECT: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-BACKWARD-DELETE-OBJECT%ACCEPTOR%22 +; compiling DEFINE-COMMAND COM-BACKWARD-DELETE-OBJECT: +; compiling top level form: +; recognizing DEFUN COM-BACKWARD-DELETE-OBJECT%PARTIAL%23 +; compiling DEFINE-COMMAND COM-BACKWARD-DELETE-OBJECT: +; compiling top level form: +; recognizing DEFUN |COM-BACKWARD-DELETE-OBJECT%unparser%24| +; compiling DEFINE-COMMAND COM-BACKWARD-DELETE-OBJECT: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-PREVIOUS-LINE +; compiling DEFINE-COMMAND COM-PREVIOUS-LINE: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-PREVIOUS-LINE%ACCEPTOR%25 +; compiling DEFINE-COMMAND COM-PREVIOUS-LINE: +; compiling top level form: +; recognizing DEFUN COM-PREVIOUS-LINE%PARTIAL%26 +; compiling DEFINE-COMMAND COM-PREVIOUS-LINE: +; compiling top level form: +; recognizing DEFUN |COM-PREVIOUS-LINE%unparser%27| +; compiling DEFINE-COMMAND COM-PREVIOUS-LINE: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-NEXT-LINE +; compiling DEFINE-COMMAND COM-NEXT-LINE: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-NEXT-LINE%ACCEPTOR%28 +; compiling DEFINE-COMMAND COM-NEXT-LINE: +; compiling top level form: +; recognizing DEFUN COM-NEXT-LINE%PARTIAL%29 +; compiling DEFINE-COMMAND COM-NEXT-LINE: +; compiling top level form: +; recognizing DEFUN |COM-NEXT-LINE%unparser%30| +; compiling DEFINE-COMMAND COM-NEXT-LINE: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-OPEN-LINE +; compiling DEFINE-COMMAND COM-OPEN-LINE: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-OPEN-LINE%ACCEPTOR%31 +; compiling DEFINE-COMMAND COM-OPEN-LINE: +; compiling top level form: +; recognizing DEFUN COM-OPEN-LINE%PARTIAL%32 +; compiling DEFINE-COMMAND COM-OPEN-LINE: +; compiling top level form: +; recognizing DEFUN |COM-OPEN-LINE%unparser%33| +; compiling DEFINE-COMMAND COM-OPEN-LINE: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-KILL-LINE +; compiling DEFINE-COMMAND COM-KILL-LINE: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-KILL-LINE%ACCEPTOR%34 +; compiling DEFINE-COMMAND COM-KILL-LINE: +; compiling top level form: +; recognizing DEFUN COM-KILL-LINE%PARTIAL%35 +; compiling DEFINE-COMMAND COM-KILL-LINE: +; compiling top level form: +; recognizing DEFUN |COM-KILL-LINE%unparser%36| +; compiling DEFINE-COMMAND COM-KILL-LINE: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-FORWARD-WORD +; compiling DEFINE-COMMAND COM-FORWARD-WORD: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-FORWARD-WORD%ACCEPTOR%37 +; compiling DEFINE-COMMAND COM-FORWARD-WORD: +; compiling top level form: +; recognizing DEFUN COM-FORWARD-WORD%PARTIAL%38 +; compiling DEFINE-COMMAND COM-FORWARD-WORD: +; compiling top level form: +; recognizing DEFUN |COM-FORWARD-WORD%unparser%39| +; compiling DEFINE-COMMAND COM-FORWARD-WORD: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-BACKWARD-WORD +; compiling DEFINE-COMMAND COM-BACKWARD-WORD: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-BACKWARD-WORD%ACCEPTOR%40 +; compiling DEFINE-COMMAND COM-BACKWARD-WORD: +; compiling top level form: +; recognizing DEFUN COM-BACKWARD-WORD%PARTIAL%41 +; compiling DEFINE-COMMAND COM-BACKWARD-WORD: +; compiling top level form: +; recognizing DEFUN |COM-BACKWARD-WORD%unparser%42| +; compiling DEFINE-COMMAND COM-BACKWARD-WORD: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-TOGGLE-LAYOUT +; compiling DEFINE-COMMAND COM-TOGGLE-LAYOUT: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-TOGGLE-LAYOUT%ACCEPTOR%43 +; compiling DEFINE-COMMAND COM-TOGGLE-LAYOUT: +; compiling top level form: +; recognizing DEFUN COM-TOGGLE-LAYOUT%PARTIAL%44 +; compiling DEFINE-COMMAND COM-TOGGLE-LAYOUT: +; compiling top level form: +; recognizing DEFUN |COM-TOGGLE-LAYOUT%unparser%45| +; compiling DEFINE-COMMAND COM-TOGGLE-LAYOUT: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-EXTENDED-COMMAND +; compiling DEFINE-COMMAND COM-EXTENDED-COMMAND: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-EXTENDED-COMMAND%ACCEPTOR%46 +; compiling DEFINE-COMMAND COM-EXTENDED-COMMAND: +; compiling top level form: +; recognizing DEFUN COM-EXTENDED-COMMAND%PARTIAL%47 +; compiling DEFINE-COMMAND COM-EXTENDED-COMMAND: +; compiling top level form: +; recognizing DEFUN |COM-EXTENDED-COMMAND%unparser%48| +; compiling DEFINE-COMMAND COM-EXTENDED-COMMAND: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-INSERT-WEIRD-STUFF +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling DEFINE-COMMAND COM-INSERT-WEIRD-STUFF: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-INSERT-WEIRD-STUFF%ACCEPTOR%49 +; compiling DEFINE-COMMAND COM-INSERT-WEIRD-STUFF: +; compiling top level form: +; recognizing DEFUN COM-INSERT-WEIRD-STUFF%PARTIAL%50 +; compiling DEFINE-COMMAND COM-INSERT-WEIRD-STUFF: +; compiling top level form: +; recognizing DEFUN |COM-INSERT-WEIRD-STUFF%unparser%51| +; compiling DEFINE-COMMAND COM-INSERT-WEIRD-STUFF: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-INSERT-REVERSED-STRING +; compiling DEFINE-COMMAND COM-INSERT-REVERSED-STRING: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-INSERT-REVERSED-STRING%ACCEPTOR%52 +; compiling DEFINE-COMMAND COM-INSERT-REVERSED-STRING: +; compiling top level form: +; recognizing DEFUN COM-INSERT-REVERSED-STRING%PARTIAL%53 +; compiling DEFINE-COMMAND COM-INSERT-REVERSED-STRING: +; compiling top level form: +; recognizing DEFUN |COM-INSERT-REVERSED-STRING%unparser%54| +; compiling DEFINE-COMMAND COM-INSERT-REVERSED-STRING: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; compiling DEFINE-PRESENTATION-TYPE COMPLETABLE-PATHNAME: +; compiling DEFINE-PRESENTATION-TYPE COMPLETABLE-PATHNAME: +; compiling top level form: +; compiling DEFINE-PRESENTATION-TYPE COMPLETABLE-PATHNAME: +; compiling top level form: +; recognizing DEFUN FILENAME-COMPLETER +; compiling DEFUN FILENAME-COMPLETER: +; compiling top level form: +; compiling DEFINE-PRESENTATION-METHOD ACCEPT: +; compiling top level form (SB-KERNEL:FIND-CLASSOID-CELL (QUOTE CLIM:TEXTUAL-VIEW)): +; compiling top level form: +; recognizing DEFUN PATHNAME-FILENAME +; compiling DEFUN PATHNAME-FILENAME: +; compiling top level form: +; recognizing DEFUN COM-FIND-FILE +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFINE-COMMAND (COM-FIND-FILE :NAME "Find File" :COMMAND-TABLE CLIMACS): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-FIND-FILE%ACCEPTOR%55 +; compiling DEFINE-COMMAND (COM-FIND-FILE :NAME "Find File" :COMMAND-TABLE CLIMACS): +; compiling top level form: +; recognizing DEFUN COM-FIND-FILE%PARTIAL%56 +; compiling DEFINE-COMMAND (COM-FIND-FILE :NAME "Find File" :COMMAND-TABLE CLIMACS): +; compiling top level form: +; recognizing DEFUN |COM-FIND-FILE%unparser%57| +; compiling DEFINE-COMMAND (COM-FIND-FILE :NAME "Find File" :COMMAND-TABLE CLIMACS): +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-SAVE-BUFFER +; compiling DEFINE-COMMAND COM-SAVE-BUFFER: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-SAVE-BUFFER%ACCEPTOR%58 +; compiling DEFINE-COMMAND COM-SAVE-BUFFER: +; compiling top level form: +; recognizing DEFUN COM-SAVE-BUFFER%PARTIAL%59 +; compiling DEFINE-COMMAND COM-SAVE-BUFFER: +; compiling top level form: +; recognizing DEFUN |COM-SAVE-BUFFER%unparser%60| +; compiling DEFINE-COMMAND COM-SAVE-BUFFER: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-WRITE-BUFFER +; compiling DEFINE-COMMAND COM-WRITE-BUFFER: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-WRITE-BUFFER%ACCEPTOR%61 +; compiling DEFINE-COMMAND COM-WRITE-BUFFER: +; compiling top level form: +; recognizing DEFUN COM-WRITE-BUFFER%PARTIAL%62 +; compiling DEFINE-COMMAND COM-WRITE-BUFFER: +; compiling top level form: +; recognizing DEFUN |COM-WRITE-BUFFER%unparser%63| +; compiling DEFINE-COMMAND COM-WRITE-BUFFER: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-BEGINNING-OF-BUFFER +; compiling DEFINE-COMMAND COM-BEGINNING-OF-BUFFER: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-BEGINNING-OF-BUFFER%ACCEPTOR%64 +; compiling DEFINE-COMMAND COM-BEGINNING-OF-BUFFER: +; compiling top level form: +; recognizing DEFUN COM-BEGINNING-OF-BUFFER%PARTIAL%65 +; compiling DEFINE-COMMAND COM-BEGINNING-OF-BUFFER: +; compiling top level form: +; recognizing DEFUN |COM-BEGINNING-OF-BUFFER%unparser%66| +; compiling DEFINE-COMMAND COM-BEGINNING-OF-BUFFER: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-END-OF-BUFFER +; compiling DEFINE-COMMAND COM-END-OF-BUFFER: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-END-OF-BUFFER%ACCEPTOR%67 +; compiling DEFINE-COMMAND COM-END-OF-BUFFER: +; compiling top level form: +; recognizing DEFUN COM-END-OF-BUFFER%PARTIAL%68 +; compiling DEFINE-COMMAND COM-END-OF-BUFFER: +; compiling top level form: +; recognizing DEFUN |COM-END-OF-BUFFER%unparser%69| +; compiling DEFINE-COMMAND COM-END-OF-BUFFER: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-BROWSE-URL +; compiling DEFINE-COMMAND COM-BROWSE-URL: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-BROWSE-URL%ACCEPTOR%70 +; compiling DEFINE-COMMAND COM-BROWSE-URL: +; compiling top level form: +; recognizing DEFUN COM-BROWSE-URL%PARTIAL%71 +; compiling DEFINE-COMMAND COM-BROWSE-URL: +; compiling top level form: +; recognizing DEFUN |COM-BROWSE-URL%unparser%72| +; compiling DEFINE-COMMAND COM-BROWSE-URL: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-SET-MARK +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFINE-COMMAND COM-SET-MARK: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-SET-MARK%ACCEPTOR%73 +; compiling DEFINE-COMMAND COM-SET-MARK: +; compiling top level form: +; recognizing DEFUN COM-SET-MARK%PARTIAL%74 +; compiling DEFINE-COMMAND COM-SET-MARK: +; compiling top level form: +; recognizing DEFUN |COM-SET-MARK%unparser%75| +; compiling DEFINE-COMMAND COM-SET-MARK: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-COPY-IN +; compiling DEFINE-COMMAND COM-COPY-IN: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-COPY-IN%ACCEPTOR%76 +; compiling DEFINE-COMMAND COM-COPY-IN: +; compiling top level form: +; recognizing DEFUN COM-COPY-IN%PARTIAL%77 +; compiling DEFINE-COMMAND COM-COPY-IN: +; compiling top level form: +; recognizing DEFUN |COM-COPY-IN%unparser%78| +; compiling DEFINE-COMMAND COM-COPY-IN: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-CUT-IN +; compiling DEFINE-COMMAND COM-CUT-IN: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-CUT-IN%ACCEPTOR%79 +; compiling DEFINE-COMMAND COM-CUT-IN: +; compiling top level form: +; recognizing DEFUN COM-CUT-IN%PARTIAL%80 +; compiling DEFINE-COMMAND COM-CUT-IN: +; compiling top level form: +; recognizing DEFUN |COM-CUT-IN%unparser%81| +; compiling DEFINE-COMMAND COM-CUT-IN: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-CUT-OUT +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFINE-COMMAND COM-CUT-OUT: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-CUT-OUT%ACCEPTOR%82 +; compiling DEFINE-COMMAND COM-CUT-OUT: +; compiling top level form: +; recognizing DEFUN COM-CUT-OUT%PARTIAL%83 +; compiling DEFINE-COMMAND COM-CUT-OUT: +; compiling top level form: +; recognizing DEFUN |COM-CUT-OUT%unparser%84| +; compiling DEFINE-COMMAND COM-CUT-OUT: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-COPY-OUT +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-ACCESSOR # # ...)): +; compiling DEFINE-COMMAND COM-COPY-OUT: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-COPY-OUT%ACCEPTOR%85 +; compiling DEFINE-COMMAND COM-COPY-OUT: +; compiling top level form: +; recognizing DEFUN COM-COPY-OUT%PARTIAL%86 +; compiling DEFINE-COMMAND COM-COPY-OUT: +; compiling top level form: +; recognizing DEFUN |COM-COPY-OUT%unparser%87| +; compiling DEFINE-COMMAND COM-COPY-OUT: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-KR-ROTATE +; compiling DEFINE-COMMAND COM-KR-ROTATE: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-KR-ROTATE%ACCEPTOR%88 +; compiling DEFINE-COMMAND COM-KR-ROTATE: +; compiling top level form: +; recognizing DEFUN COM-KR-ROTATE%PARTIAL%89 +; compiling DEFINE-COMMAND COM-KR-ROTATE: +; compiling top level form: +; recognizing DEFUN |COM-KR-ROTATE%unparser%90| +; compiling DEFINE-COMMAND COM-KR-ROTATE: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-KR-RESIZE +; compiling DEFINE-COMMAND COM-KR-RESIZE: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN COM-KR-RESIZE%ACCEPTOR%91 +; compiling DEFINE-COMMAND COM-KR-RESIZE: +; compiling top level form: +; recognizing DEFUN COM-KR-RESIZE%PARTIAL%92 +; compiling DEFINE-COMMAND COM-KR-RESIZE: +; compiling top level form: +; recognizing DEFUN |COM-KR-RESIZE%unparser%93| +; compiling DEFINE-COMMAND COM-KR-RESIZE: +; compiling top level form: +; compiling top level form: +; compiling top level form (SB-KERNEL:MAKE-VALUE-CELL (SB-PCL::ENSURE-CTOR # # ...)): +; compiling top level form: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN GLOBAL-SET-KEY +; compiling DEFUN GLOBAL-SET-KEY: +; compiling top level form: +; compiling LOOP FOR: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; recognizing DEFUN C-X-SET-KEY +; compiling DEFUN C-X-SET-KEY: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: +; compiling top level form: + +; /home/ejohnson/cvs-dir/climacs/gui.fasl written +; compilation finished in 0:00:05 +NIL +CL-USER> (climacs-gui::climacs) +No such offset: 11 +No such offset: 11 +NIL +CL-USER> (climacs-gui::climacs) +NIL +CL-USER> (climacs-gui::climacs) +NIL +CL-USER> \ No newline at end of file

1 0

[climacs-cvs] CVS update: climacs/kill-ring.lisp climacs/climacs.asd climacs/gui.lisp climacs/packages.lisp
by ejohnson＠common-lisp.net 29 Dec '04

29 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv15124 Modified Files: climacs.asd gui.lisp packages.lisp Added Files: kill-ring.lisp Log Message: adding in kill ring material Date: Wed Dec 29 06:45:38 2004 Author: ejohnson Index: climacs/climacs.asd diff -u climacs/climacs.asd:1.5 climacs/climacs.asd:1.6 --- climacs/climacs.asd:1.5 Sat Dec 25 00:14:40 2004 +++ climacs/climacs.asd Wed Dec 29 06:45:37 2004 @@ -55,4 +55,5 @@ "io" "abbrev" "syntax" + "kill-ring" "gui") Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.24 climacs/gui.lisp:1.25 --- climacs/gui.lisp:1.24 Wed Dec 29 05:55:20 2004 +++ climacs/gui.lisp Wed Dec 29 06:45:37 2004 @@ -34,14 +34,18 @@ (defclass climacs-pane (application-pane) ((buffer :initform (make-instance 'climacs-buffer) :accessor buffer) (point :initform nil :initarg :point :reader point) - (syntax :initarg :syntax :accessor syntax))) + (syntax :initarg :syntax :accessor syntax) + (mark :initform nil :initarg :mark :reader mark))) (defmethod initialize-instance :after ((pane climacs-pane) &rest args) (declare (ignore args)) - (with-slots (buffer point syntax) pane + (with-slots (buffer point syntax mark) pane (when (null point) (setf point (make-instance 'standard-right-sticky-mark :buffer buffer))) + (when (null mark) + (setf mark (make-instance 'standard-right-sticky-mark + :buffer buffer))) (setf syntax (make-instance 'texinfo-syntax :pane pane)))) (define-application-frame climacs () @@ -96,6 +100,7 @@ (setf table (command-menu-item-value item))) finally (return item))) +(defvar *kill-ring* (initialize-kill-ring 7)) (defparameter *current-gesture* nil) (defun climacs-top-level (frame &key @@ -331,6 +336,49 @@ (define-command com-browse-url () (accept 'url :prompt "Browse URL")) +(define-command com-set-mark () + (with-slots (point mark) (win *application-frame*) + (setf mark (clone-mark point)))) + +;;;;;;;;;;;;;;;;;;;; +;; Kill ring commands + +;; The naming may sound odd here, but think of electronic wireing: +;; outputs to inputs and inputs to outputs. Copying into a buffer +;; first requires coping out of the kill ring. + +(define-command com-copy-in () + (kr-copy-out (point (win *application-frame*)) *kill-ring*)) + +(define-command com-cut-in () + (kr-cut-out (point (win *application-frame*)) *kill-ring*)) + +(define-command com-cut-out () + (with-slots (buffer point mark)(win *application-frame*) + (let ((off1 (offset point)) + (off2 (offset mark))) + (if (< off1 off2) + (kr-cut-in buffer *kill-ring* off1 off2) + (kr-cut-in buffer *kill-ring* off2 off1))))) + +(define-command com-copy-out () + (with-slots (buffer point mark)(win *application-frame*) + (let ((off1 (offset point)) + (off2 (offset mark))) + (if (< off1 off2) + (kr-copy-in buffer *kill-ring* off1 off2) + (kr-copy-in buffer *kill-ring* off2 off1))))) + +;; Needs adjustment to be like emacs M-y +(define-command com-kr-rotate () + (kr-rotate *kill-ring* -1)) + +;; Not bound to a key yet +(define-command com-kr-resize () + (let ((size (accept 'fixnum :prompt "New kill ring size: "))) + (kr-resize *kill-ring* size))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Global command table @@ -355,11 +403,16 @@ (global-set-key '(#\n :control) 'com-next-line) (global-set-key '(#\o :control) 'com-open-line) (global-set-key '(#\k :control) 'com-kill-line) +(global-set-key '(#\Space :control) 'com-set-mark) +(global-set-key '(#\y :control) 'com-copy-in) +(global-set-key '(#\w :control) 'com-cut-in) (global-set-key '(#\f :meta) 'com-forward-word) (global-set-key '(#\b :meta) 'com-backward-word) (global-set-key '(#\x :meta) 'com-extended-command) (global-set-key '(#\a :meta) 'com-insert-weird-stuff) (global-set-key '(#\c :meta) 'com-insert-reversed-string) +(global-set-key '(#\y :meta) 'com-kr-rotate) ;currently rotates only +(global-set-key '(#\w :meta) 'com-copy-out) (global-set-key '(#\< :shift :meta) 'com-beginning-of-buffer) (global-set-key '(#\> :shift :meta) 'com-end-of-buffer) (global-set-key '(#\u :meta) 'com-browse-url) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.11 climacs/packages.lisp:1.12 --- climacs/packages.lisp:1.11 Sun Dec 26 08:18:01 2004 +++ climacs/packages.lisp Wed Dec 29 06:45:37 2004 @@ -60,6 +60,12 @@ #:redisplay-pane #:redisplay-with-syntax #:full-redisplay #:url)) +(defpackage :climacs-kill-ring + (:use :clim-lisp :climacs-buffer :flexichain) + (:export #:initialize-kill-ring #:kr-length #:kr-resize + #:kr-rotate #:kr-copy-in #:kr-cut-in #:kr-copy-out + #:kr-cut-out)) + (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))

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by abridgewater＠common-lisp.net 29 Dec '04

29 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv12180 Modified Files: gui.lisp Log Message: First cut at getting M-x extended commands to work. Covers Quit and Find File. Date: Wed Dec 29 05:55:20 2004 Author: abridgewater Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.23 climacs/gui.lisp:1.24 --- climacs/gui.lisp:1.23 Tue Dec 28 18:32:18 2004 +++ climacs/gui.lisp Wed Dec 29 05:55:20 2004 @@ -137,7 +137,7 @@ (t nil)))) (redisplay-frame-panes frame)))) -(define-command com-quit () +(define-command (com-quit :name "Quit" :command-table climacs) () (frame-exit *application-frame*)) (define-command com-self-insert () @@ -193,7 +193,9 @@ 'default))) (define-command com-extended-command () - (accept 'command :prompt "Extended Command")) + (let ((item (accept 'command :prompt "Extended Command"))) + (window-clear *standard-input*) + (execute-frame-command *application-frame* item))) (defclass weird () () (:documentation "An open ended class.")) @@ -286,7 +288,7 @@ (concatenate 'string (pathname-name pathname) "." (pathname-type pathname)))) -(define-command com-find-file () +(define-command (com-find-file :name "Find File" :command-table climacs) () (let ((filename (accept 'completable-pathname :prompt "Find File"))) (with-slots (buffer point syntax) (win *application-frame*)

1 0

[climacs-cvs] CVS update: climacs/syntax.lisp
by abridgewater＠common-lisp.net 28 Dec '04

28 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv25376 Modified Files: syntax.lisp Log Message: Changed redisplay to not create output records for #\Space characters. Date: Tue Dec 28 23:41:15 2004 Author: abridgewater Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.10 climacs/syntax.lisp:1.11 --- climacs/syntax.lisp:1.10 Mon Dec 27 18:43:08 2004 +++ climacs/syntax.lisp Tue Dec 28 23:41:14 2004 @@ -106,7 +106,8 @@ until (eql (buffer-object (buffer pane) scan) #\Newline) do (let ((obj (buffer-object (buffer pane) scan))) (cond ((eql obj #\Space) - (output-word (princ obj pane))) + (output-word) + (stream-increment-cursor-position pane space-width 0)) ((eql obj #\Tab) (output-word) (let ((x (stream-cursor-position pane)))

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by rstrandh＠common-lisp.net 28 Dec '04

28 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv9146 Modified Files: gui.lisp Log Message: Better buffer name. Save-buffer now sets the filename and the name of the buffer. Date: Tue Dec 28 18:32:20 2004 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.22 climacs/gui.lisp:1.23 --- climacs/gui.lisp:1.22 Tue Dec 28 17:57:26 2004 +++ climacs/gui.lisp Tue Dec 28 18:32:18 2004 @@ -280,6 +280,12 @@ (declare (ignore success)) (or pathname string))) +(defun pathname-filename (pathname) + (if (null (pathname-type pathname)) + (pathname-name pathname) + (concatenate 'string (pathname-name pathname) + "." (pathname-type pathname)))) + (define-command com-find-file () (let ((filename (accept 'completable-pathname :prompt "Find File"))) @@ -290,7 +296,7 @@ (with-open-file (stream filename :direction :input :if-does-not-exist :create) (input-from-stream stream buffer 0)) (setf (filename buffer) filename - (name buffer) (pathname-name filename)) + (name buffer) (pathname-filename filename)) (beginning-of-buffer point)))) (define-command com-save-buffer () @@ -300,6 +306,8 @@ (buffer (buffer (win *application-frame*)))) (with-open-file (stream filename :direction :output :if-exists :supersede) (output-to-stream stream buffer 0 (size buffer))) + (setf (filename buffer) filename + (name buffer) (pathname-filename filename)) (setf (modified-p (buffer (win *application-frame*))) nil))) (define-command com-write-buffer () @@ -309,7 +317,7 @@ (with-open-file (stream filename :direction :output :if-exists :supersede) (output-to-stream stream buffer 0 (size buffer))) (setf (filename buffer) filename - (name buffer) (pathname-name filename)) + (name buffer) (pathname-filename filename)) (setf (modified-p (buffer (win *application-frame*))) nil))) (define-command com-beginning-of-buffer ()

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by rstrandh＠common-lisp.net 28 Dec '04

28 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv7032 Modified Files: gui.lisp Log Message: Nicer layout. Buffer name and buffer modification flag shown on new status line. write-buffer command. Date: Tue Dec 28 17:57:26 2004 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.21 climacs/gui.lisp:1.22 --- climacs/gui.lisp:1.21 Mon Dec 27 17:47:45 2004 +++ climacs/gui.lisp Tue Dec 28 17:57:26 2004 @@ -27,7 +27,9 @@ (defclass filename-mixin () ((filename :initform nil :accessor filename))) -(defclass climacs-buffer (standard-buffer abbrev-mixin filename-mixin) ()) +(defclass climacs-buffer (standard-buffer abbrev-mixin filename-mixin) + ((name :initform "*scratch*" :accessor name) + (modified :initform nil :accessor modified-p))) (defclass climacs-pane (application-pane) ((buffer :initform (make-instance 'climacs-buffer) :accessor buffer) @@ -50,11 +52,19 @@ :name 'win :incremental-redisplay t :display-function 'display-win)) - (int :interactor :width 900 :height 50 :max-height 50)) + (info :application + :width 900 :height 20 :max-height 20 + :name 'info :background +light-gray+ + :scroll-bars nil + :incremental-redisplay t + :display-function 'display-info) + (int :application :width 900 :height 20 :max-height 20 + :scroll-bars nil)) (:layouts (default - (vertically () + (vertically (:scroll-bars nil) (scrolling (:width 900 :height 400) win) + info int))) (:top-level (climacs-top-level))) @@ -63,6 +73,14 @@ (let ((frame (make-application-frame 'climacs))) (run-frame-top-level frame))) +(defun display-info (frame pane) + (let* ((win (win frame)) + (buf (buffer win)) + (name-info (format nil " ~a ~a" + (if (modified-p buf) "**" "--") + (name buf)))) + (princ name-info pane))) + (defun display-win (frame pane) "The display function used by the climacs application frame." (declare (ignore frame)) @@ -85,8 +103,10 @@ partial-command-parser prompt) (declare (ignore command-parser command-unparser partial-command-parser prompt)) (setf (slot-value frame 'win) (find-pane-named frame 'win)) - (let ((*standard-output* (frame-standard-output frame)) - (*standard-input* (frame-standard-input frame)) +;; (let ((*standard-output* (frame-standard-output frame)) +;; (*standard-input* (frame-standard-input frame)) + (let ((*standard-output* (find-pane-named frame 'win)) + (*standard-input* (find-pane-named frame 'int)) (*print-pretty* nil) (*abort-gestures* nil)) (redisplay-frame-panes frame :force-p t) @@ -123,7 +143,8 @@ (define-command com-self-insert () (unless (constituentp *current-gesture*) (possibly-expand-abbrev (point (win *application-frame*)))) - (insert-object (point (win *application-frame*)) *current-gesture*)) + (insert-object (point (win *application-frame*)) *current-gesture*) + (setf (modified-p (buffer (win *application-frame*))) t)) (define-command com-backward-object () (decf (offset (point (win *application-frame*))))) @@ -138,10 +159,12 @@ (end-of-line (point (win *application-frame*)))) (define-command com-delete-object () - (delete-range (point (win *application-frame*)))) + (delete-range (point (win *application-frame*))) + (setf (modified-p (buffer (win *application-frame*))) t)) (define-command com-backward-delete-object () - (delete-range (point (win *application-frame*)) -1)) + (delete-range (point (win *application-frame*)) -1) + (setf (modified-p (buffer (win *application-frame*))) t)) (define-command com-previous-line () (previous-line (point (win *application-frame*)))) @@ -150,10 +173,12 @@ (next-line (point (win *application-frame*)))) (define-command com-open-line () - (open-line (point (win *application-frame*)))) + (open-line (point (win *application-frame*))) + (setf (modified-p (buffer (win *application-frame*))) t)) (define-command com-kill-line () - (kill-line (point (win *application-frame*)))) + (kill-line (point (win *application-frame*))) + (setf (modified-p (buffer (win *application-frame*))) t)) (define-command com-forward-word () (forward-word (point (win *application-frame*)))) @@ -174,11 +199,13 @@ (:documentation "An open ended class.")) (define-command com-insert-weird-stuff () - (insert-object (point (win *application-frame*)) (make-instance 'weird))) + (insert-object (point (win *application-frame*)) (make-instance 'weird)) + (setf (modified-p (buffer (win *application-frame*))) t)) (define-command com-insert-reversed-string () (insert-sequence (point (win *application-frame*)) - (reverse (accept 'string)))) + (reverse (accept 'string))) + (setf (modified-p (buffer (win *application-frame*))) t)) (define-presentation-type completable-pathname () :inherit-from 'pathname) @@ -227,7 +254,7 @@ (values completed-string nil nil (length pathnames) nil)))) (:complete (cond ((null pathnames) - (values so-far nil nil 0 nil)) + (values so-far t so-far 1 nil)) ((null (cdr pathnames)) (values completed-string t (car pathnames) 1 nil)) ((find full-completed-string strings :test #'string-equal) @@ -259,10 +286,11 @@ (with-slots (buffer point syntax) (win *application-frame*) (setf buffer (make-instance 'climacs-buffer) point (make-instance 'standard-right-sticky-mark :buffer buffer) - syntax (make-instance 'texinfo-syntax :pane (win *application-frame*)) - (filename buffer) filename) - (with-open-file (stream filename :direction :input) + syntax (make-instance 'texinfo-syntax :pane (win *application-frame*))) + (with-open-file (stream filename :direction :input :if-does-not-exist :create) (input-from-stream stream buffer 0)) + (setf (filename buffer) filename + (name buffer) (pathname-name filename)) (beginning-of-buffer point)))) (define-command com-save-buffer () @@ -271,7 +299,18 @@ :prompt "Save Buffer to File"))) (buffer (buffer (win *application-frame*)))) (with-open-file (stream filename :direction :output :if-exists :supersede) - (output-to-stream stream buffer 0 (size buffer))))) + (output-to-stream stream buffer 0 (size buffer))) + (setf (modified-p (buffer (win *application-frame*))) nil))) + +(define-command com-write-buffer () + (let ((filename (accept 'completable-pathname + :prompt "Write Buffer to File")) + (buffer (buffer (win *application-frame*)))) + (with-open-file (stream filename :direction :output :if-exists :supersede) + (output-to-stream stream buffer 0 (size buffer))) + (setf (filename buffer) filename + (name buffer) (pathname-name filename)) + (setf (modified-p (buffer (win *application-frame*))) nil))) (define-command com-beginning-of-buffer () (beginning-of-buffer (point (win *application-frame*)))) @@ -345,3 +384,4 @@ (c-x-set-key '(#\c :control) 'com-quit) (c-x-set-key '(#\f :control) 'com-find-file) (c-x-set-key '(#\s :control) 'com-save-buffer) +(c-x-set-key '(#\w :control) 'com-write-buffer)

1 0

[climacs-cvs] CVS update: climacs/buffer.lisp climacs/io.lisp
by rstrandh＠common-lisp.net 28 Dec '04

28 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv7130 Modified Files: buffer.lisp io.lisp Log Message: Improved performance of loading a file by employing an new addition to the Flexichain library. You will have to update your Flexichain directory from CVS in order for this to work. Date: Tue Dec 28 07:58:36 2004 Author: rstrandh Index: climacs/buffer.lisp diff -u climacs/buffer.lisp:1.11 climacs/buffer.lisp:1.12 --- climacs/buffer.lisp:1.11 Fri Dec 24 09:21:34 2004 +++ climacs/buffer.lisp Tue Dec 28 07:58:36 2004 @@ -327,9 +327,7 @@ sequence.")) (defmethod insert-buffer-sequence ((buffer standard-buffer) offset sequence) - (loop for elem across sequence - do (insert-buffer-object buffer offset elem) - (incf offset))) + (insert-vector* (slot-value buffer 'contents) offset sequence)) (defgeneric insert-object (mark object) (:documentation "Insert the object at the mark. This function simply calls Index: climacs/io.lisp diff -u climacs/io.lisp:1.2 climacs/io.lisp:1.3 --- climacs/io.lisp:1.2 Thu Dec 23 09:00:33 2004 +++ climacs/io.lisp Tue Dec 28 07:58:36 2004 @@ -23,11 +23,14 @@ (in-package :climacs-base) (defun input-from-stream (stream buffer offset) - (let ((eof-object (cons nil nil))) - (loop for obj = (read-char stream nil eof-object) - until (eq obj eof-object) - do (insert-buffer-object buffer offset obj) - (incf offset)))) + (loop with vec = (make-array 10000 :element-type 'character) + for count = (read-sequence vec stream) + while (plusp count) + do (if (= count (length vec)) + (insert-buffer-sequence buffer offset vec) + (insert-buffer-sequence buffer offset + (subseq vec 0 count))) + (incf offset count))) (defun output-to-stream (stream buffer offset1 offset2) (loop for offset from offset1 below offset2

1 0

[climacs-cvs] CVS update: climacs/syntax.lisp
by rstrandh＠common-lisp.net 27 Dec '04

27 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv29501 Modified Files: syntax.lisp Log Message: Improved cursor redisplay. Thanks to Alastair Bridgewater Date: Mon Dec 27 18:43:09 2004 Author: rstrandh Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.9 climacs/syntax.lisp:1.10 --- climacs/syntax.lisp:1.9 Mon Dec 27 17:47:45 2004 +++ climacs/syntax.lisp Mon Dec 27 18:43:08 2004 @@ -163,10 +163,13 @@ (multiple-value-bind (x y) (stream-cursor-position pane) (setf cursor-x x cursor-y y))) - (draw-line* pane - cursor-x (- cursor-y (* 0.2 height)) - cursor-x (+ cursor-y (* 0.8 height)) - :ink +red+)))))) + (maybe-updating-output (pane :all-new t :fixed-position t) + (draw-line* pane + ;; cursors with odd x-positions were invisible + ;; so we strip off the low bit to make them even. + (logand -2 cursor-x) (- cursor-y (* 0.2 height)) + (logand -2 cursor-x) (+ cursor-y (* 0.8 height)) + :ink +red+))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[climacs-cvs] CVS update: climacs/gui.lisp climacs/syntax.lisp
by rstrandh＠common-lisp.net 27 Dec '04

27 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv26651 Modified Files: gui.lisp syntax.lisp Log Message: Patch to get incremental redisplay to work. There is still a small problem with the cursor disappearing. Thanks to Alastair Bridgewater. Date: Mon Dec 27 17:47:46 2004 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.20 climacs/gui.lisp:1.21 --- climacs/gui.lisp:1.20 Mon Dec 27 12:32:46 2004 +++ climacs/gui.lisp Mon Dec 27 17:47:45 2004 @@ -48,7 +48,7 @@ (win (make-pane 'climacs-pane :width 900 :height 400 :name 'win -;;; :incremental-redisplay t + :incremental-redisplay t :display-function 'display-win)) (int :interactor :width 900 :height 50 :max-height 50)) (:layouts Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.8 climacs/syntax.lisp:1.9 --- climacs/syntax.lisp:1.8 Mon Dec 27 12:32:46 2004 +++ climacs/syntax.lisp Mon Dec 27 17:47:45 2004 @@ -66,11 +66,11 @@ 'string) :stream pane))) -(defmacro maybe-updating-output (stuff &body body) - `(progn ,@body)) +;;(defmacro maybe-updating-output (stuff &body body) +;; `(progn ,@body)) -;; (defmacro maybe-updating-output (stuff &body body) -;; `(updating-output ,stuff ,@body)) + (defmacro maybe-updating-output (stuff &body body) + `(updating-output ,stuff ,@body)) (defmethod display-line (pane (syntax basic-syntax)) (with-slots (saved-offset bot scan cursor-x cursor-y space-width tab-width) syntax @@ -81,12 +81,18 @@ (macrolet ((output-word (&body body) `(let ((contents (compute-contents))) (if (null contents) - (progn ,@body) + ,(if body + `(maybe-updating-output (pane :unique-id (incf id)) + ,@body) + `(progn)) + (progn (maybe-updating-output (pane :unique-id (incf id) :cache-value contents :cache-test #'string=) - (present-contents contents pane syntax) - ,@body))))) + (present-contents contents pane syntax)) + ,(when body + `(maybe-updating-output (pane :unique-id (incf id)) + ,@body))))))) (loop with id = 0 when (mark= scan (point pane)) do (multiple-value-bind (x y) (stream-cursor-position pane)

1 0

[climacs-cvs] CVS update: climacs/base.lisp climacs/gui.lisp climacs/syntax.lisp
by rstrandh＠common-lisp.net 27 Dec '04

27 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv11024 Modified Files: base.lisp gui.lisp syntax.lisp Log Message: performance improvements. Date: Mon Dec 27 12:32:46 2004 Author: rstrandh Index: climacs/base.lisp diff -u climacs/base.lisp:1.5 climacs/base.lisp:1.6 --- climacs/base.lisp:1.5 Sun Dec 26 08:18:01 2004 +++ climacs/base.lisp Mon Dec 27 12:32:46 2004 @@ -66,14 +66,12 @@ (end-of-line mark) (delete-region offset mark)))) -(defun buffer-number-of-lines-in-region (mark1 mark2) - "Helper function for number-of-lines-in-region. Moves the position -of mark1 until it is greater than or equal to that of mark2 and counts -Newline characters along the way" - (loop do (end-of-line mark1) - while (mark< mark1 mark2) - count t - do (incf (offset mark1)))) +(defun buffer-number-of-lines-in-region (buffer offset1 offset2) + "Helper function for number-of-lines-in-region. Count newline +characters in the region between offset1 and offset2" + (loop while (< offset1 offset2) + count (eql (buffer-object buffer offset1) #\Newline) + do (incf offset1))) (defgeneric number-of-lines-in-region (mark1 mark2) (:documentation "Return the number of lines (or rather the number of @@ -81,21 +79,13 @@ acceptable to pass an offset in place of one of the marks")) (defmethod number-of-lines-in-region ((mark1 mark) (mark2 mark)) - (buffer-number-of-lines-in-region (clone-mark mark1) mark2)) + (buffer-number-of-lines-in-region (buffer mark1) (offset mark1) (offset mark2))) (defmethod number-of-lines-in-region ((offset integer) (mark mark)) - (buffer-number-of-lines-in-region - (make-instance 'standard-left-sticky-mark - :buffer (buffer mark) - :offset offset) - mark)) + (buffer-number-of-lines-in-region (buffer mark) offset (offset mark))) (defmethod number-of-lines-in-region ((mark mark) (offset integer)) - (buffer-number-of-lines-in-region - (clone-mark mark) - (make-instance 'standard-left-sticky-mark - :buffer (buffer mark) - :offset offset))) + (buffer-number-of-lines-in-region (buffer mark) (offset mark) offset)) (defun constituentp (obj) "A predicate to ensure that an object is a constituent character." Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.19 climacs/gui.lisp:1.20 --- climacs/gui.lisp:1.19 Mon Dec 27 06:58:29 2004 +++ climacs/gui.lisp Mon Dec 27 12:32:46 2004 @@ -48,6 +48,7 @@ (win (make-pane 'climacs-pane :width 900 :height 400 :name 'win +;;; :incremental-redisplay t :display-function 'display-win)) (int :interactor :width 900 :height 50 :max-height 50)) (:layouts @@ -114,7 +115,7 @@ (format *error-output* "~a~%" condition))) (setf gestures '())) (t nil)))) - (redisplay-frame-panes frame :force-p t)))) + (redisplay-frame-panes frame)))) (define-command com-quit () (frame-exit *application-frame*)) Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.7 climacs/syntax.lisp:1.8 --- climacs/syntax.lisp:1.7 Mon Dec 27 05:32:44 2004 +++ climacs/syntax.lisp Mon Dec 27 12:32:46 2004 @@ -49,8 +49,7 @@ (let ((buffer (buffer pane))) (with-slots (top bot scan space-width tab-width) syntax (setf top (make-instance 'standard-left-sticky-mark :buffer buffer) - bot (make-instance 'standard-right-sticky-mark :buffer buffer) - scan (make-instance 'standard-left-sticky-mark :buffer buffer)) + bot (make-instance 'standard-right-sticky-mark :buffer buffer)) (let* ((medium (sheet-medium pane)) (style (medium-text-style medium))) (setf space-width (text-style-width style medium) @@ -67,27 +66,39 @@ 'string) :stream pane))) +(defmacro maybe-updating-output (stuff &body body) + `(progn ,@body)) + +;; (defmacro maybe-updating-output (stuff &body body) +;; `(updating-output ,stuff ,@body)) + (defmethod display-line (pane (syntax basic-syntax)) (with-slots (saved-offset bot scan cursor-x cursor-y space-width tab-width) syntax (flet ((compute-contents () (unless (null saved-offset) - (prog1 (coerce (region-to-sequence saved-offset scan) 'string) + (prog1 (coerce (buffer-sequence (buffer pane) saved-offset scan) 'string) (setf saved-offset nil))))) (macrolet ((output-word (&body body) `(let ((contents (compute-contents))) - (present-contents contents pane syntax) - ,@body))) - (loop when (mark= scan (point pane)) + (if (null contents) + (progn ,@body) + (maybe-updating-output (pane :unique-id (incf id) + :cache-value contents + :cache-test #'string=) + (present-contents contents pane syntax) + ,@body))))) + (loop with id = 0 + when (mark= scan (point pane)) do (multiple-value-bind (x y) (stream-cursor-position pane) (setf cursor-x (+ x (if (null saved-offset) 0 - (* space-width (- (offset scan) saved-offset)))) + (* space-width (- scan saved-offset)))) cursor-y y)) when (mark= scan bot) do (output-word) (return) - until (eql (object-after scan) #\Newline) - do (let ((obj (object-after scan))) + until (eql (buffer-object (buffer pane) scan) #\Newline) + do (let ((obj (buffer-object (buffer pane) scan))) (cond ((eql obj #\Space) (output-word (princ obj pane))) ((eql obj #\Tab) @@ -97,13 +108,12 @@ pane (- tab-width (mod x tab-width)) 0))) ((constituentp obj) (when (null saved-offset) - (setf saved-offset (offset scan)))) + (setf saved-offset scan))) (t (output-word (princ obj pane))))) - (incf (offset scan)) - finally (output-word) - (incf (offset scan)) - (terpri pane)))))) + (incf scan) + finally (output-word (terpri pane)) + (incf scan)))))) (defmethod redisplay-with-syntax (pane (syntax basic-syntax)) (let* ((medium (sheet-medium pane)) @@ -138,9 +148,11 @@ until (end-of-buffer-p bot) do (incf (offset bot)) (end-of-line bot))) - (setf (offset scan) (offset top)) - (loop until (mark= scan bot) - do (display-line pane syntax)) + (setf scan (offset top)) + (loop for id from 0 + until (mark= scan bot) + do (maybe-updating-output (pane :unique-id id) + (display-line pane syntax))) (when (mark= scan (point pane)) (multiple-value-bind (x y) (stream-cursor-position pane) (setf cursor-x x

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by rstrandh＠common-lisp.net 27 Dec '04

27 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv26075 Modified Files: gui.lisp Log Message: Key bindings for several function keys. Thanks to Alastair Bridgewater. Date: Mon Dec 27 06:58:32 2004 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.18 climacs/gui.lisp:1.19 --- climacs/gui.lisp:1.18 Mon Dec 27 05:32:43 2004 +++ climacs/gui.lisp Mon Dec 27 06:58:29 2004 @@ -93,7 +93,15 @@ do (setf *current-gesture* (read-gesture :stream *standard-input*)) (when (or (characterp *current-gesture*) (and (typep *current-gesture* 'keyboard-event) - (keyboard-event-character *current-gesture*))) + (or (keyboard-event-character *current-gesture*) + (not (member (keyboard-event-key-name + *current-gesture*) + '(:control-left :control-right + :shift-left :shift-right + :meta-left :meta-right + :super-left :super-right + :hyper-left :hyper-right + :shift-lock :caps-lock)))))) (setf gestures (nconc gestures (list *current-gesture*))) (let ((item (find-gestures gestures 'global-climacs-table))) (cond ((not item) @@ -131,6 +139,9 @@ (define-command com-delete-object () (delete-range (point (win *application-frame*)))) +(define-command com-backward-delete-object () + (delete-range (point (win *application-frame*)) -1)) + (define-command com-previous-line () (previous-line (point (win *application-frame*)))) @@ -302,6 +313,19 @@ (global-set-key '(#\< :shift :meta) 'com-beginning-of-buffer) (global-set-key '(#\> :shift :meta) 'com-end-of-buffer) (global-set-key '(#\u :meta) 'com-browse-url) + +(global-set-key '(:up) 'com-previous-line) +(global-set-key '(:down) 'com-next-line) +(global-set-key '(:left) 'com-backward-object) +(global-set-key '(:right) 'com-forward-object) +(global-set-key '(:left :control) 'com-backward-word) +(global-set-key '(:right :control) 'com-forward-word) +(global-set-key '(:home) 'com-beginning-of-line) +(global-set-key '(:end) 'com-end-of-line) +(global-set-key '(:home :control) 'com-beginning-of-buffer) +(global-set-key '(:end :control) 'com-end-of-buffer) +(global-set-key #\Rubout 'com-delete-object) +(global-set-key #\Backspace 'com-backward-delete-object) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[climacs-cvs] CVS update: climacs/gui.lisp climacs/syntax.lisp
by rstrandh＠common-lisp.net 27 Dec '04

27 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv21776 Modified Files: gui.lisp syntax.lisp Log Message: Patch for C-c problem by Alastair Bridgewater. Thanks again. Date: Mon Dec 27 05:32:44 2004 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.17 climacs/gui.lisp:1.18 --- climacs/gui.lisp:1.17 Sun Dec 26 08:18:01 2004 +++ climacs/gui.lisp Mon Dec 27 05:32:43 2004 @@ -86,7 +86,8 @@ (setf (slot-value frame 'win) (find-pane-named frame 'win)) (let ((*standard-output* (frame-standard-output frame)) (*standard-input* (frame-standard-input frame)) - (*print-pretty* nil)) + (*print-pretty* nil) + (*abort-gestures* nil)) (redisplay-frame-panes frame :force-p t) (loop with gestures = '() do (setf *current-gesture* (read-gesture :stream *standard-input*)) @@ -316,7 +317,6 @@ (add-command-to-command-table command 'c-x-climacs-table :keystroke gesture :errorp nil)) -;;; for some reason, C-c does not seem to arrive as far as CLIM. -(c-x-set-key '(#\q :control) 'com-quit) +(c-x-set-key '(#\c :control) 'com-quit) (c-x-set-key '(#\f :control) 'com-find-file) (c-x-set-key '(#\s :control) 'com-save-buffer) Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.6 climacs/syntax.lisp:1.7 --- climacs/syntax.lisp:1.6 Sun Dec 26 16:19:59 2004 +++ climacs/syntax.lisp Mon Dec 27 05:32:44 2004 @@ -77,8 +77,7 @@ `(let ((contents (compute-contents))) (present-contents contents pane syntax) ,@body))) - (loop with id = 0 - when (mark= scan (point pane)) + (loop when (mark= scan (point pane)) do (multiple-value-bind (x y) (stream-cursor-position pane) (setf cursor-x (+ x (if (null saved-offset) 0

1 0

[climacs-cvs] CVS update: climacs/syntax.lisp
by rstrandh＠common-lisp.net 26 Dec '04

26 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv13413 Modified Files: syntax.lisp Log Message: Prepared the syntax module for incremental output. I didn't put it in though, because I have problems getting it to work. I'll check with Tim Moore before making another attempt. Date: Sun Dec 26 16:20:00 2004 Author: rstrandh Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.5 climacs/syntax.lisp:1.6 --- climacs/syntax.lisp:1.5 Sun Dec 26 08:18:01 2004 +++ climacs/syntax.lisp Sun Dec 26 16:19:59 2004 @@ -59,48 +59,52 @@ (define-presentation-type url () :inherit-from 'string) -(defmethod present-contents (pane (syntax basic-syntax)) - (with-slots (saved-offset scan) syntax - (unless (null saved-offset) - (let ((word (coerce (region-to-sequence saved-offset scan) 'string))) - (present word - (if (and (>= (length word) 7) (string= (subseq word 0 7) "http://")) - 'url - 'string) - :stream pane)) - (setf saved-offset nil)))) +(defmethod present-contents (contents pane (syntax basic-syntax)) + (unless (null contents) + (present contents + (if (and (>= (length contents) 7) (string= (subseq contents 0 7) "http://")) + 'url + 'string) + :stream pane))) (defmethod display-line (pane (syntax basic-syntax)) (with-slots (saved-offset bot scan cursor-x cursor-y space-width tab-width) syntax - (loop when (mark= scan (point pane)) - do (multiple-value-bind (x y) (stream-cursor-position pane) - (setf cursor-x (+ x (if (null saved-offset) - 0 - (* space-width (- (offset scan) saved-offset)))) - cursor-y y)) - when (mark= scan bot) - do (present-contents pane syntax) - (return) - until (eql (object-after scan) #\Newline) - do (let ((obj (object-after scan))) - (cond ((eql obj #\Space) - (present-contents pane syntax) - (princ obj pane)) - ((eql obj #\Tab) - (present-contents pane syntax) - (let ((x (stream-cursor-position pane))) - (stream-increment-cursor-position - pane (- tab-width (mod x tab-width)) 0))) - ((constituentp obj) - (when (null saved-offset) - (setf saved-offset (offset scan)))) - (t - (present-contents pane syntax) - (princ obj pane)))) - (incf (offset scan)) - finally (present-contents pane syntax) - (incf (offset scan)) - (terpri pane)))) + (flet ((compute-contents () + (unless (null saved-offset) + (prog1 (coerce (region-to-sequence saved-offset scan) 'string) + (setf saved-offset nil))))) + (macrolet ((output-word (&body body) + `(let ((contents (compute-contents))) + (present-contents contents pane syntax) + ,@body))) + (loop with id = 0 + when (mark= scan (point pane)) + do (multiple-value-bind (x y) (stream-cursor-position pane) + (setf cursor-x (+ x (if (null saved-offset) + 0 + (* space-width (- (offset scan) saved-offset)))) + cursor-y y)) + when (mark= scan bot) + do (output-word) + (return) + until (eql (object-after scan) #\Newline) + do (let ((obj (object-after scan))) + (cond ((eql obj #\Space) + (output-word (princ obj pane))) + ((eql obj #\Tab) + (output-word) + (let ((x (stream-cursor-position pane))) + (stream-increment-cursor-position + pane (- tab-width (mod x tab-width)) 0))) + ((constituentp obj) + (when (null saved-offset) + (setf saved-offset (offset scan)))) + (t + (output-word (princ obj pane))))) + (incf (offset scan)) + finally (output-word) + (incf (offset scan)) + (terpri pane)))))) (defmethod redisplay-with-syntax (pane (syntax basic-syntax)) (let* ((medium (sheet-medium pane)) @@ -156,13 +160,10 @@ (define-presentation-type texinfo-command () :inherit-from 'string) -(defmethod present-contents (pane (syntax texinfo-syntax)) - (with-slots (saved-offset scan) syntax - (unless (null saved-offset) - (let ((word (coerce (region-to-sequence saved-offset scan) 'string))) - (if (char= (aref word 0) #\@) - (with-drawing-options (pane :ink +red+) - (present word 'texinfo-command :stream pane)) - (present word 'string :stream pane))) - (setf saved-offset nil)))) +(defmethod present-contents (contents pane (syntax texinfo-syntax)) + (unless (null contents) + (if (char= (aref contents 0) #\@) + (with-drawing-options (pane :ink +red+) + (present contents 'texinfo-command :stream pane)) + (present contents 'string :stream pane))))

1 0

[climacs-cvs] CVS update: climacs/base.lisp climacs/gui.lisp climacs/packages.lisp climacs/syntax.lisp
by rstrandh＠common-lisp.net 26 Dec '04

26 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv22191 Modified Files: base.lisp gui.lisp packages.lisp syntax.lisp Log Message: Much improved redisplay algorithm. The behavior when point is outside the current region on display is much faster and similar to that of Emacs, in that the algorithm tries to position point in the middle of the pane. Date: Sun Dec 26 08:18:01 2004 Author: rstrandh Index: climacs/base.lisp diff -u climacs/base.lisp:1.4 climacs/base.lisp:1.5 --- climacs/base.lisp:1.4 Thu Dec 23 09:00:33 2004 +++ climacs/base.lisp Sun Dec 26 08:18:01 2004 @@ -66,6 +66,37 @@ (end-of-line mark) (delete-region offset mark)))) +(defun buffer-number-of-lines-in-region (mark1 mark2) + "Helper function for number-of-lines-in-region. Moves the position +of mark1 until it is greater than or equal to that of mark2 and counts +Newline characters along the way" + (loop do (end-of-line mark1) + while (mark< mark1 mark2) + count t + do (incf (offset mark1)))) + +(defgeneric number-of-lines-in-region (mark1 mark2) + (:documentation "Return the number of lines (or rather the number of +Newline characters) in the region between MARK and MARK2. It is +acceptable to pass an offset in place of one of the marks")) + +(defmethod number-of-lines-in-region ((mark1 mark) (mark2 mark)) + (buffer-number-of-lines-in-region (clone-mark mark1) mark2)) + +(defmethod number-of-lines-in-region ((offset integer) (mark mark)) + (buffer-number-of-lines-in-region + (make-instance 'standard-left-sticky-mark + :buffer (buffer mark) + :offset offset) + mark)) + +(defmethod number-of-lines-in-region ((mark mark) (offset integer)) + (buffer-number-of-lines-in-region + (clone-mark mark) + (make-instance 'standard-left-sticky-mark + :buffer (buffer mark) + :offset offset))) + (defun constituentp (obj) "A predicate to ensure that an object is a constituent character." (and (characterp obj) Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.16 climacs/gui.lisp:1.17 --- climacs/gui.lisp:1.16 Sat Dec 25 15:49:54 2004 +++ climacs/gui.lisp Sun Dec 26 08:18:01 2004 @@ -46,14 +46,14 @@ ((win :reader win)) (:panes (win (make-pane 'climacs-pane - :width 600 :height 400 + :width 900 :height 400 :name 'win :display-function 'display-win)) - (int :interactor :width 600 :height 50)) + (int :interactor :width 900 :height 50 :max-height 50)) (:layouts (default (vertically () - (scrolling (:width 600 :height 400) win) + (scrolling (:width 900 :height 400) win) int))) (:top-level (climacs-top-level))) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.10 climacs/packages.lisp:1.11 --- climacs/packages.lisp:1.10 Sat Dec 25 15:49:54 2004 +++ climacs/packages.lisp Sun Dec 26 08:18:01 2004 @@ -44,6 +44,7 @@ (:use :clim-lisp :climacs-buffer) (:export #:previous-line #:next-line #:open-line #:kill-line + #:number-of-lines-in-region #:constituentp #:forward-word #:backward-word #:input-from-stream #:output-to-stream)) Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.4 climacs/syntax.lisp:1.5 --- climacs/syntax.lisp:1.4 Sat Dec 25 15:49:54 2004 +++ climacs/syntax.lisp Sun Dec 26 08:18:01 2004 @@ -111,24 +111,30 @@ (end-of-line bot) (multiple-value-bind (x y w h) (bounding-rectangle* pane) (declare (ignore x y w)) - (let ((nb-lines (max 1 (floor h (+ height (stream-vertical-spacing pane)))))) - (loop while (> (1+ (- (line-number bot) (line-number top))) nb-lines) + (let ((nb-lines-in-pane (max 1 (floor h (+ height (stream-vertical-spacing pane))))) + (nb-lines-on-display (1+ (number-of-lines-in-region top bot)))) + ;; adjust the region on display to fit the pane + (loop repeat (- nb-lines-on-display nb-lines-in-pane) do (beginning-of-line bot) (decf (offset bot))) (loop until (end-of-buffer-p bot) - while (< (1+ (- (line-number bot) (line-number top))) nb-lines) + repeat (- nb-lines-in-pane nb-lines-on-display) do (incf (offset bot)) (end-of-line bot)) - (loop while (mark< (point pane) top) - do (decf (offset top)) - (beginning-of-line top) - (beginning-of-line bot) - (decf (offset bot))) - (loop while (mark> (point pane) bot) - do (end-of-line top) - (incf (offset top)) - (incf (offset bot)) - (end-of-line bot)) + ;; move region on display if point is outside the current region + (when (or (mark< (point pane) top) (mark> (point pane) bot)) + (setf (offset top) (offset (point pane))) + (loop do (beginning-of-line top) + repeat (floor nb-lines-in-pane 2) + until (beginning-of-buffer-p top) + do (decf (offset top)) + (beginning-of-line top)) + (setf (offset bot) (offset top)) + (loop do (end-of-line bot) + repeat (1- nb-lines-in-pane) + until (end-of-buffer-p bot) + do (incf (offset bot)) + (end-of-line bot))) (setf (offset scan) (offset top)) (loop until (mark= scan bot) do (display-line pane syntax))

1 0

[climacs-cvs] CVS update: climacs/Doc/climacs-internals.texi
by rstrandh＠common-lisp.net 26 Dec '04

26 Dec '04

Update of /project/climacs/cvsroot/climacs/Doc In directory common-lisp.net:/tmp/cvs-serv18486 Modified Files: climacs-internals.texi Log Message: Added a chapter on the purpose and efficiency considerations concerning the climacs-base package. Date: Sun Dec 26 07:14:52 2004 Author: rstrandh Index: climacs/Doc/climacs-internals.texi diff -u climacs/Doc/climacs-internals.texi:1.3 climacs/Doc/climacs-internals.texi:1.4 --- climacs/Doc/climacs-internals.texi:1.3 Sat Dec 25 15:49:59 2004 +++ climacs/Doc/climacs-internals.texi Sun Dec 26 07:14:51 2004 @@ -443,6 +443,112 @@ concludes the interaction loop and Climacs is again ready to read and execute commands. +@chapter The climacs-base package + +@section Purpose + +The buffer protocol has been designed to be reasonably efficient with +a variety of different implementation strategies (single gap buffer or +sequence of independent lines). It contains (and should only contain) +the absolute minimum of functionality that can be implemented +efficiently independently of strategy. However, this minimum of +functionality is not always convenient. + +The purpose of the climacs-base package is to implement additional +functionality on top of the buffer protocol, in a way that does not +depend on how the buffer protocol was implemented. Thus, the +climacs-base package should remain intact across different +implementation strategies of the buffer protocol. + +Achieving portability of the climacs-base package is not terribly hard +as long as only buffer protocol functions are used. What is slightly +harder is to be sure to maximize efficiency across several +implementation strategies. The next section discusses such +considerations and gives guidelines to implementers of additional +functionality. + +Implementers of the buffer protocol may use the contents of the next +section to make sure they respect the efficiency considerations that +are expected by the climacs-base package. + +@section Efficiency considerations + +In this section, we give a list of rules that implementors of +additional functionality should follow in order to make sure that such +functionality remains efficient (in addition to being portable) across +a variety of implementation strategies of the buffer protocol. + +@quotation Rule +Comparing the position of two marks is efficient, i.e. at most O(log +n) where n is the number of marks in the buffer (which is expected to +be very small compared to the number of objects) in all +implementations. This is true for all types of comparisons. +@end quotation + +It is expected that marks are managed very efficiently. Some balanced +tree management might be necessary, which will make operations have +logarithmic complexity, but only in the number of marks that are +actually used. + +@quotation Rule +While computing and setting the offset of a mark is fairly efficient, +it is not guaranteed to be O(1) even though it might be in an +implementation using a single gap buffer. It might have a complexity +of O(log n) where n is the number of lines in the buffer. This is +true for using incf on the offset of a mark as well, as incf expands +to a setf of the offset. + +Do not hesitate computing or setting the offset of a mark, but avoid +doing it in a tight loop over many objects of the buffer. +@end quotation + +@quotation Rule +Determining whether a mark is at the beginning or at the end of the +buffer is efficient, i.e. O(1), in all implementations. +@end quotation + +@quotation Rule +Determining whether a mark is at the beginning or at the end of a line +is efficient, i.e. O(1), in all implementations. +@end quotation + +@quotation Rule +Going to the beginning or to the end of a line might have linear-time +complexity in the number of characters of the line, though it is +constant-time complexity if the implementation is line oriented. + +It is sometimes inevitable to use this functionality, and since lines +are expected to be short, it should not be avoided at all cost, +especially since it might be very efficient in some implementations. +We do recommend, however to avoid it in tight loops. + +Always use this functionality rather than manually incrementing the +offset of a mark in a loop until a Newline character has been found, +especially since each iteration might take logarithmic time then. +@end quotation + +@quotation Rule +Computing the size of the buffer is always efficient, i.e., O(1). +@end quotation + +@quotation Rule +Computing the number of lines of the buffer is always efficient, i.e., +O(1). +@end quotation + +Implementations of the buffer protocol could always track the number +of insertions and deletions of objects, so there is no reason why this +operation should be inefficient. + +@quotation Rule +Computing the line number of a mark or of an offset can be very +costly, i.e. O(n) where n is size of the buffer. +@end quotation + +This operation is part of the buffer protocol because some +implementations may implement it fairly efficiently, say O(log n) +where n is the number of lines in the buffer. + @chapter Redisplay and the syntax protocol @section General

1 0

[climacs-cvs] CVS update: climacs/Doc/climacs-internals.texi
by rstrandh＠common-lisp.net 25 Dec '04

25 Dec '04

Update of /project/climacs/cvsroot/climacs/Doc In directory common-lisp.net:/tmp/cvs-serv4250/Doc Modified Files: climacs-internals.texi Log Message: Simplified the syntax protocol according to suggestions from Teemu Kalvas. Date: Sat Dec 25 15:50:01 2004 Author: rstrandh Index: climacs/Doc/climacs-internals.texi diff -u climacs/Doc/climacs-internals.texi:1.2 climacs/Doc/climacs-internals.texi:1.3 --- climacs/Doc/climacs-internals.texi:1.2 Sat Dec 25 14:22:59 2004 +++ climacs/Doc/climacs-internals.texi Sat Dec 25 15:49:59 2004 @@ -467,19 +467,20 @@ display after the previous invocation of the redisplay algorithm. @end deftp -@deftp {:initarg} :buffer -Indicates the buffer that this syntax should display. -@end deftp - @deftp {:initarg} :pane Indicates the pane where rendering is to take place. @end deftp -All subclasses of the syntax class must support the :pane and :buffer -initargs. These are both mandatory, because the syntax module needs -to query both the buffer (for things like setting marks that -correspond to the top and the bottom of the pane on display) and the -pane (for things like font size). +All subclasses of the syntax class must support the :pane initarg. +The pane that is passed as an initarg must have a valid buffer +associated with it. + +@deffn {Function} {redisplay-pane} pane + +This function is called by the command loop on every pane that is on +display. It simply calls redisplay-with-syntax with the pane and the +syntax of the pane. +@end deffn @deffn {Generic Function} {redisplay-with-syntax} pane syntax

1 0

[climacs-cvs] CVS update: climacs/gui.lisp climacs/packages.lisp climacs/syntax.lisp
by rstrandh＠common-lisp.net 25 Dec '04

25 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv4250 Modified Files: gui.lisp packages.lisp syntax.lisp Log Message: Simplified the syntax protocol according to suggestions from Teemu Kalvas. Date: Sat Dec 25 15:49:56 2004 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.15 climacs/gui.lisp:1.16 --- climacs/gui.lisp:1.15 Sat Dec 25 14:36:20 2004 +++ climacs/gui.lisp Sat Dec 25 15:49:54 2004 @@ -40,7 +40,7 @@ (when (null point) (setf point (make-instance 'standard-right-sticky-mark :buffer buffer))) - (setf syntax (make-instance 'texinfo-syntax :buffer buffer :pane pane)))) + (setf syntax (make-instance 'texinfo-syntax :pane pane)))) (define-application-frame climacs () ((win :reader win)) @@ -65,7 +65,7 @@ (defun display-win (frame pane) "The display function used by the climacs application frame." (declare (ignore frame)) - (redisplay-with-syntax pane (syntax pane))) + (redisplay-pane pane)) (defun find-gestures (gestures start-table) (loop with table = (find-command-table start-table) @@ -246,7 +246,7 @@ (with-slots (buffer point syntax) (win *application-frame*) (setf buffer (make-instance 'climacs-buffer) point (make-instance 'standard-right-sticky-mark :buffer buffer) - syntax (make-instance 'texinfo-syntax :buffer buffer :pane (win *application-frame*)) + syntax (make-instance 'texinfo-syntax :pane (win *application-frame*)) (filename buffer) filename) (with-open-file (stream filename :direction :input) (input-from-stream stream buffer 0)) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.9 climacs/packages.lisp:1.10 --- climacs/packages.lisp:1.9 Sat Dec 25 13:29:24 2004 +++ climacs/packages.lisp Sat Dec 25 15:49:54 2004 @@ -56,7 +56,7 @@ (defpackage :climacs-syntax (:use :clim-lisp :clim :climacs-buffer :climacs-base) (:export #:syntax #:basic-syntax #:texinfo-syntax - #:redisplay-with-syntax #:full-redisplay + #:redisplay-pane #:redisplay-with-syntax #:full-redisplay #:url)) (defpackage :climacs-gui Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.3 climacs/syntax.lisp:1.4 --- climacs/syntax.lisp:1.3 Sat Dec 25 13:29:24 2004 +++ climacs/syntax.lisp Sat Dec 25 15:49:54 2004 @@ -28,6 +28,10 @@ (defgeneric redisplay-with-syntax (pane syntax)) +(defun redisplay-pane (pane) + "redisplay the pane according to its syntax" + (redisplay-with-syntax pane (syntax pane))) + (defgeneric full-redisplay (pane syntax)) (defclass basic-syntax (syntax) @@ -40,16 +44,17 @@ (space-width :initform nil) (tab-width :initform nil))) -(defmethod initialize-instance :after ((syntax basic-syntax) &rest args &key buffer pane) +(defmethod initialize-instance :after ((syntax basic-syntax) &rest args &key pane) (declare (ignore args)) - (with-slots (top bot scan space-width tab-width) syntax - (setf top (make-instance 'standard-left-sticky-mark :buffer buffer) - bot (make-instance 'standard-right-sticky-mark :buffer buffer) - scan (make-instance 'standard-left-sticky-mark :buffer buffer)) - (let* ((medium (sheet-medium pane)) - (style (medium-text-style medium))) - (setf space-width (text-style-width style medium) - tab-width (* 8 space-width))))) + (let ((buffer (buffer pane))) + (with-slots (top bot scan space-width tab-width) syntax + (setf top (make-instance 'standard-left-sticky-mark :buffer buffer) + bot (make-instance 'standard-right-sticky-mark :buffer buffer) + scan (make-instance 'standard-left-sticky-mark :buffer buffer)) + (let* ((medium (sheet-medium pane)) + (style (medium-text-style medium))) + (setf space-width (text-style-width style medium) + tab-width (* 8 space-width)))))) (define-presentation-type url () :inherit-from 'string)

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by rstrandh＠common-lisp.net 25 Dec '04

25 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv586 Modified Files: gui.lisp Log Message: I made a mistake trying to fix the conflict in gui.lisp. It should be OK now. Date: Sat Dec 25 14:36:21 2004 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.14 climacs/gui.lisp:1.15 --- climacs/gui.lisp:1.14 Sat Dec 25 13:29:24 2004 +++ climacs/gui.lisp Sat Dec 25 14:36:20 2004 @@ -316,10 +316,6 @@ (add-command-to-command-table command 'c-x-climacs-table :keystroke gesture :errorp nil)) -(defun c-x-set-key (gesture command) - (add-command-to-command-table command 'c-x-climacs-table - :keystroke gesture :errorp nil)) - ;;; for some reason, C-c does not seem to arrive as far as CLIM. (c-x-set-key '(#\q :control) 'com-quit) (c-x-set-key '(#\f :control) 'com-find-file)

1 0

[climacs-cvs] CVS update: climacs/Doc/climacs-internals.texi
by rstrandh＠common-lisp.net 25 Dec '04

25 Dec '04

Update of /project/climacs/cvsroot/climacs/Doc In directory common-lisp.net:/tmp/cvs-serv32318 Modified Files: climacs-internals.texi Log Message: Common Lisp syntax section. Date: Sat Dec 25 14:23:01 2004 Author: rstrandh Index: climacs/Doc/climacs-internals.texi diff -u climacs/Doc/climacs-internals.texi:1.1 climacs/Doc/climacs-internals.texi:1.2 --- climacs/Doc/climacs-internals.texi:1.1 Sat Dec 25 13:05:17 2004 +++ climacs/Doc/climacs-internals.texi Sat Dec 25 14:22:59 2004 @@ -445,6 +445,8 @@ @chapter Redisplay and the syntax protocol +@section General + A buffer can be on display in several panes. The redisplay algorithm is invoked on each such pane. Each pane is associated with a distinguished mark called the `point' of the pane. The point @@ -511,6 +513,781 @@ parser needs to use the low-mark and high-mark to determine which parts of the buffer have changed, and recompute parsing information as necessary. + +@section Common Lisp syntax + +Technically, comments and such are not expressions, but it is OK for +our purposes to consider that they are. + +@multitable @columnfractions .2 .1 .5 +@item program @tab -> @tab expr* +@item expr @tab -> @tab quoted-expression +@item expr @tab -> @tab comment +@item expr @tab -> @tab string +@item expr @tab -> @tab backquote-expression +@item expr @tab -> @tab unquote-expression +@item expr @tab -> @tab list-expression +@item expr @tab -> @tab label-ref +@item expr @tab -> @tab function-expression +@item expr @tab -> @tab vector-expression +@item expr @tab -> @tab array-expression +@item expr @tab -> @tab bitvector-expression +@item expr @tab -> @tab labeled-expression +@item expr @tab -> @tab character +@item expr @tab -> @tab balanced-comment +@item expr @tab -> @tab read-time-conditional-+ +@item expr @tab -> @tab read-time-conditional-- +@item expr @tab -> @tab read-time-evaluation +@item expr @tab -> @tab binary-expression +@item expr @tab -> @tab complex-expression +@item expr @tab -> @tab octal-expression +@item expr @tab -> @tab pathname-expression +@item expr @tab -> @tab radix-n-expression +@item expr @tab -> @tab hex-expression +@item expr @tab -> @tab token +@end multitable + +@multitable @columnfractions .3 .3 .3 +@headitem Expression @tab Syntax @tab handle/read +@item quoted-expression @tab 'expr @tab handle +@item comment @tab ; chars <newline> @tab handle +@item string @tab " chars " @tab read +@item backquote-expression @tab ` expr @tab handle +@item unquote-expression @tab , expr @tab handle +@item list-expression @tab ( expr* ) @tab handle +@item label-ref @tab #n# @tab handle +@item function-expression @tab #' expr @tab handle +@item vector-expression @tab #( expr* ) @tab handle +@item array-expression @tab #nA(...) @tab handle +@item bitvector-expression @tab #* bits @tab read +@item labeled-expression @tab #n= @tab handle +@item character @tab #\.. @tab read +@item balanced-comment @tab #| .. |# @tab handle +@item read-time-conditional-+ @tab #+test expr @tab handle +@item read-time-conditional-- @tab #-test expr @tab handle +@item read-time-evaluation @tab #.expr @tab handle +@item binary-expression @tab #b... @tab read +@item complex-expression @tab #c... @tab read +@item octal-expression @tab #o... @tab read +@item pathname-expression @tab #p... @tab read +@item radix-n-expression @tab #nr @tab read +@item hex-expression @tab #x @tab read +@end multitable + +@deftp {class} stack-entry + +A stack entry corresponds to a syntactic category and contains a +start offset and an end offset. The end offset is initialized to +nil, meaning we do not know where it ends. +@end deftp + +@deftp {initarg} :start-offset +@end deftp + +@deftp {class} error-entry + +This is a subclass of stack-entry. It is used whenever some invalid +input syntax is encountered. +@end deftp + +@deftp {class} terminal-entry + +This is a subclass of stack-entry. It is used for tokens (numbers, +symbols), but also for macro characters that start more complex +expressions. +@end deftp + +@deftp {class} number-entry + +A subclass of terminal-entry corresponding to the syntactic class of +numbers. +@end deftp + +@deftp {class} symbol-entry + +A subclass of terminal-entry corresponding to the syntactic class of +symbols. +@end deftp + +@deftp {class} character-entry + +A subclass of terminal-entry corresponding to the syntactic class of +characters. +@end deftp + +@deftp {class} string-entry + +A subclass of terminal-entry corresponding to the syntactic class of +character strings +@end deftp + +@deftp {class} quote-entry + +A subclass of terminal-entry corresponding to the syntactic class of +quote inidicators. +@end deftp + +@deftp {class} backquote-entry + +A subclass of terminal-entry corresponding to the syntactic class of +backquote indicators. +@end deftp + +@deftp {class} unquote-entry + +A subclass of terminal-entry corresponding to the syntactic class of +unquote indicators. +@end deftp + +@deftp {class} comment-entry + +A subclass of terminal-entry corresponding to the syntactic class of +single-line comment indicators. +@end deftp + +@deftp {class} list-start-entry + +A subclass of terminal-entry corresponding to the syntactic class of +list start indicators. +@end deftp + +@deftp {class} list-end-entry + +A subclass of terminal-entry corresponding to the syntactic class of +list end indicators. +@end deftp + +@deftp {class} label-ref-entry + +A subclass of terminal-entry corresponding to the syntactic class of +label reference indicators. +@end deftp + +@deftp {class} label-entry + +A subclass of terminal-entry corresponding to the syntactic class of +label indicators. +@end deftp + +@deftp {class} function-entry + +A subclass of terminal-entry corresponding to the syntactic class of +function indicators. +@end deftp + +@deftp {class} balanced-comment-entry + +A subclass of terminal-entry corresponding to the syntactic class of +balanced comment entry indicators. +@end deftp + +@deftp {class} read-time-conditional-entry + +A subclass of terminal-entry corresponding to the syntactic class of +read-time conditional indicators. +@end deftp + +@deftp {class} vector-entry + +A subclass of terminal-entry corresponding to the syntactic class of +vector indicators. +@end deftp + +@deftp {class} array-entry + +A subclass of terminal-entry corresponding to the syntactic class of +array indicators. +@end deftp + +@deftp {class} bitvector-entry + +A subclass of terminal-entry corresponding to the syntactic class of +bit vector indicators. +@end deftp + +@deftp {class} read-time-evaluation-entry + +A subclass of terminal-entry corresponding to the syntactic class of +read-time evaluation indicators. +@end deftp + +@deftp {class} complex-entry + +A subclass of terminal-entry corresponding to the syntactic class of +complex indicators. +@end deftp + +@deftp {class} octal-entry + +A subclass of terminal-entry corresponding to the syntactic class of +octal rational indicators. +@end deftp + +@deftp {class} hex-entry + +A subclass of terminal-entry corresponding to the syntactic class of +hex rational indicators. +@end deftp + +@deftp {class} radix-n-entry + +A subclass of terminal-entry corresponding to the syntactic class of +radix-n rational indicators. +@end deftp + +@deftp {class} pathname-entry + +A subclass of terminal-entry corresponding to the syntactic class of +pathname indicators. +@end deftp + +@deftp {class} binary-entry + +A subclass of terminal-entry corresponding to the syntactic class of +binary rational indicators. +@end deftp + +@deftp {class} unknown-entry + +A subclass of terminal-entry corresponding to unknown (user-defined) +syntactic classes. +@end deftp + +@deftp {class} nonterminal-entry + +This is a subclass of stack-entry. A nonterminal entry maintains an +expression count, which is initialized to 0. It corresponds to the +number of subexpressions of this expression that have been detected. +A nonterminal entry also maintains a backquote-depth which is +initially 0, is incremented by 1 for each nested backquote, and is +decremented by 1 for each comma. +@end deftp + +@deffn {generic function} expression-count nonterminal-entry + +Return the expression count of this entry. +@end deffn + +@deffn {generic function} {(setf expression-count)} count nonterminal-entry + +Set the expression count of this entry. +@end deffn + +@deffn {generic function} backquote-depth nonterminal-entry + +Return the backquote-depth of this entry. +@end deffn + +@deffn {generic function} {(setf backquote-depth)} depth nonterminal-entry + +Set the backquote-depth of this entry. +@end deffn + +@deftp {class} program-entry + +A subclass of nonterminal-entry corresponding to the entire buffer +contents. +@end deftp + +@deftp {class} quoted-expression-entry + +A subclass of nonterminal-entry corresponding to a quoted +expression. +@end deftp + +@deftp {class} unquoted-expression-entry + +A subclass of nonterminal-entry corresponding to an unquoted +expression. +@end deftp + +@deftp {class} list-expression-entry + +A subclass of nonterminal-entry corresponding to a list expression. +@end deftp + +@deftp {class} function-expression-entry + +A subclass of nonterminal-entry corresponding to a function +expression. +@end deftp + +@deftp {class} vector-expression-entry + +A subclass of nonterminal-entry corresponding to a vector expression. +@end deftp + +@deftp {class} labeled-expression-entry + +A subclass of nonterminal-entry corresponding to a labeled expression. +@end deftp + +@deftp {class} array-expression-entry + +A subclass of nonterminal-entry corresponding to a list expression. +@end deftp + +@deftp {class} array-dimension-entry + +A subclass of nonterminal-entry corresponding to an array dimension. +@end deftp + +@deftp {class} read-time-feature-entry + +A subclass of nonterminal-entry corresponding to a read-time +feature. +@end deftp + +@deftp {class} read-time-conditional-expression-entry + +A subclass of nonterminal-entry corresponding to a read-time +conditional expression. +@end deftp + +@deftp {class} read-time-evaluation-expression-entry + +A subclass of nonterminal-entry corresponding to a read-time +evaluation expression. +@end deftp + +@deftp {class} complex-expression-entry + +A subclass of nonterminal-entry corresponding to a complex +expression. +@end deftp + +@deftp {class} octal-expression-entry + +A subclass of nonterminal-entry corresponding to an octal expression. +@end deftp + +@deftp {class} hex-expression-entry + +A subclass of nonterminal-entry corresponding to a hexadecimal +expression. +@end deftp + +@deftp {class} radix-n-expression-entry + +A subclass of nonterminal-entry corresponding to a radix-n +expression. +@end deftp + +@deftp {class} pathname-expression-entry + +A subclass of nonterminal-entry corresponding to a pathname +expression. +@end deftp + +@deftp {class} binary-expression-entry + +A subclass of nonterminal-entry corresponding to binary expression. +@end deftp + +@deftp {class} buffer-stream + +A stream corresponding to a text buffer. It contains a current parse +stack which is a list of stack entries. +@end deftp + +@deftp {initarg} :buffer + +The buffer underlying the stream. +@end deftp + +@deffn {generic function} current-offset buffer-stream + +Return the current offset of the buffer stream. +@end deffn + +@deffn {generic function} {(setf current-offset)} offset buffer-stream + +set the current offset of the buffer stream. +@end deffn + +@deffn {generic function} max-offset buffer-stream + +Return the maximum offset of the buffer stream, beyond which no +parsing is required. +@end deffn + +@deffn {generic function} {(setf max-offset)} offset buffer-stream + +set the maximum offset of the buffer stream. +@end deffn + +@deffn {method} stream-read-char buffer-stream + +Return the character at the current offset (or :eof if the offset is +equal to the size of the buffer) +@end deffn + +@deffn {generic function} parse-stack buffer-stream + +Return the current parse stack of the buffer stream. The parse stack +contains either all nonterminal, or all but the top element +nonterminal. The list of entries is initially a list of a single +entry corresponding to the syntactic category `program-entry' with a +start offset of 0 and an expression count of 0. +@end deffn + +@deffn {generic function} {(setf parse-stack)} stack buffer-stream + +Set the current parse stack of the buffer. +@end deffn + +@deffn {generic function} analysis buffer-stream + +An adjustable vector each element of which is a parse stack with top +element being terminal. The vector is initially empty. +@end deffn + +@deffn {generic function} invalidate-parse buffer-stream offset + +Called by client code to indicate that the buffer has been altered +starting at the offset indicated. The analysis vector of the buffer +stream is shortened to the last entry ending before or at the +offset. The parse stack is set to the tail of the stack at the last +entry of the analysis vector. The current offset is set to the end +offset of the last entry of the analysis vector. +@end deffn + +@deffn {generic function} advance-parse buffer-stream offset + +Inform the parser that it should construct a valid analysis vector up +to the offset indicated. The redisplay module will call this +function with the highest offset of all the windows on display before +calling display-region for each window. The algorithm is as follows: + + Set the max offset of the buffer stream to the offset passed as + argument. + Loop until the current offset is greater than or equal to max + offset (i.e., EOF on the buffer stream is reached): + Remember the current offset + Read a character + If it is a whitespace, + do nothing + Else if it is a single-dispatch-macro character + Call parse-macro-character with the buffer stream, the value of + a call to get-macro-character of the character, the + top-element of the current parse stack, and the remembered + offset. + Else + Unread the character and call `read' on the stream. + Add an entry to the end of the analysis vector containing as + start offset the remembered offset, as end offset the current + offset after the call to read, and a stack containing the + current parse stack with an additional entry on top + corresponding to the item read (number, symbol, etc). + Increment the expression count of the top of the stack. + Perform a count check (see below). +@end deffn + +@deffn {Generic Function} parse-macro-character buffer-stream function entry o + +This generic function is called with a buffer stream, with a function +that is returned by a call to get-macro-character, the top-entry +of the current parse stack, and a remembered offset. +@end deffn + +It has a number of methods, each one specialized (using an eql +specializer) on a function returned by a call to get-macro-character +in standard syntax. We indicate here the character itself, but it is +the associated function that is actually used. + +@table @samp +@item ) nonterminal-entry +@itemize @bullet +@item +Add an entry at the end of the analysis vector with the current +stack augmented with an entry for `error-entry' with a start offset +of the remembered offset and an end offset of the current offset. +@end itemize +@item ) vector-expression-entry +@itemx ) list-expression-entry +@itemx ) array-expression-entry +@itemize @bullet +@item +Set the end offset of the entry on top of the stack to the current +offset. +@item +Pop the current stack. +@item +Increment the expression count of the top of the stack. +@item +Perform a count check (see below) +@item +Add an entry at the end of the analysis vector with the current +stack augmented with an entry for `list-end-entry' with a start +offset of the remembered offset, and an end offset of the current +offset +@end itemize + +@item ) nonterminal-entry +@itemize @bullet + Add an entry at the end of the analysis vector with the current + stack augmented with an entry for `error-entry' with a start offset + of the remembered offset and an end offset of the current offset. +@end itemize + +@item ) vector-expression-entry +@itemx ) list-expression-entry +@itemx ) array-expression-entry +@itemize @bullet +@item + Set the end offset of the entry on top of the stack to the current + offset. +@item + Pop the current stack. +@item + Increment the expression count of the top of the stack. +@item + Perform a count check (see below). +@item + Add an entry at the end of the analysis vector with the current + stack augmented with an entry for `list-end-entry' with a start + offset of the remembered offset, and an end offset of the current + offset. +@end itemize + +@item ; nonterminal-entry +@itemize @bullet +@item + Read characters until a newline has been read. +@item + Add an entry to the end of the analysis vector with the current + stack augmented with an entry for `comment-entry' with a start + offset of the remembered offset and the end offset of the current + offset. +@end itemize + +@item ' nonterminal-entry +@itemize @bullet +@item + Push an entry for quoted-expression-entry on the stack with a + backquote-depth of one plus that of the current top of the stack. +@item + Add an entry at the end of the analysis vector with the current + stack augmented with an entry for `quote-entry' with a + start offset of the remembered offset and an end offset of + the current offset. +@end itemize + +@item ` nonterminal-entry +@itemize @bullet +@item + Push an entry for quoted-expression-entry on the stack with a + backquote-depth of that of the current top of the stack plus one. +@item + Add an entry at the end of the analysis vector with the current + stack augmented with an entry for `backquote-entry' with a + start offset of the remembered offset and an end offset of + the current offset. +@end itemize + +@item , nonterminal-entry +@itemize @bullet +@item + If the backquote-depth of the top of the stack is greater than 0 +@itemize @bullet +@item + Push an entry for unquoted-expression-entry on the stack with a + backquote-depth of that of the current top of the stack minus + one. +@item + Add an entry at the end of the analysis vector with the current + stack augmented with an entry for `unquote-entry' with a + start offset of the remembered offset and an end offset of + the current offset. +@end itemize +@item + Else +@itemize @bullet +@item + Push an entry for unquoted-expression-entry on the stack with a + backquote-depth of 0. +@item + Add an entry at the end of the analysis vector with the current + stack augmented with an entry for `error-entry' with a start + offset of the remembered offset and an end offset of the current + offset. +@end itemize +@end itemize + +@item ( nonterminal-entry +@itemize @bullet +@item + Push an entry for list-expression-entry on the stack with a + backquote-depth of that of the current top of the stack. +@item + Add an entry at the end of the analysis vector with the current + stack augmented with an entry for `list-start-entry' with a + start offset of the remembered offset and an end offset of + the current offset. +@end itemize + +@item " nonterminal-entry +@itemize @bullet +@item + Call the function associated with the character. + Increment the expression count of the top of the stack. +@item + Perform a count check (see below). +@item + Add an entry at the end of the analysis vector with the current + stack augmented with an entry for `string-entry' with a start + offset of the remembered offset and an end offset of the current + offset. +@end itemize + +@item # nonterminal-entry +@itemize @bullet +@item + Remember the first char. +@item + Read characters as long as they are digits, and form a count (a + number or nil if there are no digits). +@item + If the first non-digit character is a dispatch macro character +@itemize @bullet +@item + Call parse-dispatch-macro-character with the buffer stream, the + result of a call to get-dispatch-macro-character, the entry, and + the remembered offset +@end itemize +@item + Else +@item + Add an entry at the end of the analysis vector with the current + stack augmented with an entry for `error-entry' with a start + offset of the remembered offset and an end offset of the current + offset. +@end itemize + +@item any nonterminal-entry +@itemize @bullet +@item + Call the function associated with the character. +@item + Add an entry at the end of the analysis vector with the current + stack augmented with an entry for `unknown-entry' with a start + offset of the remembered offset and an end offset of the + current offset. +@end itemize +@end table + +@deffn {Generic Function} parse-dispatch-macro-character buffer-stream function entry o +@end deffn + +@table @samp +@item # nonterminal-entry +@itemize @bullet +@item + Increment the expression count of the top of the stack. +@item + Perform a count check (see below). +@item + Add an entry at the end of the analysis vector with the current + stack augmented with an entry for `label-ref-entry' with a + start offset of the remembered offset and an end offset of + the current offset. +@end itemize + +@item ' nonterminal-entry +@itemize @bullet +@item + Push an entry for function-expression-entry on the stack with a + backquote-depth of that of the current top of the stack. +@item + Add an entry at the end of the analysis vector with the current + stack augmented with the entry for function-entry with a start + offset of the remembered offset and the end offset of the current + offset. +@end itemize + +@item ( nonterminal-entry +@itemize @bullet +@item + Push an entry for vector-expression-entry on the stack with a + backquote-depth of that of the current top of the stack. +@item + Add an entry at the end of the analysis vector with the current + stack augmented with the entry for vector-entry with a start offset + of the remembered offset and the end offset of the current offset. +@end itemize + +@item A nonterminal-entry + [to be filled in] + +@item = nonterminal-entry +@itemize @bullet +@item + Push an entry for labeled-expression-entry on the stack with a + backquote-depth of that of the current top of the stack. +@item + Add an entry at the end of the analysis vector with the current + stack augmented with the entry for label-entry with a start offset + of the remembered offset and the end offset of the current offset. +@end itemize + +@item | nonterminal-entry +@itemize @bullet +@item + Read characters until a |# pair has been seen or EOF is reached. +@item + Add an entry at the end of the analysis vector with the current + stack augmented with the entry for balanced-comment-entry with a + start offset of the remembered offset and the end offset of the + current offset. +@end itemize + +@item + nonterminal-entry +@itemx - nonterminal-entry +@itemize @bullet +@item + Push an entry for read-time-conditional-expression-entry on the + stack with a backquote-depth of that of the current top of the + stack. +@item + Add an entry at the end of the analysis vector with the current + stack augmented with the entry for read-time-conditional-entry with + a start offset of the remembered offset and the end offset of the + current offset. +@end itemize + +@item . nonterminal-entry +@itemize @bullet +@item + Push an entry for read-time-evaluation-expression-entry on the + stack with a backquote-depth of that of the current top of the + stack. +@item + Add an entry at the end of the analysis vector with the current + stack augmented with the entry for read-time-evaluation-entry with + a start offset of the remembered offset and the end offset of the + current offset. +@end itemize + +@item any nonterminal-entry +@itemize @bullet +@item + Call the function associated with the character. +@item + Add an entry at the end of the analysis vector with the current + stack augmented with an entry for `unknown terminal' with a start + offset of the remembered offset and an end offset of the + current offset. +@end itemize +@end table + +@deffn {Generic Function} count-check nonterminal-entry + +A count check means that we compare the expression count of the top of +the stack and its syntactic category. If the category has a limited +number of expressions allowed, and we have reached it, we pop off the +top element, increment the expression count of the new top entry, and +perform a count check again. +@end deffn @chapter The undo protocol

1 0

[climacs-cvs] CVS update: climacs/gui.lisp climacs/packages.lisp climacs/syntax.lisp climacs/buffer.text climacs/syntax.text climacs/undo.text
by rstrandh＠common-lisp.net 25 Dec '04

25 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv29346 Modified Files: gui.lisp packages.lisp syntax.lisp Removed Files: buffer.text syntax.text undo.text Log Message: Resolved conflict in gui.lisp. Date: Sat Dec 25 13:29:24 2004 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.13 climacs/gui.lisp:1.14 --- climacs/gui.lisp:1.13 Sat Dec 25 00:17:48 2004 +++ climacs/gui.lisp Sat Dec 25 13:29:24 2004 @@ -40,7 +40,7 @@ (when (null point) (setf point (make-instance 'standard-right-sticky-mark :buffer buffer))) - (setf syntax (make-instance 'basic-syntax :buffer buffer :pane pane)))) + (setf syntax (make-instance 'texinfo-syntax :buffer buffer :pane pane)))) (define-application-frame climacs () ((win :reader win)) @@ -246,10 +246,11 @@ (with-slots (buffer point syntax) (win *application-frame*) (setf buffer (make-instance 'climacs-buffer) point (make-instance 'standard-right-sticky-mark :buffer buffer) - syntax (make-instance 'basic-syntax :buffer buffer :pane (win *application-frame*)) + syntax (make-instance 'texinfo-syntax :buffer buffer :pane (win *application-frame*)) (filename buffer) filename) (with-open-file (stream filename :direction :input) - (input-from-stream stream buffer 0))))) + (input-from-stream stream buffer 0)) + (beginning-of-buffer point)))) (define-command com-save-buffer () (let ((filename (or (filename (buffer (win *application-frame*))) @@ -259,6 +260,15 @@ (with-open-file (stream filename :direction :output :if-exists :supersede) (output-to-stream stream buffer 0 (size buffer))))) +(define-command com-beginning-of-buffer () + (beginning-of-buffer (point (win *application-frame*)))) + +(define-command com-end-of-buffer () + (end-of-buffer (point (win *application-frame*)))) + +(define-command com-browse-url () + (accept 'url :prompt "Browse URL")) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Global command table @@ -288,6 +298,9 @@ (global-set-key '(#\x :meta) 'com-extended-command) (global-set-key '(#\a :meta) 'com-insert-weird-stuff) (global-set-key '(#\c :meta) 'com-insert-reversed-string) +(global-set-key '(#\< :shift :meta) 'com-beginning-of-buffer) +(global-set-key '(#\> :shift :meta) 'com-end-of-buffer) +(global-set-key '(#\u :meta) 'com-browse-url) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -299,12 +312,15 @@ :menu 'c-x-climacs-table :keystroke '(#\x :control)) -;;; for some reason, C-c does not seem to arrive as far as CLIM. +(defun c-x-set-key (gesture command) + (add-command-to-command-table command 'c-x-climacs-table + :keystroke gesture :errorp nil)) (defun c-x-set-key (gesture command) (add-command-to-command-table command 'c-x-climacs-table :keystroke gesture :errorp nil)) +;;; for some reason, C-c does not seem to arrive as far as CLIM. (c-x-set-key '(#\q :control) 'com-quit) (c-x-set-key '(#\f :control) 'com-find-file) -(c-x-set-key '(#\s :control) 'com-save-buffer) \ No newline at end of file +(c-x-set-key '(#\s :control) 'com-save-buffer) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.8 climacs/packages.lisp:1.9 --- climacs/packages.lisp:1.8 Thu Dec 23 19:49:32 2004 +++ climacs/packages.lisp Sat Dec 25 13:29:24 2004 @@ -55,8 +55,9 @@ (defpackage :climacs-syntax (:use :clim-lisp :clim :climacs-buffer :climacs-base) - (:export #:syntax #:basic-syntax - #:redisplay-with-syntax #:full-redisplay)) + (:export #:syntax #:basic-syntax #:texinfo-syntax + #:redisplay-with-syntax #:full-redisplay + #:url)) (defpackage :climacs-gui (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax)) Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.2 climacs/syntax.lisp:1.3 --- climacs/syntax.lisp:1.2 Fri Dec 24 09:21:34 2004 +++ climacs/syntax.lisp Sat Dec 25 13:29:24 2004 @@ -51,15 +51,21 @@ (setf space-width (text-style-width style medium) tab-width (* 8 space-width))))) -(defun present-contents (pane syntax) +(define-presentation-type url () + :inherit-from 'string) + +(defmethod present-contents (pane (syntax basic-syntax)) (with-slots (saved-offset scan) syntax (unless (null saved-offset) - (present (coerce (region-to-sequence saved-offset scan) 'string) - 'string - :stream pane) + (let ((word (coerce (region-to-sequence saved-offset scan) 'string))) + (present word + (if (and (>= (length word) 7) (string= (subseq word 0 7) "http://")) + 'url + 'string) + :stream pane)) (setf saved-offset nil)))) -(defun display-line (pane syntax) +(defmethod display-line (pane (syntax basic-syntax)) (with-slots (saved-offset bot scan cursor-x cursor-y space-width tab-width) syntax (loop when (mark= scan (point pane)) do (multiple-value-bind (x y) (stream-cursor-position pane) @@ -129,3 +135,23 @@ cursor-x (- cursor-y (* 0.2 height)) cursor-x (+ cursor-y (* 0.8 height)) :ink +red+)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Texinfo syntax + +(defclass texinfo-syntax (basic-syntax) ()) + +(define-presentation-type texinfo-command () + :inherit-from 'string) + +(defmethod present-contents (pane (syntax texinfo-syntax)) + (with-slots (saved-offset scan) syntax + (unless (null saved-offset) + (let ((word (coerce (region-to-sequence saved-offset scan) 'string))) + (if (char= (aref word 0) #\@) + (with-drawing-options (pane :ink +red+) + (present word 'texinfo-command :stream pane)) + (present word 'string :stream pane))) + (setf saved-offset nil)))) +

1 0

[climacs-cvs] CVS update: climacs/Doc/Makefile climacs/Doc/climacs-internals.texi climacs/Doc/undo.fig
by rstrandh＠common-lisp.net 25 Dec '04

25 Dec '04

Update of /project/climacs/cvsroot/climacs/Doc In directory common-lisp.net:/tmp/cvs-serv28534 Added Files: Makefile climacs-internals.texi undo.fig Log Message: Interals documentation to replace existing text files. Date: Sat Dec 25 13:05:18 2004 Author: rstrandh

1 0

[climacs-cvs] CVS update: Directory change: climacs/Doc
by rstrandh＠common-lisp.net 25 Dec '04

25 Dec '04

Update of /project/climacs/cvsroot/climacs/Doc In directory common-lisp.net:/tmp/cvs-serv28509/Doc Log Message: Directory /project/climacs/cvsroot/climacs/Doc added to the repository Date: Sat Dec 25 13:03:33 2004 Author: rstrandh New directory climacs/Doc added

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by abakic＠common-lisp.net 24 Dec '04

24 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv21795 Modified Files: gui.lisp Log Message: A minor refactoring, in fact to get around a CMUCL problem (probably related to eval-when...). Date: Sat Dec 25 00:17:48 2004 Author: abakic Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.12 climacs/gui.lisp:1.13 --- climacs/gui.lisp:1.12 Fri Dec 24 09:21:34 2004 +++ climacs/gui.lisp Sat Dec 25 00:17:48 2004 @@ -301,14 +301,10 @@ ;;; for some reason, C-c does not seem to arrive as far as CLIM. -(add-command-to-command-table 'com-quit 'c-x-climacs-table - :keystroke '(#\q :control)) - -(add-command-to-command-table 'com-find-file 'c-x-climacs-table - :keystroke '(#\f :control)) - -(add-command-to-command-table 'com-save-buffer 'c-x-climacs-table - :keystroke '(#\s :control)) - - +(defun c-x-set-key (gesture command) + (add-command-to-command-table command 'c-x-climacs-table + :keystroke gesture :errorp nil)) +(c-x-set-key '(#\q :control) 'com-quit) +(c-x-set-key '(#\f :control) 'com-find-file) +(c-x-set-key '(#\s :control) 'com-save-buffer) \ No newline at end of file

1 0

[climacs-cvs] CVS update: climacs/climacs.asd
by abakic＠common-lisp.net 24 Dec '04

24 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv21427 Modified Files: climacs.asd Log Message: Added a dependency on :clim-clx so that build is smooth for both CMUCL and SBCL. (Make sure CLIM and CLX are in central registry/provided.) Date: Sat Dec 25 00:14:41 2004 Author: abakic Index: climacs/climacs.asd diff -u climacs/climacs.asd:1.4 climacs/climacs.asd:1.5 --- climacs/climacs.asd:1.4 Thu Dec 23 19:49:32 2004 +++ climacs/climacs.asd Sat Dec 25 00:14:40 2004 @@ -42,7 +42,7 @@ :defaults *climacs-directory*)) collect `(:file ,(pathname-name p) :pathname ,p)))))) -(climacs-defsystem (:climacs) +(climacs-defsystem (:climacs :depends-on (:clim-clx)) "Flexichain/skiplist-package" "Flexichain/skiplist" "Flexichain/flexichain-package"

1 0

[climacs-cvs] CVS update: climacs/buffer.lisp climacs/gui.lisp climacs/syntax.lisp
by rstrandh＠common-lisp.net 24 Dec '04

24 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv7462 Modified Files: buffer.lisp gui.lisp syntax.lisp Log Message: Implemented a basic syntax according to the syntax protocol specification (which I haven't written yet). The current implementation should be improved upon, but it basically shows how to do it. Also implemented a demo command that accepts a string and inserts its reverse in the buffer. This shows that the words in the buffer are actually presentations (of type string) that become clickable by the accept. Added two missing methods on region-to-sequence. There were no methods when one of the arguments is an offset instead of a mark. Date: Fri Dec 24 09:21:35 2004 Author: rstrandh Index: climacs/buffer.lisp diff -u climacs/buffer.lisp:1.10 climacs/buffer.lisp:1.11 --- climacs/buffer.lisp:1.10 Thu Dec 23 18:24:44 2004 +++ climacs/buffer.lisp Fri Dec 24 09:21:34 2004 @@ -450,6 +450,12 @@ (assert (eq (buffer mark1) (buffer mark2))) (buffer-sequence (buffer mark1) (offset mark1) (offset mark2))) +(defmethod region-to-sequence ((offset integer) (mark mark-mixin)) + (buffer-sequence (buffer mark) offset (offset mark))) + +(defmethod region-to-sequence ((mark mark-mixin) (offset integer)) + (buffer-sequence (buffer mark) (offset mark) offset)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Buffer modification protocol Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.11 climacs/gui.lisp:1.12 --- climacs/gui.lisp:1.11 Thu Dec 23 19:49:32 2004 +++ climacs/gui.lisp Fri Dec 24 09:21:34 2004 @@ -32,14 +32,15 @@ (defclass climacs-pane (application-pane) ((buffer :initform (make-instance 'climacs-buffer) :accessor buffer) (point :initform nil :initarg :point :reader point) - (syntax :initform (make-instance 'basic-syntax) :initarg :syntax :accessor syntax))) + (syntax :initarg :syntax :accessor syntax))) (defmethod initialize-instance :after ((pane climacs-pane) &rest args) (declare (ignore args)) - (with-slots (buffer point) pane + (with-slots (buffer point syntax) pane (when (null point) (setf point (make-instance 'standard-right-sticky-mark - :buffer buffer))))) + :buffer buffer))) + (setf syntax (make-instance 'basic-syntax :buffer buffer :pane pane)))) (define-application-frame climacs () ((win :reader win)) @@ -162,6 +163,9 @@ (define-command com-insert-weird-stuff () (insert-object (point (win *application-frame*)) (make-instance 'weird))) +(define-command com-insert-reversed-string () + (insert-sequence (point (win *application-frame*)) + (reverse (accept 'string)))) (define-presentation-type completable-pathname () :inherit-from 'pathname) @@ -238,14 +242,14 @@ (define-command com-find-file () (let ((filename (accept 'completable-pathname - :prompt "Find File")) - (buffer (make-instance 'climacs-buffer))) - (setf (buffer (win *application-frame*)) buffer - (filename (buffer (win *application-frame*))) filename) - (with-open-file (stream filename :direction :input) - (input-from-stream stream buffer 0)) - (setf (slot-value (win *application-frame*) 'point) - (make-instance 'standard-right-sticky-mark :buffer buffer)))) + :prompt "Find File"))) + (with-slots (buffer point syntax) (win *application-frame*) + (setf buffer (make-instance 'climacs-buffer) + point (make-instance 'standard-right-sticky-mark :buffer buffer) + syntax (make-instance 'basic-syntax :buffer buffer :pane (win *application-frame*)) + (filename buffer) filename) + (with-open-file (stream filename :direction :input) + (input-from-stream stream buffer 0))))) (define-command com-save-buffer () (let ((filename (or (filename (buffer (win *application-frame*))) @@ -283,6 +287,7 @@ (global-set-key '(#\b :meta) 'com-backward-word) (global-set-key '(#\x :meta) 'com-extended-command) (global-set-key '(#\a :meta) 'com-insert-weird-stuff) +(global-set-key '(#\c :meta) 'com-insert-reversed-string) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.1 climacs/syntax.lisp:1.2 --- climacs/syntax.lisp:1.1 Thu Dec 23 19:49:32 2004 +++ climacs/syntax.lisp Fri Dec 24 09:21:34 2004 @@ -31,63 +31,101 @@ (defgeneric full-redisplay (pane syntax)) (defclass basic-syntax (syntax) - ()) + ((top :reader top) + (bot :reader bot) + (scan :reader scan) + (saved-offset :initform nil :accessor saved-offset) + (cursor-x :initform nil) + (cursor-y :initform nil) + (space-width :initform nil) + (tab-width :initform nil))) + +(defmethod initialize-instance :after ((syntax basic-syntax) &rest args &key buffer pane) + (declare (ignore args)) + (with-slots (top bot scan space-width tab-width) syntax + (setf top (make-instance 'standard-left-sticky-mark :buffer buffer) + bot (make-instance 'standard-right-sticky-mark :buffer buffer) + scan (make-instance 'standard-left-sticky-mark :buffer buffer)) + (let* ((medium (sheet-medium pane)) + (style (medium-text-style medium))) + (setf space-width (text-style-width style medium) + tab-width (* 8 space-width))))) + +(defun present-contents (pane syntax) + (with-slots (saved-offset scan) syntax + (unless (null saved-offset) + (present (coerce (region-to-sequence saved-offset scan) 'string) + 'string + :stream pane) + (setf saved-offset nil)))) + +(defun display-line (pane syntax) + (with-slots (saved-offset bot scan cursor-x cursor-y space-width tab-width) syntax + (loop when (mark= scan (point pane)) + do (multiple-value-bind (x y) (stream-cursor-position pane) + (setf cursor-x (+ x (if (null saved-offset) + 0 + (* space-width (- (offset scan) saved-offset)))) + cursor-y y)) + when (mark= scan bot) + do (present-contents pane syntax) + (return) + until (eql (object-after scan) #\Newline) + do (let ((obj (object-after scan))) + (cond ((eql obj #\Space) + (present-contents pane syntax) + (princ obj pane)) + ((eql obj #\Tab) + (present-contents pane syntax) + (let ((x (stream-cursor-position pane))) + (stream-increment-cursor-position + pane (- tab-width (mod x tab-width)) 0))) + ((constituentp obj) + (when (null saved-offset) + (setf saved-offset (offset scan)))) + (t + (present-contents pane syntax) + (princ obj pane)))) + (incf (offset scan)) + finally (present-contents pane syntax) + (incf (offset scan)) + (terpri pane)))) (defmethod redisplay-with-syntax (pane (syntax basic-syntax)) (let* ((medium (sheet-medium pane)) (style (medium-text-style medium)) - (height (text-style-height style medium)) - (width (text-style-width style medium)) - (tab-width (* 8 width)) - (buffer (buffer pane)) - (size (size (buffer pane))) - (offset 0) - (offset1 nil) - (cursor-x nil) - (cursor-y nil)) - (labels ((present-contents () - (unless (null offset1) - (present (coerce (buffer-sequence buffer offset1 offset) 'string) - 'string - :stream pane) - (setf offset1 nil))) - (display-line () - (loop when (= offset (offset (point pane))) - do (multiple-value-bind (x y) (stream-cursor-position pane) - (setf cursor-x (+ x (if (null offset1) - 0 - (* width (- offset offset1)))) - cursor-y y)) - when (= offset size) - do (present-contents) - (return) - until (eql (buffer-object buffer offset) #\Newline) - do (let ((obj (buffer-object buffer offset))) - (cond ((eql obj #\Space) - (present-contents) - (princ obj pane)) - ((eql obj #\Tab) - (present-contents) - (let ((x (stream-cursor-position pane))) - (stream-increment-cursor-position - pane (- tab-width (mod x tab-width)) 0))) - ((constituentp obj) - (when (null offset1) - (setf offset1 offset))) - (t - (present-contents) - (princ obj pane)))) - (incf offset) - finally (present-contents) - (incf offset) - (terpri pane)))) - (loop while (< offset size) - do (display-line)) - (when (= offset (offset (point pane))) - (multiple-value-bind (x y) (stream-cursor-position pane) - (setf cursor-x x - cursor-y y)))) - (draw-line* pane - cursor-x (- cursor-y (* 0.2 height)) - cursor-x (+ cursor-y (* 0.8 height)) - :ink +red+))) + (height (text-style-height style medium))) + (with-slots (top bot scan cursor-x cursor-y) syntax + (beginning-of-line top) + (end-of-line bot) + (multiple-value-bind (x y w h) (bounding-rectangle* pane) + (declare (ignore x y w)) + (let ((nb-lines (max 1 (floor h (+ height (stream-vertical-spacing pane)))))) + (loop while (> (1+ (- (line-number bot) (line-number top))) nb-lines) + do (beginning-of-line bot) + (decf (offset bot))) + (loop until (end-of-buffer-p bot) + while (< (1+ (- (line-number bot) (line-number top))) nb-lines) + do (incf (offset bot)) + (end-of-line bot)) + (loop while (mark< (point pane) top) + do (decf (offset top)) + (beginning-of-line top) + (beginning-of-line bot) + (decf (offset bot))) + (loop while (mark> (point pane) bot) + do (end-of-line top) + (incf (offset top)) + (incf (offset bot)) + (end-of-line bot)) + (setf (offset scan) (offset top)) + (loop until (mark= scan bot) + do (display-line pane syntax)) + (when (mark= scan (point pane)) + (multiple-value-bind (x y) (stream-cursor-position pane) + (setf cursor-x x + cursor-y y))) + (draw-line* pane + cursor-x (- cursor-y (* 0.2 height)) + cursor-x (+ cursor-y (* 0.8 height)) + :ink +red+))))))

1 0

[climacs-cvs] CVS update: climacs/syntax.lisp climacs/climacs.asd climacs/gui.lisp climacs/packages.lisp
by rstrandh＠common-lisp.net 23 Dec '04

23 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv29237 Modified Files: climacs.asd gui.lisp packages.lisp Added Files: syntax.lisp Log Message: First steps toward a decent redisplay function. We introduce a protocol class `syntax' used to specialize methods of the redisplay functions. We also introduce a class `basic-syntax', a subclass of `syntax' that can redisplay basic text. Currently, the redisplay method on basic-syntax is not terribly smart, as it displays the entire buffer. Each pane that displays a buffer also contains a syntax used to determine the way the buffer is to be rendered in that pane. Currently, the implementation is ahead of the specification with respect to this syntax abstraction. That will not be the case for very long, though. Date: Thu Dec 23 19:49:33 2004 Author: rstrandh Index: climacs/climacs.asd diff -u climacs/climacs.asd:1.3 climacs/climacs.asd:1.4 --- climacs/climacs.asd:1.3 Wed Dec 22 15:43:18 2004 +++ climacs/climacs.asd Thu Dec 23 19:49:32 2004 @@ -54,4 +54,5 @@ "base" "io" "abbrev" + "syntax" "gui") Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.10 climacs/gui.lisp:1.11 --- climacs/gui.lisp:1.10 Thu Dec 23 17:37:08 2004 +++ climacs/gui.lisp Thu Dec 23 19:49:32 2004 @@ -31,7 +31,8 @@ (defclass climacs-pane (application-pane) ((buffer :initform (make-instance 'climacs-buffer) :accessor buffer) - (point :initform nil :initarg :point :reader point))) + (point :initform nil :initarg :point :reader point) + (syntax :initform (make-instance 'basic-syntax) :initarg :syntax :accessor syntax))) (defmethod initialize-instance :after ((pane climacs-pane) &rest args) (declare (ignore args)) @@ -63,63 +64,7 @@ (defun display-win (frame pane) "The display function used by the climacs application frame." (declare (ignore frame)) - (let* ((medium (sheet-medium pane)) - (style (medium-text-style medium)) - (height (text-style-height style medium)) - (width (text-style-width style medium)) - (tab-width (* 8 width)) - (buffer (buffer pane)) - (size (size (buffer pane))) - (offset 0) - (offset1 nil) - (cursor-x nil) - (cursor-y nil)) - (labels ((present-contents () - (unless (null offset1) - (present (coerce (buffer-sequence buffer offset1 offset) 'string) - 'string - :stream pane) - (setf offset1 nil))) - (display-line () - (loop when (= offset (offset (point pane))) - do (multiple-value-bind (x y) (stream-cursor-position pane) - (setf cursor-x (+ x (if (null offset1) - 0 - (* width (- offset offset1)))) - cursor-y y)) - when (= offset size) - do (present-contents) - (return) - until (eql (buffer-object buffer offset) #\Newline) - do (let ((obj (buffer-object buffer offset))) - (cond ((eql obj #\Space) - (present-contents) - (princ obj pane)) - ((eql obj #\Tab) - (present-contents) - (let ((x (stream-cursor-position pane))) - (stream-increment-cursor-position - pane (- tab-width (mod x tab-width)) 0))) - ((constituentp obj) - (when (null offset1) - (setf offset1 offset))) - (t - (present-contents) - (princ obj pane)))) - (incf offset) - finally (present-contents) - (incf offset) - (terpri pane)))) - (loop while (< offset size) - do (display-line)) - (when (= offset (offset (point pane))) - (multiple-value-bind (x y) (stream-cursor-position pane) - (setf cursor-x x - cursor-y y)))) - (draw-line* pane - cursor-x (- cursor-y (* 0.2 height)) - cursor-x (+ cursor-y (* 0.8 height)) - :ink +red+))) + (redisplay-with-syntax pane (syntax pane))) (defun find-gestures (gestures start-table) (loop with table = (find-command-table start-table) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.7 climacs/packages.lisp:1.8 --- climacs/packages.lisp:1.7 Thu Dec 23 18:24:45 2004 +++ climacs/packages.lisp Thu Dec 23 19:49:32 2004 @@ -53,6 +53,11 @@ (:export #:abbrev-expander #:dictionary-abbrev-expander #:dictionary #:expand-abbrev #:abbrev-mixin #:possibly-expand-abbrev)) +(defpackage :climacs-syntax + (:use :clim-lisp :clim :climacs-buffer :climacs-base) + (:export #:syntax #:basic-syntax + #:redisplay-with-syntax #:full-redisplay)) + (defpackage :climacs-gui - (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev)) + (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax))

1 0

[climacs-cvs] CVS update: climacs/buffer.lisp climacs/buffer.text climacs/packages.lisp
by rstrandh＠common-lisp.net 23 Dec '04

23 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv25441 Modified Files: buffer.lisp buffer.text packages.lisp Log Message: Completed the description of the buffer modification protocol. Implemented the protocol. Updated the buffer package accordingly. Date: Thu Dec 23 18:24:45 2004 Author: rstrandh Index: climacs/buffer.lisp diff -u climacs/buffer.lisp:1.9 climacs/buffer.lisp:1.10 --- climacs/buffer.lisp:1.9 Thu Dec 23 09:00:33 2004 +++ climacs/buffer.lisp Thu Dec 23 18:24:44 2004 @@ -34,8 +34,14 @@ newline characters. The last object of the buffer is not necessarily a newline character.")) +(defgeneric low-mark (buffer)) + +(defgeneric high-mark (buffer)) + (defclass standard-buffer (buffer) - ((contents :initform (make-instance 'standard-cursorchain))) + ((contents :initform (make-instance 'standard-cursorchain)) + (low-mark :reader low-mark) + (high-mark :reader high-mark)) (:documentation "The Climacs standard buffer [an instantable subclass of buffer].")) (defgeneric buffer (mark) @@ -99,6 +105,13 @@ :chain (slot-value (buffer mark) 'contents) :position offset))) +(defmethod initialize-instance :after ((buffer standard-buffer) &rest args) + "Create the low-mark and high-mark" + (declare (ignore args)) + (with-slots (low-mark high-mark) buffer + (setf low-mark (make-instance 'standard-left-sticky-mark :buffer buffer)) + (setf high-mark (make-instance 'standard-right-sticky-mark :buffer buffer)))) + (defgeneric clone-mark (mark &optional type) (:documentation "Clone a mark. By default (when type is NIL) the same type of mark is returned. Otherwise type is the name of a class (subclass of the mark @@ -240,27 +253,6 @@ (defmethod end-of-buffer-p ((mark mark-mixin)) (= (offset mark) (size (buffer mark)))) -(defgeneric beginning-of-line (mark) - (:documentation "Move the mark to the beginning of the line. The mark will be - positioned either immediately after the closest preceding newline - character, or at the beginning of the buffer if no preceding newline - character exists.")) - -(defmethod beginning-of-line ((mark mark-mixin)) - (loop until (or (beginning-of-buffer-p mark) - (eql (object-before mark) #\Newline)) - do (decf (offset mark)))) - -(defgeneric end-of-line (mark) - (:documentation "Move the mark to the end of the line. The mark will be positioned -either immediately before the closest following newline character, or -at the end of the buffer if no following newline character exists.")) - -(defmethod end-of-line ((mark mark-mixin)) - (loop until (or (end-of-buffer-p mark) - (eql (object-after mark) #\Newline)) - do (incf (offset mark)))) - (defgeneric beginning-of-line-p (mark) (:documentation "Return t if the mark is at the beginning of the line (i.e., if the character preceding the mark is a newline character or if the mark is @@ -279,6 +271,25 @@ (or (end-of-buffer-p mark) (eql (object-after mark) #\Newline))) +(defgeneric beginning-of-line (mark) + (:documentation "Move the mark to the beginning of the line. The mark will be + positioned either immediately after the closest preceding newline + character, or at the beginning of the buffer if no preceding newline + character exists.")) + +(defmethod beginning-of-line ((mark mark-mixin)) + (loop until (beginning-of-line-p mark) + do (decf (offset mark)))) + +(defgeneric end-of-line (mark) + (:documentation "Move the mark to the end of the line. The mark will be positioned +either immediately before the closest following newline character, or +at the end of the buffer if no following newline character exists.")) + +(defmethod end-of-line ((mark mark-mixin)) + (loop until (end-of-line-p mark) + do (incf (offset mark)))) + (defgeneric line-number (mark) (:documentation "Return the line number of the mark. Lines are numbered from zero.")) @@ -439,4 +450,32 @@ (assert (eq (buffer mark1) (buffer mark2))) (buffer-sequence (buffer mark1) (offset mark1) (offset mark2))) - +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Buffer modification protocol + +(defmethod insert-buffer-object :before ((buffer standard-buffer) offset object) + (declare (ignore object)) + (setf (offset (low-mark buffer)) + (min (offset (low-mark buffer)) offset)) + (setf (offset (high-mark buffer)) + (max (offset (high-mark buffer)) offset))) + +(defmethod insert-buffer-sequence :before ((buffer standard-buffer) offset sequence) + (declare (ignore sequence)) + (setf (offset (low-mark buffer)) + (min (offset (low-mark buffer)) offset)) + (setf (offset (high-mark buffer)) + (max (offset (high-mark buffer)) offset))) + +(defmethod delete-buffer-range :before ((buffer standard-buffer) offset n) + (setf (offset (low-mark buffer)) + (min (offset (low-mark buffer)) offset)) + (setf (offset (high-mark buffer)) + (max (offset (high-mark buffer)) (+ offset n)))) + +(defgeneric reset-low-high-marks (buffer)) + +(defmethod reset-low-high-marks ((buffer standard-buffer)) + (beginning-of-buffer (high-mark buffer)) + (end-of-buffer (low-mark buffer))) Index: climacs/buffer.text diff -u climacs/buffer.text:1.3 climacs/buffer.text:1.4 --- climacs/buffer.text:1.3 Tue Dec 21 17:19:26 2004 +++ climacs/buffer.text Thu Dec 23 18:24:44 2004 @@ -323,12 +323,13 @@ of its current value and the position of the modification. Redisplay code may use these values to determine what part of the - screen needs to be updated. At the end of an invocation of - redisplay, the offset of the low mark is set to the size of the - buffer, and the offset of the high mark is set to zero. + screen needs to be updated. These values can also be used to update + information about syntax highlighting and other cached information. - These values can also be used to update information about syntax - highlighting and other cached information. +reset-low-high-marks buffer [generic function] + + Set the high-mark to the beginning of the beginning of the buffer and + the low-mark to the end of the buffer. The redisplay protocol ====================== Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.6 climacs/packages.lisp:1.7 --- climacs/packages.lisp:1.6 Thu Dec 23 09:00:33 2004 +++ climacs/packages.lisp Thu Dec 23 18:24:45 2004 @@ -37,7 +37,8 @@ #:delete-buffer-range #:delete-range #:delete-region #:buffer-object #:buffer-sequence - #:object-before #:object-after #:region-to-sequence)) + #:object-before #:object-after #:region-to-sequence + #:low-mark #:high-mark #:reset-low-high-marks)) (defpackage :climacs-base (:use :clim-lisp :climacs-buffer)

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by rstrandh＠common-lisp.net 23 Dec '04

23 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv22843 Modified Files: gui.lisp Log Message: Rendering of #\Tab characters works. Replaced occurrences of (win frame) by pane in display function. The #\Tab character now self-inserts. Date: Thu Dec 23 17:37:08 2004 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.9 climacs/gui.lisp:1.10 --- climacs/gui.lisp:1.9 Thu Dec 23 09:03:53 2004 +++ climacs/gui.lisp Thu Dec 23 17:37:08 2004 @@ -62,12 +62,14 @@ (defun display-win (frame pane) "The display function used by the climacs application frame." + (declare (ignore frame)) (let* ((medium (sheet-medium pane)) (style (medium-text-style medium)) (height (text-style-height style medium)) (width (text-style-width style medium)) - (buffer (buffer (win frame))) - (size (size (buffer (win frame)))) + (tab-width (* 8 width)) + (buffer (buffer pane)) + (size (size (buffer pane))) (offset 0) (offset1 nil) (cursor-x nil) @@ -79,7 +81,7 @@ :stream pane) (setf offset1 nil))) (display-line () - (loop when (= offset (offset (point (win frame)))) + (loop when (= offset (offset (point pane))) do (multiple-value-bind (x y) (stream-cursor-position pane) (setf cursor-x (+ x (if (null offset1) 0 @@ -93,6 +95,11 @@ (cond ((eql obj #\Space) (present-contents) (princ obj pane)) + ((eql obj #\Tab) + (present-contents) + (let ((x (stream-cursor-position pane))) + (stream-increment-cursor-position + pane (- tab-width (mod x tab-width)) 0))) ((constituentp obj) (when (null offset1) (setf offset1 offset))) @@ -105,7 +112,7 @@ (terpri pane)))) (loop while (< offset size) do (display-line)) - (when (= offset (offset (point (win frame)))) + (when (= offset (offset (point pane))) (multiple-value-bind (x y) (stream-cursor-position pane) (setf cursor-x x cursor-y y)))) @@ -317,6 +324,7 @@ do (global-set-key (code-char code) 'com-self-insert)) (global-set-key #\newline 'com-self-insert) +(global-set-key #\tab 'com-self-insert) (global-set-key '(#\f :control) 'com-forward-object) (global-set-key '(#\b :control) 'com-backward-object) (global-set-key '(#\a :control) 'com-beginning-of-line)

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

climacs-cvs December 2004