Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv24994/Drei
Added Files: unicode-commands.lisp undo.lisp syntax.lisp search-commands.lisp rectangle.lisp packages.lisp motion.lisp motion-commands.lisp misc-commands.lisp lisp-syntax.lisp lisp-syntax-swine.lisp lisp-syntax-swank.lisp lisp-syntax-commands.lisp kill-ring.lisp kill-ring-test.lisp input-editor.lisp fundamental-syntax.lisp editing.lisp editing-commands.lisp drei.lisp drei.asd drei-redisplay.lisp drei-clim.lisp delegating-buffer.lisp core.lisp core-commands.lisp buffer.lisp buffer-test.lisp basic-commands.lisp base.lisp base-test.lisp abbrev.lisp Log Message: Committed Drei.
--- /project/mcclim/cvsroot/mcclim/Drei/unicode-commands.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/unicode-commands.lisp 2006/11/08 01:15:33 1.1 ;;; -*- Mode: Lisp; Package: DREI-COMMANDS -*-
;;; (c) copyright 2004-2005 by ;;; Robert Strandh (strandh@labri.fr) ;;; (c) copyright 2004-2005 by ;;; Elliott Johnson (ejohnson@fasl.info) ;;; (c) copyright 2005 by ;;; Matthieu Villeneuve (matthieu.villeneuve@free.fr) ;;; (c) copyright 2005 by ;;; Aleksandar Bakic (a_bakic@yahoo.com)
;;; 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.
;;; Unicode handling for the editing component of the Climacs editor.
(in-package :drei-commands)
(do ((i 160 (+ i 1))) ((> i 255)) (set-key `(com-self-insert ,*numeric-argument-marker*) 'self-insert-table (list (code-char i))))
(define-command (com-insert-charcode :name t :command-table self-insert-table) ((code 'integer :prompt "Code point") (count 'integer)) (let ((char (code-char code))) (loop repeat count do (insert-character char))))
(macrolet ((set-charcode-key (code sequence) `(set-key `(com-insert-charcode ,',code ,*numeric-argument-marker*) 'self-insert-table ',sequence)) (set-dead-acute-key (code &rest sequence) `(set-charcode-key ,code ((:dead-acute) ,@sequence))) (set-dead-grave-key (code &rest sequence) `(set-charcode-key ,code ((:dead-grave) ,@sequence))) (set-dead-diaresis-key (code &rest sequence) `(set-charcode-key ,code ((:dead-diaresis :shift) ,@sequence))) (set-dead-tilde-key (code &rest sequence) `(set-charcode-key ,code ((:dead-tilde :shift) ,@sequence))) (set-dead-circumflex-key (code &rest sequence) `(set-charcode-key ,code ((:dead-circumflex :shift) ,@sequence)))) (set-dead-acute-key 193 (#\A)) (set-dead-acute-key 201 (#\E)) (set-dead-acute-key 205 (#\I)) (set-dead-acute-key 211 (#\O)) (set-dead-acute-key 218 (#\U)) (set-dead-acute-key 221 (#\Y)) (set-dead-acute-key 225 (#\a)) (set-dead-acute-key 233 (#\e)) (set-dead-acute-key 237 (#\i)) (set-dead-acute-key 243 (#\o)) (set-dead-acute-key 250 (#\u)) (set-dead-acute-key 253 (#\y)) (set-dead-acute-key 199 (#\C)) (set-dead-acute-key 231 (#\c)) (set-dead-acute-key 215 (#\x)) (set-dead-acute-key 247 (#-)) (set-dead-acute-key 222 (#\T)) (set-dead-acute-key 254 (#\t)) (set-dead-acute-key 223 (#\s)) (set-dead-acute-key 39 (#\Space))
(set-dead-acute-key 197 (:dead-acute) (#\A)) (set-dead-acute-key 229 (:dead-acute) (#\a))
(set-dead-grave-key 192 (#\A)) (set-dead-grave-key 200 (#\E)) (set-dead-grave-key 204 (#\I)) (set-dead-grave-key 210 (#\O)) (set-dead-grave-key 217 (#\U)) (set-dead-grave-key 224 (#\a)) (set-dead-grave-key 232 (#\e)) (set-dead-grave-key 236 (#\i)) (set-dead-grave-key 242 (#\o)) (set-dead-grave-key 249 (#\u)) (set-dead-grave-key 96 (#\Space))
(set-dead-diaresis-key 196 (#\A)) (set-dead-diaresis-key 203 (#\E)) (set-dead-diaresis-key 207 (#\I)) (set-dead-diaresis-key 214 (#\O)) (set-dead-diaresis-key 220 (#\U)) (set-dead-diaresis-key 228 (#\a)) (set-dead-diaresis-key 235 (#\e)) (set-dead-diaresis-key 239 (#\i)) (set-dead-diaresis-key 246 (#\o)) (set-dead-diaresis-key 252 (#\u)) (set-dead-diaresis-key 255 (#\y)) (set-dead-diaresis-key 34 (#\Space))
(set-dead-tilde-key 195 (#\A)) (set-dead-tilde-key 209 (#\N)) (set-dead-tilde-key 227 (#\a)) (set-dead-tilde-key 241 (#\n))
(set-dead-tilde-key 198 (#\E)) (set-dead-tilde-key 230 (#\e)) (set-dead-tilde-key 208 (#\D)) (set-dead-tilde-key 240 (#\d)) (set-dead-tilde-key 248 (#\o)) (set-dead-tilde-key 126 (#\Space))
(set-dead-circumflex-key 194 (#\A)) (set-dead-circumflex-key 202 (#\E)) (set-dead-circumflex-key 206 (#\I)) (set-dead-circumflex-key 212 (#\O)) (set-dead-circumflex-key 219 (#\U)) (set-dead-circumflex-key 226 (#\a)) (set-dead-circumflex-key 234 (#\e)) (set-dead-circumflex-key 238 (#\i)) (set-dead-circumflex-key 244 (#\o)) (set-dead-circumflex-key 251 (#\u)) (set-dead-circumflex-key 94 (#\Space))) --- /project/mcclim/cvsroot/mcclim/Drei/undo.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/undo.lisp 2006/11/08 01:15:33 1.1 ;;; -*- Mode: Lisp; Package: DREI-UNDO -*-
;;; (c) copyright 2005 by ;;; Robert Strandh (strandh@labri.fr)
;;; 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.
;;; General-purpose undo module
(in-package :drei-undo)
(defgeneric add-undo (undo-record undo-tree) (:documentation "Add an undo record to the undo tree below the current state, and set the current state to be below the transition represented by the undo record."))
(defgeneric flip-undo-record (undo-record) (:documentation "This function is called by the undo module whenever the current state is changed from its current value to that of the parent state (presumably as a result of a call to undo) or to that of one of its child states.
Client code is required to supply methods for this function on client-specific subclasses of undo-record."))
(defgeneric undo (undo-tree &optional n) (:documentation "Move the current state n steps up the undo tree and call flip-undo-record on each step. If the current state is at a level less than n, a no-more-undo condition is signaled and the current state is not moved (and no calls to flip-undo-record are made).
As long as no new record are added to the tree, the undo module remembers which branch it was in before a sequence of calls to undo."))
(defgeneric redo (undo-tree &optional n) (:documentation "Move the current state n steps down the remembered branch of the undo tree and call flip-undo-record on each step. If the remembered branch is shorter than n, a no-more-undo condition is signaled and the current state is not moved (and no calls to flip-undo-record are made)."))
(define-condition no-more-undo (simple-error) () (:report (lambda (condition stream) (declare (ignore condition)) (format stream "No more undo"))) (:documentation "This condition is signaled whenever an attempt is made to call undo on a tree that is in its initial state."))
(defclass undo-tree () () (:documentation "Protocol class for all undo trees"))
(defclass standard-undo-tree (undo-tree) ((current-record :accessor current-record) (leaf-record :accessor leaf-record) (redo-path :initform '() :accessor redo-path) (children :initform '() :accessor children) (depth :initform 0 :reader depth)) (:documentation "Standard instantiable class for undo trees."))
(defmethod initialize-instance :after ((tree standard-undo-tree) &rest args) (declare (ignore args)) (setf (current-record tree) tree (leaf-record tree) tree))
(defclass undo-record () () (:documentation "The protocol class for all undo records."))
(defclass standard-undo-record (undo-record) ((parent :initform nil :accessor parent) (tree :initform nil :accessor undo-tree) (children :initform '() :accessor children) (depth :initform nil :accessor depth)) (:documentation "Standard instantiable class for undo records."))
(defmethod add-undo ((record standard-undo-record) (tree standard-undo-tree)) (push record (children (current-record tree))) (setf (undo-tree record) tree (parent record) (current-record tree) (depth record) (1+ (depth (current-record tree))) (current-record tree) record (leaf-record tree) record (redo-path tree) '()))
(defmethod undo ((tree standard-undo-tree) &optional (n 1)) (assert (<= n (depth (current-record tree))) () (make-condition 'no-more-undo)) (loop repeat n do (flip-undo-record (current-record tree)) (push (current-record tree) (redo-path tree)) (setf (current-record tree) (parent (current-record tree)))))
(defmethod redo ((tree standard-undo-tree) &optional (n 1)) (assert (<= n (- (depth (leaf-record tree)) (depth (current-record tree)))) () (make-condition 'no-more-undo)) (loop repeat n do (setf (current-record tree) (pop (redo-path tree))) (flip-undo-record (current-record tree)))) --- /project/mcclim/cvsroot/mcclim/Drei/syntax.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/syntax.lisp 2006/11/08 01:15:33 1.1 ;;; -*- Mode: Lisp; Package: DREI-SYNTAX -*-
;;; (c) copyright 2004-2005 by ;;; Robert Strandh (strandh@labri.fr) ;;; (c) copyright 2005 by ;;; Matthieu Villeneuve (matthieu.villeneuve@free.fr)
;;; 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.
(in-package :drei-syntax)
(defclass syntax (name-mixin) ((buffer :initarg :buffer :reader buffer) (command-table :initarg :command-table :initform nil :reader command-table) (%cursor-positions :accessor cursor-positions :initform nil)))
(defun syntaxp (object) "Return T if `object' is an instance of a syntax, NIL otherwise." (typep object 'syntax))
(define-condition no-such-operation (simple-error) () (:report (lambda (condition stream) (declare (ignore condition)) (format stream "Operation unavailable for this syntax"))) (:documentation "This condition is signaled whenever an attempt is made to execute an operation that is unavailable for the particular syntax" ))
(define-condition no-expression (simple-error) () (:report (lambda (condition stream) (declare (ignore condition)) (format stream "No expression at point"))) (:documentation "This condition is signaled whenever an attempt is made to execute a by-experssion motion command and no expression is available." ))
(defgeneric update-syntax (buffer syntax))
(defgeneric update-syntax-for-display (buffer syntax from to))
(defgeneric syntax-line-indentation (mark tab-width syntax) (:documentation "Return the correct indentation for the line containing the mark, according to the specified syntax."))
(defgeneric eval-defun (mark syntax))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Syntax command tables.
(defclass syntax-command-table (standard-command-table) () (:documentation "A syntax command table provides facilities for having frame-specific commands that do not show up when the syntax is used in other applications than the one it is supposed to. For example, the Return From Definition command should be available when Lisp syntax is used in Climacs (or another editor), but not anywhere else."))
(defgeneric additional-command-tables (editor command-table) (:method-combination append) (:documentation "Get a list of additional command tables that should be checked for commands in addition to those `command-table' inherits from. The idea is that methods are specialised to `editor', and that those methods may call the function again recursively with a new `editor' argument to provide arbitrary granularity for command-table-selection. For instance, some commands may be applicable in a situation where the editor is a pane or gadget in its own right, but not when it functions as an input-editor. In this case, a method could be defined for `application-frame' as the `editor' argument, that calls `additional-command-tables' again with whatever the "current" editor instance is.") (:method append (editor command-table) '()))
(defmethod command-table-inherit-from ((table syntax-command-table)) "Fetch extra command tables to inherit from (using `additional-command-tables') as well as the command tables `table' actually directly inherits from." (append (additional-command-tables *application-frame* table) (call-next-method)))
(defmacro define-syntax-command-table (name &rest args &key &allow-other-keys) "Define a syntax command table class with the provided name, as well as defining a CLIM command table of the same name. `Args' will be passed on to `make-command-table'. An :around method on `command-table-inherit-from' for the defined class will also be defined. This method will make sure that when an instance of the syntax command table is asked for its inherited command tables, it will return those of the defined CLIM command table, as well as those provided by methods on `additional-command-tables'. Command tables provided through `additional-command-tables' will take precence over those specified in the usual way with :inherit-from." `(progn (make-command-table ',name ,@args) (defclass ,name (syntax-command-table) ()) (defmethod command-table-inherit-from :around ((table ,name)) (append (call-next-method) '(,name) (command-table-inherit-from (find-command-table ',name))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Commenting
(defgeneric syntax-line-comment-string (syntax) (:documentation "string to use at the beginning of a line to indicate a line comment"))
(defgeneric line-comment-region (syntax mark1 mark2) (:documentation "inset a line comment string at the beginning of every line in the region"))
(defmethod line-comment-region (syntax mark1 mark2) (when (mark< mark2 mark1) (rotatef mark1 mark2)) (let ((mark (clone-mark mark1))) (unless (beginning-of-line-p mark) (end-of-line mark) (unless (end-of-buffer-p mark) (forward-object mark))) (loop while (mark< mark mark2) do (insert-sequence mark (syntax-line-comment-string syntax)) (end-of-line mark) (unless (end-of-buffer-p mark) (forward-object mark)))))
(defgeneric line-uncomment-region (syntax mark1 mark2) (:documentation "inset a line comment string at the beginning of every line in the region"))
(defmethod line-uncomment-region (syntax mark1 mark2) (when (mark< mark2 mark1) (rotatef mark1 mark2)) (let ((mark (clone-mark mark1))) (unless (beginning-of-line-p mark) (end-of-line mark) (unless (end-of-buffer-p mark)
[666 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/search-commands.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/search-commands.lisp 2006/11/08 01:15:33 1.1
[1120 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/rectangle.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/rectangle.lisp 2006/11/08 01:15:33 1.1
[1257 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2006/11/08 01:15:33 1.1
[1681 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/motion.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/motion.lisp 2006/11/08 01:15:33 1.1
[2188 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/motion-commands.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/motion-commands.lisp 2006/11/08 01:15:33 1.1
[2210 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/misc-commands.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/misc-commands.lisp 2006/11/08 01:15:33 1.1
[2295 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2006/11/08 01:15:33 1.1
[5304 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-swine.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-swine.lisp 2006/11/08 01:15:33 1.1
[6407 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-swank.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-swank.lisp 2006/11/08 01:15:33 1.1
[6513 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-commands.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-commands.lisp 2006/11/08 01:15:33 1.1
[6803 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/kill-ring.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/kill-ring.lisp 2006/11/08 01:15:33 1.1
[6978 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/kill-ring-test.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/kill-ring-test.lisp 2006/11/08 01:15:33 1.1
[7096 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2006/11/08 01:15:33 1.1
[7680 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/fundamental-syntax.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/fundamental-syntax.lisp 2006/11/08 01:15:33 1.1
[8031 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/editing.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/editing.lisp 2006/11/08 01:15:33 1.1
[8297 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/editing-commands.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/editing-commands.lisp 2006/11/08 01:15:33 1.1
[8331 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2006/11/08 01:15:33 1.1
[9041 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/drei.asd 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/drei.asd 2006/11/08 01:15:33 1.1
[9088 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2006/11/08 01:15:33 1.1
[9519 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2006/11/08 01:15:33 1.1
[10008 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/delegating-buffer.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/delegating-buffer.lisp 2006/11/08 01:15:33 1.1
[10080 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/core.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/core.lisp 2006/11/08 01:15:33 1.1
[10498 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/core-commands.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/core-commands.lisp 2006/11/08 01:15:33 1.1
[11224 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/buffer.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/buffer.lisp 2006/11/08 01:15:33 1.1
[11886 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/buffer-test.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/buffer-test.lisp 2006/11/08 01:15:33 1.1
[12948 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/basic-commands.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/basic-commands.lisp 2006/11/08 01:15:33 1.1
[13455 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/base.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/base.lisp 2006/11/08 01:15:33 1.1
[14262 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/base-test.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/base-test.lisp 2006/11/08 01:15:33 1.1
[15544 lines skipped] --- /project/mcclim/cvsroot/mcclim/Drei/abbrev.lisp 2006/11/08 01:15:33 NONE +++ /project/mcclim/cvsroot/mcclim/Drei/abbrev.lisp 2006/11/08 01:15:33 1.1
[15635 lines skipped]