- climacs-cvs@common-lisp.net - mailman3.common-lisp.net

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

17 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv3050 Modified Files: base.lisp gui.lisp packages.lisp pane.lisp syntax.lisp text-syntax.lisp Log Message: Added indent-line and newline-and-indent (bound to C-j) Date: Mon Jan 17 15:10:25 2005 Author: mvilleneuve Index: climacs/base.lisp diff -u climacs/base.lisp:1.18 climacs/base.lisp:1.19 --- climacs/base.lisp:1.18 Sun Jan 16 12:04:59 2005 +++ climacs/base.lisp Mon Jan 17 15:10:23 2005 @@ -89,6 +89,24 @@ (end-of-line mark) (delete-region offset mark)))) +(defun empty-line-p (mark) + "Check whether the mark is in an empty line." + (and (beginning-of-line-p mark) (end-of-line-p mark))) + +(defun line-indentation (mark tab-width) + "Return the distance from the beginning of the line and the first +constituent character of the line." + (let ((mark2 (clone-mark mark))) + (beginning-of-line mark2) + (loop with indentation = 0 + until (end-of-buffer-p mark2) + as object = (object-after mark2) + while (or (eql object #\Space) (eql object #\Tab)) + do (incf indentation + (if (eql (object-after mark2) #\Tab) tab-width 1)) + (incf (offset mark2)) + finally (return indentation)))) + (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" @@ -328,7 +346,6 @@ (loop repeat count do (insert-buffer-object buffer offset #\Space)) (incf offset (1- count)) - (finish-output *error-output*) (incf offset2 (1- count))))) (defgeneric untabify-region (mark1 mark2 tab-width) @@ -348,7 +365,24 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; -;;; Delete indentation +;;; Indentation + +(defun indent-line (mark indentation tab-width) + "Indent the line containing mark with indentation spaces. Use tabs and spaces +if tab-width is not nil, otherwise use spaces only." + (let ((mark2 (clone-mark mark))) + (beginning-of-line mark2) + (loop until (end-of-buffer-p mark2) + as object = (object-after mark2) + while (or (eql object #\Space) (eql object #\Tab)) + do (delete-range mark2 1)) + (loop until (zerop indentation) + do (cond ((and tab-width (>= indentation tab-width)) + (insert-object mark2 #\Tab) + (decf indentation tab-width)) + (t + (insert-object mark2 #\Space) + (decf indentation)))))) (defun delete-indentation (mark) (beginning-of-line mark) Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.78 climacs/gui.lisp:1.79 --- climacs/gui.lisp:1.78 Mon Jan 17 05:35:52 2005 +++ climacs/gui.lisp Mon Jan 17 15:10:23 2005 @@ -433,6 +433,27 @@ (multiple-value-bind (start end) (region-limits pane) (untabify-region start end (tab-space-count (stream-default-view pane)))))) +(defun indent-current-line (pane point) + (let* ((buffer (buffer pane)) + (view (stream-default-view pane)) + (tab-space-count (tab-space-count view)) + (indentation (syntax-line-indentation point + tab-space-count + (syntax buffer)))) + (indent-line point indentation (and (indent-tabs-mode buffer) + tab-space-count)))) + +(define-named-command com-indent-line () + (let* ((pane (win *application-frame*)) + (point (point pane))) + (indent-current-line pane point))) + +(define-named-command com-newline-and-indent () + (let* ((pane (win *application-frame*)) + (point (point pane))) + (insert-object point #\Newline) + (indent-current-line pane point))) + (define-named-command com-delete-indentation () (delete-indentation (point (win *application-frame*)))) @@ -799,7 +820,8 @@ 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 #\tab 'com-indent-line) +(global-set-key '(#\j :control) 'com-newline-and-indent) (global-set-key '(#\f :control) `(com-forward-object ,*numeric-argument-marker*)) (global-set-key '(#\b :control) `(com-backward-object ,*numeric-argument-marker*)) (global-set-key '(#\a :control) 'com-beginning-of-line) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.34 climacs/packages.lisp:1.35 --- climacs/packages.lisp:1.34 Sun Jan 16 12:04:59 2005 +++ climacs/packages.lisp Mon Jan 17 15:10:24 2005 @@ -49,6 +49,8 @@ #:forward-object #:backward-object #:previous-line #:next-line #:open-line #:kill-line + #:empty-line-p + #:line-indentation #:number-of-lines-in-region #:constituentp #:whitespacep #:forward-word #:backward-word @@ -56,6 +58,7 @@ #:upcase-region #:downcase-region #:capitalize-region #:upcase-word #:downcase-word #:capitalize-word #:tabify-region #:untabify-region + #:indent-line #:delete-indentation #:input-from-stream #:output-to-stream #:name-mixin #:name @@ -74,6 +77,7 @@ (:export #:syntax #:define-syntax #:basic-syntax #:update-syntax + #:syntax-line-indentation #:beginning-of-paragraph #:end-of-paragraph)) (defpackage :climacs-kill-ring @@ -90,6 +94,7 @@ #:redisplay-pane #:full-redisplay #:page-down #:page-up #:tab-space-count + #:indent-tabs-mode #:url)) (defpackage :climacs-gui Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.3 climacs/pane.lisp:1.4 --- climacs/pane.lisp:1.3 Mon Jan 17 05:35:52 2005 +++ climacs/pane.lisp Mon Jan 17 15:10:24 2005 @@ -2,6 +2,8 @@ ;;; (c) copyright 2005 by ;;; Robert Strandh (strandh(a)labri.fr) +;;; (c) copyright 2005 by +;;; Matthieu Villeneuve (matthieu.villeneuve(a)free.fr) ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public @@ -50,9 +52,13 @@ (defclass filename-mixin () ((filename :initform nil :accessor filename))) +;(defgeneric indent-tabs-mode (climacs-buffer)) + (defclass climacs-buffer (standard-buffer abbrev-mixin filename-mixin name-mixin) ((needs-saving :initform nil :accessor needs-saving) - (syntax :initarg :syntax :initform (make-instance 'basic-syntax) :accessor syntax)) + (syntax :initarg :syntax :initform (make-instance 'basic-syntax) :accessor syntax) + (indent-tabs-mode :initarg indent-tabs-mode :initform t + :accessor indent-tabs-mode)) (:default-initargs :name "*scratch*")) Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.27 climacs/syntax.lisp:1.28 --- climacs/syntax.lisp:1.27 Mon Jan 17 05:35:52 2005 +++ climacs/syntax.lisp Mon Jan 17 15:10:24 2005 @@ -26,6 +26,10 @@ (defgeneric update-syntax (buffer syntax)) +(defgeneric syntax-line-indentation (mark tab-width syntax) + (:documentation "Return the correct indentation for the line containing +the mark, according to the specified syntax.")) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Syntax completion @@ -62,3 +66,7 @@ (defmethod update-syntax (buffer (syntax basic-syntax)) (declare (ignore buffer)) nil) + +(defmethod syntax-line-indentation (mark tab-width (syntax basic-syntax)) + (declare (ignore mark tab-width)) + 0) Index: climacs/text-syntax.lisp diff -u climacs/text-syntax.lisp:1.4 climacs/text-syntax.lisp:1.5 --- climacs/text-syntax.lisp:1.4 Mon Jan 17 05:35:52 2005 +++ climacs/text-syntax.lisp Mon Jan 17 15:10:24 2005 @@ -2,6 +2,8 @@ ;;; (c) copyright 2005 by ;;; Robert Strandh (strandh(a)labri.fr) +;;; (c) copyright 2005 by +;;; Matthieu Villeneuve (matthieu.villeneuve(a)free.fr) ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public @@ -119,3 +121,12 @@ (if (typep (element* paragraphs pos1) 'left-sticky-mark) (offset (element* paragraphs (1+ pos1))) (offset (element* paragraphs pos1)))))))) + +(defmethod syntax-line-indentation (mark tab-width (syntax text-syntax)) + (loop with indentation = 0 + with mark2 = (clone-mark mark) + until (beginning-of-buffer-p mark2) + do (previous-line mark2) + (setf indentation (line-indentation mark2 tab-width)) + while (empty-line-p mark2) + finally (return indentation)))

1 0

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

17 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv6156 Modified Files: gui.lisp pane.lisp syntax.lisp text-syntax.lisp Log Message: Code factoring in text-syntax.lisp (thanks to Rudi Schlatte). Date: Mon Jan 17 14:35:53 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.77 climacs/gui.lisp:1.78 --- climacs/gui.lisp:1.77 Mon Jan 17 13:26:11 2005 +++ climacs/gui.lisp Mon Jan 17 14:35:52 2005 @@ -457,7 +457,9 @@ (let* ((directory-prefix (if (and (plusp (length so-far)) (eql (aref so-far 0) #\/)) "" - (namestring #+sbcl (car (directory ".")) #+cmu (ext:default-directory)))) + (namestring #+sbcl *default-pathname-defaults* + #+cmu (ext:default-directory) + #-(or sbcl cmu) *default-pathname-defaults*))) (full-so-far (concatenate 'string directory-prefix so-far)) (pathnames (loop with length = (length full-so-far) Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.2 climacs/pane.lisp:1.3 --- climacs/pane.lisp:1.2 Mon Jan 17 08:10:19 2005 +++ climacs/pane.lisp Mon Jan 17 14:35:52 2005 @@ -34,7 +34,7 @@ ((space-width :initform nil :reader space-width) (tab-width :initform nil :reader tab-width))) -(defmethod tab-space-count (tabify) +(defmethod tab-space-count ((tabify t)) 1) (defmethod tab-space-count ((tabify tabify-mixin)) @@ -122,6 +122,7 @@ (defgeneric display-line (pane line offset syntax view)) (defmethod display-line (pane line offset (syntax basic-syntax) (view textual-view)) + (declare (ignore offset)) (let ((saved-index nil) (id 0)) (flet ((output-word (index) Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.26 climacs/syntax.lisp:1.27 --- climacs/syntax.lisp:1.26 Mon Jan 17 08:10:19 2005 +++ climacs/syntax.lisp Mon Jan 17 14:35:52 2005 @@ -60,4 +60,5 @@ ()) (defmethod update-syntax (buffer (syntax basic-syntax)) + (declare (ignore buffer)) nil) Index: climacs/text-syntax.lisp diff -u climacs/text-syntax.lisp:1.3 climacs/text-syntax.lisp:1.4 --- climacs/text-syntax.lisp:1.3 Sat Jan 15 22:35:53 2005 +++ climacs/text-syntax.lisp Mon Jan 17 14:35:52 2005 @@ -44,6 +44,17 @@ (in-package :climacs-syntax) ;;; Put this in a separate package once it works +(defun index-of-mark-after-offset (flexichain offset) + "Searches for the mark after `offset' in the marks stored in `flexichain'." + (loop with low-position = 0 + with high-position = (nb-elements flexichain) + for middle-position = (floor (+ low-position high-position) 2) + until (= low-position high-position) + do (if (mark>= (element* flexichain middle-position) offset) + (setf high-position middle-position) + (setf low-position (floor (+ low-position 1 high-position) 2))) + finally (return low-position))) + (define-syntax text-syntax ("Text" (basic-syntax)) ((paragraphs :initform (make-instance 'standard-flexichain)))) @@ -51,18 +62,10 @@ (let* ((high-offset (min (+ (offset (high-mark buffer)) 3) (size buffer))) (low-offset (max (- (offset (low-mark buffer)) 3) 0))) (with-slots (paragraphs) syntax - (let* ((nb-paragraphs (nb-elements paragraphs)) - (pos2 nb-paragraphs) - (pos1 0)) + (let ((pos1 (index-of-mark-after-offset paragraphs low-offset))) ;; start by deleting all syntax marks that are between the low and ;; the high marks - (loop until (= pos1 pos2) - do (cond ((mark< (element* paragraphs (floor (+ pos1 pos2) 2)) - low-offset) - (setf pos1 (floor (+ pos1 1 pos2) 2))) - (t - (setf pos2 (floor (+ pos1 pos2) 2))))) - (loop repeat (- nb-paragraphs pos1) + (loop repeat (- (nb-elements paragraphs) pos1) while (mark<= (element* paragraphs pos1) high-offset) do (delete* paragraphs pos1)) ;; check the zone between low-offset and high-offset for @@ -95,31 +98,23 @@ (defmethod beginning-of-paragraph (mark (syntax text-syntax)) (with-slots (paragraphs) syntax - (let* ((nb-paragraphs (nb-elements paragraphs)) - (pos2 nb-paragraphs) - (pos1 0) - (offset (offset mark))) - (loop until (= pos1 pos2) - do (if (mark>= (element* paragraphs (floor (+ pos1 pos2) 2)) offset) - (setf pos2 (floor (+ pos1 pos2) 2)) - (setf pos1 (floor (+ pos1 1 pos2) 2)))) + (let ((pos1 (index-of-mark-after-offset paragraphs (offset mark)))) (when (> pos1 0) (setf (offset mark) (if (typep (element* paragraphs (1- pos1)) 'right-sticky-mark) (offset (element* paragraphs (- pos1 2))) (offset (element* paragraphs (1- pos1))))))))) +(defgeneric end-of-paragraph (mark text-syntax)) + (defmethod end-of-paragraph (mark (syntax text-syntax)) (with-slots (paragraphs) syntax - (let* ((nb-paragraphs (nb-elements paragraphs)) - (pos2 nb-paragraphs) - (pos1 0) - (offset (offset mark))) - (loop until (= pos1 pos2) - do (if (mark<= (element* paragraphs (floor (+ pos1 pos2) 2)) offset) - (setf pos1 (floor (+ pos1 1 pos2) 2)) - (setf pos2 (floor (+ pos1 pos2) 2)))) - (when (< pos1 nb-paragraphs) + (let ((pos1 (index-of-mark-after-offset + paragraphs + ;; if mark is at paragraph-end, jump to end of next + ;; paragraph + (1+ (offset mark))))) + (when (< pos1 (nb-elements paragraphs)) (setf (offset mark) (if (typep (element* paragraphs pos1) 'left-sticky-mark) (offset (element* paragraphs (1+ pos1)))

1 0

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

17 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv2459 Modified Files: gui.lisp Log Message: preliminary multi-window support. Date: Mon Jan 17 13:26:12 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.76 climacs/gui.lisp:1.77 --- climacs/gui.lisp:1.76 Mon Jan 17 09:04:44 2005 +++ climacs/gui.lisp Mon Jan 17 13:26:11 2005 @@ -49,15 +49,29 @@ ((win :reader win) (buffers :initform '() :accessor buffers)) (:panes - (win (make-pane 'extended-pane - :width 900 :height 400 - :name 'win - :incremental-redisplay t - :display-function 'display-win)) + (win (vertically () + (scrolling () + (make-pane 'extended-pane + :width 900 :height 400 + :name 'bla + :incremental-redisplay t + :display-function 'display-win)) + (make-pane 'application-pane + :width 900 :height 20 :max-height 20 :min-height 20 + ::background +gray85+ + :scroll-bars nil + :borders nil + :incremental-redisplay t + :display-function 'display-info))) +; (win (make-pane 'extended-pane +; :width 900 :height 400 +; :name 'bla +; :incremental-redisplay t +; :display-function 'display-win)) (info :application - :width 900 :height 20 :max-height 20 - :name 'info :background +light-gray+ + :width 900 :height 20 :max-height 30 :min-height 30 + :name 'info :background +gray85+ :scroll-bars nil :borders nil :incremental-redisplay t @@ -68,8 +82,7 @@ (:layouts (default (vertically (:scroll-bars nil) - (scrolling (:width 900 :height 400) win) - info + win int)) (without-interactor (vertically (:scroll-bars nil) @@ -180,51 +193,61 @@ (t (unread-gesture gesture :stream stream) (values 1 nil))))) +;;; we know the vbox pane has a scroller pane and an info +;;; pane in it. The scroller pane has a viewport in it, +;;; and the viewport contains the climacs-pane as its only child. +(defun find-climacs-pane (vbox) + (first (sheet-children + (find-if-not (lambda (pane) (typep pane 'scroll-bar-pane)) + (sheet-children + (find-if (lambda (pane) (typep pane 'scroller-pane)) + (sheet-children vbox))))))) + (defun climacs-top-level (frame &key command-parser command-unparser partial-command-parser prompt) (declare (ignore command-parser command-unparser partial-command-parser prompt)) (with-slots (win) frame - (setf win (find-pane-named frame 'win)) - (push (buffer win) (buffers 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 (catch 'outer-loop - (loop for gestures = '() - for numarg = (read-numeric-argument :stream *standard-input*) - do (loop (setf *current-gesture* (climacs-read-gesture)) - (setf gestures (nconc gestures (list *current-gesture*))) - (let ((item (find-gestures gestures 'global-climacs-table))) - (cond ((not item) - (beep) (return)) - ((eq (command-menu-item-type item) :command) - (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 (previous-command *standard-output*) - (if (consp command) - (car command) - command)) - (return))) - (t nil)))) - (let ((buffer (buffer (win frame)))) - (when (modified-p buffer) - (setf (needs-saving buffer) t))) - (redisplay-frame-panes frame))) - (beep) - (let ((buffer (buffer (win frame)))) - (when (modified-p buffer) - (setf (needs-saving buffer) t))) - (redisplay-frame-panes frame)))) + (setf win (find-climacs-pane (find-pane-named frame 'win))) + (push (buffer win) (buffers frame)) + (let ((*standard-output* win) + (*standard-input* (find-pane-named frame 'int)) + (*print-pretty* nil) + (*abort-gestures* nil)) + (redisplay-frame-panes frame :force-p t) + (loop (catch 'outer-loop + (loop for gestures = '() + for numarg = (read-numeric-argument :stream *standard-input*) + do (loop (setf *current-gesture* (climacs-read-gesture)) + (setf gestures (nconc gestures (list *current-gesture*))) + (let ((item (find-gestures gestures 'global-climacs-table))) + (cond ((not item) + (beep) (return)) + ((eq (command-menu-item-type item) :command) + (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 (previous-command *standard-output*) + (if (consp command) + (car command) + command)) + (return))) + (t nil)))) + (let ((buffer (buffer (win frame)))) + (when (modified-p buffer) + (setf (needs-saving buffer) t))) + (redisplay-frame-panes frame))) + (beep) + (let ((buffer (buffer (win frame)))) + (when (modified-p buffer) + (setf (needs-saving buffer) t))) + (redisplay-frame-panes frame))))) (defun region-limits (pane) (if (mark< (mark pane) (point pane)) @@ -636,6 +659,36 @@ (setf (offset (low-mark buffer)) 0 (offset (high-mark buffer)) (size buffer)))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Commands for splitting windows + +(define-named-command com-split-window-vertically () + (with-look-and-feel-realization + ((frame-manager *application-frame*) *application-frame*) + (let* ((pane (win *application-frame*)) + (new-pane (make-pane 'extended-pane + :width 900 :height 400 + :name 'win + :incremental-redisplay t + :display-function 'display-win)) + (parent (sheet-parent (sheet-parent (sheet-parent pane))))) + (setf (buffer new-pane) (buffer pane)) + (sheet-adopt-child parent + (vertically () + (scrolling () new-pane) + (make-pane 'application-pane + :width 900 :height 20 + :max-height 20 :min-height 20 + ::background +gray85+ + :scroll-bars nil + :borders nil + :incremental-redisplay t + :display-function 'display-info))) + (setf (sheet-enabled-p new-pane) t) + (full-redisplay pane) + (full-redisplay new-pane)))) + ;;;;;;;;;;;;;;;;;;;; ;; Kill ring commands @@ -811,6 +864,7 @@ (add-command-to-command-table command 'c-x-climacs-table :keystroke gesture :errorp nil)) +(c-x-set-key '(#\2) 'com-split-window-vertically) (c-x-set-key '(#\b) 'com-switch-to-buffer) (c-x-set-key '(#\c :control) 'com-quit) (c-x-set-key '(#\f :control) 'com-find-file)

1 0

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

17 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv21951 Modified Files: gui.lisp Log Message: Create a new buffer when a name that corresponds to no existing buffer is issued by the user when prompted for a buffer name. Date: Mon Jan 17 09:04:45 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.75 climacs/gui.lisp:1.76 --- climacs/gui.lisp:1.75 Mon Jan 17 08:10:19 2005 +++ climacs/gui.lisp Mon Jan 17 09:04:44 2005 @@ -558,8 +558,10 @@ :value-key #'identity)) :partial-completers '(#\Space) :allow-any-input t) - (declare (ignore success string)) - object)) + (declare (ignore success)) + (or object + (car (push (make-instance 'climacs-buffer :name string) + (buffers *application-frame*)))))) (define-named-command com-switch-to-buffer () (let ((buffer (accept 'buffer

1 0

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

17 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv18965 Modified Files: gui.lisp pane.lisp syntax.lisp Log Message: implemented full-redisplay (C-l). implemented multi-buffer support, with C-x b bound to the command switch-to-buffer. Buffer completion works as expected. Date: Mon Jan 17 08:10:19 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.74 climacs/gui.lisp:1.75 --- climacs/gui.lisp:1.74 Sun Jan 16 21:24:07 2005 +++ climacs/gui.lisp Mon Jan 17 08:10:19 2005 @@ -46,7 +46,8 @@ (window-clear pane)) (define-application-frame climacs () - ((win :reader win)) + ((win :reader win) + (buffers :initform '() :accessor buffers)) (:panes (win (make-pane 'extended-pane :width 900 :height 400 @@ -183,7 +184,9 @@ 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)) + (with-slots (win) frame + (setf win (find-pane-named frame 'win)) + (push (buffer win) (buffers frame))) (let ((*standard-output* (find-pane-named frame 'win)) (*standard-input* (find-pane-named frame 'int)) (*print-pretty* nil) @@ -505,6 +508,7 @@ :prompt "Find File")) (buffer (make-instance 'climacs-buffer)) (pane (win *application-frame*))) + (push buffer (buffers *application-frame*)) (setf (buffer (win *application-frame*)) buffer) (setf (syntax buffer) (make-instance 'basic-syntax)) (with-open-file (stream filename :direction :input :if-does-not-exist :create) @@ -543,6 +547,31 @@ (needs-saving buffer) nil) (display-message "Wrote: ~a" (filename buffer)))) +(define-presentation-method accept + ((type buffer) stream (view textual-view) &key) + (multiple-value-bind (object success string) + (complete-input stream + (lambda (so-far action) + (complete-from-possibilities + so-far (buffers *application-frame*) '() :action action + :name-key #'name + :value-key #'identity)) + :partial-completers '(#\Space) + :allow-any-input t) + (declare (ignore success string)) + object)) + +(define-named-command com-switch-to-buffer () + (let ((buffer (accept 'buffer + :prompt "Switch to buffer"))) + (setf (buffer (win *application-frame*)) buffer) + (setf (syntax buffer) (make-instance 'basic-syntax)) + (beginning-of-buffer (point (win *application-frame*))) + (full-redisplay (win *application-frame*)))) + +(define-named-command com-full-redisplay () + (full-redisplay (win *application-frame*))) + (define-named-command com-load-file () (let ((filename (accept 'completable-pathname :prompt "Load File"))) @@ -720,6 +749,7 @@ (global-set-key '(#\e :control) 'com-end-of-line) (global-set-key '(#\d :control) `(com-delete-object ,*numeric-argument-marker*)) (global-set-key '(#\p :control) 'com-previous-line) +(global-set-key '(#\l :control) 'com-full-redisplay) (global-set-key '(#\n :control) 'com-next-line) (global-set-key '(#\o :control) 'com-open-line) (global-set-key '(#\k :control) 'com-kill-line) @@ -779,6 +809,7 @@ (add-command-to-command-table command 'c-x-climacs-table :keystroke gesture :errorp nil)) +(c-x-set-key '(#\b) 'com-switch-to-buffer) (c-x-set-key '(#\c :control) 'com-quit) (c-x-set-key '(#\f :control) 'com-find-file) (c-x-set-key '(#\l :control) 'com-load-file) Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.1 climacs/pane.lisp:1.2 --- climacs/pane.lisp:1.1 Sat Jan 15 20:50:43 2005 +++ climacs/pane.lisp Mon Jan 17 08:10:19 2005 @@ -67,6 +67,7 @@ (cursor-y :initform 2) (space-width :initform nil) (tab-width :initform nil) + (full-redisplay-p :initform nil :accessor full-redisplay-p) (cache :initform (let ((cache (make-instance 'standard-flexichain))) (insert* cache 0 nil) cache)))) @@ -223,7 +224,7 @@ ;;; of the pane by moving top half a pane-size up. (defun reposition-window (pane) (let ((nb-lines-in-pane (nb-lines-in-pane pane))) - (with-slots (top bot cache) pane + (with-slots (top cache) pane (empty-cache cache) (setf (offset top) (offset (point pane))) (loop do (beginning-of-line top) @@ -296,15 +297,11 @@ (beginning-of-line (point pane)) (empty-cache cache))))) -(defgeneric redisplay-pane (pane)) - -(defmethod redisplay-pane ((pane climacs-pane)) +(defun display-cache (pane) (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) pane - (adjust-cache pane) - (fill-cache pane) (loop with start-offset = (offset top) for id from 0 below (nb-elements cache) do (setf scan start-offset) @@ -327,7 +324,20 @@ (draw-rectangle* pane (1- cursor-x) (- cursor-y (* 0.2 height)) (+ cursor-x 2) (+ cursor-y (* 0.8 height)) - :ink +red+))))) + :ink +red+))))) + +(defgeneric redisplay-pane (pane)) + +(defmethod redisplay-pane ((pane climacs-pane)) + (if (full-redisplay-p pane) + (progn (reposition-window pane) + (adjust-cache-size-and-bot pane) + (setf (full-redisplay-p pane) nil)) + (adjust-cache pane)) + (fill-cache pane) + (display-cache pane)) (defgeneric full-redisplay (pane)) +(defmethod full-redisplay ((pane climacs-pane)) + (setf (full-redisplay-p pane) t)) \ No newline at end of file Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.25 climacs/syntax.lisp:1.26 --- climacs/syntax.lisp:1.25 Sat Jan 15 20:50:43 2005 +++ climacs/syntax.lisp Mon Jan 17 08:10:19 2005 @@ -40,7 +40,7 @@ (define-presentation-method accept ((type syntax) stream (view textual-view) &key) - (multiple-value-bind (pathname success string) + (multiple-value-bind (object success string) (complete-input stream (lambda (so-far action) (complete-from-possibilities @@ -49,8 +49,8 @@ :value-key #'cdr)) :partial-completers '(#\Space) :allow-any-input t) - (declare (ignore success)) - (or pathname string))) + (declare (ignore success string)) + object)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

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

16 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv18562 Modified Files: gui.lisp Log Message: Fixed key binding for delete-indentation Date: Sun Jan 16 21:24:08 2005 Author: mvilleneuve Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.73 climacs/gui.lisp:1.74 --- climacs/gui.lisp:1.73 Sun Jan 16 21:08:54 2005 +++ climacs/gui.lisp Sun Jan 16 21:24:07 2005 @@ -741,7 +741,7 @@ (global-set-key '(#\< :shift :meta) 'com-beginning-of-buffer) (global-set-key '(#\> :shift :meta) 'com-end-of-buffer) (global-set-key '(#\m :meta) 'com-back-to-indentation) -(global-set-key '(#\^ :meta) 'com-delete-indentation) +(global-set-key '(#\^ :shift :meta) 'com-delete-indentation) (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/gui.lisp
by mvilleneuve＠common-lisp.net 16 Jan '05

16 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv17758 Modified Files: gui.lisp Log Message: Added key binding for delete-indentation Date: Sun Jan 16 21:08:55 2005 Author: mvilleneuve Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.72 climacs/gui.lisp:1.73 --- climacs/gui.lisp:1.72 Sun Jan 16 21:04:59 2005 +++ climacs/gui.lisp Sun Jan 16 21:08:54 2005 @@ -741,6 +741,7 @@ (global-set-key '(#\< :shift :meta) 'com-beginning-of-buffer) (global-set-key '(#\> :shift :meta) 'com-end-of-buffer) (global-set-key '(#\m :meta) 'com-back-to-indentation) +(global-set-key '(#\^ :meta) 'com-delete-indentation) (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 climacs/gui.lisp climacs/packages.lisp
by mvilleneuve＠common-lisp.net 16 Jan '05

16 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv17711 Modified Files: base.lisp gui.lisp packages.lisp Log Message: Added delete-indentation Date: Sun Jan 16 21:05:00 2005 Author: mvilleneuve Index: climacs/base.lisp diff -u climacs/base.lisp:1.17 climacs/base.lisp:1.18 --- climacs/base.lisp:1.17 Sat Jan 15 18:39:23 2005 +++ climacs/base.lisp Sun Jan 16 21:04:59 2005 @@ -348,6 +348,21 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; +;;; Delete indentation + +(defun delete-indentation (mark) + (beginning-of-line mark) + (unless (beginning-of-buffer-p mark) + (loop until (end-of-buffer-p mark) + until (constituentp (object-after mark)) + do (delete-range mark 1)) + (loop until (beginning-of-buffer-p mark) + until (constituentp (object-before mark)) + do (delete-range mark -1)) + (insert-object mark #\Space))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; Named objects (defgeneric name (obj)) Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.71 climacs/gui.lisp:1.72 --- climacs/gui.lisp:1.71 Sat Jan 15 22:35:53 2005 +++ climacs/gui.lisp Sun Jan 16 21:04:59 2005 @@ -407,6 +407,9 @@ (multiple-value-bind (start end) (region-limits pane) (untabify-region start end (tab-space-count (stream-default-view pane)))))) +(define-named-command com-delete-indentation () + (delete-indentation (point (win *application-frame*)))) + (define-named-command com-toggle-layout () (setf (frame-current-layout *application-frame*) (if (eq (frame-current-layout *application-frame*) 'default) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.33 climacs/packages.lisp:1.34 --- climacs/packages.lisp:1.33 Sat Jan 15 22:35:53 2005 +++ climacs/packages.lisp Sun Jan 16 21:04:59 2005 @@ -56,6 +56,7 @@ #:upcase-region #:downcase-region #:capitalize-region #:upcase-word #:downcase-word #:capitalize-word #:tabify-region #:untabify-region + #:delete-indentation #:input-from-stream #:output-to-stream #:name-mixin #:name #:buffer-lookin-at #:looking-at

1 0

[climacs-cvs] CVS update: climacs/testing/rt.lisp
by abakic＠common-lisp.net 16 Jan '05

16 Jan '05

Update of /project/climacs/cvsroot/climacs/testing In directory common-lisp.net:/tmp/cvs-serv10884/testing Modified Files: rt.lisp Log Message: One more patch... Sorry for the inconvenience. If testing proves worthwhile, :rtest and :climacs-testing defpackages may be moved to packages.lisp. Date: Sun Jan 16 18:58:14 2005 Author: abakic Index: climacs/testing/rt.lisp diff -u climacs/testing/rt.lisp:1.1 climacs/testing/rt.lisp:1.2 --- climacs/testing/rt.lisp:1.1 Sun Jan 16 00:23:47 2005 +++ climacs/testing/rt.lisp Sun Jan 16 18:58:14 2005 @@ -19,7 +19,7 @@ | SOFTWARE. | |----------------------------------------------------------------------------|# -(defpackage #:regression-test +(cl:defpackage #:regression-test (:nicknames #:rtest #-lispworks #:rt) (:use #:cl) (:export #:*do-tests-when-defined* #:*test* #:continue-testing

1 0

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

16 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv10884 Modified Files: buffer-test.lisp Log Message: One more patch... Sorry for the inconvenience. If testing proves worthwhile, :rtest and :climacs-testing defpackages may be moved to packages.lisp. Date: Sun Jan 16 18:58:13 2005 Author: abakic Index: climacs/buffer-test.lisp diff -u climacs/buffer-test.lisp:1.4 climacs/buffer-test.lisp:1.5 --- climacs/buffer-test.lisp:1.4 Sun Jan 16 15:42:23 2005 +++ climacs/buffer-test.lisp Sun Jan 16 18:58:13 2005 @@ -4,7 +4,7 @@ ;;; (cl:defpackage :climacs-tests - (:use :rtest :climacs-buffer)) + (:use :rtest :climacs-buffer #+cmu :cl)) (in-package :climacs-tests) @@ -19,7 +19,7 @@ (eq (buffer high) buffer))) t) -(deftest standard-buffer-mark-make-instance.test-2 +(deftest standard-buffer-mark-make-instance.test-1 (handler-case (let ((buffer (make-instance 'standard-buffer))) (make-instance 'standard-left-sticky-mark :buffer buffer :offset 1)) @@ -27,7 +27,7 @@ (= (climacs-buffer::condition-offset c) 1))) t) -(deftest standard-buffer-mark-make-instance.test-3 +(deftest standard-buffer-mark-make-instance.test-2 (handler-case (let ((buffer (make-instance 'standard-buffer))) (make-instance 'standard-right-sticky-mark :buffer buffer :offset 1)) @@ -39,11 +39,7 @@ (flet ((%all-eq (&optional x y) (cond ((null x) nil) - (t (when (eq x y) y)))) - (%all-= (&optional x y) - (cond - ((null x) nil) - (t (when (= x y) y))))) + (t (when (eq x y) y))))) (let* ((buffer (make-instance 'standard-buffer)) (low (slot-value buffer 'low-mark)) (high (slot-value buffer 'high-mark))

1 0