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

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

17 Jun '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv32229 Modified Files: slidemacs-gui.lisp Log Message: Cheap way of working around some possible McCLIM display bugs Date: Fri Jun 17 03:21:22 2005 Author: bmastenbrook Index: climacs/slidemacs-gui.lisp diff -u climacs/slidemacs-gui.lisp:1.9 climacs/slidemacs-gui.lisp:1.10 --- climacs/slidemacs-gui.lisp:1.9 Fri Jun 17 03:17:27 2005 +++ climacs/slidemacs-gui.lisp Fri Jun 17 03:21:22 2005 @@ -34,6 +34,7 @@ (defvar *current-slideset*) (defvar *did-display-a-slide*) +(defvar *last-slide-displayed* nil) (defun slidemacs-entity-string (entity) (coerce (buffer-sequence (buffer entity) @@ -151,6 +152,9 @@ (when (and (mark>= point (start-offset parse-tree)) (mark<= point (end-offset parse-tree))) (when (boundp '*did-display-a-slide*) + (when (not (eq *last-slide-displayed* parse-tree)) + (setf *last-slide-displayed* parse-tree) + (window-erase-viewport pane)) (setf *did-display-a-slide* t)) (with-slots (slidemacs-slide-name nonempty-list-of-bullets) parse-tree @@ -170,6 +174,9 @@ (when (and (mark>= point (start-offset parse-tree)) (mark<= point (end-offset parse-tree))) (when (boundp '*did-display-a-slide*) + (when (not (eq *last-slide-displayed* parse-tree)) + (setf *last-slide-displayed* parse-tree) + (window-erase-viewport pane)) (setf *did-display-a-slide* t)) (with-slots (slidemacs-slide-name list-of-roots list-of-edges) parse-tree

1 0

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

17 Jun '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv32186 Modified Files: slidemacs-gui.lisp Log Message: some small font size changes, some source formatting changes Date: Fri Jun 17 03:17:27 2005 Author: bmastenbrook Index: climacs/slidemacs-gui.lisp diff -u climacs/slidemacs-gui.lisp:1.8 climacs/slidemacs-gui.lisp:1.9 --- climacs/slidemacs-gui.lisp:1.8 Wed Jun 15 03:39:46 2005 +++ climacs/slidemacs-gui.lisp Fri Jun 17 03:17:27 2005 @@ -73,7 +73,7 @@ (subseq text start cur) (setf start (1+ cur)))) :test #'equal))) - (present (pop split) 'string :stream pane) + (write-string (pop split) pane) (loop with margin = (stream-text-margin pane) for word in split @@ -82,14 +82,14 @@ margin) (progn (terpri pane) - (present word 'string :stream pane)) + (write-string word pane)) (progn - (present " " 'string :stream pane) - (present word 'string :stream pane)))) + (write-string " " pane) + (write-string word pane)))) (terpri pane))) (defparameter *slidemacs-sizes* - '(:title 64 + '(:title 48 :bullet 32 :graph-node 16 :slideset-title 48 @@ -148,14 +148,14 @@ (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))))) + (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))))) (defun traverse-list-entry (list-entry unit-type function) (when (and @@ -212,8 +212,8 @@ (present node 'string :stream stream)))) (lambda (node) (loop for edge in edges - if (equal (car edge) node) - collect (cdr edge))) + if (equal (car edge) node) + collect (cdr edge))) :orientation :horizontal :generation-separation "xxxxxx" :arc-drawer @@ -270,7 +270,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 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 @@ -328,7 +328,7 @@ (setf *slidemacs-sizes* (loop for thing in *slidemacs-sizes* if (or (not (numberp thing)) - (< thing 16)) + (and (not decrease-p) (< thing 16))) collect thing else collect (if decrease-p (- thing 8) (+ thing 8)))))

1 0

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

17 Jun '05

Update of /project/climacs/cvsroot/papers/ilc2005/syntax In directory common-lisp.net:/tmp/cvs-serv31292 Modified Files: climacs-slides.slidemacs Log Message: MORE SLIDES Date: Fri Jun 17 03:15:10 2005 Author: bmastenbrook Index: papers/ilc2005/syntax/climacs-slides.slidemacs diff -u papers/ilc2005/syntax/climacs-slides.slidemacs:1.2 papers/ilc2005/syntax/climacs-slides.slidemacs:1.3 --- papers/ilc2005/syntax/climacs-slides.slidemacs:1.2 Wed Jun 15 03:40:04 2005 +++ papers/ilc2005/syntax/climacs-slides.slidemacs Fri Jun 17 03:15:09 2005 @@ -9,6 +9,11 @@ * "A CLIM application" * "Protocols for buffer implementation and syntax analysis" } +slide "CLIM" { +* "The Common Lisp Interface Manager" +* "Standard for user interfaces and graphics in Common Lisp" +* "Free implementation in McCLIM" +} slide "Buffer protocol" { * "Multiple buffer implementations" @@ -76,7 +81,11 @@ * "Slidemacs syntax (used for slide display)" * "Tabcode editor (used for tablature display)" } -graph "Parser class hierarchy" { +slide "Lexer and Parser" { +* "Incremental lexer creates objects for each lexeme" +* "Parser parses lexemes into production classes" +} +graph "Sample parser class hierarchy" { root "parse-tree" edge from "parse-tree" to "ttcn3-parse-tree" edge from "ttcn3-parse-tree" to "ttcn3-entry" @@ -86,5 +95,27 @@ edge from "ttcn3-entry" to "empty-ttcn3-terminals" edge from "ttcn3-entry" to "ttcn3-nonterminal" edge from "ttcn3-entry" to "ttcn3-terminal" +} +slide "Parse tree display" { +* "Application controls display of parse tree" +* "Could be a simple colorised display of text..." +* "... or a specialized display of the parse tree" +} +slide "Future directions" { +* "More improvements to McCLIM (speed, completeness)" +* "Better Lisp mode" +* "TTCN-3 Graphical Representation (GR) editor" +* "Slidemacs GUI-mode editor" +} +slide "Future directions, cont." { +* "Beter resynchronization on parse errors" +* "More syntax modules" +* "Other applications (news readers, mail) using Climacs for editable +buffers" +} +slide "Demos" { +* "Lisp mode and incremental parser" +* "Slidemacs mode" +* "Tabcode editor" } }

1 0

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

15 Jun '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv1314 Modified Files: gui.lisp lisp-syntax.lisp Log Message: Initial steps toward more Common Lisp awareness. For now, we parse lexemes into symbols whenever possible, and present them as such. For experimentation, two commands com-accept-string and com-accept-symbol exist to verify that the presentation works. The symbols we obtain will be used to compute indentation, which is next on the list of things to do. Date: Wed Jun 15 08:00:13 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.143 climacs/gui.lisp:1.144 --- climacs/gui.lisp:1.143 Mon May 30 11:33:39 2005 +++ climacs/gui.lisp Wed Jun 15 08:00:12 2005 @@ -1412,6 +1412,18 @@ (syntax (syntax (buffer pane)))) (eval-defun point syntax))) +(define-named-command com-package () + (let* ((pane (current-window)) + (syntax (syntax (buffer pane))) + (package (climacs-lisp-syntax::package-of syntax))) + (display-message (format nil "~s" package)))) + +(define-named-command com-accept-string () + (display-message (format nil "~s" (accept 'string)))) + +(define-named-command com-accept-symbol () + (display-message (format nil "~s" (accept 'symbol)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Global and dead-escape command tables Index: climacs/lisp-syntax.lisp diff -u climacs/lisp-syntax.lisp:1.6 climacs/lisp-syntax.lisp:1.7 --- climacs/lisp-syntax.lisp:1.6 Mon Jun 13 09:08:23 2005 +++ climacs/lisp-syntax.lisp Wed Jun 15 08:00:12 2005 @@ -33,7 +33,8 @@ (current-state) (current-start-mark) (current-size) - (scan)) + (scan) + (package)) (:name "Lisp") (:pathname-types "lisp" "lsp" "cl")) @@ -757,6 +758,30 @@ (defmethod update-syntax-for-display (buffer (syntax lisp-syntax) top bot) nil) +(defun package-of (syntax) + (let ((buffer (buffer syntax))) + (flet ((test (x) + (and (typep x 'list-form) + (not (null (cdr (children x)))) + (buffer-looking-at buffer + (start-offset (cadr (children x))) + "in-package" + :test #'char-equal)))) + (with-slots (stack-top) syntax + (let ((form (find-if #'test (children stack-top)))) + (and form + (not (null (cddr (children form)))) + (let* ((package-form (caddr (children form))) + (package-name (coerce (buffer-sequence + buffer + (start-offset package-form) + (end-offset package-form)) + 'string)) + (package-symbol + (let ((*package* (find-package :common-lisp))) + (read-from-string package-name nil nil)))) + (find-package package-symbol)))))))) + (defmethod update-syntax (buffer (syntax lisp-syntax)) (let* ((low-mark (low-mark buffer)) (high-mark (high-mark buffer))) @@ -775,7 +800,9 @@ (new-state syntax (parser-state stack-top) stack-top))) - (loop do (parse-patch syntax))))))) + (loop do (parse-patch syntax)))))) + (with-slots (package) syntax + (setf package (package-of syntax)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -849,19 +876,24 @@ (medium-ink (sheet-medium pane))) (eq (slot-value t1 'face) (text-style-face (medium-text-style (sheet-medium pane))))))) - (updating-output (pane :unique-id parser-symbol - :id-test #'eq - :cache-value parser-symbol - :cache-test #'cache-test) - (with-slots (ink face) parser-symbol - (setf ink (medium-ink (sheet-medium pane)) - face (text-style-face (medium-text-style (sheet-medium pane)))) - (present (coerce (buffer-sequence (buffer syntax) - (start-offset parser-symbol) - (end-offset parser-symbol)) - 'string) - 'string - :stream pane))))) + (updating-output + (pane :unique-id parser-symbol + :id-test #'eq + :cache-value parser-symbol + :cache-test #'cache-test) + (with-slots (ink face) parser-symbol + (setf ink (medium-ink (sheet-medium pane)) + face (text-style-face (medium-text-style (sheet-medium pane)))) + (let ((string (coerce (buffer-sequence (buffer syntax) + (start-offset parser-symbol) + (end-offset parser-symbol)) + 'string))) + (multiple-value-bind (symbol status) + (token-to-symbol syntax parser-symbol) + (declare (ignore symbol)) + (if (and status (typep parser-symbol 'form)) + (present string 'symbol :stream pane) + (present string 'string :stream pane)))))))) (defmethod display-parse-tree :before ((parse-symbol lisp-lexeme) (syntax lisp-syntax) pane) (handle-whitespace pane (buffer pane) *white-space-start* (start-offset parse-symbol)) @@ -1007,4 +1039,52 @@ (coerce (buffer-sequence (buffer syntax) (start-offset form) (end-offset form)) - 'string))))))) \ No newline at end of file + 'string))))))) + +;;; shamelessly stolen from SWANK + +(defconstant keyword-package (find-package :keyword) + "The KEYWORD package.") + +;; FIXME: deal with #\| etc. hard to do portably. +(defun tokenize-symbol (string) + (let ((package (let ((pos (position #\: string))) + (if pos (subseq string 0 pos) nil))) + (symbol (let ((pos (position #\: string :from-end t))) + (if pos (subseq string (1+ pos)) string))) + (internp (search "::" string))) + (values symbol package internp))) + +;; FIXME: Escape chars are ignored +(defun casify (string) + "Convert string accoring to readtable-case." + (ecase (readtable-case *readtable*) + (:preserve string) + (:upcase (string-upcase string)) + (:downcase (string-downcase string)) + (:invert (multiple-value-bind (lower upper) (determine-case string) + (cond ((and lower upper) string) + (lower (string-upcase string)) + (upper (string-downcase string)) + (t string)))))) + +(defun parse-symbol (string &optional (package *package*)) + "Find the symbol named STRING. +Return the symbol and a flag indicating whether the symbols was found." + (multiple-value-bind (sname pname) (tokenize-symbol string) + (let ((package (cond ((string= pname "") keyword-package) + (pname (find-package (casify pname))) + (t package)))) + (if package + (find-symbol (casify sname) package) + (values nil nil))))) + + +(defun token-to-symbol (syntax token) + (let ((package (or (slot-value syntax 'package) + (find-package :common-lisp))) + (token-string (coerce (buffer-sequence (buffer syntax) + (start-offset token) + (end-offset token)) + 'string))) + (parse-symbol token-string package)))

1 0

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

15 Jun '05

Update of /project/climacs/cvsroot/papers/ilc2005/syntax In directory common-lisp.net:/tmp/cvs-serv17782 Modified Files: climacs-slides.slidemacs Log Message: Current state of the slides Date: Wed Jun 15 03:40:04 2005 Author: bmastenbrook Index: papers/ilc2005/syntax/climacs-slides.slidemacs diff -u papers/ilc2005/syntax/climacs-slides.slidemacs:1.1 papers/ilc2005/syntax/climacs-slides.slidemacs:1.2 --- papers/ilc2005/syntax/climacs-slides.slidemacs:1.1 Tue Jun 14 04:01:39 2005 +++ papers/ilc2005/syntax/climacs-slides.slidemacs Wed Jun 15 03:40:04 2005 @@ -76,4 +76,15 @@ * "Slidemacs syntax (used for slide display)" * "Tabcode editor (used for tablature display)" } +graph "Parser class hierarchy" { +root "parse-tree" +edge from "parse-tree" to "ttcn3-parse-tree" +edge from "ttcn3-parse-tree" to "ttcn3-entry" +edge from "ttcn3-entry" to "ttcn3-lexeme" +edge from "ttcn3-lexeme" to /lexeme classes/ +edge from "ttcn3-entry" to /parser production classes/ +edge from "ttcn3-entry" to "empty-ttcn3-terminals" +edge from "ttcn3-entry" to "ttcn3-nonterminal" +edge from "ttcn3-entry" to "ttcn3-terminal" +} }

1 0

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

15 Jun '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv17742 Modified Files: slidemacs-gui.lisp slidemacs.lisp Log Message: Graph formatting for Slidemacs! Date: Wed Jun 15 03:39:46 2005 Author: bmastenbrook Index: climacs/slidemacs-gui.lisp diff -u climacs/slidemacs-gui.lisp:1.7 climacs/slidemacs-gui.lisp:1.8 --- climacs/slidemacs-gui.lisp:1.7 Wed Jun 15 01:14:18 2005 +++ climacs/slidemacs-gui.lisp Wed Jun 15 03:39:46 2005 @@ -91,12 +91,13 @@ (defparameter *slidemacs-sizes* '(:title 64 :bullet 32 + :graph-node 16 :slideset-title 48 :slideset-info 32)) (defmethod display-parse-tree ((parse-tree slideset-info) (syntax slidemacs-gui-syntax) pane) (with-slots (point) pane - (with-text-style (pane `(:serif :bold ,(getf *slidemacs-sizes* :slideset-title))) + (with-text-style (pane `(:sans-serif :bold ,(getf *slidemacs-sizes* :slideset-title))) (display-text-with-wrap-for-pane *current-slideset* pane) (terpri pane)) @@ -108,19 +109,19 @@ (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-text-style (pane `(:sans-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-text-style (pane `(:sans-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-text-style (pane `(:sans-serif :roman ,(getf *slidemacs-sizes* :slideset-info))) (with-slots (venue) entity (display-text-with-wrap-for-pane (slidemacs-entity-string venue) pane)))) @@ -137,7 +138,7 @@ 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-text-style (pane `(:sans-serif :roman ,(getf *slidemacs-sizes* :slideset-info))) (with-slots (opt-date-string) entity (if (typep (slot-value opt-date-string 'item) 'empty-slidemacs-terminals) @@ -156,15 +157,83 @@ (display-parse-tree slidemacs-slide-name syntax pane) (display-parse-tree nonempty-list-of-bullets syntax pane))))) +(defun traverse-list-entry (list-entry unit-type function) + (when (and + (slot-exists-p list-entry 'items) + (slot-exists-p list-entry 'item) + (typep (slot-value list-entry 'item) unit-type)) + (funcall function (slot-value list-entry 'item)) + (traverse-list-entry (slot-value list-entry 'items) unit-type function))) + +(defmethod display-parse-tree ((parse-tree slidemacs-graph-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 list-of-roots list-of-edges) + parse-tree + (display-parse-tree slidemacs-slide-name syntax pane) + (let (roots edges italic) + (traverse-list-entry + list-of-roots 'graph-root + (lambda (entry) + (with-slots (vertex-name) entry + (with-slots (slidemacs-string) vertex-name + (with-slots (item) slidemacs-string + (when (typep item 'slidemacs-italic-string) + (pushnew (slidemacs-entity-string vertex-name) italic :test #'equal)))) + (pushnew (slidemacs-entity-string vertex-name) roots + :test #'equal)))) + (traverse-list-entry + list-of-edges 'graph-edge + (flet ((push-if-italic (thing) + (with-slots (vertex-name) thing + (with-slots (slidemacs-string) vertex-name + (with-slots (item) slidemacs-string + (when (typep item 'slidemacs-italic-string) + (pushnew (slidemacs-entity-string vertex-name) italic :test #'equal))))))) + (lambda (entry) + (with-slots (from-vertex to-vertex) entry + (let ((from (slidemacs-entity-string from-vertex)) + (to (slidemacs-entity-string to-vertex))) + (push-if-italic from-vertex) + (push-if-italic to-vertex) + (pushnew (cons from to) + edges :test #'equal)))))) + (format-graph-from-roots + roots + (lambda (node stream) + (with-text-style (pane `(:sans-serif + ,(if (find node italic :test #'equal) + :italic :roman) + ,(getf *slidemacs-sizes* :graph-node))) + (surrounding-output-with-border (pane :shape :drop-shadow) + (present node 'string :stream stream)))) + (lambda (node) + (loop for edge in edges + if (equal (car edge) node) + collect (cdr edge))) + :orientation :horizontal + :generation-separation "xxxxxx" + :arc-drawer + (lambda (stream obj1 obj2 x1 y1 x2 y2) + (declare (ignore obj1 obj2)) + (draw-arrow* stream x1 y1 x2 y2 :line-thickness 1 :head-length 8 :head-width 4)) + :merge-duplicates t + :duplicate-test #'equal + :graph-type :tree + )))))) + (defmethod display-parse-tree ((entity slidemacs-slide-name) (syntax slidemacs-gui-syntax) pane) - (with-text-style (pane `(:serif :bold ,(getf *slidemacs-sizes* :title))) + (with-text-style (pane `(:sans-serif :bold ,(getf *slidemacs-sizes* :title))) (display-text-with-wrap-for-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) - (with-text-style (pane `(:serif :roman ,(getf *slidemacs-sizes* :bullet))) + (with-text-style (pane `(:sans-serif :roman ,(getf *slidemacs-sizes* :bullet))) (with-slots (point) pane (if (and (mark>= point (start-offset entity)) (mark<= point (end-offset entity))) @@ -178,12 +247,15 @@ (stream-increment-cursor-position pane (space-width pane) 0)) (defmethod display-parse-tree ((entity talking-point) (syntax slidemacs-gui-syntax) 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) - (terpri pane))) + (with-slots (slidemacs-string) entity + (let ((is-italic (typep (slot-value slidemacs-string 'item) + 'slidemacs-italic-string)) + (bullet-text (slidemacs-entity-string entity))) + (if is-italic + (with-text-face (pane :italic) + (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 @@ -219,7 +291,8 @@ (defun talking-point-stop-p (lexeme) (or (typep lexeme 'bullet) (and (typep lexeme 'slidemacs-keyword) - (word-is lexeme "info")))) + (or (word-is lexeme "info") + (word-is lexeme "graph"))))) (climacs-gui::define-named-command com-next-talking-point () (let* ((pane (climacs-gui::current-window)) Index: climacs/slidemacs.lisp diff -u climacs/slidemacs.lisp:1.2 climacs/slidemacs.lisp:1.3 --- climacs/slidemacs.lisp:1.2 Wed Jun 15 01:12:26 2005 +++ climacs/slidemacs.lisp Wed Jun 15 03:39:46 2005 @@ -60,7 +60,7 @@ collect `(defclass ,lexeme (,superclass) ())))) (define-lexemes slidemacs-lexeme start-lexeme slidemacs-keyword - block-open block-close slidemacs-string bullet other-entry) + block-open block-close slidemacs-quoted-string slidemacs-italic-string bullet other-entry) (defclass slidemacs-lexer (incremental-lexer) ()) @@ -89,7 +89,13 @@ do (fo)) (unless (end-of-buffer-p scan) (fo)) ; get the closing #\" - (make-instance 'slidemacs-string)) + (make-instance 'slidemacs-quoted-string)) + (#\/ (loop until (end-of-buffer-p scan) + while (not (eql (object-after scan) #\/)) + do (fo)) + (unless (end-of-buffer-p scan) + (fo)) ; get the closing #\/ + (make-instance 'slidemacs-italic-string)) (#\* bullet) (t (cond ((identifier-char-p object :start t) @@ -237,6 +243,7 @@ (:== slidemacs-slideset slidemacs-slideset-keyword slidemacs-slideset-name block-open slideset-info nonempty-list-of-slides block-close) (:= slidemacs-slideset-keyword "slideset") + (:= slidemacs-string (or slidemacs-quoted-string slidemacs-italic-string)) (:= slidemacs-slideset-name slidemacs-string) (:= slideset-info slideset-info-keyword block-open opt-slide-author opt-slide-institution opt-slide-venue opt-slide-date block-close) (:= slideset-info-keyword "info") @@ -258,7 +265,22 @@ (:= date-keyword "date") (:= date-string slidemacs-string) (:= nonempty-list-of-slides - (nonempty-list-of slidemacs-slide)) + (nonempty-list-of slidemacs-all-slide-types)) + (:= slidemacs-all-slide-types + (or slidemacs-slide slidemacs-graph-slide)) + (:= slidemacs-graph-slide slidemacs-graph-slide-keyword slidemacs-slide-name block-open list-of-roots list-of-edges block-close) + (:= slidemacs-graph-slide-keyword "graph") + (:= list-of-roots (list-of graph-root)) + (:= graph-root graph-root-keyword vertex-name) + (:= graph-root-keyword "root") + (:= list-of-edges (list-of graph-edge)) + (:= graph-edge graph-edge-keyword from-keyword from-vertex to-keyword to-vertex) + (:= graph-edge-keyword "edge") + (:= from-keyword "from") + (:= to-keyword "to") + (:= from-vertex vertex-name) + (:= to-vertex vertex-name) + (:= vertex-name slidemacs-string) (:= slidemacs-slide slidemacs-slide-keyword slidemacs-slide-name block-open nonempty-list-of-bullets block-close) (:= slidemacs-slide-keyword "slide") @@ -270,6 +292,10 @@ (defmethod display-parse-tree ((entity slidemacs-terminal) (syntax slidemacs-editor-syntax) pane) (with-slots (item) entity (display-parse-tree item syntax pane))) + +(defmethod display-parse-tree ((entity slidemacs-italic-string) (syntax slidemacs-editor-syntax) pane) + (with-text-face (pane :italic) + (call-next-method))) (defmethod display-parse-tree ((entity slidemacs-entry) (syntax slidemacs-editor-syntax) pane) (flet ((cache-test (t1 t2)

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-serv8935 Modified Files: slidemacs-gui.lisp Log Message: Kill the Set Colors For ... commands; they didn't add much and there's a lot of room for a rethink here Date: Wed Jun 15 01:14:19 2005 Author: bmastenbrook Index: climacs/slidemacs-gui.lisp diff -u climacs/slidemacs-gui.lisp:1.6 climacs/slidemacs-gui.lisp:1.7 --- climacs/slidemacs-gui.lisp:1.6 Tue Jun 14 04:00:56 2005 +++ climacs/slidemacs-gui.lisp Wed Jun 15 01:14:18 2005 @@ -198,12 +198,6 @@ (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 - *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 *slidemacs-gui-ink*) (with-slots (top bot point) pane @@ -264,12 +258,6 @@ (< 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)

1 0

[climacs-cvs] CVS update: climacs/slidemacs.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-serv8886 Modified Files: slidemacs.lisp Log Message: oops, commit the latest version of the slidemacs grammar Date: Wed Jun 15 01:12:26 2005 Author: bmastenbrook Index: climacs/slidemacs.lisp diff -u climacs/slidemacs.lisp:1.1 climacs/slidemacs.lisp:1.2 --- climacs/slidemacs.lisp:1.1 Sun Jun 5 03:59:52 2005 +++ climacs/slidemacs.lisp Wed Jun 15 01:12:26 2005 @@ -235,9 +235,28 @@ (define-parsing-rules (*slidemacs-grammar* slidemacs-entry slidemacs-terminal slidemacs-editor-syntax) (:== slidemacs-slideset slidemacs-slideset-keyword slidemacs-slideset-name block-open - nonempty-list-of-slides block-close) + slideset-info nonempty-list-of-slides block-close) (:= slidemacs-slideset-keyword "slideset") (:= slidemacs-slideset-name slidemacs-string) + (:= slideset-info slideset-info-keyword block-open opt-slide-author opt-slide-institution opt-slide-venue opt-slide-date block-close) + (:= slideset-info-keyword "info") + (:= opt-slide-author (or slide-author empty-slidemacs-terminals)) + (:= slide-author author-keyword author) + (:= author-keyword "author") + (:= author slidemacs-string) + (:= opt-slide-venue (or slide-venue empty-slidemacs-terminals)) + (:= slide-venue slide-venue-keyword venue) + (:= slide-venue-keyword "venue") + (:= venue slidemacs-string) + (:= opt-slide-institution (or slide-institution empty-slidemacs-terminals)) + (:= slide-institution institution-keyword institution) + (:= institution-keyword "institution") + (:= institution slidemacs-string) + (:= opt-slide-date (or slide-date empty-slidemacs-terminals)) + (:= slide-date date-keyword opt-date-string) + (:= opt-date-string (or date-string empty-slidemacs-terminals)) + (:= date-keyword "date") + (:= date-string slidemacs-string) (:= nonempty-list-of-slides (nonempty-list-of slidemacs-slide)) (:= slidemacs-slide slidemacs-slide-keyword slidemacs-slide-name block-open

1 0

[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