January 2005 - climacs-cvs@common-lisp.net

[climacs-cvs] CVS update: climacs/gui.lisp climacs/packages.lisp climacs/pane.lisp
by mvilleneuve＠common-lisp.net 23 Jan '05

23 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv20514 Modified Files: gui.lisp packages.lisp pane.lisp Log Message: Added basic Isearch support Date: Sun Jan 23 02:21:09 2005 Author: mvilleneuve Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.95 climacs/gui.lisp:1.96 --- climacs/gui.lisp:1.95 Sat Jan 22 07:20:44 2005 +++ climacs/gui.lisp Sun Jan 23 02:21:08 2005 @@ -109,7 +109,7 @@ (declare (ignore frame)) (with-slots (climacs-pane) pane (let* ((buf (buffer climacs-pane)) - (name-info (format nil " ~a ~a Syntax: ~a~a~a ~a" + (name-info (format nil " ~a ~a Syntax: ~a~a~a~a ~a" (if (needs-saving buf) "**" "--") (name buf) (name (syntax buf)) @@ -119,6 +119,9 @@ (if (auto-fill-mode climacs-pane) " Fill" "") + (if (isearch-mode climacs-pane) + " Isearch" + "") (if (recordingp *application-frame*) "Def" "")))) @@ -983,17 +986,102 @@ (let ((size (accept 'integer :prompt "New kill ring size"))) (setf (kill-ring-max-size *kill-ring*) size))) -(define-named-command com-search-forward () - (search-forward (point (current-window)) - (accept 'string :prompt "Search Forward") - :test (lambda (a b) - (and (characterp b) (char-equal a b))))) - -(define-named-command com-search-backward () - (search-backward (point (current-window)) - (accept 'string :prompt "Search Backward") - :test (lambda (a b) - (and (characterp b) (char-equal a b))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Incremental search + +(define-named-command com-isearch-mode () + (let* ((pane (current-window)) + (point (point pane))) + (unless (endp (isearch-states pane)) + (setf (isearch-previous-string pane) + (search-string (first (isearch-states pane))))) + (setf (isearch-mode pane) t) + (setf (isearch-states pane) + (list (make-instance 'isearch-state + :search-string "" + :search-mark (clone-mark point)))) + (redisplay-frame-panes *application-frame*) + (loop while (isearch-mode pane) + as gesture = (climacs-read-gesture) + as item = (find-gestures (list gesture) 'isearch-climacs-table) + do (cond ((and item (eq (command-menu-item-type item) :command)) + (setf *current-gesture* gesture) + (let ((command (command-menu-item-value item))) + (unless (consp command) + (setf command (list command))) + (handler-case + (execute-frame-command *application-frame* command) + (error (condition) + (beep) + (format *error-output* "~a~%" condition))))) + (t + (unread-gesture gesture) + (setf (isearch-mode pane) nil))) + (redisplay-frame-panes *application-frame*)))) + +(defun isearch-from-mark (pane mark string) + (let* ((point (point pane)) + (mark2 (clone-mark mark))) + (when (search-forward mark2 string + :test (lambda (x y) + (if (characterp x) + (and (characterp y) (char-equal x y)) + (eql x y)))) + (setf (offset point) (offset mark2)) + (setf (offset mark) (- (offset mark2) (length string)))))) + +(define-named-command com-isearch-append-char () + (let* ((pane (current-window)) + (point (point pane)) + (states (isearch-states pane)) + (string (concatenate 'string + (search-string (first states)) + (string *current-gesture*))) + (mark (clone-mark (search-mark (first states)))) + (previous-point-offset (offset point))) + (isearch-from-mark pane mark string) + (if (/= (offset point) previous-point-offset) + (push (make-instance 'isearch-state + :search-string string + :search-mark mark) + (isearch-states pane)) + (beep)))) + +(define-named-command com-isearch-delete-char () + (let* ((pane (current-window))) + (cond ((null (second (isearch-states pane))) + (beep)) + (t + (pop (isearch-states pane)) + (let ((state (first (isearch-states pane)))) + (setf (offset (point pane)) + (+ (offset (search-mark state)) + (length (search-string state))))))))) + +(define-named-command com-isearch-forward () + (let* ((pane (current-window)) + (point (point pane)) + (states (isearch-states pane)) + (string (if (null (second states)) + (isearch-previous-string pane) + (search-string (first states)))) + (mark (clone-mark point)) + (previous-point-offset (offset point))) + (isearch-from-mark pane mark string) + (if (/= (offset point) previous-point-offset) + (push (make-instance 'isearch-state + :search-string string + :search-mark mark) + (isearch-states pane)) + (beep)))) + +(define-named-command com-isearch-exit () + (setf (isearch-mode (current-window)) nil)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Dynamic abbrevs (define-named-command com-dabbrev-expand () (let* ((win (current-window)) @@ -1109,6 +1197,7 @@ (global-set-key '(#\/ :meta) 'com-dabbrev-expand) (global-set-key '(#\a :control :meta) 'com-beginning-of-paragraph) (global-set-key '(#\e :control :meta) 'com-end-of-paragraph) +(global-set-key '(#\s :control) 'com-isearch-mode) (global-set-key '(:up) 'com-previous-line) (global-set-key '(:down) 'com-next-line) @@ -1316,3 +1405,21 @@ (dead-circumflex-set-key '(#\o) '(com-insert-charcode 244)) (dead-circumflex-set-key '(#\u) '(com-insert-charcode 251)) (dead-circumflex-set-key '(#\Space) '(com-insert-charcode 94)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Isearch command table + +(make-command-table 'isearch-climacs-table :errorp nil) + +(defun isearch-set-key (gesture command) + (add-command-to-command-table command 'isearch-climacs-table + :keystroke gesture :errorp nil)) + +(loop for code from (char-code #\Space) to (char-code #\~) + do (isearch-set-key (code-char code) 'com-isearch-append-char)) + +(isearch-set-key '(#\Newline) 'com-isearch-exit) +(isearch-set-key '(#\Backspace) 'com-isearch-delete-char) +(isearch-set-key '(#\s :control) 'com-isearch-forward) + Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.37 climacs/packages.lisp:1.38 --- climacs/packages.lisp:1.37 Thu Jan 20 22:54:54 2005 +++ climacs/packages.lisp Sun Jan 23 02:21:08 2005 @@ -98,6 +98,8 @@ #:tab-space-count #:indent-tabs-mode #:auto-fill-mode #:auto-fill-column + #:isearch-state #:search-string #:search-mark + #:isearch-mode #:isearch-states #:isearch-previous-string #:url)) (defpackage :climacs-gui Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.10 climacs/pane.lisp:1.11 --- climacs/pane.lisp:1.10 Sat Jan 22 07:20:44 2005 +++ climacs/pane.lisp Sun Jan 23 02:21:08 2005 @@ -44,6 +44,14 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; +;;; Isearch + +(defclass isearch-state () + ((search-string :initarg :search-string :accessor search-string) + (search-mark :initarg :search-mark :accessor search-mark))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; View (defclass climacs-textual-view (textual-view tabify-mixin) @@ -75,6 +83,9 @@ (tab-width :initform nil) (auto-fill-mode :initform t :accessor auto-fill-mode) (auto-fill-column :initform 70 :accessor auto-fill-column) + (isearch-mode :initform nil :accessor isearch-mode) + (isearch-states :initform '() :accessor isearch-states) + (isearch-previous-string :initform nil :accessor isearch-previous-string) (full-redisplay-p :initform nil :accessor full-redisplay-p) (cache :initform (let ((cache (make-instance 'standard-flexichain))) (insert* cache 0 nil)

1 0

[climacs-cvs] CVS update: climacs/gui.lisp climacs/pane.lisp
by mvilleneuve＠common-lisp.net 22 Jan '05

22 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv25661 Modified Files: gui.lisp pane.lisp Log Message: Copy auto-fill parameters when splitting panes, moved auto-fill-column to pane Date: Sat Jan 22 07:20:45 2005 Author: mvilleneuve Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.94 climacs/gui.lisp:1.95 --- climacs/gui.lisp:1.94 Sat Jan 22 00:04:35 2005 +++ climacs/gui.lisp Sat Jan 22 07:20:44 2005 @@ -290,13 +290,13 @@ (let* ((pane (current-window)) (buffer (buffer pane))) (when (auto-fill-mode pane) - (let* ((fill-column (auto-fill-column buffer)) + (let* ((fill-column (auto-fill-column pane)) (point (point pane)) (offset (offset point)) (tab-width (tab-space-count (stream-default-view pane))) (syntax (syntax buffer))) (when (>= (buffer-display-column buffer offset tab-width) - (1- (auto-fill-column buffer))) + (1- fill-column)) (fill-line point (lambda (mark) (syntax-line-indentation mark tab-width syntax)) @@ -876,7 +876,9 @@ (multiple-value-bind (vbox new-pane) (make-pane-constellation) (let* ((current-window (current-window)) (constellation-root (parent3 current-window))) - (setf (buffer new-pane) (buffer current-window)) + (setf (buffer new-pane) (buffer current-window) + (auto-fill-mode new-pane) (auto-fill-mode current-window) + (auto-fill-column new-pane) (auto-fill-column current-window)) (push new-pane (windows *application-frame*)) (replace-constellation constellation-root vbox t) (full-redisplay current-window) @@ -888,7 +890,9 @@ (multiple-value-bind (vbox new-pane) (make-pane-constellation) (let* ((current-window (current-window)) (constellation-root (parent3 current-window))) - (setf (buffer new-pane) (buffer current-window)) + (setf (buffer new-pane) (buffer current-window) + (auto-fill-mode new-pane) (auto-fill-mode current-window) + (auto-fill-column new-pane) (auto-fill-column current-window)) (push new-pane (windows *application-frame*)) (replace-constellation constellation-root vbox nil) (full-redisplay current-window) Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.9 climacs/pane.lisp:1.10 --- climacs/pane.lisp:1.9 Sat Jan 22 00:04:35 2005 +++ climacs/pane.lisp Sat Jan 22 07:20:44 2005 @@ -58,8 +58,7 @@ ((needs-saving :initform nil :accessor needs-saving) (syntax :initarg :syntax :initform (make-instance 'basic-syntax) :accessor syntax) (indent-tabs-mode :initarg indent-tabs-mode :initform t - :accessor indent-tabs-mode) - (auto-fill-column :initform 70 :accessor auto-fill-column)) + :accessor indent-tabs-mode)) (:default-initargs :name "*scratch*")) @@ -75,6 +74,7 @@ (space-width :initform nil) (tab-width :initform nil) (auto-fill-mode :initform t :accessor auto-fill-mode) + (auto-fill-column :initform 70 :accessor auto-fill-column) (full-redisplay-p :initform nil :accessor full-redisplay-p) (cache :initform (let ((cache (make-instance 'standard-flexichain))) (insert* cache 0 nil)

1 0

[climacs-cvs] CVS update: climacs/gui.lisp climacs/pane.lisp
by rstrandh＠common-lisp.net 22 Jan '05

22 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv3538 Modified Files: gui.lisp pane.lisp Log Message: Prepare for the day when McCLIM moves output records instead of recomputing them. Date: Sat Jan 22 00:04:37 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.93 climacs/gui.lisp:1.94 --- climacs/gui.lisp:1.93 Fri Jan 21 21:45:25 2005 +++ climacs/gui.lisp Sat Jan 22 00:04:35 2005 @@ -922,6 +922,30 @@ (sheet-adopt-child parent other) (reorder-sheets parent (list first other))))))) +;; (define-named-command com-delete-window () +;; (unless (null (cdr (windows *application-frame*))) +;; (let* ((constellation (parent3 (current-window))) +;; (box (sheet-parent constellation)) +;; (box-children (sheet-children box)) +;; (other (if (eq constellation (first box-children)) +;; (third box-children) +;; (first box-children))) +;; (parent (sheet-parent box)) +;; (children (sheet-children parent)) +;; (first (first children)) +;; (second (second children)) +;; (third (third children))) +;; (pop (windows *application-frame*)) +;; (sheet-disown-child box other) +;; (cond ((eq box first) +;; (sheet-disown-child parent box) +;; (sheet-adopt-child parent other) +;; (reorder-sheets parent (list other second third))) +;; (t +;; (sheet-disown-child parent box) +;; (sheet-adopt-child parent other) +;; (reorder-sheets parent (list first second other))))))) + ;;;;;;;;;;;;;;;;;;;; ;; Kill ring commands Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.8 climacs/pane.lisp:1.9 --- climacs/pane.lisp:1.8 Fri Jan 21 11:39:50 2005 +++ climacs/pane.lisp Sat Jan 22 00:04:35 2005 @@ -315,7 +315,7 @@ for id from 0 below (nb-elements cache) do (setf scan start-offset) (updating-output - (pane :unique-id id + (pane :unique-id (element* cache id) :cache-value (if (<= start-offset (offset (point pane)) (+ start-offset (length (element* cache id))))

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by rstrandh＠common-lisp.net 22 Jan '05

22 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv28656 Modified Files: gui.lisp Log Message: Factored out buffer saving into a separate function. Improved on com-quit so that it asks the user to save buffers before quitting. Date: Fri Jan 21 21:45:26 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.92 climacs/gui.lisp:1.93 --- climacs/gui.lisp:1.92 Fri Jan 21 11:39:50 2005 +++ climacs/gui.lisp Fri Jan 21 21:45:25 2005 @@ -282,9 +282,6 @@ `(,@command-name :name t) `(,command-name :name t)) ,args ,@body)) -(define-named-command (com-quit) () - (frame-exit *application-frame*)) - (define-named-command com-toggle-overwrite-mode () (with-slots (overwrite-mode) (current-window) (setf overwrite-mode (not overwrite-mode)))) @@ -631,20 +628,34 @@ ;; resets the low and high marks after redisplay (redisplay-frame-panes *application-frame*))) +(defun save-buffer (buffer) + (let ((filename (or (filename buffer) + (accept 'completable-pathname + :prompt "Save Buffer to File")))) + (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)) + (setf (needs-saving buffer) nil))) + (define-named-command com-save-buffer () - (let* ((buffer (buffer (current-window))) - (filename (or (filename buffer) - (accept 'completable-pathname - :prompt "Save Buffer to File")))) + (let ((buffer (buffer (current-window)))) (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))) + (save-buffer buffer) + (display-message "No changes need to be saved from ~a" (name buffer))))) + +(define-named-command (com-quit) () + (loop for buffer in (buffers *application-frame*) + when (and (needs-saving buffer) + (accept 'boolean + :prompt (format nil "Save buffer: ~a ?" (name buffer)))) + do (save-buffer buffer)) + (when (or (notany #'needs-saving + (buffers *application-frame*)) + (accept 'boolean :prompt "Modified buffers exist. Quit anyway?")) + (frame-exit *application-frame*))) (define-named-command com-write-buffer () (let ((filename (accept 'completable-pathname

1 0

[climacs-cvs] CVS update: climacs/Doc/climacs-internals.texi
by rstrandh＠common-lisp.net 22 Jan '05

22 Jan '05

Update of /project/climacs/cvsroot/climacs/Doc In directory common-lisp.net:/tmp/cvs-serv27428 Modified Files: climacs-internals.texi Log Message: Separated syntax from redisplay. Date: Fri Jan 21 21:15:52 2005 Author: rstrandh Index: climacs/Doc/climacs-internals.texi diff -u climacs/Doc/climacs-internals.texi:1.8 climacs/Doc/climacs-internals.texi:1.9 --- climacs/Doc/climacs-internals.texi:1.8 Tue Jan 18 10:59:54 2005 +++ climacs/Doc/climacs-internals.texi Fri Jan 21 21:15:50 2005 @@ -558,77 +558,77 @@ 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 +@chapter 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 -is a right-sticky mark independently of whether you are typing -left-to-right or right-to-left. - -The redisplay function works by dispatching on an object of type -syntax, which determines exactly how the buffer contents is going to -be rendered in this particular pane. +A buffer may have a syntax module associated with it. The syntax +module usually consists of an incremental parser that analyzes the +contents of the buffer and creates some kind of parse tree or other +representation of the contents in order that it can be exploited by +the redisplay module and by user commands. @deftp {Protocol Class} syntax The base class for all syntaxes. - -A syntax object is a placeholder for many kinds of information -depending on the exact syntax, but in particular, it holds information -(in the form of two marks) about what part of the buffer was on -display after the previous invocation of the redisplay algorithm. @end deftp -@deftp {:initarg} :pane -Indicates the pane where rendering is to take place. -@end deftp +The redisplay module exploits the syntax module for several things: + +@itemize @bullet +@item highlighting of various syntactic entities of the buffer +@item highlighting of matching parenthesis, +@item turning syntactic entities into clickable presentations, +@item marking lines with inconsistent indentation, +@item etc. +@end itemize -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. +User commands can use the syntax module for: -@deffn {Function} {redisplay-pane} pane +@itemize @bullet +@item moving point by units that are specific to a particular buffer +syntax, such as expressions, statements, or paragraphs, +@item transposing syntactic units, +@item sending the text of a syntactic unit to a language processor, +@item indenting lines according to the syntax, +@item etc. +@end itemize -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 +The view that the syntax module has of the buffer is updated only when +needed, and then only for the parts of the buffer that are needed. +Most syntax modules (such as for programming languages) need to +compute their representations from the beginning of the buffer up to a +particular point beyond which the structure of the buffer does not +need to be known. + +There are two situations where updating might be needed: -@deffn {Generic Function} {redisplay-with-syntax} pane syntax +@itemize @bullet +@item before redisplay is about to show the contents of part of the +buffer in a pane. +@item as a result of a command that exploits the syntactic entities of +the buffer contents. +@end itemize + +The first case is handled by the redisplay invoking the following +generic function before proceeding to display the buffer contents in a +pane: -Redisplay a pane using a given syntax. +@deffn {Generic Function} {update-syntax} buffer syntax mark + +Inform the syntax module that it must update its view of the buffer +contents up to the point indicated by the mark. It is acceptable to +pass an offset instead of the mark. @end deffn -This function can behave radically differently for different syntaxes. -In all cases, however, it starts by determining the current dimensions -of the pane, and compare that to the size of the region of the buffer -that is currently on display. Adjustments are made as necessary. It -then determines whether the point of the pane is within the region on -display. If not, a new region is computed in a way that the point is -as close to the middle of the pane as possible. It is important to -maintain the region on display as much as possible, so as to avoid -unnecessary scrolling. +The second case is handled by the syntax module itself when needed in +order to correctly compute the effects of a command. -The final step of this function is to render the region of the buffer -that is to be displayed. Some syntaxes can use simple algorithms that -simply draw everything in the region. Others can optimize so that -only the portions of the pane that have actually changed are redrawn. - -The redisplay-with-syntax function also implements parsing of the -buffer text. - -Simple parsers may be restricted to dividing the text into words, -possibly recognizing special words like URLs or email addresses, and -then using `present' to render these words. - -More complicated parsers may use incremental parsing techniques to -maintain sophisticated information of the buffer contents. Such a -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. +It is important to realize that the syntax module is not directly +involved in displaying buffer contents in a pane. In fact, the syntax +module should work even if there is no graphic user interface +present, and it should be exploitable by several, potentially totally +different, display units. @section Common Lisp syntax @@ -1404,6 +1404,58 @@ top element, increment the expression count of the new top entry, and perform a count check again. @end deffn + +@chapter Redisplay + +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 +is a right-sticky mark independently of whether you are typing +left-to-right or right-to-left. + +@deffn {Generic Function} {redisplay-pane} pane view current-p + +This function is invoked on all panes at the end of each iteration of +the command loop. The current-p argument is a boolean that indicates +whether the pane is the one that currently has the input focus +@end deffn + +For maximum flexibility, the redisplay-pane function dispatches off of +two objects, a pane and a CLIM view. The reason for this is that the +same type of pane, such as a simple CLIM application pane, can be used +to show the buffer contents in slightly different ways: + +@itemize @bullet +@item highlighted or not, +@item highlighting tabulation characters (for makefiles) +@item showing control characters in a special font +@item etc. +@end itemize + +These minor variations are obtained by creating a special view type +and a method that dispatches on that type. + +Major differences such as the need to have pane-specific output +recording are best handled by creating a different pane type. + +The redisplay-pane function may use the current-p argument to slightly +alter the presentation such as drawing the cursor in a different +color. + +The redisplay-pane function starts by determining the current +dimensions of the pane, and compare that to the size of the region of +the buffer that is currently on display. Adjustments are made as +necessary. It then determines whether the point of the pane is within +the region on display. If not, a new region is computed in a way that +the point is as close to the middle of the pane as possible. It is +important to maintain the region on display as much as possible, so as +to avoid unnecessary scrolling. + +The final step of this function is to render the region of the buffer +that is to be displayed. Some pane types can use simple algorithms +that simply draw everything in the region. Others can optimize so +that only the portions of the pane that have actually changed are +redrawn. @chapter The undo protocol

1 0

[climacs-cvs] CVS update: climacs/gui.lisp climacs/pane.lisp
by mvilleneuve＠common-lisp.net 21 Jan '05

21 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv29715 Modified Files: gui.lisp pane.lisp Log Message: Moved auto-fill-mode from buffer to pane Date: Fri Jan 21 11:39:50 2005 Author: mvilleneuve Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.91 climacs/gui.lisp:1.92 --- climacs/gui.lisp:1.91 Thu Jan 20 22:54:54 2005 +++ climacs/gui.lisp Fri Jan 21 11:39:50 2005 @@ -116,7 +116,7 @@ (if (slot-value climacs-pane 'overwrite-mode) " Ovwrt" "") - (if (auto-fill-mode buf) + (if (auto-fill-mode climacs-pane) " Fill" "") (if (recordingp *application-frame*) @@ -292,7 +292,7 @@ (defun possibly-fill-line () (let* ((pane (current-window)) (buffer (buffer pane))) - (when (auto-fill-mode buffer) + (when (auto-fill-mode pane) (let* ((fill-column (auto-fill-column buffer)) (point (point pane)) (offset (offset point)) @@ -502,8 +502,8 @@ (delete-indentation (point (current-window)))) (define-named-command com-auto-fill-mode () - (let ((buffer (buffer (current-window)))) - (setf (auto-fill-mode buffer) (not (auto-fill-mode buffer))))) + (let ((pane (current-window))) + (setf (auto-fill-mode pane) (not (auto-fill-mode pane))))) (define-named-command com-fill-paragraph () (let* ((pane (current-window)) Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.7 climacs/pane.lisp:1.8 --- climacs/pane.lisp:1.7 Wed Jan 19 12:04:39 2005 +++ climacs/pane.lisp Fri Jan 21 11:39:50 2005 @@ -59,7 +59,6 @@ (syntax :initarg :syntax :initform (make-instance 'basic-syntax) :accessor syntax) (indent-tabs-mode :initarg indent-tabs-mode :initform t :accessor indent-tabs-mode) - (auto-fill-mode :initform t :accessor auto-fill-mode) (auto-fill-column :initform 70 :accessor auto-fill-column)) (:default-initargs :name "*scratch*")) @@ -75,6 +74,7 @@ (cursor-y :initform 2) (space-width :initform nil) (tab-width :initform nil) + (auto-fill-mode :initform t :accessor auto-fill-mode) (full-redisplay-p :initform nil :accessor full-redisplay-p) (cache :initform (let ((cache (make-instance 'standard-flexichain))) (insert* cache 0 nil)

1 0

[climacs-cvs] CVS update: climacs/gui.lisp climacs/packages.lisp
by rstrandh＠common-lisp.net 21 Jan '05

21 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv23154 Modified Files: gui.lisp packages.lisp Log Message: Box ajuster gadget for changing size of windows (thanks to Nicolas Lamirault) [though I did not put this in yet, because it seems to break com-delete-window. If someone can figure out why, I'll put it in.] Kill-buffer command (thanks to Lawrence Mitchell) Date: Thu Jan 20 22:54:55 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.90 climacs/gui.lisp:1.91 --- climacs/gui.lisp:1.90 Thu Jan 20 15:42:04 2005 +++ climacs/gui.lisp Thu Jan 20 22:54:54 2005 @@ -681,6 +681,19 @@ (beginning-of-buffer (point (current-window))) (full-redisplay (current-window)))) +(define-named-command com-kill-buffer () + (with-slots (buffers) *application-frame* + (let ((buffer (buffer (current-window)))) + (when (and (needs-saving buffer) + (accept 'boolean :prompt "Save buffer first?")) + (com-save-buffer)) + (setf buffers (remove buffer buffers)) + ;; Always need one buffer. + (when (null buffers) + (push (make-instance 'climacs-buffer :name "*scratch*") + buffers)) + (setf (buffer (current-window)) (car buffers))))) + (define-named-command com-full-redisplay () (full-redisplay (current-window))) @@ -769,6 +782,34 @@ ;;; ;;; Commands for splitting windows +;;; put this in for real when we find a solution for the problem +;;; it causes for com-delete-window +;; (defun replace-constellation (constellation additional-constellation vertical-p) +;; (let* ((parent (sheet-parent constellation)) +;; (children (sheet-children parent)) +;; (first (first children)) +;; (second (second children)) +;; (adjust (make-pane 'clim-extensions:box-adjuster-gadget))) +;; (assert (member constellation children)) +;; (cond ((eq constellation first) +;; (sheet-disown-child parent constellation) +;; (let ((new (if vertical-p +;; (vertically () +;; constellation adjust additional-constellation) +;; (horizontally () +;; constellation adjust additional-constellation)))) +;; (sheet-adopt-child parent new) +;; (reorder-sheets parent (list new second)))) +;; (t +;; (sheet-disown-child parent constellation) +;; (let ((new (if vertical-p +;; (vertically () +;; constellation adjust additional-constellation) +;; (horizontally () +;; constellation adjust additional-constellation)))) +;; (sheet-adopt-child parent new) +;; (reorder-sheets parent (list first new))))))) + (defun replace-constellation (constellation additional-constellation vertical-p) (let* ((parent (sheet-parent constellation)) (children (sheet-children parent)) @@ -1070,6 +1111,7 @@ (c-x-set-key '(#\e) 'com-call-last-kbd-macro) (c-x-set-key '(#\c :control) 'com-quit) (c-x-set-key '(#\f :control) 'com-find-file) +(c-x-set-key '(#\k) 'com-kill-buffer) (c-x-set-key '(#\l :control) 'com-load-file) (c-x-set-key '(#\o) 'com-other-window) (c-x-set-key '(#\s :control) 'com-save-buffer) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.36 climacs/packages.lisp:1.37 --- climacs/packages.lisp:1.36 Wed Jan 19 12:04:39 2005 +++ climacs/packages.lisp Thu Jan 20 22:54:54 2005 @@ -102,5 +102,5 @@ (defpackage :climacs-gui (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax - :climacs-kill-ring :climacs-pane)) + :climacs-kill-ring :climacs-pane :clim-extensions))

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by mvilleneuve＠common-lisp.net 20 Jan '05

20 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv867 Modified Files: gui.lisp Log Message: Added command fill-paragraph (bound to M-q) Date: Thu Jan 20 15:42:05 2005 Author: mvilleneuve Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.89 climacs/gui.lisp:1.90 --- climacs/gui.lisp:1.89 Thu Jan 20 11:12:48 2005 +++ climacs/gui.lisp Thu Jan 20 15:42:04 2005 @@ -505,6 +505,26 @@ (let ((buffer (buffer (current-window)))) (setf (auto-fill-mode buffer) (not (auto-fill-mode buffer))))) +(define-named-command com-fill-paragraph () + (let* ((pane (current-window)) + (buffer (buffer pane)) + (syntax (syntax buffer)) + (point (point pane)) + (begin-mark (clone-mark point)) + (end-mark (clone-mark point))) + (unless (eql (object-before begin-mark) #\Newline) + (beginning-of-paragraph begin-mark syntax)) + (unless (eql (object-after end-mark) #\Newline) + (end-of-paragraph end-mark syntax)) + (do-buffer-region (object offset buffer + (offset begin-mark) (offset end-mark)) + (when (eql object #\Newline) + (setf object #\Space))) + (let ((point-backup (clone-mark point))) + (setf (offset point) (offset end-mark)) + (possibly-fill-line) + (setf (offset point) (offset point-backup))))) + (define-command com-extended-command () (let ((item (accept 'command :prompt "Extended Command"))) (execute-frame-command *application-frame* item))) @@ -1003,6 +1023,7 @@ (global-set-key '(#\> :shift :meta) 'com-end-of-buffer) (global-set-key '(#\m :meta) 'com-back-to-indentation) (global-set-key '(#\^ :shift :meta) 'com-delete-indentation) +(global-set-key '(#\q :meta) 'com-fill-paragraph) (global-set-key '(#\d :meta) 'com-delete-word) (global-set-key '(#\Backspace :meta) 'com-backward-delete-word) (global-set-key '(#\/ :meta) 'com-dabbrev-expand)

1 0

[climacs-cvs] CVS update: climacs/base.lisp
by mvilleneuve＠common-lisp.net 20 Jan '05

20 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv804 Modified Files: base.lisp Log Message: Fixed bug in do-buffer-region Date: Thu Jan 20 15:37:38 2005 Author: mvilleneuve Index: climacs/base.lisp diff -u climacs/base.lisp:1.23 climacs/base.lisp:1.24 --- climacs/base.lisp:1.23 Thu Jan 20 11:12:48 2005 +++ climacs/base.lisp Thu Jan 20 15:37:38 2005 @@ -36,7 +36,7 @@ The body is executed for each element, with object being the current object (setf-able), and offset being its offset." `(symbol-macrolet ((,object (buffer-object ,buffer ,offset))) - (loop for ,offset from ,offset1 to ,offset2 + (loop for ,offset from ,offset1 below ,offset2 do ,@body))) (defgeneric backward-object (mark &optional count))

1 0

[climacs-cvs] CVS update: climacs/base-test.lisp climacs/climacs.asd climacs/buffer-test.lisp
by abakic＠common-lisp.net 20 Jan '05

20 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv32470 Modified Files: climacs.asd buffer-test.lisp Added Files: base-test.lisp Log Message: Tests for previous-line and next-line in combination with standard buffer and mark. Date: Thu Jan 20 15:21:53 2005 Author: abakic Index: climacs/climacs.asd diff -u climacs/climacs.asd:1.12 climacs/climacs.asd:1.13 --- climacs/climacs.asd:1.12 Sat Jan 15 15:23:45 2005 +++ climacs/climacs.asd Thu Jan 20 15:21:52 2005 @@ -62,7 +62,8 @@ "gui" ;;---- optional ---- "testing/rt" - "buffer-test") + "buffer-test" + "base-test") #+asdf (defmethod asdf:perform :around ((o asdf:compile-op) Index: climacs/buffer-test.lisp diff -u climacs/buffer-test.lisp:1.7 climacs/buffer-test.lisp:1.8 --- climacs/buffer-test.lisp:1.7 Wed Jan 19 17:22:19 2005 +++ climacs/buffer-test.lisp Thu Jan 20 15:21:52 2005 @@ -4,7 +4,7 @@ ;;; (cl:defpackage :climacs-tests - (:use :rtest :climacs-buffer :cl)) + (:use :cl :rtest :climacs-buffer :climacs-base)) (cl:in-package :climacs-tests)

1 0