climacs-cvs January 2005

climacs-cvs@common-lisp.net

5 participants
108 discussions

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

18 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv4423 Modified Files: buffer.lisp pane.lisp Log Message: Added :stream argument to presentations of characters Date: Tue Jan 18 02:11:30 2005 Author: rstrandh Index: climacs/buffer.lisp diff -u climacs/buffer.lisp:1.21 climacs/buffer.lisp:1.22 --- climacs/buffer.lisp:1.21 Sat Jan 15 15:13:46 2005 +++ climacs/buffer.lisp Tue Jan 18 02:11:29 2005 @@ -451,9 +451,13 @@ (make-condition 'no-such-offset :offset offset1)) (assert (<= 0 offset2 (size buffer)) () (make-condition 'no-such-offset :offset offset2)) - (coerce (loop for offset from offset1 below offset2 - collect (buffer-object buffer offset)) - 'vector)) + (if (< offset1 offset2) + (loop with result = (make-array (- offset2 offset1)) + for offset from offset1 below offset2 + for i upfrom 0 + do (setf (aref result i) (buffer-object buffer offset)) + finally (return result)) + (make-array 0))) (defgeneric object-before (mark) (:documentation "Return the object that is immediately before the mark. If mark is at Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.4 climacs/pane.lisp:1.5 --- climacs/pane.lisp:1.4 Mon Jan 17 15:10:24 2005 +++ climacs/pane.lisp Tue Jan 18 02:11:29 2005 @@ -165,13 +165,13 @@ (output-word index) (updating-output (pane :unique-id (incf id) :cache-value obj) - (present obj))) + (present obj 'character :stream pane))) (t (output-word index) (updating-output (pane :unique-id (incf id) :cache-value obj :cache-test #'eq) - (present obj)))) + (present obj 'character :stream pane)))) (incf scan) finally (output-word index) (when (mark= scan (point pane))

1 0

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

18 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv27111 Modified Files: gui.lisp Log Message: The info pane now displays info about its own associated Climacs pane. Date: Mon Jan 17 22:55:47 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.80 climacs/gui.lisp:1.81 --- climacs/gui.lisp:1.80 Mon Jan 17 21:58:24 2005 +++ climacs/gui.lisp Mon Jan 17 22:55:47 2005 @@ -39,6 +39,9 @@ (dabbrev-expansion-mark :initform nil) (overwrite-mode :initform nil))) +(defclass info-pane (application-pane) + ((climacs-pane :initarg :climacs-pane))) + (defclass minibuffer-pane (application-pane) ()) (defmethod stream-accept :before ((pane minibuffer-pane) type &rest args) @@ -49,20 +52,25 @@ ((win :reader win) (buffers :initform '() :accessor buffers)) (:panes - (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 (let* ((extended-pane + (make-pane 'extended-pane + :width 900 :height 400 + :name 'bla + :incremental-redisplay t + :display-function 'display-win)) + (info-pane + (make-pane 'info-pane + :climacs-pane extended-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))) + (vertically () + (scrolling () + extended-pane) + info-pane))) (int (make-pane 'minibuffer-pane :width 900 :height 20 :max-height 20 :min-height 20 :scroll-bars nil))) @@ -92,16 +100,17 @@ (apply #'format *standard-input* format-string format-args)) (defun display-info (frame pane) - (let* ((win (win frame)) - (buf (buffer win)) - (name-info (format nil " ~a ~a Syntax: ~a ~a" - (if (needs-saving buf) "**" "--") - (name buf) - (name (syntax buf)) - (if (slot-value win 'overwrite-mode) - "Ovwrt" - "")))) - (princ name-info pane))) + (declare (ignore frame)) + (with-slots (climacs-pane) pane + (let* ((buf (buffer climacs-pane)) + (name-info (format nil " ~a ~a Syntax: ~a ~a" + (if (needs-saving buf) "**" "--") + (name buf) + (name (syntax buf)) + (if (slot-value climacs-pane 'overwrite-mode) + "Ovwrt" + "")))) + (princ name-info pane)))) (defun display-win (frame pane) "The display function used by the climacs application frame." @@ -678,7 +687,8 @@ (sheet-adopt-child parent (vertically () (scrolling () new-pane) - (make-pane 'application-pane + (make-pane 'info-pane + :climacs-pane new-pane :width 900 :height 20 :max-height 20 :min-height 20 ::background +gray85+

1 0

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

18 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv24090 Modified Files: gui.lisp Log Message: Cleaned up some useless code. Introduced a macro `current-window' in preparation for true multi-window support. Please use it now instead of the previous idiom (win *application-frame*). A key sequence such as ESC <key> now works the same way as they keystroke M-<key>. (thanks to Ignas Mikalajunas) Date: Mon Jan 17 21:58:27 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.79 climacs/gui.lisp:1.80 --- climacs/gui.lisp:1.79 Mon Jan 17 15:10:23 2005 +++ climacs/gui.lisp Mon Jan 17 21:58:24 2005 @@ -63,19 +63,6 @@ :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 30 :min-height 30 - :name 'info :background +gray85+ - :scroll-bars nil - :borders 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))) @@ -83,21 +70,18 @@ (default (vertically (:scroll-bars nil) win - int)) - (without-interactor - (vertically (:scroll-bars nil) - (scrolling (:width 900 :height 400) win) - info))) + int))) (:top-level (climacs-top-level))) -(defmethod redisplay-frame-panes :before ((frame climacs) &rest args) - (declare (ignore args)) - (let ((buffer (buffer (win frame)))) - (update-syntax buffer (syntax buffer)))) +(defmacro current-window () + `(win *application-frame*)) -(defmethod redisplay-frame-panes :after ((frame climacs) &rest args) +(defmethod redisplay-frame-panes :around ((frame climacs) &rest args) (declare (ignore args)) - (clear-modify (buffer (win frame)))) + (let ((buffer (buffer (win frame)))) + (update-syntax buffer (syntax buffer)) + (call-next-method) + (clear-modify buffer))) (defun climacs () "Starts up a climacs session" @@ -263,12 +247,12 @@ (frame-exit *application-frame*)) (define-named-command com-toggle-overwrite-mode () - (let ((win (win *application-frame*))) + (let ((win (current-window))) (setf (slot-value win 'overwrite-mode) (not (slot-value win 'overwrite-mode))))) (define-command com-self-insert () - (let* ((win (win *application-frame*)) + (let* ((win (current-window)) (point (point win))) (unless (constituentp *current-gesture*) (possibly-expand-abbrev point)) @@ -279,19 +263,19 @@ (insert-object point *current-gesture*)))) (define-named-command com-beginning-of-line () - (beginning-of-line (point (win *application-frame*)))) + (beginning-of-line (point (current-window)))) (define-named-command com-end-of-line () - (end-of-line (point (win *application-frame*)))) + (end-of-line (point (current-window)))) (define-named-command com-delete-object ((count 'integer :prompt "Number of Objects")) - (delete-range (point (win *application-frame*)) count)) + (delete-range (point (current-window)) count)) (define-named-command com-backward-delete-object ((count 'integer :prompt "Number of Objects")) - (delete-range (point (win *application-frame*)) (- count))) + (delete-range (point (current-window)) (- count))) (define-named-command com-transpose-objects () - (let* ((point (point (win *application-frame*)))) + (let* ((point (point (current-window)))) (unless (beginning-of-buffer-p point) (when (end-of-line-p point) (backward-object point)) @@ -302,13 +286,13 @@ (forward-object point))))) (define-named-command com-backward-object ((count 'integer :prompt "Number of Objects")) - (backward-object (point (win *application-frame*)) count)) + (backward-object (point (current-window)) count)) (define-named-command com-forward-object ((count 'integer :prompt "Number of Objects")) - (forward-object (point (win *application-frame*)) count)) + (forward-object (point (current-window)) count)) (define-named-command com-transpose-words () - (let* ((point (point (win *application-frame*)))) + (let* ((point (point (current-window)))) (let (bw1 bw2 ew1 ew2) (backward-word point) (setf bw1 (offset point)) @@ -332,7 +316,7 @@ (forward-word point))))) (define-named-command com-transpose-lines () - (let ((point (point (win *application-frame*)))) + (let ((point (point (current-window)))) (beginning-of-line point) (unless (beginning-of-buffer-p point) (previous-line point)) @@ -355,7 +339,7 @@ (insert-object point #\Newline)))) (define-named-command com-previous-line () - (let* ((win (win *application-frame*)) + (let* ((win (current-window)) (point (point win))) (unless (or (eq (previous-command win) 'com-previous-line) (eq (previous-command win) 'com-next-line)) @@ -363,7 +347,7 @@ (previous-line point (slot-value win 'goal-column)))) (define-named-command com-next-line () - (let* ((win (win *application-frame*)) + (let* ((win (current-window)) (point (point win))) (unless (or (eq (previous-command win) 'com-previous-line) (eq (previous-command win) 'com-next-line)) @@ -371,10 +355,10 @@ (next-line point (slot-value win 'goal-column)))) (define-named-command com-open-line () - (open-line (point (win *application-frame*)))) + (open-line (point (current-window)))) (define-named-command com-kill-line () - (let* ((pane (win *application-frame*)) + (let* ((pane (current-window)) (point (point pane)) (mark (offset point))) (cond ((end-of-buffer-p point) nil) @@ -391,45 +375,45 @@ (delete-region mark point))) (define-named-command com-forward-word () - (forward-word (point (win *application-frame*)))) + (forward-word (point (current-window)))) (define-named-command com-backward-word () - (backward-word (point (win *application-frame*)))) + (backward-word (point (current-window)))) (define-named-command com-delete-word () - (delete-word (point (win *application-frame*)))) + (delete-word (point (current-window)))) (define-named-command com-backward-delete-word () - (backward-delete-word (point (win *application-frame*)))) + (backward-delete-word (point (current-window)))) (define-named-command com-upcase-region () - (multiple-value-bind (start end) (region-limits (win *application-frame*)) + (multiple-value-bind (start end) (region-limits (current-window)) (upcase-region start end))) (define-named-command com-downcase-region () - (multiple-value-bind (start end) (region-limits (win *application-frame*)) + (multiple-value-bind (start end) (region-limits (current-window)) (downcase-region start end))) (define-named-command com-capitalize-region () - (multiple-value-bind (start end) (region-limits (win *application-frame*)) + (multiple-value-bind (start end) (region-limits (current-window)) (capitalize-region start end))) (define-named-command com-upcase-word () - (upcase-word (point (win *application-frame*)))) + (upcase-word (point (current-window)))) (define-named-command com-downcase-word () - (downcase-word (point (win *application-frame*)))) + (downcase-word (point (current-window)))) (define-named-command com-capitalize-word () - (capitalize-word (point (win *application-frame*)))) + (capitalize-word (point (current-window)))) (define-named-command com-tabify-region () - (let ((pane (win *application-frame*))) + (let ((pane (current-window))) (multiple-value-bind (start end) (region-limits pane) (tabify-region start end (tab-space-count (stream-default-view pane)))))) (define-named-command com-untabify-region () - (let ((pane (win *application-frame*))) + (let ((pane (current-window))) (multiple-value-bind (start end) (region-limits pane) (untabify-region start end (tab-space-count (stream-default-view pane)))))) @@ -444,24 +428,18 @@ tab-space-count)))) (define-named-command com-indent-line () - (let* ((pane (win *application-frame*)) + (let* ((pane (current-window)) (point (point pane))) (indent-current-line pane point))) (define-named-command com-newline-and-indent () - (let* ((pane (win *application-frame*)) + (let* ((pane (current-window)) (point (point pane))) (insert-object point #\Newline) (indent-current-line pane point))) (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) - 'without-interactor - 'default))) + (delete-indentation (point (current-window)))) (define-command com-extended-command () (let ((item (accept 'command :prompt "Extended Command"))) @@ -553,9 +531,9 @@ (let ((filename (accept 'completable-pathname :prompt "Find File")) (buffer (make-instance 'climacs-buffer)) - (pane (win *application-frame*))) + (pane (current-window))) (push buffer (buffers *application-frame*)) - (setf (buffer (win *application-frame*)) buffer) + (setf (buffer (current-window)) buffer) (setf (syntax buffer) (make-instance 'basic-syntax)) (with-open-file (stream filename :direction :input :if-does-not-exist :create) (input-from-stream stream buffer 0)) @@ -568,7 +546,7 @@ (redisplay-frame-panes *application-frame*))) (define-named-command com-save-buffer () - (let* ((buffer (buffer (win *application-frame*))) + (let* ((buffer (buffer (current-window))) (filename (or (filename buffer) (accept 'completable-pathname :prompt "Save Buffer to File")))) @@ -585,7 +563,7 @@ (define-named-command com-write-buffer () (let ((filename (accept 'completable-pathname :prompt "Write Buffer to File")) - (buffer (buffer (win *application-frame*)))) + (buffer (buffer (current-window)))) (with-open-file (stream filename :direction :output :if-exists :supersede) (output-to-stream stream buffer 0 (size buffer))) (setf (filename buffer) filename @@ -612,13 +590,13 @@ (define-named-command com-switch-to-buffer () (let ((buffer (accept 'buffer :prompt "Switch to buffer"))) - (setf (buffer (win *application-frame*)) buffer) + (setf (buffer (current-window)) buffer) (setf (syntax buffer) (make-instance 'basic-syntax)) - (beginning-of-buffer (point (win *application-frame*))) - (full-redisplay (win *application-frame*)))) + (beginning-of-buffer (point (current-window))) + (full-redisplay (current-window)))) (define-named-command com-full-redisplay () - (full-redisplay (win *application-frame*))) + (full-redisplay (current-window))) (define-named-command com-load-file () (let ((filename (accept 'completable-pathname @@ -626,56 +604,56 @@ (load filename))) (define-named-command com-beginning-of-buffer () - (beginning-of-buffer (point (win *application-frame*)))) + (beginning-of-buffer (point (current-window)))) (define-named-command com-page-down () - (let ((pane (win *application-frame*))) + (let ((pane (current-window))) (page-down pane))) (define-named-command com-page-up () - (let ((pane (win *application-frame*))) + (let ((pane (current-window))) (page-up pane))) (define-named-command com-end-of-buffer () - (end-of-buffer (point (win *application-frame*)))) + (end-of-buffer (point (current-window)))) (define-named-command com-back-to-indentation () - (let ((point (point (win *application-frame*)))) + (let ((point (point (current-window)))) (beginning-of-line point) (loop until (end-of-line-p point) while (whitespacep (object-after point)) do (incf (offset point))))) (define-named-command com-goto-position () - (setf (offset (point (win *application-frame*))) + (setf (offset (point (current-window))) (accept 'integer :prompt "Goto Position"))) (define-named-command com-goto-line () (loop with mark = (make-instance 'standard-right-sticky-mark - :buffer (buffer (win *application-frame*))) + :buffer (buffer (current-window))) 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*))) + (setf (offset (point (current-window))) (offset mark)))) (define-named-command com-browse-url () (accept 'url :prompt "Browse URL")) (define-named-command com-set-mark () - (let ((pane (win *application-frame*))) + (let ((pane (current-window))) (setf (mark pane) (clone-mark (point pane))))) (define-named-command com-exchange-point-and-mark () - (let ((pane (win *application-frame*))) + (let ((pane (current-window))) (psetf (offset (mark pane)) (offset (point pane)) (offset (point pane)) (offset (mark pane))))) (define-named-command com-set-syntax () - (let* ((pane (win *application-frame*)) + (let* ((pane (current-window)) (buffer (buffer pane))) (setf (syntax buffer) (make-instance (accept 'syntax :prompt "Set Syntax"))) @@ -689,7 +667,7 @@ (define-named-command com-split-window-vertically () (with-look-and-feel-realization ((frame-manager *application-frame*) *application-frame*) - (let* ((pane (win *application-frame*)) + (let* ((pane (current-window)) (new-pane (make-pane 'extended-pane :width 900 :height 400 :name 'win @@ -717,21 +695,21 @@ ;; Copies an element from a kill-ring to a buffer at the given offset (define-named-command com-yank () - (insert-sequence (point (win *application-frame*)) (kill-ring-yank *kill-ring*))) + (insert-sequence (point (current-window)) (kill-ring-yank *kill-ring*))) ;; Destructively cut a given buffer region into the kill-ring (define-named-command com-cut-out () - (multiple-value-bind (start end) (region-limits (win *application-frame*)) + (multiple-value-bind (start end) (region-limits (current-window)) (kill-ring-standard-push *kill-ring* (region-to-sequence start end)) (delete-region (offset start) end))) ;; Non destructively copies in buffer region to the kill ring (define-named-command com-copy-out () - (let ((pane (win *application-frame*))) + (let ((pane (current-window))) (kill-ring-standard-push *kill-ring* (region-to-sequence (point pane) (mark pane))))) (define-named-command com-rotate-yank () - (let* ((pane (win *application-frame*)) + (let* ((pane (current-window)) (point (point pane)) (last-yank (kill-ring-yank *kill-ring*))) (if (eq (previous-command pane) @@ -746,19 +724,19 @@ (setf (kill-ring-max-size *kill-ring*) size))) (define-named-command com-search-forward () - (search-forward (point (win *application-frame*)) + (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 (win *application-frame*)) + (search-backward (point (current-window)) (accept 'string :prompt "Search Backward") :test (lambda (a b) (and (characterp b) (char-equal a b))))) (define-named-command com-dabbrev-expand () - (let* ((win (win *application-frame*)) + (let* ((win (current-window)) (point (point win))) (with-slots (original-prefix prefix-start-offset dabbrev-expansion-mark) win (flet ((move () (cond ((beginning-of-buffer-p dabbrev-expansion-mark) @@ -795,26 +773,40 @@ (move)))))))) (define-named-command com-beginning-of-paragraph () - (let* ((pane (win *application-frame*)) + (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) (beginning-of-paragraph point syntax))) (define-named-command com-end-of-paragraph () - (let* ((pane (win *application-frame*)) + (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) (end-of-paragraph point syntax))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; -;;; Global command table +;;; Global and dead-escape command tables (make-command-table 'global-climacs-table :errorp nil) +(make-command-table 'dead-escape-climacs-table :errorp nil) + +(add-menu-item-to-command-table 'global-climacs-table "dead-escape" + :menu 'dead-escape-climacs-table + :keystroke '(:escape)) + +(defun dead-escape-set-key (gesture command) + (add-command-to-command-table command 'dead-escape-climacs-table + :keystroke gesture :errorp nil)) + (defun global-set-key (gesture command) (add-command-to-command-table command 'global-climacs-table - :keystroke gesture :errorp nil)) + :keystroke gesture :errorp nil) + (when (and + (listp gesture) + (find :meta gesture)) + (dead-escape-set-key (remove :meta gesture) command))) (loop for code from (char-code #\space) to (char-code #\~) do (global-set-key (code-char code) 'com-self-insert)) @@ -903,7 +895,7 @@ ;;; Some Unicode stuff (define-named-command com-insert-charcode ((code 'integer :prompt "Code point")) - (insert-object (point (win *application-frame*)) (code-char code))) + (insert-object (point (current-window)) (code-char code))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[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 18 Jan '05

18 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

← Newer
1
2
3
4
5
6
7
8
...
11
Older →

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

climacs-cvs January 2005