Commit 791af4a7 authored by Troels Henriksen's avatar Troels Henriksen

Make Climacs use Drei. There are known problems (apart from the docs

now being outdated):

* Some syntaxes have not been updated.
* Group functionality has been disabled.
* It's a large change and Climacs has no test suite. Bugs probably
  still remain.

But it should work nicely most of the time. Otherwise, you'll get a
full refund.
parent 6b1c4c43
......@@ -1106,7 +1106,7 @@
(display-parse-tree (target-parse-tree state) syntax pane))))
(defmethod redisplay-pane-with-syntax ((pane climacs-pane) (syntax cl-syntax) current-p)
(defmethod redisplay-pane-with-syntax ((pane drei-pane) (syntax cl-syntax) current-p)
(with-slots (top bot) pane
(setf *cursor-positions* (make-array (1+ (number-of-lines-in-region top bot)))
*current-line* 0
......
;;; -*- Mode: Lisp; Package: CLIMACS-LISP-SYNTAX; -*-
;;; (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)
;;; (c) copyright 2006 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.
;;; Commands specific to the Lisp syntax for Climacs.
(in-package :drei-lisp-syntax)
(make-command-table 'climacs-lisp-table
:errorp nil)
(defmethod additional-command-tables append ((frame climacs-gui:climacs) (command-table lisp-table))
'(climacs-lisp-table))
(define-command (com-package :name t :command-table climacs-lisp-table) ()
(let ((package (package-at-mark *current-syntax* *current-point*)))
(esa:display-message (format nil "~A" (if (packagep package)
(package-name package)
package)))))
(define-command (com-set-base :name t :command-table climacs-lisp-table)
((base '(integer 2 36)))
"Set the base for the current buffer."
(setf (base *current-syntax*) base))
(define-command (com-set-package :name t :command-table climacs-lisp-table)
((package 'package))
"Set the package for the current buffer."
(setf (option-specified-package *current-syntax*) package))
(define-command (com-macroexpand-1 :name t :command-table climacs-lisp-table)
()
"Macroexpand-1 the expression at point.
The expanded expression will be displayed in a
\"*Macroexpansion*\"-buffer."
(let*((token (expression-at-mark *current-point* *current-syntax*)))
(if token
(macroexpand-token *current-syntax* token)
(esa:display-message "Nothing to expand at point."))))
(define-command (com-macroexpand-all :name t :command-table climacs-lisp-table)
()
"Completely macroexpand the expression at point.
The expanded expression will be displayed in a
\"*Macroexpansion*\"-buffer."
(let ((token (expression-at-mark *current-point* *current-syntax*)))
(if token
(macroexpand-token *current-syntax* token t)
(esa:display-message "Nothing to expand at point."))))
(define-command (com-compile-and-load-file :name t :command-table climacs-lisp-table)
()
"Compile and load the current file.
Compiler notes will be displayed in a seperate buffer."
(compile-file-interactively *current-buffer* t))
(define-command (com-compile-file :name t :command-table climacs-lisp-table)
()
"Compile the file open in the current buffer.
This command does not load the file after it has been compiled."
(compile-file-interactively *current-buffer* nil))
(define-command (com-goto-location :name t :command-table climacs-lisp-table)
((note 'compiler-note))
"Move point to the part of a given file that caused the
compiler note.
If the file is not already open, a new buffer will be opened with
that file."
(goto-location (location note)))
(define-presentation-to-command-translator compiler-note-to-goto-location-translator
(compiler-note com-goto-location climacs-lisp-table)
(presentation)
(list (presentation-object presentation)))
(define-command (com-goto-xref :name t :command-table climacs-lisp-table)
((xref 'xref))
"Go to the referenced location of a code cross-reference."
(goto-location xref))
(define-presentation-to-command-translator xref-to-goto-location-translator
(xref com-goto-xref climacs-lisp-table)
(presentation)
(list (presentation-object presentation)))
(define-command (com-edit-this-definition :command-table climacs-lisp-table)
()
"Edit definition of the symbol at point.
If there is no symbol at point, this is a no-op."
(let* ((token (this-form *current-point* *current-syntax*))
(this-symbol (token-to-object *current-syntax* token)))
(when (and this-symbol (symbolp this-symbol))
(edit-definition this-symbol))))
(define-command (com-return-from-definition :name t :command-table climacs-lisp-table)
()
"Return point to where it was before the previous Edit
Definition command was issued."
(pop-find-definition-stack))
(esa:set-key 'com-eval-defun
'climacs-lisp-table
'((#\x :control :meta)))
(esa:set-key 'com-macroexpand-1
'climacs-lisp-table
'((#\c :control) (#\Newline)))
(esa:set-key 'com-macroexpand-all
'climacs-lisp-table
'((#\c :control) (#\m :control)))
(esa:set-key 'com-compile-and-load-file
'climacs-lisp-table
'((#\c :control) (#\k :control)))
(esa:set-key 'com-compile-file
'climacs-lisp-table
'((#\c :control) (#\k :meta)))
(esa:set-key 'com-edit-this-definition
'climacs-lisp-table
'((#\. :meta)))
(esa:set-key 'com-return-from-definition
'climacs-lisp-table
'((#\, :meta)))
This diff is collapsed.
......@@ -29,105 +29,31 @@
(defparameter *climacs-directory* (directory-namestring *load-truename*))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun find-swank-package ()
(find-package :swank))
(defun find-swank-system ()
(handler-case (asdf:find-system :swank)
(asdf:missing-component ())))
(defun find-swank ()
(or (find-swank-package)
(find-swank-system))))
(defsystem :climacs
:depends-on (:mcclim :flexichain :esa #.(if (find-swank-system) :swank (values)))
:depends-on (:mcclim :flexichain)
:components
((:module "cl-automaton"
:components ((:file "automaton-package")
(:file "eqv-hash" :depends-on ("automaton-package"))
(:file "state-and-transition" :depends-on ("eqv-hash"))
(:file "automaton" :depends-on ("state-and-transition" "eqv-hash"))
(:file "regexp" :depends-on ("automaton"))))
(:module "Persistent"
:components ((:file "binseq-package")
(:file "binseq" :depends-on ("binseq-package"))
(:file "obinseq" :depends-on ("binseq-package" "binseq"))
(:file "binseq2" :depends-on ("binseq-package" "obinseq" "binseq"))))
(:file "packages" :depends-on ("cl-automaton" "Persistent"))
(:file "utils" :depends-on ("packages"))
(:file "buffer" :depends-on ("packages"))
(:file "motion" :depends-on ("packages" "buffer" "syntax"))
(:file "editing" :depends-on ("packages" "buffer" "syntax" "motion" "kill-ring"))
(:file "persistent-buffer"
:pathname #p"Persistent/persistent-buffer.lisp"
:depends-on ("packages" "buffer" "Persistent"))
(:file "base" :depends-on ("packages" "utils" "buffer" "persistent-buffer" "kill-ring"))
(:file "abbrev" :depends-on ("packages" "buffer" "base"))
(:file "syntax" :depends-on ("packages" "utils" "buffer" "base"))
(:file "text-syntax" :depends-on ("packages" "base" "buffer" "syntax" "motion"))
(:file "delegating-buffer" :depends-on ("packages" "buffer"))
(:file "kill-ring" :depends-on ("packages"))
(:file "undo" :depends-on ("packages"))
(:file "persistent-undo"
:pathname #p"Persistent/persistent-undo.lisp"
:depends-on ("packages" "buffer" "persistent-buffer" "undo"))
(:file "pane" :depends-on ("packages" "utils" "syntax" "buffer" "base"
"persistent-undo" "persistent-buffer" "abbrev"
"delegating-buffer" "undo"))
(:file "fundamental-syntax" :depends-on ("packages" "syntax" "buffer" "pane"
"base"))
(:file "cl-syntax" :depends-on ("packages" "buffer" "syntax" "base" "pane"))
(:file "html-syntax" :depends-on ("packages" "buffer" "syntax" "base" "pane"))
(:file "prolog-syntax" :depends-on ("packages" "base" "syntax" "pane" "buffer"))
((:file "packages")
(:file "text-syntax" :depends-on ("packages"))
(:file "cl-syntax" :depends-on ("packages"))
(:file "html-syntax" :depends-on ("packages"))
(:file "prolog-syntax" :depends-on ("packages"))
(:file "prolog2paiprolog" :depends-on ("prolog-syntax"))
(:file "ttcn3-syntax" :depends-on ("packages" "buffer" "syntax" "base"
"pane"))
(:file "lisp-syntax" :depends-on ("packages" "utils" "syntax" "buffer" "base" "pane"
"window-commands" "gui" "groups"))
(:file "lisp-syntax-swine" :depends-on ("lisp-syntax"))
(:file "lisp-syntax-commands" :depends-on ("lisp-syntax-swine" "motion-commands"
"editing-commands" "misc-commands"))
#.(if (find-swank)
'(:file "lisp-syntax-swank" :depends-on ("lisp-syntax"))
(values))
(:file "gui" :depends-on ("packages" "utils" "syntax" "base" "buffer" "undo" "pane"
"kill-ring" "text-syntax"
"abbrev" "editing" "motion"))
(:file "io" :depends-on ("packages" "gui"))
(:file "ttcn3-syntax" :depends-on ("packages"))
(:file "climacs-lisp-syntax" :depends-on ("core" #+nil groups))
(:file "climacs-lisp-syntax-commands" :depends-on ("climacs-lisp-syntax" "misc-commands"))
(:file "gui" :depends-on ("packages" "text-syntax"))
(:file "core" :depends-on ("gui"))
(:file "rectangle" :depends-on ("core"))
(:file "groups" :depends-on ("core"))
(:file "io" :depends-on ("packages" "gui"))
#+nil (:file "groups" :depends-on ("core"))
(:file "climacs" :depends-on ("gui" "core"))
;; (:file "buffer-commands" :depends-on ("gui"))
(:file "developer-commands" :depends-on ("gui" "lisp-syntax" "core"))
(:file "motion-commands" :depends-on ("gui" "core"))
(:file "editing-commands" :depends-on ("gui" "core"))
(:file "developer-commands" :depends-on ("core"))
(:file "file-commands" :depends-on ("gui" "core"))
(:file "misc-commands" :depends-on ("gui" "core" "rectangle" "groups"))
(:file "search-commands" :depends-on ("gui" "core"))
(:file "misc-commands" :depends-on ("gui" "core" #+nil "groups"))
(:file "search-commands" :depends-on ("gui" "core" #+nil "groups"))
(:file "window-commands" :depends-on ("gui" "core"))
(:file "unicode-commands" :depends-on ("gui" "core"))
(:file "slidemacs" :depends-on ("packages" "buffer" "syntax" "base" "pane" ))
(:file "slidemacs-gui" :depends-on ("packages" "slidemacs" "pane" "buffer" "syntax" "gui"))))
(defsystem :climacs.tests
:depends-on (:climacs)
:components
((:file "rt" :pathname #p"testing/rt.lisp")
(:file "buffer-test" :depends-on ("rt"))
(:file "base-test" :depends-on ("rt" "buffer-test"))
(:file "kill-ring-test" :depends-on ("buffer-test"))
(:module
"cl-automaton"
:depends-on ("rt")
:components
((:file "automaton-test-package")
(:file "eqv-hash-test" :depends-on ("automaton-test-package"))
(:file "state-and-transition-test" :depends-on ("automaton-test-package"))
(:file "automaton-test" :depends-on ("automaton-test-package"))
(:file "regexp-test" :depends-on ("automaton-test-package"))))))
(:file "slidemacs" :depends-on ("packages" ))
(:file "slidemacs-gui" :depends-on ("packages" "gui" "slidemacs"))))
#+asdf
(defmethod asdf:perform :around ((o asdf:compile-op)
......
......@@ -46,8 +46,8 @@
;; SBCL doesn't inherit dynamic bindings when starting new
;; processes, so start a new processes and THEN setup the colors.
(flet ((run ()
(let ((*bg-color* +black+)
(*fg-color* +gray+)
(let ((*background-color* +black+)
(*foreground-color* +gray+)
(*info-bg-color* +darkslategray+)
(*info-fg-color* +gray+)
(*mini-bg-color* +black+)
......
This diff is collapsed.
......@@ -43,7 +43,7 @@
(define-gesture-name :select-other #+mcclim :pointer-button-press #-mcclim :pointer-button (:left :meta) :unique nil)
(define-presentation-translator lisp-string-to-string
(climacs-lisp-syntax::lisp-string string development-table
(drei-lisp-syntax::lisp-string string development-table
:gesture :select-other
:tester-definitive t
:menu nil
......
......@@ -99,10 +99,10 @@
name))))))))
(define-presentation-method present (object (type pathname)
stream (view climacs-textual-view) &key)
stream (view drei-textual-view) &key)
(princ (namestring object) stream))
(define-presentation-method accept ((type pathname) stream (view climacs-textual-view)
(define-presentation-method accept ((type pathname) stream (view drei-textual-view)
&key (default nil defaultp) (default-type type))
(multiple-value-bind (pathname success string)
(complete-input stream
......
......@@ -113,7 +113,7 @@ have a corresponding buffer, open a buffer for that pathname."))
NIL. If a pathname is returned, it is assumed to be safe to find
the file with that name."
(typecase element
(climacs-buffer
(drei-buffer
(find element (buffers *application-frame*)))
((or pathname string)
(or (find-buffer-with-pathname (pathname element))
......@@ -125,7 +125,7 @@ the file with that name."
(defun display-group-element (element stream)
(let ((norm-element (normalise-group-element element)))
(typecase norm-element
(climacs-buffer
(drei-buffer
(present norm-element 'buffer stream))
((or pathname string)
(present norm-element 'pathname stream)))))
......@@ -133,7 +133,7 @@ the file with that name."
;; Singular group elements.
(defmethod group-buffers ((group group-element))
(let ((element (element group)))
(cond ((and (typep element 'climacs-buffer)
(cond ((and (typep element 'drei-buffer)
(find element (buffers *application-frame*)))
(list element))
((or (pathnamep element)
......@@ -144,7 +144,7 @@ the file with that name."
(defmethod ensure-group-buffers ((group group-element))
(typecase (element group)
(climacs-buffer
(drei-buffer
(unless (find (element group) (buffers *application-frame*))
(ensure-open-file (pathname (filepath (element group))))))
(pathname
......
This diff is collapsed.
......@@ -697,20 +697,21 @@
(defun handle-whitespace (pane buffer start end)
(let ((space-width (space-width pane))
(tab-width (tab-width pane)))
(loop while (< start end)
do (ecase (buffer-object buffer start)
(#\Newline (terpri pane)
(setf (aref *cursor-positions* (incf *current-line*))
(multiple-value-bind (x y) (stream-cursor-position pane)
(declare (ignore x))
y)))
(#\Space (stream-increment-cursor-position
pane space-width 0))
(#\Tab (let ((x (stream-cursor-position pane)))
(stream-increment-cursor-position
pane (- tab-width (mod x tab-width)) 0))))
(incf start))))
(tab-width (tab-width pane)))
(with-sheet-medium (medium pane)
(with-accessors ((cursor-positions cursor-positions)) (syntax buffer)
(loop while (< start end)
do (case (buffer-object buffer start)
(#\Newline (record-line-vertical-offset pane (syntax buffer) (incf *current-line*))
(terpri pane)
(stream-increment-cursor-position
pane (first (aref cursor-positions 0)) 0))
((#\Page #\Return #\Space) (stream-increment-cursor-position
pane space-width 0))
(#\Tab (let ((x (stream-cursor-position pane)))
(stream-increment-cursor-position
pane (- tab-width (mod x tab-width)) 0))))
(incf start))))))
(defmethod display-parse-tree :around ((entity html-parse-tree) syntax pane)
(with-slots (top bot) pane
......@@ -762,42 +763,42 @@
(display-parse-stack (parse-stack-symbol top) top syntax pane)
(display-parse-tree (target-parse-tree state) syntax pane))))
(defmethod redisplay-pane-with-syntax ((pane climacs-pane) (syntax html-syntax) current-p)
(defmethod display-drei-contents ((pane clim-stream-pane) (drei drei) (syntax html-syntax))
(with-slots (top bot) pane
(setf *cursor-positions* (make-array (1+ (number-of-lines-in-region top bot)))
*current-line* 0
(aref *cursor-positions* 0) (stream-cursor-position pane))
(with-slots (lexer) syntax
(let ((average-token-size (max (float (/ (size (buffer pane)) (nb-lexemes lexer)))
1.0)))
;; find the last token before bot
(let ((end-token-index (max (floor (/ (offset bot) average-token-size)) 1)))
;; go back to a token before bot
(loop until (mark<= (end-offset (lexeme lexer (1- end-token-index))) bot)
do (decf end-token-index))
;; go forward to the last token before bot
(loop until (or (= end-token-index (nb-lexemes lexer))
(mark> (start-offset (lexeme lexer end-token-index)) bot))
do (incf end-token-index))
(let ((start-token-index end-token-index))
;; go back to the first token after top, or until the previous token
;; contains a valid parser state
(loop until (or (mark<= (end-offset (lexeme lexer (1- start-token-index))) top)
(not (parse-state-empty-p
(slot-value (lexeme lexer (1- start-token-index)) 'state))))
do (decf start-token-index))
(let ((*white-space-start* (offset top)))
;; display the parse tree if any
(unless (parse-state-empty-p (slot-value (lexeme lexer (1- start-token-index)) 'state))
(display-parse-state (slot-value (lexeme lexer (1- start-token-index)) 'state)
syntax
pane))
;; display the lexemes
(with-drawing-options (pane :ink +red+)
(loop while (< start-token-index end-token-index)
do (let ((token (lexeme lexer start-token-index)))
(display-parse-tree token syntax pane))
(incf start-token-index))))))))
(when (region-visible-p pane) (display-region pane syntax))
(display-cursor pane syntax current-p)))
(with-accessors ((cursor-positions cursor-positions)) syntax
(setf cursor-positions (make-array (1+ (number-of-lines-in-region top bot))
:initial-element nil)
*current-line* 0
(aref cursor-positions 0) (multiple-value-list
(stream-cursor-position pane))))
(setf *white-space-start* (offset top))
(with-slots (lexer) syntax
(let ((average-token-size (max (float (/ (size (buffer pane)) (nb-lexemes lexer)))
1.0)))
;; find the last token before bot
(let ((end-token-index (max (floor (/ (offset bot) average-token-size)) 1)))
;; go back to a token before bot
(loop until (mark<= (end-offset (lexeme lexer (1- end-token-index))) bot)
do (decf end-token-index))
;; go forward to the last token before bot
(loop until (or (= end-token-index (nb-lexemes lexer))
(mark> (start-offset (lexeme lexer end-token-index)) bot))
do (incf end-token-index))
(let ((start-token-index end-token-index))
;; go back to the first token after top, or until the previous token
;; contains a valid parser state
(loop until (or (mark<= (end-offset (lexeme lexer (1- start-token-index))) top)
(not (parse-state-empty-p
(slot-value (lexeme lexer (1- start-token-index)) 'state))))
do (decf start-token-index))
;; display the parse tree if any
(unless (parse-state-empty-p (slot-value (lexeme lexer (1- start-token-index)) 'state))
(display-parse-state (slot-value (lexeme lexer (1- start-token-index)) 'state)
syntax
pane))
;; display the lexemes
(with-drawing-options (pane :ink +red+)
(loop while (< start-token-index end-token-index)
do (let ((token (lexeme lexer start-token-index)))
(display-parse-tree token syntax pane))
(incf start-token-index)))))))))
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
......@@ -53,13 +53,13 @@
buffer))
(defun buffer->paiprolog (buffer)
(let ((lexemes (climacs-syntax::lexemes (lexer (syntax buffer))))
(let ((lexemes (drei-syntax::lexemes (lexer (syntax buffer))))
(expressions '()))
(dotimes (i (flexichain:nb-elements lexemes) (nreverse expressions))
(let ((lexeme (flexichain:element* lexemes i)))
(when (typep lexeme 'end-lexeme)
(with-hash-table-iterator
(next-entry (climacs-syntax::parse-trees (slot-value lexeme 'state)))
(next-entry (drei-syntax::parse-trees (slot-value lexeme 'state)))
(loop
(multiple-value-bind (more from-state items)
(next-entry)
......
This diff is collapsed.
......@@ -240,7 +240,7 @@
(pushnew (cons from to)
edges :test #'equal))))))
(possibly-capturing-and-flipping-output-twice
pane (typep pane 'climacs-pane)
pane (typep pane 'drei-pane)
(format-graph-from-roots
roots
(lambda (node stream)
......@@ -437,7 +437,7 @@
(defparameter *slidemacs-gui-ink* +black+)
(defmethod redisplay-pane-with-syntax ((pane climacs-pane) (syntax slidemacs-gui-syntax) current-p)
(defmethod redisplay-pane-with-syntax ((pane drei-pane) (syntax slidemacs-gui-syntax) current-p)
(with-drawing-options (pane :ink *slidemacs-gui-ink*)
(with-slots (top bot point) pane
(with-slots (lexer) syntax
......@@ -530,11 +530,11 @@
(full-redisplay (climacs-gui::current-window)))
(define-command (com-first-talking-point :name t :command-table slidemacs-table) ()
(climacs-commands::com-beginning-of-buffer)
(drei-commands::com-beginning-of-buffer)
(com-next-talking-point))
(define-command (com-last-talking-point :name t :command-table slidemacs-table) ()
(climacs-commands::com-end-of-buffer)
(drei-commands::com-end-of-buffer)
(com-previous-talking-point))
(define-command (com-flip-slidemacs-syntax :name t :command-table slidemacs-table) ()
......@@ -572,7 +572,7 @@
(define-command (com-postscript-print-presentation :name t :command-table slidemacs-table) ()
(let ((pane (climacs-gui::current-window)))
(if (not (and (typep pane 'climacs-pane)
(if (not (and (typep pane 'drei-pane)
(typep (syntax (buffer pane)) 'slidemacs-gui-syntax)))
(beep)
(let ((file (accept 'pathname :prompt "Output to")))
......
......@@ -21,8 +21,8 @@
;;; Boston, MA 02111-1307 USA.
(defpackage :climacs-slidemacs-editor
(:use :clim-lisp :clim :clim-extensions :climacs-buffer :climacs-base
:climacs-syntax :flexichain :climacs-pane :climacs-fundamental-syntax)
(:use :clim-lisp :clim :clim-extensions :drei-buffer :drei-base
:drei-syntax :flexichain :drei :drei-fundamental-syntax)
(:export))
(in-package :climacs-slidemacs-editor)
......@@ -387,23 +387,21 @@
(defun handle-whitespace (pane buffer start end)
(let ((space-width (space-width pane))
(tab-width (tab-width pane)))
(loop while (and (< start end)
(whitespacep (syntax buffer)
(buffer-object buffer start)))
do (ecase (buffer-object buffer start)
(#\Newline (terpri pane)
(setf (aref *cursor-positions* (incf *current-line*))
(multiple-value-bind (x y) (stream-cursor-position pane)
(declare (ignore x))
y)))
(#\Space (stream-increment-cursor-position
pane space-width 0))
(#\Tab (let ((x (stream-cursor-position pane)))
(stream-increment-cursor-position
pane (- tab-width (mod x tab-width)) 0)))
(#\Page nil))
(incf start))))
(tab-width (tab-width pane)))
(with-sheet-medium (medium pane)
(with-accessors ((cursor-positions cursor-positions)) (syntax buffer)
(loop while (< start end)
do (case (buffer-object buffer start)
(#\Newline (record-line-vertical-offset pane (syntax buffer) (incf *current-line*))
(terpri pane)
(stream-increment-cursor-position
pane (first (aref cursor-positions 0)) 0))
((#\Page #\Return #\Space) (stream-increment-cursor-position
pane space-width 0))
(#\Tab (let ((x (stream-cursor-position pane)))
(stream-increment-cursor-position
pane (- tab-width (mod x tab-width)) 0))))
(incf start))))))
(defvar *handle-whitespace* t)
......@@ -419,11 +417,13 @@
(call-next-method)))
(call-next-method)))
(defmethod redisplay-pane-with-syntax ((pane climacs-pane) (syntax slidemacs-editor-syntax) current-p)
(defmethod display-drei-contents ((pane drei-pane) (drei drei) (syntax slidemacs-editor-syntax))
(with-slots (top bot) pane
(setf *cursor-positions* (make-array (1+ (number-of-lines-in-region top bot)))
*current-line* 0
(aref *cursor-positions* 0) (stream-cursor-position pane))
(with-accessors ((cursor-positions cursor-positions)) syntax
(setf cursor-positions (make-array (1+ (number-of-lines-in-region top bot))
:initial-element nil)
*current-line* 0
(aref cursor-positions 0) (multiple-value-list (stream-cursor-position pane))))
(with-slots (lexer) syntax
(let ((average-token-size (max (float (/ (size (buffer pane)) (nb-lexemes lexer)))
1.0)))
......@@ -442,7 +442,7 @@
(loop until (or (mark<= (end-offset (lexeme lexer (1- start-token-index))) top)
(not (parse-state-empty-p
(slot-value (lexeme lexer (1- start-token-index)) 'state))))
do (decf start-token-index))
do (decf start-token-index))
(let ((*white-space-start* (offset top)))
;; display the parse tree if any
(unless (parse-state-empty-p (slot-value (lexeme lexer (1- start-token-index)) 'state))
......@@ -454,6 +454,4 @@
(loop while (< start-token-index end-token-index)
do (let ((token (lexeme lexer start-token-index)))
(display-parse-tree token syntax pane))
(incf start-token-index))))))))
(when (region-visible-p pane) (display-region pane syntax))
(display-cursor pane syntax current-p)))
(incf start-token-index))))))))))
......@@ -52,7 +52,7 @@
;;; Right stickies at non whitespace characters preceeded by space and punctuation.
;;;
(in-package :climacs-syntax) ;;; Put this in a separate package once it works
(in-package :drei-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'."
......@@ -65,7 +65,7 @@
(setf low-position (floor (+ low-position 1 high-position) 2)))
finally (return low-position)))
(define-syntax text-syntax (climacs-fundamental-syntax:fundamental-syntax)
(define-syntax text-syntax (drei-fundamental-syntax:fundamental-syntax)
((paragraphs :initform (make-instance 'standard-flexichain))
(sentence-beginnings :initform (make-instance 'standard-flexichain))
(sentence-endings :initform (make-instance 'standard-flexichain)))
......@@ -197,7 +197,7 @@
(loop with indentation = 0
with mark2 = (clone-mark mark)
until (beginning-of-buffer-p mark2)
do (climacs-motion:backward-line mark2 syntax)
do (drei-motion:backward-line mark2 syntax)
(setf indentation (line-indentation mark2 tab-width))
while (empty-line-p mark2)
finally (return indentation)))
......@@ -21,8 +21,8 @@
;;; Boston, MA 02111-1307 USA.
(defpackage :climacs-ttcn3-syntax
(:use :clim-lisp :clim :clim-extensions :climacs-buffer :climacs-base
:climacs-syntax :flexichain :climacs-pane :climacs-fundamental-syntax)
(:use :clim-lisp :clim :clim-extensions :drei-buffer :drei-base
:drei-syntax :flexichain :drei :drei-fundamental-syntax)
(:export))
(in-package :climacs-ttcn3-syntax)
......@@ -417,7 +417,7 @@
(when (and (end-offset entity) (mark> (end-offset entity) top))
(call-next-method))))
(defmethod redisplay-pane-with-syntax ((pane climacs-pane) (syntax ttcn3-syntax) current-p)
(defmethod redisplay-pane-with-syntax ((pane drei-pane) (syntax ttcn3-syntax) current-p)
(with-slots (top bot) pane
(setf *cursor-positions* (make-array (1+ (number-of-lines-in-region top bot)))
*current-line* 0
......
......@@ -96,8 +96,8 @@
(eq window (current-window)))
(setf (offset (mark window))
(click-to-offset window x y))
(com-exchange-point-and-mark)
(com-copy-region)))
(drei-commands::com-exchange-point-and-mark)
(drei-commands::com-copy-region)))
(define-presentation-to-command-translator blank-area-to-mouse-save
(blank-area com-mouse-save window-table :echo nil :gesture :select-other)
......@@ -112,7 +112,7 @@
(other-window window)
(setf (offset (point window))
(click-to-offset window x y))
(com-yank)))
(drei-commands::com-yank)))
(define-presentation-to-command-translator blank-area-to-yank-here
(blank-area com-yank-here window-table :echo nil :gesture :middle-button)
......
</