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)))) +