Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv2026/Drei

Modified Files: drei.lisp packages.lisp syntax.lisp views.lisp Added Files: modes.lisp Log Message: Added support for "modes" (roughly similar to Emacs' minor-modes) to Drei.

--- /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2007/12/25 06:46:21 1.23 +++ /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2007/12/28 10:08:28 1.24 @@ -219,7 +219,7 @@ ;;; ;;; The basic Drei class.

-(defclass drei () +(defclass drei (modual-mixin) ((%view :initform (make-instance 'textual-drei-syntax-view) :initarg :view :accessor view @@ -288,6 +288,25 @@ (defmethod (setf active) (new-val (drei drei)) (setf (active (view drei)) new-val))

+(defmethod available-modes append ((modual drei)) + (available-modes (view modual))) + +(defmethod mode-applicable-p or ((modual drei) mode-name) + (mode-applicable-p (view modual) mode-name)) + +(defmethod mode-enabled-p or ((modual drei) mode-name) + (mode-enabled-p (view modual) mode-name)) + +(defmethod enable-mode ((modual drei) mode-name &rest initargs) + (if (mode-applicable-p (view modual) mode-name) + (apply #'enable-mode (view modual) mode-name initargs) + (call-next-method))) + +(defmethod disable-mode ((modual drei) mode-name) + (if (mode-applicable-p (view modual) mode-name) + (disable-mode (view modual) mode-name) + (call-next-method))) + (defun add-view-cursors (drei) "Add the cursors desired by the Drei view to the editor-pane of the Drei instance." --- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2007/12/27 15:22:54 1.26 +++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2007/12/28 10:08:33 1.27 @@ -138,7 +138,8 @@

(defpackage :drei-syntax (:use :clim-lisp :clim :drei-buffer :drei-base :flexichain :esa-utils) - (:export #:syntax #:update-parse #:syntaxp #:define-syntax #:*default-syntax* #:cursor-positions + (:export #:syntax #:syntax-command-tables #:update-parse #:syntaxp + #:define-syntax #:*default-syntax* #:cursor-positions #:syntax-command-table #:additional-command-tables #:define-syntax-command-table #:eval-option #:define-option-for-syntax @@ -277,7 +278,12 @@ #:*foreground-color* #:*background-color* #:*show-mark* - #:*use-tabs-for-indentation*)) + #:*use-tabs-for-indentation* + + #:view-mode #:syntax-mode + #:applicable-modes + #:define-mode #:define-view-mode #:define-syntax-mode + #:define-mode-toggle-commands))

(defpackage :drei-motion (:use :clim-lisp :drei-base :drei-buffer :drei-syntax) --- /project/mcclim/cvsroot/mcclim/Drei/syntax.lisp 2007/12/10 21:25:12 1.8 +++ /project/mcclim/cvsroot/mcclim/Drei/syntax.lisp 2007/12/28 10:08:34 1.9 @@ -22,7 +22,7 @@

(in-package :drei-syntax)

-(defclass syntax (name-mixin) +(defclass syntax (name-mixin modual-mixin) ((%buffer :initarg :buffer :reader buffer) (%command-table :initarg :command-table :initform (error "A command table has not been provided for this syntax") @@ -32,6 +32,13 @@ :accessor updater-fns)) (:documentation "The base class for all syntaxes."))

+(defgeneric syntax-command-tables (syntax) + (:documentation "Returns additional command tables provided by +`syntax'.") + (:method-combination append) + (:method append ((syntax syntax)) + (list (command-table syntax)))) + (defun syntaxp (object) "Return T if `object' is an instance of a syntax, NIL otherwise." --- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2007/12/19 17:17:37 1.7 +++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2007/12/28 10:08:35 1.8 @@ -403,7 +403,7 @@ ;;; ;;; View classes.

-(defclass drei-view (tabify-mixin subscriptable-name-mixin) +(defclass drei-view (tabify-mixin subscriptable-name-mixin modual-mixin) ((%active :accessor active :initform t :initarg :active @@ -445,6 +445,12 @@ (print-unreadable-object (view stream :type t :identity t) (format stream "name: ~a ~a" (name view) (subscript view))))

+(defmethod available-modes append ((modual drei-view)) + *global-modes*) + +(defmethod mode-applicable-p or ((modual drei-view) mode-name) + (mode-applicable-p (syntax modual) mode-name)) + (defgeneric synchronize-view (view &key &allow-other-keys) (:documentation "Synchronize the view with the object under observation - what exactly this entails, and what keyword @@ -583,6 +589,19 @@ (buffer-size view) (size (buffer view))) (synchronize-view view :force-p t))

+(defmethod mode-enabled-p or ((modual drei-syntax-view) mode-name) + (mode-enabled-p (syntax modual) mode-name)) + +(defmethod enable-mode ((modual drei-syntax-view) mode-name &rest initargs) + (if (mode-applicable-p (syntax modual) mode-name) + (apply #'enable-mode (syntax modual) mode-name initargs) + (call-next-method))) + +(defmethod disable-mode ((modual drei-syntax-view) mode-name) + (if (mode-applicable-p (syntax modual) mode-name) + (disable-mode (syntax modual) mode-name) + (call-next-method))) + (defmethod observer-notified ((view drei-syntax-view) (buffer drei-buffer) changed-region) (with-accessors ((prefix-size prefix-size) @@ -668,7 +687,7 @@ (make-instance 'mark-cursor :view view :output-stream output-stream))))

(defmethod view-command-tables append ((view textual-drei-syntax-view)) - (list (command-table (syntax view)))) + (syntax-command-tables (syntax view)))

(defmethod use-editor-commands-p ((view textual-drei-syntax-view)) t)

--- /project/mcclim/cvsroot/mcclim/Drei/modes.lisp 2007/12/28 10:08:50 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/modes.lisp 2007/12/28 10:08:50 1.1 ;;; -*- Mode: Lisp; Package: DREI -*-

;;; (c) copyright 2007-2008 by ;;; Troels Henriksen (athas@sigkill.dk)

;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public ;;; License as published by the Free Software Foundation; either ;;; version 2 of the License, or (at your option) any later version. ;;; ;;; This library is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; Library General Public License for more details. ;;; ;;; You should have received a copy of the GNU Library General Public ;;; License along with this library; if not, write to the ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. ;;; ;;; This file contains the implementation of the infrastructure for ;;; Drei "modes", loosely equivalent to Emacs minor modes. They modify ;;; aspects of the behavior of a view or syntax.

(in-package :drei)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; The general mode protocol and macros.

(defvar *global-modes* '() "A list of the names of modes globally available to Drei instances. Do not use this list to retrieve modes, use the function `available-modes' instead. The modes on this list are available to all Drei variants.")

(defun applicable-modes (drei) "Return a list of the names of all modes applicable for `drei'." (remove-if-not #'(lambda (mode) (mode-applicable-p (view drei) mode)) (available-modes drei)))

(defclass view-mode (mode) () (:documentation "The superclass for all view modes."))

(defclass syntax-mode (mode) () (:documentation "The superclass for all syntax modes."))

(defmacro define-mode (name (&rest superclasses) (&rest slot-specs) &rest options) "Define a toggable Drei mode. It is essentially a class, with the provided `name', `superclasses', `slot-specs' and `options'. It will automatically be a subclass of `mode'. Apart from the normal class options, `options' can also have a `:global' option, which when true signifies that the mode is globally available to all Drei instances. This option is true by default. Note that modes created via this macro are not applicable to anything." (let ((global t) (actual-options '())) (dolist (option options) (case (first option) (:global (setf global (second option))) (t (push option actual-options)))) `(progn (defclass ,name (,@superclasses mode) (,@slot-specs) ,@actual-options) (defmethod enabled-modes append ((modual ,name)) '(,name)) ,(when global `(push ',name *global-modes*)))))

(defmacro define-view-mode (name (&rest superclasses) (&rest slot-specs) &rest options) "Define a mode (as `define-mode') that is applicable to views. Apart from taking the same options as `define-mode', it also takes an `:applicable-views' option (nil by default) that is a list of views the mode should be applicable to. Multiple uses of this option are cumulative." (let ((applicable-views '()) (actual-options '())) (dolist (option options) (case (first option) (:applicable-views (setf applicable-views (append applicable-views (rest option)))) (t (push option actual-options)))) `(progn (define-mode ,name (,@superclasses view-mode) (,@slot-specs) ,@actual-options) ,@(loop for view in applicable-views collecting `(defmethod mode-directly-applicable-p or ((view ,view) (mode-name (eql ',name))) t)))))

(defmacro define-syntax-mode (name (&rest superclasses) (&rest slot-specs) &rest options) "Define a mode (as `define-mode') that is applicable to syntaxes. Apart from taking the same options as `define-mode', it also takes an `:applicable-syntaxes' option (nil by default) that is a list of syntaxes the mode should be applicable to. Multiple uses of this option are cumulative." (let ((applicable-syntaxes '()) (actual-options '())) (dolist (option options) (case (first option) (:applicable-syntaxes (setf applicable-syntaxes (append applicable-syntaxes (rest option)))) (t (push option actual-options)))) `(progn (define-mode ,name (,@superclasses syntax-mode) (,@slot-specs) ,@actual-options) ,@(loop for syntax in applicable-syntaxes collecting `(defmethod mode-directly-applicable-p or ((syntax ,syntax) (mode-name (eql ',name))) t)))))

(defmacro define-mode-toggle-commands (command-name (mode-name &optional (string-form (capitalize (string mode-name)))) &key (name t) command-table) "Define a simple command (named `command-name') for toggling the mode named by `mode-name' on and off. `String-form' is the name of the mode that will be put in the docstring, `name' and `command-table' work as in `define-command'." (check-type command-name symbol) (check-type mode-name symbol) (check-type string-form string) `(define-command (,command-name :name ,name :command-table ,command-table) () ,(concatenate 'string "Toggle " string-form " mode.") (if (mode-enabled-p *drei-instance* ',mode-name) (disable-mode *drei-instance* ',mode-name) (enable-mode *drei-instance* ',mode-name))))