June 2005 - climacs-cvs@common-lisp.net - mailman3.common-lisp.net

[climacs-cvs] CVS update: papers/ilc2005/syntax/climacs-slides.slidemacs
by bmastenbrook＠common-lisp.net 14 Jun '05

14 Jun '05

Update of /project/climacs/cvsroot/papers/ilc2005/syntax In directory common-lisp.net:/tmp/cvs-serv29238 Added Files: climacs-slides.slidemacs Log Message: Might as well put this in CVS for now Date: Tue Jun 14 04:01:39 2005 Author: bmastenbrook

1 0

[climacs-cvs] CVS update: climacs/slidemacs-gui.lisp
by bmastenbrook＠common-lisp.net 14 Jun '05

14 Jun '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv29104 Modified Files: slidemacs-gui.lisp Log Message: Add display for the slideset information Date: Tue Jun 14 04:00:57 2005 Author: bmastenbrook Index: climacs/slidemacs-gui.lisp diff -u climacs/slidemacs-gui.lisp:1.5 climacs/slidemacs-gui.lisp:1.6 --- climacs/slidemacs-gui.lisp:1.5 Tue Jun 14 03:22:59 2005 +++ climacs/slidemacs-gui.lisp Tue Jun 14 04:00:56 2005 @@ -33,12 +33,21 @@ (defvar *slidemacs-display* nil) (defvar *current-slideset*) +(defvar *did-display-a-slide*) + +(defun slidemacs-entity-string (entity) + (coerce (buffer-sequence (buffer entity) + (1+ (start-offset entity)) + (1- (end-offset entity))) + 'string)) (defmethod display-parse-tree ((parse-tree slidemacs-slideset) (syntax slidemacs-gui-syntax) pane) (with-slots (slideset-info nonempty-list-of-slides slidemacs-slideset-name) parse-tree - (let ((*current-slideset* (lexeme-string slidemacs-slideset-name))) - (display-parse-tree slideset-info syntax pane) - (display-parse-tree nonempty-list-of-slides syntax pane)))) + (let ((*current-slideset* (slidemacs-entity-string slidemacs-slideset-name)) + (*did-display-a-slide* nil)) + (display-parse-tree nonempty-list-of-slides syntax pane) + (unless *did-display-a-slide* + (display-parse-tree slideset-info syntax pane))))) (defmethod display-parse-tree ((parse-tree slidemacs-slideset-keyword) (syntax slidemacs-gui-syntax) pane) (format *debug-io* "Oops!~%") @@ -77,39 +86,81 @@ (progn (present " " 'string :stream pane) (present word 'string :stream pane)))) - (loop repeat 2 do (terpri pane)))) + (terpri pane))) + +(defparameter *slidemacs-sizes* + '(:title 64 + :bullet 32 + :slideset-title 48 + :slideset-info 32)) (defmethod display-parse-tree ((parse-tree slideset-info) (syntax slidemacs-gui-syntax) pane) - ;; do nothing yet - #+nil (with-slots (point) pane - (when (and (mark>= point (start-offset parse-tree)) - (mark<= point (end-offset parse-tree))) - (with-slots (opt-slide-author opt-slide-institution opt-slide-venue opt-slide-date) - parse-tree - (display-parse-tree slidemacs-slide-name syntax pane) - (display-parse-tree nonempty-list-of-bullets syntax pane))))) + (with-text-style (pane `(:serif :bold ,(getf *slidemacs-sizes* :slideset-title))) + (display-text-with-wrap-for-pane + *current-slideset* pane) + (terpri pane)) + (with-slots (opt-slide-author opt-slide-institution opt-slide-venue opt-slide-date) + parse-tree + (display-parse-tree opt-slide-author syntax pane) + (display-parse-tree opt-slide-institution syntax pane) + (display-parse-tree opt-slide-venue syntax pane) + (display-parse-tree opt-slide-date syntax pane)))) + +(defmethod display-parse-tree ((entity slide-author) (syntax slidemacs-gui-syntax) pane) + (with-text-style (pane `(:serif :roman ,(getf *slidemacs-sizes* :slideset-info))) + (with-slots (author) entity + (display-text-with-wrap-for-pane + (slidemacs-entity-string author) pane)))) + +(defmethod display-parse-tree ((entity slide-institution) (syntax slidemacs-gui-syntax) pane) + (with-text-style (pane `(:serif :roman ,(getf *slidemacs-sizes* :slideset-info))) + (with-slots (institution) entity + (display-text-with-wrap-for-pane + (slidemacs-entity-string institution) pane)))) + +(defmethod display-parse-tree ((entity slide-venue) (syntax slidemacs-gui-syntax) pane) + (with-text-style (pane `(:serif :roman ,(getf *slidemacs-sizes* :slideset-info))) + (with-slots (venue) entity + (display-text-with-wrap-for-pane + (slidemacs-entity-string venue) pane)))) + +(defun today-string () + (multiple-value-bind (second minute hour date month year day) + (get-decoded-time) + (declare (ignore second minute hour day)) + (format nil "~A ~A ~A" + date + (elt + '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec") + (1- month)) + year))) + +(defmethod display-parse-tree ((entity slide-date) (syntax slidemacs-gui-syntax) pane) + (with-text-style (pane `(:serif :roman ,(getf *slidemacs-sizes* :slideset-info))) + (with-slots (opt-date-string) entity + (if (typep (slot-value opt-date-string 'item) + 'empty-slidemacs-terminals) + (display-text-with-wrap-for-pane (today-string) pane) + (display-text-with-wrap-for-pane + (slidemacs-entity-string opt-date-string) pane))))) (defmethod display-parse-tree ((parse-tree slidemacs-slide) (syntax slidemacs-gui-syntax) pane) (with-slots (point) pane (when (and (mark>= point (start-offset parse-tree)) (mark<= point (end-offset parse-tree))) + (when (boundp '*did-display-a-slide*) + (setf *did-display-a-slide* t)) (with-slots (slidemacs-slide-name nonempty-list-of-bullets) parse-tree (display-parse-tree slidemacs-slide-name syntax pane) (display-parse-tree nonempty-list-of-bullets syntax pane))))) -(defparameter *slidemacs-sizes* - '(:title 64 - :bullet 32)) ;; must all be powers of 2 - (defmethod display-parse-tree ((entity slidemacs-slide-name) (syntax slidemacs-gui-syntax) pane) (with-text-style (pane `(:serif :bold ,(getf *slidemacs-sizes* :title))) (display-text-with-wrap-for-pane - (coerce (buffer-sequence (buffer syntax) - (1+ (start-offset entity)) - (1- (end-offset entity))) - 'string) pane))) + (slidemacs-entity-string entity) pane) + (terpri pane))) (defmethod display-parse-tree ((entity slidemacs-bullet) (syntax slidemacs-gui-syntax) pane) (stream-increment-cursor-position pane (space-width pane) 0) @@ -131,7 +182,8 @@ (1+ (start-offset entity)) (1- (end-offset entity))) 'string))) - (display-text-with-wrap-for-pane bullet-text pane))) + (display-text-with-wrap-for-pane bullet-text pane) + (terpri pane))) (defmethod display-parse-tree ((entity slidemacs-entry) (syntax slidemacs-gui-syntax) pane) (with-slots (ink face) entity @@ -170,6 +222,11 @@ ;;; It's not necessary to draw the cursor, and in fact quite confusing ))) +(defun talking-point-stop-p (lexeme) + (or (typep lexeme 'bullet) + (and (typep lexeme 'slidemacs-keyword) + (word-is lexeme "info")))) + (climacs-gui::define-named-command com-next-talking-point () (let* ((pane (climacs-gui::current-window)) (buffer (buffer pane)) @@ -180,7 +237,7 @@ (loop for token from 0 below (nb-lexemes lexer) for lexeme = (lexeme lexer token) do - (when (and (typep lexeme 'bullet) + (when (and (talking-point-stop-p lexeme) (> (start-offset lexeme) point-pos)) (return (setf (offset point) (start-offset lexeme))))) (full-redisplay pane)))))) @@ -195,7 +252,7 @@ (loop for token from (1- (nb-lexemes lexer)) downto 0 for lexeme = (lexeme lexer token) do - (when (and (typep lexeme 'bullet) + (when (and (talking-point-stop-p lexeme) (< (start-offset lexeme) point-pos)) (return (setf (offset point) (start-offset lexeme))))) (full-redisplay pane))))))

1 0

[climacs-cvs] CVS update: climacs/slidemacs-gui.lisp
by bmastenbrook＠common-lisp.net 14 Jun '05

14 Jun '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv26508 Modified Files: slidemacs-gui.lisp Log Message: Significantly enhanced display with word wrap Date: Tue Jun 14 03:22:59 2005 Author: bmastenbrook Index: climacs/slidemacs-gui.lisp diff -u climacs/slidemacs-gui.lisp:1.4 climacs/slidemacs-gui.lisp:1.5 --- climacs/slidemacs-gui.lisp:1.4 Mon Jun 6 01:27:45 2005 +++ climacs/slidemacs-gui.lisp Tue Jun 14 03:22:59 2005 @@ -32,9 +32,13 @@ (defvar *slidemacs-display* nil) +(defvar *current-slideset*) + (defmethod display-parse-tree ((parse-tree slidemacs-slideset) (syntax slidemacs-gui-syntax) pane) - (with-slots (nonempty-list-of-slides slidemacs-slideset-name) parse-tree - (display-parse-tree nonempty-list-of-slides syntax pane))) + (with-slots (slideset-info nonempty-list-of-slides slidemacs-slideset-name) parse-tree + (let ((*current-slideset* (lexeme-string slidemacs-slideset-name))) + (display-parse-tree slideset-info syntax pane) + (display-parse-tree nonempty-list-of-slides syntax pane)))) (defmethod display-parse-tree ((parse-tree slidemacs-slideset-keyword) (syntax slidemacs-gui-syntax) pane) (format *debug-io* "Oops!~%") @@ -44,6 +48,48 @@ (let ((*handle-whitespace* nil)) (call-next-method))) +(defun display-text-with-wrap-for-pane (text pane) + (let* ((text (substitute #\space #\newline text)) + (split (remove + "" + (loop with start = 0 + with length = (length text) + for cur from 0 upto length + for is-space = + (or (eql cur length) + (eql (elt text cur) #\space)) + when is-space + collect + (prog1 + (subseq text start cur) + (setf start (1+ cur)))) + :test #'equal))) + (present (pop split) 'string :stream pane) + (loop + with margin = (stream-text-margin pane) + for word in split + do (if (> (+ (stream-cursor-position pane) + (stream-string-width pane word)) + margin) + (progn + (terpri pane) + (present word 'string :stream pane)) + (progn + (present " " 'string :stream pane) + (present word 'string :stream pane)))) + (loop repeat 2 do (terpri pane)))) + +(defmethod display-parse-tree ((parse-tree slideset-info) (syntax slidemacs-gui-syntax) pane) + ;; do nothing yet + #+nil + (with-slots (point) pane + (when (and (mark>= point (start-offset parse-tree)) + (mark<= point (end-offset parse-tree))) + (with-slots (opt-slide-author opt-slide-institution opt-slide-venue opt-slide-date) + parse-tree + (display-parse-tree slidemacs-slide-name syntax pane) + (display-parse-tree nonempty-list-of-bullets syntax pane))))) + (defmethod display-parse-tree ((parse-tree slidemacs-slide) (syntax slidemacs-gui-syntax) pane) (with-slots (point) pane (when (and (mark>= point (start-offset parse-tree)) @@ -53,19 +99,21 @@ (display-parse-tree slidemacs-slide-name syntax pane) (display-parse-tree nonempty-list-of-bullets syntax pane))))) +(defparameter *slidemacs-sizes* + '(:title 64 + :bullet 32)) ;; must all be powers of 2 + (defmethod display-parse-tree ((entity slidemacs-slide-name) (syntax slidemacs-gui-syntax) pane) - (with-text-style (pane '(:serif :bold 64)) - (present (coerce (buffer-sequence (buffer syntax) - (1+ (start-offset entity)) - (1- (end-offset entity))) - 'string) - 'string - :stream pane) - (loop repeat 2 do (terpri pane)))) + (with-text-style (pane `(:serif :bold ,(getf *slidemacs-sizes* :title))) + (display-text-with-wrap-for-pane + (coerce (buffer-sequence (buffer syntax) + (1+ (start-offset entity)) + (1- (end-offset entity))) + 'string) pane))) (defmethod display-parse-tree ((entity slidemacs-bullet) (syntax slidemacs-gui-syntax) pane) (stream-increment-cursor-position pane (space-width pane) 0) - (with-text-style (pane '(:serif :roman 48)) + (with-text-style (pane `(:serif :roman ,(getf *slidemacs-sizes* :bullet))) (with-slots (point) pane (if (and (mark>= point (start-offset entity)) (mark<= point (end-offset entity))) @@ -79,12 +127,11 @@ (stream-increment-cursor-position pane (space-width pane) 0)) (defmethod display-parse-tree ((entity talking-point) (syntax slidemacs-gui-syntax) pane) - (present (coerce (buffer-sequence (buffer syntax) - (1+ (start-offset entity)) - (1- (end-offset entity))) - 'string) - 'string :stream pane) - (loop repeat 2 do (terpri pane))) + (let* ((bullet-text (coerce (buffer-sequence (buffer syntax) + (1+ (start-offset entity)) + (1- (end-offset entity))) + 'string))) + (display-text-with-wrap-for-pane bullet-text pane))) (defmethod display-parse-tree ((entity slidemacs-entry) (syntax slidemacs-gui-syntax) pane) (with-slots (ink face) entity @@ -105,7 +152,7 @@ *slidemacs-gui-ink* c2) (window-refresh pane)) -(defmethod redisplay-pane-with-syntax ((pane climacs-pane) (syntax slidemacs-gui-syntax) current-p) +(defmethod redisplay-pane-with-syntax ((pane climacs-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 @@ -153,11 +200,29 @@ (return (setf (offset point) (start-offset lexeme))))) (full-redisplay pane)))))) +(defun adjust-font-sizes (decrease-p) + (setf *slidemacs-sizes* + (loop for thing in *slidemacs-sizes* + if (or (not (numberp thing)) + (< thing 16)) + collect thing + else collect (if decrease-p (- thing 8) (+ thing 8))))) + (climacs-gui::define-named-command com-set-colors-for-presentation () (set-pane-colors (climacs-gui::current-window) +blue+ +white+)) (climacs-gui::define-named-command com-set-colors-for-editing () (set-pane-colors (climacs-gui::current-window) +white+ +black+)) +(climacs-gui::define-named-command com-decrease-presentation-font-sizes () + (adjust-font-sizes t) + (full-redisplay (climacs-gui::current-window))) + +(climacs-gui::define-named-command com-increase-presentation-font-sizes () + (adjust-font-sizes nil) + (full-redisplay (climacs-gui::current-window))) + (climacs-gui::global-set-key '(#\= :control) 'com-next-talking-point) (climacs-gui::global-set-key '(#\- :control) 'com-previous-talking-point) +(climacs-gui::global-set-key '(#\= :meta) 'com-increase-presentation-font-sizes) +(climacs-gui::global-set-key '(#\- :meta) 'com-decrease-presentation-font-sizes) \ No newline at end of file

1 0

[climacs-cvs] CVS update: climacs/lisp-syntax.lisp
by rstrandh＠common-lisp.net 13 Jun '05

13 Jun '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv23765 Modified Files: lisp-syntax.lisp Log Message: Tabs are now handled correctly as far as displaying the cursor is concerned. Introduced a lexer error state in which entire lines are returned as lexemes. This speeds up the parser after a parse error. Date: Mon Jun 13 09:08:24 2005 Author: rstrandh Index: climacs/lisp-syntax.lisp diff -u climacs/lisp-syntax.lisp:1.5 climacs/lisp-syntax.lisp:1.6 --- climacs/lisp-syntax.lisp:1.5 Wed Jun 1 18:42:28 2005 +++ climacs/lisp-syntax.lisp Mon Jun 13 09:08:23 2005 @@ -20,8 +20,6 @@ ;;; Alternative syntax module for analysing Common Lisp -;;; move the package definition to packages.lisp later - (in-package :climacs-lisp-syntax) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -64,6 +62,11 @@ `(defclass ,name (,@superclasses lexer-state) ,@body)) +(define-lexer-state lexer-error-state () + () + (:documentation "In this state, the lexer returns error lexemes + consisting of entire lines of text")) + (define-lexer-state lexer-toplevel-state () () (:documentation "In this state, the lexer assumes it can skip @@ -332,6 +335,12 @@ (fo))) (t (fo)))))))) +(defmethod lex ((syntax lisp-syntax) (state lexer-error-state) scan) + (macrolet ((fo () `(forward-object scan))) + (loop until (end-of-line-p scan) + do (fo)) + (make-instance 'error-lexeme))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; nonterminals @@ -408,7 +417,7 @@ size 0)))) result)) -(define-parser-state error-state (lexer-toplevel-state parser-state) ()) +(define-parser-state error-state (lexer-error-state parser-state) ()) (define-parser-state error-reduce-state (lexer-toplevel-state parser-state) ()) (define-lisp-action (error-reduce-state (eql nil)) @@ -899,7 +908,10 @@ (let* ((cursor-line (number-of-lines-in-region top (point pane))) (height (text-style-height (medium-text-style pane) pane)) (cursor-y (+ (* cursor-line (+ height (stream-vertical-spacing pane))))) - (cursor-column (column-number (point pane))) + (cursor-column + (buffer-display-column + (buffer (point pane)) (offset (point pane)) + (round (tab-width pane) (space-width pane)))) (cursor-x (* cursor-column (text-style-width (medium-text-style pane) pane)))) (updating-output (pane :unique-id -1) (draw-rectangle* pane

1 0

[climacs-cvs] CVS update: papers/ilc2005/syntax/climacssyntax.tex
by bmastenbrook＠common-lisp.net 09 Jun '05

09 Jun '05

Update of /project/climacs/cvsroot/papers/ilc2005/syntax In directory common-lisp.net:/tmp/cvs-serv2464 Modified Files: climacssyntax.tex Log Message: Final edit to the paper: US Letter; no table as requested by Carl Shaprio Date: Thu Jun 9 23:14:34 2005 Author: bmastenbrook Index: papers/ilc2005/syntax/climacssyntax.tex diff -u papers/ilc2005/syntax/climacssyntax.tex:1.35 papers/ilc2005/syntax/climacssyntax.tex:1.36 --- papers/ilc2005/syntax/climacssyntax.tex:1.35 Tue May 24 23:36:09 2005 +++ papers/ilc2005/syntax/climacssyntax.tex Thu Jun 9 23:14:34 2005 @@ -4,7 +4,7 @@ \newcommand{\TabCode}{\textit{TabCode}} -\usepackage[a4paper,textwidth=6.7in,textheight=8.7in]{geometry} +\usepackage[textwidth=6.7in,textheight=8.7in]{geometry} \usepackage{graphics} \usepackage{url} \usepackage{times} @@ -78,40 +78,10 @@ spawned many variants with many different approaches to buffer management, incremental redisplay, and syntax analysis. Emacs itself traces its lineage to TECO, where Emacs was originally implemented as -a set of TECO macros. A summary comparison of Climacs to a -non-exhaustive set of Emacs variants is presented in table -\ref{table:editorcompare}; more information about text editing in -general, and particulars of some editors we shall not discuss further, -can be found in \cite{FinsethCraft,greenberg,Pike94,woodZ} and -references therein. - -\begin{table} -\begin{center} -{\small -\begin{tabular}{|c|c|c|c|} -\hline - \textbf{Editor} & \textbf{Buffer Implementation} & \textbf{Syntax Analysis} & \textbf{Language} -\\ -\hline TECO & Gap buffer & Unknown & Assembly + TECO Macros -\\ -\hline Zmacs & Probably doubly-linked list of lines & None & MacLisp -\\ -\hline GNU Emacs & Gap buffer & Regular Expressions & C + Emacs Lisp -\\ -\hline Hemlock & Doubly-linked list of lines & None & Common Lisp -\\ -\hline FRED & Gap buffer & None & PPC Assembly + Common Lisp -\\ -\hline Deuce & Doubly-linked lists of lines & Unknown & Dylan -\\ -\hline Climacs & Multiple & Multiple & Common Lisp -\\\hline -\end{tabular} -} -\caption{Implementation strategies of multiple Emacs variants} -\end{center} -\label{table:editorcompare} -\end{table} +a set of TECO macros. More information about text editing in general, +and particulars of some editors we shall not discuss further, can be +found in \cite{FinsethCraft,greenberg,Pike94,woodZ} and references +therein. Climacs' syntax analysis is a flexible protocol which can be implemented with a full language lexer and parser. GNU Emacs, the most

1 0

[climacs-cvs] CVS update: climacs/slidemacs-gui.lisp
by bmastenbrook＠common-lisp.net 05 Jun '05

05 Jun '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv11003 Modified Files: slidemacs-gui.lisp Log Message: Sorry for the very fine-grained commits: I'm trying to synchronize my trees between two machines right now. Add a space before the title to offset it a bit from the exact left side of the buffer Date: Mon Jun 6 01:27:45 2005 Author: bmastenbrook Index: climacs/slidemacs-gui.lisp diff -u climacs/slidemacs-gui.lisp:1.3 climacs/slidemacs-gui.lisp:1.4 --- climacs/slidemacs-gui.lisp:1.3 Mon Jun 6 01:26:18 2005 +++ climacs/slidemacs-gui.lisp Mon Jun 6 01:27:45 2005 @@ -64,6 +64,7 @@ (loop repeat 2 do (terpri pane)))) (defmethod display-parse-tree ((entity slidemacs-bullet) (syntax slidemacs-gui-syntax) pane) + (stream-increment-cursor-position pane (space-width pane) 0) (with-text-style (pane '(:serif :roman 48)) (with-slots (point) pane (if (and (mark>= point (start-offset entity))

1 0

[climacs-cvs] CVS update: climacs/slidemacs-gui.lisp
by bmastenbrook＠common-lisp.net 05 Jun '05

05 Jun '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv10937 Modified Files: slidemacs-gui.lisp Log Message: Black on white by default Date: Mon Jun 6 01:26:18 2005 Author: bmastenbrook Index: climacs/slidemacs-gui.lisp diff -u climacs/slidemacs-gui.lisp:1.2 climacs/slidemacs-gui.lisp:1.3 --- climacs/slidemacs-gui.lisp:1.2 Sun Jun 5 23:11:18 2005 +++ climacs/slidemacs-gui.lisp Mon Jun 6 01:26:18 2005 @@ -73,6 +73,7 @@ (call-next-method))))) (defmethod display-parse-tree ((entity bullet) (syntax slidemacs-gui-syntax) pane) + (stream-increment-cursor-position pane (space-width pane) 0) (present (lexeme-string entity) 'string :stream pane) (stream-increment-cursor-position pane (space-width pane) 0)) @@ -95,13 +96,16 @@ 'string :stream pane))) +(defparameter *slidemacs-gui-ink* +black+) + (defun set-pane-colors (pane c1 c2) (setf (medium-background (sheet-medium pane)) c1 - (medium-ink (sheet-medium pane)) c2) + (medium-ink (sheet-medium pane)) c2 + *slidemacs-gui-ink* c2) (window-refresh pane)) (defmethod redisplay-pane-with-syntax ((pane climacs-pane) (syntax slidemacs-gui-syntax) current-p) - (with-drawing-options (pane :ink +white+) + (with-drawing-options (pane :ink *slidemacs-gui-ink*) (with-slots (top bot point) pane (with-slots (lexer) syntax ;; display the parse tree if any

1 0

[climacs-cvs] CVS update: climacs/slidemacs-gui.lisp
by bmastenbrook＠common-lisp.net 05 Jun '05

05 Jun '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv2043 Modified Files: slidemacs-gui.lisp Log Message: Kill the C-1 and C-2 key shortcuts Date: Sun Jun 5 23:11:18 2005 Author: bmastenbrook Index: climacs/slidemacs-gui.lisp diff -u climacs/slidemacs-gui.lisp:1.1 climacs/slidemacs-gui.lisp:1.2 --- climacs/slidemacs-gui.lisp:1.1 Sun Jun 5 03:59:52 2005 +++ climacs/slidemacs-gui.lisp Sun Jun 5 23:11:18 2005 @@ -54,7 +54,7 @@ (display-parse-tree nonempty-list-of-bullets syntax pane))))) (defmethod display-parse-tree ((entity slidemacs-slide-name) (syntax slidemacs-gui-syntax) pane) - (with-text-style (pane '(:serif :bold :huge)) + (with-text-style (pane '(:serif :bold 64)) (present (coerce (buffer-sequence (buffer syntax) (1+ (start-offset entity)) (1- (end-offset entity))) @@ -64,7 +64,7 @@ (loop repeat 2 do (terpri pane)))) (defmethod display-parse-tree ((entity slidemacs-bullet) (syntax slidemacs-gui-syntax) pane) - (with-text-style (pane '(:serif :roman :very-large)) + (with-text-style (pane '(:serif :roman 48)) (with-slots (point) pane (if (and (mark>= point (start-offset entity)) (mark<= point (end-offset entity))) @@ -156,5 +156,3 @@ (climacs-gui::global-set-key '(#\= :control) 'com-next-talking-point) (climacs-gui::global-set-key '(#\- :control) 'com-previous-talking-point) -(climacs-gui::global-set-key '(#\1 :control) 'com-set-colors-for-presentation) -(climacs-gui::global-set-key '(#\2 :control) 'com-set-colors-for-editing) \ No newline at end of file

1 0

[climacs-cvs] CVS update: climacs/slidemacs-gui.lisp climacs/slidemacs.lisp climacs/climacs.asd
by bmastenbrook＠common-lisp.net 05 Jun '05

05 Jun '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv30163 Modified Files: climacs.asd Added Files: slidemacs-gui.lisp slidemacs.lisp Log Message: Add a new syntax: slidemacs is a slideshow textual description and presentation format. Date: Sun Jun 5 03:59:52 2005 Author: bmastenbrook Index: climacs/climacs.asd diff -u climacs/climacs.asd:1.30 climacs/climacs.asd:1.31 --- climacs/climacs.asd:1.30 Mon May 30 09:25:13 2005 +++ climacs/climacs.asd Sun Jun 5 03:59:52 2005 @@ -67,6 +67,8 @@ "ttcn3-syntax" "lisp-syntax" "gui" + "slidemacs" + "slidemacs-gui" ;;---- optional ---- "testing/rt" "buffer-test"

1 0

[climacs-cvs] CVS update: climacs/lisp-syntax.lisp
by rstrandh＠common-lisp.net 01 Jun '05

01 Jun '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv27858 Modified Files: lisp-syntax.lisp Log Message: Order-of-magnitude improvement in the speed of the incremental LR parser. Date: Wed Jun 1 18:42:28 2005 Author: rstrandh Index: climacs/lisp-syntax.lisp diff -u climacs/lisp-syntax.lisp:1.4 climacs/lisp-syntax.lisp:1.5 --- climacs/lisp-syntax.lisp:1.4 Mon May 30 15:47:21 2005 +++ climacs/lisp-syntax.lisp Wed Jun 1 18:42:28 2005 @@ -365,6 +365,15 @@ do (push (pop-one syntax) result) finally (return result))) +(defmacro reduce-fixed-number (symbol nb-children) + `(let ((result (make-instance ',symbol :children (pop-number syntax ,nb-children)))) + (when (zerop ,nb-children) + (with-slots (scan) syntax + (with-slots (start-mark size) result + (setf start-mark (clone-mark scan :right) + size 0)))) + result)) + (defun pop-until-type (syntax type) (with-slots (stack-top) syntax (loop with result = '() @@ -373,6 +382,16 @@ until (typep child type) finally (return result)))) +(defmacro reduce-until-type (symbol type) + `(let ((result (make-instance ',symbol + :children (pop-until-type syntax ',type)))) + (when (null (children result)) + (with-slots (scan) syntax + (with-slots (start-mark size) result + (setf start-mark (clone-mark scan :right) + size 0)))) + result)) + (defun pop-all (syntax) (with-slots (stack-top) syntax (loop with result = '() @@ -380,6 +399,15 @@ do (push (pop-one syntax) result) finally (return result)))) +(defmacro reduce-all (symbol) + `(let ((result (make-instance ',symbol :children (pop-all syntax)))) + (when (null (children result)) + (with-slots (scan) syntax + (with-slots (start-mark size) result + (setf start-mark (clone-mark scan :right) + size 0)))) + result)) + (define-parser-state error-state (lexer-toplevel-state parser-state) ()) (define-parser-state error-reduce-state (lexer-toplevel-state parser-state) ()) @@ -392,7 +420,7 @@ ;;; the action on end-of-buffer is to reduce to the error symbol (define-lisp-action (t (eql nil)) - (make-instance 'error-symbol :children (pop-all syntax))) + (reduce-all error-symbol)) ;;; the default new state is the error state (define-new-lisp-state (t parser-symbol) error-state) @@ -400,8 +428,6 @@ ;;; the new state when an error-state (define-new-lisp-state (t error-symbol) error-reduce-state) -(defmacro reduce-rule (symbol nb-children) - `(make-instance ',symbol :children (pop-number syntax ,nb-children))) ;;;;;;;;;;;;;;;; Top-level @@ -420,7 +446,7 @@ (define-new-lisp-state (|initial-state | form) |initial-state |) (define-lisp-action (|initial-state | (eql nil)) - (make-instance 'form* :children (pop-all syntax))) + (reduce-all form*)) (define-new-lisp-state (|initial-state | form*) |form* | ) @@ -445,8 +471,7 @@ ;;; reduce according to the rule form -> ( form* ) (define-lisp-action (|( form* ) | t) - (make-instance 'list-form - :children (pop-until-type syntax 'left-parenthesis-lexeme))) + (reduce-until-type list-form left-parenthesis-lexeme)) ;;;;;;;;;;;;;;;; String @@ -463,8 +488,7 @@ ;;; reduce according to the rule form -> " word* " (define-lisp-action (|" word* " | t) - (make-instance 'string-form - :children (pop-until-type syntax 'string-start-lexeme))) + (reduce-until-type string-form string-start-lexeme)) ;;;;;;;;;;;;;;;; Line comment @@ -481,8 +505,7 @@ ;;; reduce according to the rule form -> ; word* NL (define-lisp-action (|; word* NL | t) - (make-instance 'line-comment-form - :children (pop-until-type syntax 'line-comment-start-lexeme))) + (reduce-until-type line-comment-form line-comment-start-lexeme)) ;;;;;;;;;;;;;;;; Long comment @@ -503,8 +526,7 @@ ;;; reduce according to the rule form -> #| word* |# (define-lisp-action (|#\| word* \|# | t) - (make-instance 'long-comment-form - :children (pop-until-type syntax 'long-comment-start-lexeme))) + (reduce-until-type long-comment-form long-comment-start-lexeme)) ;;;;;;;;;;;;;;;; Symbol name surrounded with vertical bars @@ -520,8 +542,7 @@ ;;; reduce according to the rule form -> | text* | (define-lisp-action (|\| text* \| | t) - (make-instance 'symbol-form - :children (pop-until-type syntax 'symbol-start-lexeme))) + (reduce-until-type symbol-form symbol-start-lexeme)) ;;;;;;;;;;;;;;;; Quote @@ -536,7 +557,7 @@ ;;; reduce according to the rule form -> ' form (define-lisp-action (|' form | t) - (reduce-rule quote-form 2)) + (reduce-fixed-number quote-form 2)) ;;;;;;;;;;;;;;;; Backquote @@ -551,7 +572,7 @@ ;;; reduce according to the rule form -> ` form (define-lisp-action (|` form | t) - (reduce-rule backquote-form 2)) + (reduce-fixed-number backquote-form 2)) ;;;;;;;;;;;;;;;; Comma @@ -566,7 +587,7 @@ ;;; reduce according to the rule form -> , form (define-lisp-action (|, form | t) - (reduce-rule backquote-form 2)) + (reduce-fixed-number backquote-form 2)) ;;;;;;;;;;;;;;;; Function @@ -581,7 +602,7 @@ ;;; reduce according to the rule form -> #' form (define-lisp-action (|#' form | t) - (reduce-rule function-form 2)) + (reduce-fixed-number function-form 2)) ;;;;;;;;;;;;;;;; Reader conditionals @@ -604,10 +625,10 @@ (define-new-lisp-state (|#- form | form) |#- form form |) (define-lisp-action (|#+ form form | t) - (reduce-rule reader-conditional-positive-form 3)) + (reduce-fixed-number reader-conditional-positive-form 3)) (define-lisp-action (|#- form form | t) - (reduce-rule reader-conditional-negative-form 3)) + (reduce-fixed-number reader-conditional-negative-form 3)) ;;;;;;;;;;;;;;;; uninterned symbol @@ -622,7 +643,7 @@ ;;; reduce according to the rule form -> #: form (define-lisp-action (|#: form | t) - (reduce-rule uninterned-symbol-form 2)) + (reduce-fixed-number uninterned-symbol-form 2)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -640,12 +661,7 @@ (setf parser-state current-state current-state new-state preceding-parse-tree stack-top - stack-top new-parser-symbol))))) - -(defun parse-until-shift (syntax) - (with-slots (stack-top scan) syntax - (loop do (parser-step syntax) - until (typep stack-top 'lexeme)) + stack-top new-parser-symbol))) (setf (offset scan) (end-offset stack-top)))) (defun prev-tree (tree) @@ -691,35 +707,39 @@ finally (return tree))) (t (car parse-trees)))) -(defun find-next-lexeme (parse-tree) - (loop for tree = (next-tree parse-tree) then (next-tree tree) - until (or (null tree) (typep tree 'lexeme)) - finally (return tree))) - (defun parse-tree-equal (tree1 tree2) (and (eq (class-of tree1) (class-of tree2)) (eq (parser-state tree1) (parser-state tree2)) - (= (start-offset tree1) (start-offset tree2)) (= (end-offset tree1) (end-offset tree2)))) +(defmethod print-object ((mark mark) stream) + (print-unreadable-object (mark stream :type t :identity t) + (format stream "~s" (offset mark)))) + (defun parse-patch (syntax) (with-slots (current-state stack-top scan potentially-valid-trees) syntax - (parse-until-shift syntax) + (parser-step syntax) + (finish-output *trace-output*) (cond ((parse-tree-equal stack-top potentially-valid-trees) - (setf (slot-value potentially-valid-trees 'preceding-parse-tree) - (slot-value stack-top 'preceding-parse-tree)) + (unless (or (null (parent potentially-valid-trees)) + (eq potentially-valid-trees + (car (last (children (parent potentially-valid-trees)))))) + (loop for tree = (cadr (member potentially-valid-trees + (children (parent potentially-valid-trees)) + :test #'eq)) + then (car (children tree)) + until (null tree) + do (setf (slot-value tree 'preceding-parse-tree) + stack-top)) + (setf stack-top (prev-tree (parent potentially-valid-trees)))) (setf potentially-valid-trees (parent potentially-valid-trees)) - (setf stack-top potentially-valid-trees) - (loop until (typep stack-top 'lexeme) - do (setf stack-top (prev-tree stack-top))) (setf current-state (new-state syntax (parser-state stack-top) stack-top)) - (setf potentially-valid-trees (find-next-lexeme potentially-valid-trees) - (offset scan) (end-offset stack-top))) + (setf (offset scan) (end-offset stack-top))) (t (loop until (or (null potentially-valid-trees) (>= (start-offset potentially-valid-trees) (end-offset stack-top))) do (setf potentially-valid-trees - (find-next-lexeme potentially-valid-trees))))))) + (next-tree potentially-valid-trees))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0