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 @@ ...@@ -1106,7 +1106,7 @@
(display-parse-tree (target-parse-tree state) syntax pane)))) (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 (with-slots (top bot) pane
(setf *cursor-positions* (make-array (1+ (number-of-lines-in-region top bot))) (setf *cursor-positions* (make-array (1+ (number-of-lines-in-region top bot)))
*current-line* 0 *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 @@ ...@@ -29,105 +29,31 @@
(defparameter *climacs-directory* (directory-namestring *load-truename*)) (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 (defsystem :climacs
:depends-on (:mcclim :flexichain :esa #.(if (find-swank-system) :swank (values))) :depends-on (:mcclim :flexichain)
:components :components
((:module "cl-automaton" ((:file "packages")
:components ((:file "automaton-package") (:file "text-syntax" :depends-on ("packages"))
(:file "eqv-hash" :depends-on ("automaton-package")) (:file "cl-syntax" :depends-on ("packages"))
(:file "state-and-transition" :depends-on ("eqv-hash")) (:file "html-syntax" :depends-on ("packages"))
(:file "automaton" :depends-on ("state-and-transition" "eqv-hash")) (:file "prolog-syntax" :depends-on ("packages"))
(: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 "prolog2paiprolog" :depends-on ("prolog-syntax")) (:file "prolog2paiprolog" :depends-on ("prolog-syntax"))
(:file "ttcn3-syntax" :depends-on ("packages" "buffer" "syntax" "base" (:file "ttcn3-syntax" :depends-on ("packages"))
"pane")) (:file "climacs-lisp-syntax" :depends-on ("core" #+nil groups))
(:file "lisp-syntax" :depends-on ("packages" "utils" "syntax" "buffer" "base" "pane" (:file "climacs-lisp-syntax-commands" :depends-on ("climacs-lisp-syntax" "misc-commands"))
"window-commands" "gui" "groups")) (:file "gui" :depends-on ("packages" "text-syntax"))
(: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 "core" :depends-on ("gui")) (:file "core" :depends-on ("gui"))
(:file "rectangle" :depends-on ("core")) (:file "io" :depends-on ("packages" "gui"))
(:file "groups" :depends-on ("core")) #+nil (:file "groups" :depends-on ("core"))
(:file "climacs" :depends-on ("gui" "core")) (:file "climacs" :depends-on ("gui" "core"))
;; (:file "buffer-commands" :depends-on ("gui")) (:file "developer-commands" :depends-on ("core"))
(:file "developer-commands" :depends-on ("gui" "lisp-syntax" "core"))
(:file "motion-commands" :depends-on ("gui" "core"))
(:file "editing-commands" :depends-on ("gui" "core"))
(:file "file-commands" :depends-on ("gui" "core")) (:file "file-commands" :depends-on ("gui" "core"))
(:file "misc-commands" :depends-on ("gui" "core" "rectangle" "groups")) (:file "misc-commands" :depends-on ("gui" "core" #+nil "groups"))
(:file "search-commands" :depends-on ("gui" "core")) (:file "search-commands" :depends-on ("gui" "core" #+nil "groups"))
(:file "window-commands" :depends-on ("gui" "core")) (:file "window-commands" :depends-on ("gui" "core"))
(:file "unicode-commands" :depends-on ("gui" "core")) (:file "slidemacs" :depends-on ("packages" ))
(:file "slidemacs" :depends-on ("packages" "buffer" "syntax" "base" "pane" )) (:file "slidemacs-gui" :depends-on ("packages" "gui" "slidemacs"))))
(: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"))))))
#+asdf #+asdf
(defmethod asdf:perform :around ((o asdf:compile-op) (defmethod asdf:perform :around ((o asdf:compile-op)
......
...@@ -46,8 +46,8 @@ ...@@ -46,8 +46,8 @@
;; SBCL doesn't inherit dynamic bindings when starting new ;; SBCL doesn't inherit dynamic bindings when starting new
;; processes, so start a new processes and THEN setup the colors. ;; processes, so start a new processes and THEN setup the colors.
(flet ((run () (flet ((run ()
(let ((*bg-color* +black+) (let ((*background-color* +black+)
(*fg-color* +gray+) (*foreground-color* +gray+)
(*info-bg-color* +darkslategray+) (*info-bg-color* +darkslategray+)
(*info-fg-color* +gray+) (*info-fg-color* +gray+)
(*mini-bg-color* +black+) (*mini-bg-color* +black+)
......
This diff is collapsed.
...@@ -43,7 +43,7 @@ ...@@ -43,7 +43,7 @@
(define-gesture-name :select-other #+mcclim :pointer-button-press #-mcclim :pointer-button (:left :meta) :unique nil) (define-gesture-name :select-other #+mcclim :pointer-button-press #-mcclim :pointer-button (:left :meta) :unique nil)
(define-presentation-translator lisp-string-to-string (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 :gesture :select-other
:tester-definitive t :tester-definitive t
:menu nil :menu nil
......
...@@ -99,10 +99,10 @@ ...@@ -99,10 +99,10 @@
name)))))))) name))))))))
(define-presentation-method present (object (type pathname) (define-presentation-method present (object (type pathname)
stream (view climacs-textual-view) &key) stream (view drei-textual-view) &key)
(princ (namestring object) stream)) (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)) &key (default nil defaultp) (default-type type))
(multiple-value-bind (pathname success string) (multiple-value-bind (pathname success string)
(complete-input stream (complete-input stream
......
...@@ -113,7 +113,7 @@ have a corresponding buffer, open a buffer for that pathname.")) ...@@ -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 NIL. If a pathname is returned, it is assumed to be safe to find
the file with that name." the file with that name."
(typecase element (typecase element
(climacs-buffer (drei-buffer
(find element (buffers *application-frame*))) (find element (buffers *application-frame*)))
((or pathname string) ((or pathname string)
(or (find-buffer-with-pathname (pathname element)) (or (find-buffer-with-pathname (pathname element))
...@@ -125,7 +125,7 @@ the file with that name." ...@@ -125,7 +125,7 @@ the file with that name."
(defun display-group-element (element stream) (defun display-group-element (element stream)
(let ((norm-element (normalise-group-element element))) (let ((norm-element (normalise-group-element element)))
(typecase norm-element (typecase norm-element
(climacs-buffer (drei-buffer
(present norm-element 'buffer stream)) (present norm-element 'buffer stream))
((or pathname string) ((or pathname string)
(present norm-element 'pathname stream))))) (present norm-element 'pathname stream)))))
...@@ -133,7 +133,7 @@ the file with that name." ...@@ -133,7 +133,7 @@ the file with that name."
;; Singular group elements. ;; Singular group elements.
(defmethod group-buffers ((group group-element)) (defmethod group-buffers ((group group-element))
(let ((element (element group))) (let ((element (element group)))
(cond ((and (typep element 'climacs-buffer) (cond ((and (typep element 'drei-buffer)
(find element (buffers *application-frame*))) (find element (buffers *application-frame*)))
(list element)) (list element))
((or (pathnamep element) ((or (pathnamep element)
...@@ -144,7 +144,7 @@ the file with that name." ...@@ -144,7 +144,7 @@ the file with that name."
(defmethod ensure-group-buffers ((group group-element)) (defmethod ensure-group-buffers ((group group-element))
(typecase (element group) (typecase (element group)
(climacs-buffer (drei-buffer
(unless (find (element group) (buffers *application-frame*)) (unless (find (element group) (buffers *application-frame*))
(ensure-open-file (pathname (filepath (element group)))))) (ensure-open-file (pathname (filepath (element group))))))
(pathname (pathname
......
This diff is collapsed.
...@@ -697,20 +697,21 @@ ...@@ -697,20 +697,21 @@
(defun handle-whitespace (pane buffer start end) (defun handle-whitespace (pane buffer start end)
(let ((space-width (space-width pane)) (let ((space-width (space-width pane))
(tab-width (tab-width pane))) (tab-width (tab-width pane)))
(loop while (< start end) (with-sheet-medium (medium pane)
do (ecase (buffer-object buffer start) (with-accessors ((cursor-positions cursor-positions)) (syntax buffer)
(#\Newline (terpri pane) (loop while (< start end)
(setf (aref *cursor-positions* (incf *current-line*)) do (case (buffer-object buffer start)
(multiple-value-bind (x y) (stream-cursor-position pane) (#\Newline (record-line-vertical-offset pane (syntax buffer) (incf *current-line*))
(declare (ignore x)) (terpri pane)
y))) (stream-increment-cursor-position
(#\Space (stream-increment-cursor-position pane (first (aref cursor-positions 0)) 0))
pane space-width 0)) ((#\Page #\Return #\Space) (stream-increment-cursor-position
(#\Tab (let ((x (stream-cursor-position pane))) pane space-width 0))
(stream-increment-cursor-position (#\Tab (let ((x (stream-cursor-position pane)))
pane (- tab-width (mod x tab-width)) 0)))) (stream-increment-cursor-position
(incf start)))) pane (- tab-width (mod x tab-width)) 0))))
(incf start))))))
(defmethod display-parse-tree :around ((entity html-parse-tree) syntax pane) (defmethod display-parse-tree :around ((entity html-parse-tree) syntax pane)
(with-slots (top bot) pane (with-slots (top bot) pane
...@@ -762,42 +763,42 @@ ...@@ -762,42 +763,42 @@
(display-parse-stack (parse-stack-symbol top) top syntax pane) (display-parse-stack (parse-stack-symbol top) top syntax pane)
(display-parse-tree (target-parse-tree state) 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 (with-slots (top bot) pane
(setf *cursor-positions* (make-array (1+ (number-of-lines-in-region top bot))) (with-accessors ((cursor-positions cursor-positions)) syntax
*current-line* 0 (setf cursor-positions (make-array (1+ (number-of-lines-in-region top bot))
(aref *cursor-positions* 0) (stream-cursor-position pane)) :initial-element nil)
(with-slots (lexer) syntax *current-line* 0
(let ((average-token-size (max (float (/ (size (buffer pane)) (nb-lexemes lexer))) (aref cursor-positions 0) (multiple-value-list
1.0))) (stream-cursor-position pane))))
;; find the last token before bot (setf *white-space-start* (offset top))
(let ((end-token-index (max (floor (/ (offset bot) average-token-size)) 1))) (with-slots (lexer) syntax
;; go back to a token before bot (let ((average-token-size (max (float (/ (size (buffer pane)) (nb-lexemes lexer)))
(loop until (mark<= (end-offset (lexeme lexer (1- end-token-index))) bot) 1.0)))
do (decf end-token-index)) ;; find the last token before bot
;; go forward to the last token before bot (let ((end-token-index (max (floor (/ (offset bot) average-token-size)) 1)))
(loop until (or (= end-token-index (nb-lexemes lexer)) ;; go back to a token before bot
(mark> (start-offset (lexeme lexer end-token-index)) bot)) (loop until (mark<= (end-offset (lexeme lexer (1- end-token-index))) bot)
do (incf end-token-index)) do (decf end-token-index))
(let ((start-token-index end-token-index)) ;; go forward to the last token before bot
;; go back to the first token after top, or until the previous token (loop until (or (= end-token-index (nb-lexemes lexer))
;; contains a valid parser state (mark> (start-offset (lexeme lexer end-token-index)) bot))
(loop until (or (mark<= (end-offset (lexeme lexer (1- start-token-index))) top) do (incf end-token-index))
(not (parse-state-empty-p (let ((start-token-index end-token-index))
(slot-value (lexeme lexer (1- start-token-index)) 'state)))) ;; go back to the first token after top, or until the previous token
do (decf start-token-index)) ;; contains a valid parser state
(let ((*white-space-start* (offset top))) (loop until (or (mark<= (end-offset (lexeme lexer (1- start-token-index))) top)
;; display the parse tree if any (not (parse-state-empty-p
(unless (parse-state-empty-p (slot-value (lexeme lexer (1- start-token-index)) 'state)) (slot-value (lexeme lexer (1- start-token-index)) 'state))))
(display-parse-state (slot-value (lexeme lexer (1- start-token-index)) 'state) do (decf start-token-index))
syntax ;; display the parse tree if any
pane)) (unless (parse-state-empty-p (slot-value (lexeme lexer (1- start-token-index)) 'state))
;; display the lexemes (display-parse-state (slot-value (lexeme lexer (1- start-token-index)) 'state)
(with-drawing-options (pane :ink +red+) syntax
(loop while (< start-token-index end-token-index) pane))
do (let ((token (lexeme lexer start-token-index))) ;; display the lexemes
(display-parse-tree token syntax pane)) (with-drawing-options (pane :ink +red+)
(incf start-token-index)))))))) (loop while (< start-token-index end-token-index)
(when (region-visible-p pane) (display-region pane syntax)) do (let ((token (lexeme lexer start-token-index)))
(display-cursor pane syntax current-p))) (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 @@ ...@@ -53,13 +53,13 @@
buffer)) buffer))
(defun buffer->paiprolog (buffer) (defun buffer->paiprolog (buffer)
(let ((lexemes (climacs-syntax::lexemes (lexer (syntax buffer)))) (let ((lexemes (drei-syntax::lexemes (lexer (syntax buffer))))
(expressions '())) (expressions '()))
(dotimes (i (flexichain:nb-elements lexemes) (nreverse expressions)) (dotimes (i (flexichain:nb-elements lexemes) (nreverse expressions))
(let ((lexeme (flexichain:element* lexemes i))) (let ((lexeme (flexichain:element* lexemes i)))
(when (typep lexeme 'end-lexeme) (when (typep lexeme 'end-lexeme)
(with-hash-table-iterator (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 (loop
(multiple-value-bind (more from-state items) (multiple-value-bind (more from-state items)
(next-entry) (next-entry)
......
This diff is collapsed.
...@@ -240,7 +240,7 @@ ...@@ -240,7 +240,7 @@
(pushnew (cons from to) (pushnew (cons from to)
edges :test #'equal)))))) edges :test #'equal))))))
(possibly-capturing-and-flipping-output-twice (possibly-capturing-and-flipping-output-twice
pane (typep pane 'climacs-pane) pane (typep pane 'drei-pane)
(format-graph-from-roots (format-graph-from-roots
roots roots
(lambda (node stream) (lambda (node stream)
...@@ -437,7 +437,7 @@ ...@@ -437,7 +437,7 @@
(defparameter *slidemacs-gui-ink* +black+) (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-drawing-options (pane :ink *slidemacs-gui-ink*)
(with-slots (top bot point) pane (with-slots (top bot point) pane
(with-slots (lexer) syntax (with-slots (lexer) syntax
...@@ -530,11 +530,11 @@ ...@@ -530,11 +530,11 @@
(full-redisplay (climacs-gui::current-window))) (full-redisplay (climacs-gui::current-window)))
(define-command (com-first-talking-point :name t :command-table slidemacs-table) () (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)) (com-next-talking-point))
(define-command (com-last-talking-point :name t :command-table slidemacs-table) () (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)) (com-previous-talking-point))
(define-command (com-flip-slidemacs-syntax :name t :command-table slidemacs-table) () (define-command (com-flip-slidemacs-syntax :name t :command-table slidemacs-table) ()
...@@ -572,7 +572,7 @@ ...@@ -572,7 +572,7 @@
(define-command (com-postscript-print-presentation :name t :command-table slidemacs-table) () (define-command (com-postscript-print-presentation :name t :command-table slidemacs-table) ()
(let ((pane (climacs-gui::current-window))) (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))) (typep (syntax (buffer pane)) 'slidemacs-gui-syntax)))
(beep) (beep)
(let ((file (accept 'pathname :prompt "Output to"))) (let ((file (accept 'pathname :prompt "Output to")))
......
...@@ -21,8 +21,8 @@ ...@@ -21,8 +21,8 @@
;;; Boston, MA 02111-1307 USA. ;;; Boston, MA 02111-1307 USA.
(defpackage :climacs-slidemacs-editor (defpackage :climacs-slidemacs-editor
(:use :clim-lisp :clim :clim-extensions :climacs-buffer :climacs-base (:use :clim-lisp :clim :clim-extensions :drei-buffer :drei-base
:climacs-syntax :flexichain :climacs-pane :climacs-fundamental-syntax) :drei-syntax :flexichain :drei :drei-fundamental-syntax)
(:export)) (:export))
(in-package :climacs-slidemacs-editor) (in-package :climacs-slidemacs-editor)
...@@ -387,23 +387,21 @@ ...@@ -387,23 +387,21 @@
(defun handle-whitespace (pane buffer start end) (defun handle-whitespace (pane buffer start end)
(let ((space-width (space-width pane)) (let ((space-width (space-width pane))
(tab-width (tab-width pane))) (tab-width (tab-width pane)))
(loop while (and (< start end) (with-sheet-medium (medium pane)
(whitespacep (syntax buffer) (with-accessors ((cursor-positions cursor-positions)) (syntax buffer)
(buffer-object buffer start))) (loop while (< start end)
do (ecase (buffer-object buffer start) do (case (buffer-object buffer start)
(#\Newline (terpri pane) (#\Newline (record-line-vertical-offset pane (syntax buffer) (incf *current-line*))
(setf (aref *cursor-positions* (incf *current-line*)) (terpri pane)
(multiple-value-bind (x y) (stream-cursor-position pane) (stream-increment-cursor-position
(declare (ignore x)) pane (first (aref cursor-positions 0)) 0))
y))) ((#\Page #\Return #\Space) (stream-increment-cursor-position
(#\Space (stream-increment-cursor-position pane space-width 0))
pane space-width 0)) (#\Tab (let ((x (stream-cursor-position pane)))
(#\Tab (let ((x (stream-cursor-position pane))) (stream-increment-cursor-position
(stream-increment-cursor-position pane (- tab-width (mod x tab-width)) 0))))
pane (- tab-width (mod x tab-width)) 0))) (incf start))))))
(#\Page nil))
(incf start))))
(defvar *handle-whitespace* t) (defvar *handle-whitespace* t)
...@@ -419,11 +417,13 @@ ...@@ -419,11 +417,13 @@
(call-next-method))) (call-next-method)))
(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 (with-slots (top bot) pane
(setf *cursor-positions* (make-array (1+ (number-of-lines-in-region top bot))) (with-accessors ((cursor-positions cursor-positions)) syntax
*current-line* 0 (setf cursor-positions (make-array (1+ (number-of-lines-in-region top bot))
(aref *cursor-positions* 0) (stream-cursor-position pane)) :initial-element nil)
*current-line* 0
(aref cursor-positions 0) (multiple-value-list (stream-cursor-position pane))))
(with-slots (lexer) syntax (with-slots (lexer) syntax
(let ((average-token-size (max (float (/ (size (buffer pane)) (nb-lexemes lexer))) (let ((average-token-size (max (float (/ (size (buffer pane)) (nb-lexemes lexer)))
1.0))) 1.0)))
...@@ -442,7 +442,7 @@ ...@@ -442,7 +442,7 @@
(loop until (or (mark<= (end-offset (lexeme lexer (1- start-token-index))) top)