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

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

01 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv17974 Modified Files: gui.lisp Log Message: Patch from Christophe Rhodes implementing transpose-objects and transpose-words. Thank you. Date: Sat Jan 1 20:58:40 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.42 climacs/gui.lisp:1.43 --- climacs/gui.lisp:1.42 Sat Jan 1 14:25:19 2005 +++ climacs/gui.lisp Sat Jan 1 20:58:40 2005 @@ -212,12 +212,6 @@ (possibly-expand-abbrev (point (win *application-frame*)))) (insert-object (point (win *application-frame*)) *current-gesture*)) -(define-named-command com-backward-object () - (decf (offset (point (win *application-frame*))))) - -(define-named-command com-forward-object () - (incf (offset (point (win *application-frame*))))) - (define-named-command com-beginning-of-line () (beginning-of-line (point (win *application-frame*)))) @@ -234,12 +228,52 @@ (let* ((point (point (win *application-frame*)))) (unless (beginning-of-buffer-p point) (when (end-of-line-p point) - (decf (offset point))) - (let ((object (object-after point))) - (delete-range point) - (decf (offset point)) - (insert-object point object) - (incf (offset point)))))) + (backward-object point)) + (let ((object (object-after point))) + (delete-range point) + (backward-object point) + (insert-object point object) + (forward-object point))))) + +(defgeneric backward-object (mark &optional count)) +(defmethod backward-object ((mark climacs-buffer::mark-mixin) + &optional (count 1)) + (decf (offset mark) count)) + +(defgeneric forward-object (mark &optional count)) +(defmethod forward-object ((mark climacs-buffer::mark-mixin) + &optional (count 1)) + (incf (offset mark) count)) + +(define-named-command com-backward-object () + (backward-object (point (win *application-frame*)))) + +(define-named-command com-forward-object () + (forward-object (point (win *application-frame*)))) + +(define-named-command com-transpose-words () + (let* ((point (point (win *application-frame*)))) + (let (bw1 bw2 ew1 ew2) + (backward-word point) + (setf bw1 (offset point)) + (forward-word point) + (setf ew1 (offset point)) + (forward-word point) + (when (= (offset point) ew1) + ;; this is emacs' message in the minibuffer + (error "Don't have two things to transpose")) + (setf ew2 (offset point)) + (backward-word point) + (setf bw2 (offset point)) + (let ((w2 (buffer-sequence (buffer point) bw2 ew2)) + (w1 (buffer-sequence (buffer point) bw1 ew1))) + (delete-word point) + (insert-sequence point w1) + (backward-word point) + (backward-word point) + (delete-word point) + (insert-sequence point w2) + (forward-word point))))) (define-named-command com-previous-line () (previous-line (point (win *application-frame*)))) @@ -520,6 +554,7 @@ (global-set-key '(#\w :control) 'com-cut-out) (global-set-key '(#\f :meta) 'com-forward-word) (global-set-key '(#\b :meta) 'com-backward-word) +(global-set-key '(#\t :meta) 'com-transpose-words) (global-set-key '(#\x :meta) 'com-extended-command) (global-set-key '(#\y :meta) 'com-kr-rotate) ;currently rotates only (global-set-key '(#\w :meta) 'com-copy-out)

1 0

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

01 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv1923 Modified Files: climacs.asd Log Message: Added improvement to asdf compilation procedure. Thanks to Andreas Fuchs. Date: Sat Jan 1 15:39:56 2005 Author: rstrandh Index: climacs/climacs.asd diff -u climacs/climacs.asd:1.6 climacs/climacs.asd:1.7 --- climacs/climacs.asd:1.6 Wed Dec 29 06:45:37 2004 +++ climacs/climacs.asd Sat Jan 1 15:39:55 2005 @@ -57,3 +57,15 @@ "syntax" "kill-ring" "gui") + +#+asdf +(defmethod asdf:perform :around ((o asdf:compile-op) + (c (eql (asdf:find-component (asdf:find-system :climacs) "skiplist-package")))) + (cond + ((null (probe-file (first (asdf:input-files o c)))) + (cerror "Retry loading climacs." + "~@<You need to download & install Flexichain ~ + separately! See the file INSTALL in the Climacs distribution ~ + for instructions.~@:>" nil) + (asdf:perform o c)) + (t (call-next-method o c))))

1 0

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

01 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv30026 Modified Files: gui.lisp Log Message: implemented transpose-objects (C-t) according to a suggestion by Christophe Rhodes. Applied some code factoring to his initial suggestion. Date: Sat Jan 1 14:25:19 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.41 climacs/gui.lisp:1.42 --- climacs/gui.lisp:1.41 Sat Jan 1 13:55:01 2005 +++ climacs/gui.lisp Sat Jan 1 14:25:19 2005 @@ -230,6 +230,17 @@ (define-named-command com-backward-delete-object () (delete-range (point (win *application-frame*)) -1)) +(define-named-command com-transpose-objects () + (let* ((point (point (win *application-frame*)))) + (unless (beginning-of-buffer-p point) + (when (end-of-line-p point) + (decf (offset point))) + (let ((object (object-after point))) + (delete-range point) + (decf (offset point)) + (insert-object point object) + (incf (offset point)))))) + (define-named-command com-previous-line () (previous-line (point (win *application-frame*)))) @@ -503,6 +514,7 @@ (global-set-key '(#\n :control) 'com-next-line) (global-set-key '(#\o :control) 'com-open-line) (global-set-key '(#\k :control) 'com-kill-line) +(global-set-key '(#\t :control) 'com-transpose-objects) (global-set-key '(#\Space :control) 'com-set-mark) (global-set-key '(#\y :control) 'com-copy-in) (global-set-key '(#\w :control) 'com-cut-out)

1 0

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

01 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv28467 Modified Files: gui.lisp Log Message: Committed fix for bug found by Christophe Rhodes. Thanks. Date: Sat Jan 1 13:55:02 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.40 climacs/gui.lisp:1.41 --- climacs/gui.lisp:1.40 Sat Jan 1 11:43:39 2005 +++ climacs/gui.lisp Sat Jan 1 13:55:01 2005 @@ -264,7 +264,7 @@ (let ((item (accept 'command :prompt "Extended Command"))) (execute-frame-command *application-frame* item))) -(eval-when (:compile-toplevel) +(eval-when (:compile-toplevel :load-toplevel) (define-presentation-type completable-pathname () :inherit-from 'pathname))

1 0

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

01 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv21597 Modified Files: syntax.lisp Log Message: minor stuff. Date: Sat Jan 1 11:49:27 2005 Author: rstrandh Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.16 climacs/syntax.lisp:1.17 --- climacs/syntax.lisp:1.16 Sat Jan 1 11:43:39 2005 +++ climacs/syntax.lisp Sat Jan 1 11:49:26 2005 @@ -238,8 +238,8 @@ (defun page-up (pane syntax) (position-window pane syntax) (with-slots (top bot cache) syntax - (let ((nb-lines-in-region (number-of-lines-in-region top bot))) - (when (> (offset top) 0) + (when (> (offset top) 0) + (let ((nb-lines-in-region (number-of-lines-in-region top bot))) (setf (offset bot) (offset top)) (end-of-line bot) (loop repeat nb-lines-in-region

1 0

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

01 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv20869 Modified Files: gui.lisp packages.lisp syntax.lisp Log Message: Implemented page-down (M-v). Date: Sat Jan 1 11:43:39 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.39 climacs/gui.lisp:1.40 --- climacs/gui.lisp:1.39 Sat Jan 1 11:06:21 2005 +++ climacs/gui.lisp Sat Jan 1 11:43:39 2005 @@ -394,6 +394,10 @@ (let ((pane (win *application-frame*))) (page-down pane (syntax pane)))) +(define-named-command com-page-up () + (let ((pane (win *application-frame*))) + (page-up pane (syntax pane)))) + (define-named-command com-end-of-buffer () (end-of-buffer (point (win *application-frame*)))) @@ -508,6 +512,7 @@ (global-set-key '(#\y :meta) 'com-kr-rotate) ;currently rotates only (global-set-key '(#\w :meta) 'com-copy-out) (global-set-key '(#\v :control) 'com-page-down) +(global-set-key '(#\v :meta) 'com-page-up) (global-set-key '(#\< :shift :meta) 'com-beginning-of-buffer) (global-set-key '(#\> :shift :meta) 'com-end-of-buffer) (global-set-key '(#\u :meta) 'com-browse-url) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.18 climacs/packages.lisp:1.19 --- climacs/packages.lisp:1.18 Sat Jan 1 11:06:21 2005 +++ climacs/packages.lisp Sat Jan 1 11:43:39 2005 @@ -60,7 +60,7 @@ (:use :clim-lisp :clim :climacs-buffer :climacs-base :flexichain) (:export #:syntax #:basic-syntax #:texinfo-syntax #:redisplay-pane #:redisplay-with-syntax #:full-redisplay - #:page-down + #:page-down #:page-up #:url)) (defpackage :climacs-kill-ring Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.15 climacs/syntax.lisp:1.16 --- climacs/syntax.lisp:1.15 Sat Jan 1 11:06:21 2005 +++ climacs/syntax.lisp Sat Jan 1 11:43:39 2005 @@ -199,7 +199,6 @@ (declare (ignore x y w)) (let ((nb-lines-in-pane (max 1 (floor h (+ height (stream-vertical-spacing pane))))) (nb-lines-on-display (1+ (number-of-lines-in-region top bot)))) - (format *query-io* "~a ~a~%" (offset top) (offset bot)) ;; adjust the region on display to fit the pane (loop repeat (- nb-lines-on-display nb-lines-in-pane) do (beginning-of-line bot) @@ -235,6 +234,23 @@ (beginning-of-line top) (setf (offset (point pane)) (offset top)) (setf cache nil)))) + +(defun page-up (pane syntax) + (position-window pane syntax) + (with-slots (top bot cache) syntax + (let ((nb-lines-in-region (number-of-lines-in-region top bot))) + (when (> (offset top) 0) + (setf (offset bot) (offset top)) + (end-of-line bot) + (loop repeat nb-lines-in-region + while (> (offset top) 0) + do (decf (offset top)) + (beginning-of-line top)) + (setf (offset (point pane)) (offset top)) + (position-window pane syntax) + (setf (offset (point pane)) (offset bot)) + (beginning-of-line (point pane)) + (setf cache nil))))) ;;; this one should not be necessary. (defun round-up (x)

1 0

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

01 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv19337 Modified Files: gui.lisp packages.lisp syntax.lisp Log Message: Implemented page-down (C-v). Date: Sat Jan 1 11:06:22 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.38 climacs/gui.lisp:1.39 --- climacs/gui.lisp:1.38 Sat Jan 1 10:34:25 2005 +++ climacs/gui.lisp Sat Jan 1 11:06:21 2005 @@ -390,6 +390,10 @@ (define-named-command com-beginning-of-buffer () (beginning-of-buffer (point (win *application-frame*)))) +(define-named-command com-page-down () + (let ((pane (win *application-frame*))) + (page-down pane (syntax pane)))) + (define-named-command com-end-of-buffer () (end-of-buffer (point (win *application-frame*)))) @@ -503,6 +507,7 @@ (global-set-key '(#\x :meta) 'com-extended-command) (global-set-key '(#\y :meta) 'com-kr-rotate) ;currently rotates only (global-set-key '(#\w :meta) 'com-copy-out) +(global-set-key '(#\v :control) 'com-page-down) (global-set-key '(#\< :shift :meta) 'com-beginning-of-buffer) (global-set-key '(#\> :shift :meta) 'com-end-of-buffer) (global-set-key '(#\u :meta) 'com-browse-url) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.17 climacs/packages.lisp:1.18 --- climacs/packages.lisp:1.17 Sat Jan 1 10:34:25 2005 +++ climacs/packages.lisp Sat Jan 1 11:06:21 2005 @@ -60,6 +60,7 @@ (:use :clim-lisp :clim :climacs-buffer :climacs-base :flexichain) (:export #:syntax #:basic-syntax #:texinfo-syntax #:redisplay-pane #:redisplay-with-syntax #:full-redisplay + #:page-down #:url)) (defpackage :climacs-kill-ring Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.14 climacs/syntax.lisp:1.15 --- climacs/syntax.lisp:1.14 Sat Jan 1 10:34:25 2005 +++ climacs/syntax.lisp Sat Jan 1 11:06:21 2005 @@ -199,6 +199,7 @@ (declare (ignore x y w)) (let ((nb-lines-in-pane (max 1 (floor h (+ height (stream-vertical-spacing pane))))) (nb-lines-on-display (1+ (number-of-lines-in-region top bot)))) + (format *query-io* "~a ~a~%" (offset top) (offset bot)) ;; adjust the region on display to fit the pane (loop repeat (- nb-lines-on-display nb-lines-in-pane) do (beginning-of-line bot) @@ -226,6 +227,14 @@ do (incf (offset bot)) (end-of-line bot)))))))) +(defun page-down (pane syntax) + (position-window pane syntax) + (with-slots (top bot cache) syntax + (when (mark> (size (buffer bot)) bot) + (setf (offset top) (offset bot)) + (beginning-of-line top) + (setf (offset (point pane)) (offset top)) + (setf cache nil)))) ;;; this one should not be necessary. (defun round-up (x)

1 0

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

01 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv17852 Modified Files: base.lisp gui.lisp packages.lisp syntax.lisp Log Message: Factored aspects of named objects (currently buffers and syntaxes) into a syntax-mixin class in base.lisp. Updated packages.lisp accordingly. Implemented syntax completion (i.e., the possibility to use CLIM completion to determine the name of a syntax). I Implemented an extended command "Set Syntax" using the completion. Currently, it does not invalidate the CLIM output history, because I need to think a bit more about how to do that properly. Date: Sat Jan 1 10:34:26 2005 Author: rstrandh Index: climacs/base.lisp diff -u climacs/base.lisp:1.8 climacs/base.lisp:1.9 --- climacs/base.lisp:1.8 Thu Dec 30 06:28:21 2004 +++ climacs/base.lisp Sat Jan 1 10:34:25 2005 @@ -135,3 +135,12 @@ while (constituentp (object-before mark)) do (delete-range mark -1))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Named objects + +(defgeneric name (obj)) + +(defclass name-mixin () + ((name :initarg :name :accessor name))) + Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.37 climacs/gui.lisp:1.38 --- climacs/gui.lisp:1.37 Fri Dec 31 14:33:06 2004 +++ climacs/gui.lisp Sat Jan 1 10:34:25 2005 @@ -27,9 +27,10 @@ (defclass filename-mixin () ((filename :initform nil :accessor filename))) -(defclass climacs-buffer (standard-buffer abbrev-mixin filename-mixin) - ((name :initform "*scratch*" :accessor name) - (needs-saving :initform nil :accessor needs-saving))) +(defclass climacs-buffer (standard-buffer abbrev-mixin filename-mixin name-mixin) + ((needs-saving :initform nil :accessor needs-saving)) + (:default-initargs :name "*scratch*")) + (defclass climacs-pane (application-pane) ((buffer :initform (make-instance 'climacs-buffer) :accessor buffer) @@ -94,9 +95,10 @@ (defun display-info (frame pane) (let* ((win (win frame)) (buf (buffer win)) - (name-info (format nil " ~a ~a" + (name-info (format nil " ~a ~a Syntax: ~a" (if (needs-saving buf) "**" "--") - (name buf)))) + (name buf) + (name (syntax win))))) (princ name-info pane))) (defun display-win (frame pane) @@ -420,6 +422,11 @@ (define-named-command com-set-mark () (with-slots (point mark) (win *application-frame*) (setf mark (clone-mark point)))) + +(define-named-command com-set-syntax () + (setf (syntax (win *application-frame*)) + (make-instance (accept 'syntax :prompt "Set Syntax") + :pane (win *application-frame*)))) ;;;;;;;;;;;;;;;;;;;; ;; Kill ring commands Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.16 climacs/packages.lisp:1.17 --- climacs/packages.lisp:1.16 Fri Dec 31 14:33:06 2004 +++ climacs/packages.lisp Sat Jan 1 10:34:25 2005 @@ -48,7 +48,8 @@ #:constituentp #:whitespacep #:forward-word #:backward-word #:delete-word #:backward-delete-word - #:input-from-stream #:output-to-stream)) + #:input-from-stream #:output-to-stream + #:name-mixin #:name)) (defpackage :climacs-abbrev (:use :clim-lisp :clim :climacs-buffer :climacs-base) Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.13 climacs/syntax.lisp:1.14 --- climacs/syntax.lisp:1.13 Fri Dec 31 14:33:06 2004 +++ climacs/syntax.lisp Sat Jan 1 10:34:25 2005 @@ -24,7 +24,7 @@ (in-package :climacs-syntax) -(defclass syntax () ()) +(defclass syntax (name-mixin) ()) (defgeneric redisplay-with-syntax (pane syntax)) @@ -34,7 +34,37 @@ (defgeneric full-redisplay (pane syntax)) -(defclass basic-syntax (syntax) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Syntax completion + +(defparameter *syntaxes* '()) + +(defmacro define-syntax (class-name (name superclasses) &body body) + `(progn (push '(,name . ,class-name) *syntaxes*) + (defclass ,class-name ,superclasses + ,@body + (:default-initargs :name ,name)))) + +(define-presentation-method accept + ((type syntax) stream (view textual-view) &key) + (multiple-value-bind (pathname success string) + (complete-input stream + (lambda (so-far action) + (complete-from-possibilities + so-far *syntaxes* '() :action action + :name-key #'car + :value-key #'cdr)) + :partial-completers '(#\Space) + :allow-any-input t) + (declare (ignore success)) + (or pathname string))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Basic syntax + +(define-syntax basic-syntax ("Basic" (syntax)) ((top :reader top) (bot :reader bot) (scan :reader scan) @@ -58,6 +88,8 @@ (define-presentation-type url () :inherit-from 'string) +(defgeneric present-contents (contenst pane syntax)) + (defmethod present-contents (contents pane (syntax basic-syntax)) (unless (null contents) (present contents @@ -66,6 +98,8 @@ 'string) :stream pane))) +(defgeneric display-line (pane syntax line)) + (defmethod display-line (pane (syntax basic-syntax) line) (let ((saved-index nil) (id 0)) @@ -117,6 +151,8 @@ (terpri pane) (incf scan)))))) +(defgeneric compute-cache (pane syntax)) + (defmethod compute-cache (pane (syntax basic-syntax)) (with-slots (top bot cache) syntax (let* ((buffer (buffer pane)) @@ -225,7 +261,7 @@ ;;; ;;; Texinfo syntax -(defclass texinfo-syntax (basic-syntax) ()) +(define-syntax texinfo-syntax ("Texinfo" (basic-syntax)) ()) (define-presentation-type texinfo-command () :inherit-from 'string) @@ -236,4 +272,5 @@ (with-drawing-options (pane :ink +red+) (present contents 'texinfo-command :stream pane)) (present contents 'string :stream pane)))) +

1 0