Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv18270

Modified Files: slidemacs-gui.lisp slidemacs.lisp Log Message: MORE PRESENTATION OBJECTS: urls and reveal buttons

Date: Tue Jun 21 18:51:05 2005 Author: bmastenbrook

Index: climacs/slidemacs-gui.lisp diff -u climacs/slidemacs-gui.lisp:1.14 climacs/slidemacs-gui.lisp:1.15 --- climacs/slidemacs-gui.lisp:1.14 Mon Jun 20 19:33:11 2005 +++ climacs/slidemacs-gui.lisp Tue Jun 21 18:51:05 2005 @@ -80,7 +80,7 @@ (let ((*handle-whitespace* nil)) (call-next-method)))

-(defun undisplay-text-with-wrap-for-pane (text pane) +(defun display-text-with-wrap-for-pane (text pane) (let* ((text (substitute #\space #\newline text)) (split (remove "" @@ -295,6 +295,79 @@ (display-text-with-wrap-for-pane bullet-text pane)) (terpri pane))))

+(define-presentation-type slidemacs-url () :inherit-from 'string) + +(define-presentation-method present (object (type slidemacs-url) + stream (view textual-view) + &key &allow-other-keys) + (display-text-with-wrap-for-pane object stream)) + +(define-command (com-browse-to-url :name "Browse To URL" + :command-table global-command-table + :menu t + :provide-output-destination-keyword t) + ((url 'slidemacs-url :prompt "url")) + #+sbcl + (sb-ext:run-program "/usr/bin/open" (list url))) + +(define-presentation-to-command-translator browse-url-translator + (slidemacs-url com-browse-to-url global-command-table + :gesture :select + :documentation "Browse To URL" + :pointer-documentation "Browse To URL") + (presentation) + (list (presentation-object presentation))) + +(defmethod display-parse-tree ((entity url-point) (syntax slidemacs-gui-syntax) pane) + (stream-write-string pane " ") + (with-text-style (pane `(:sans-serif :roman ,(getf *slidemacs-sizes* :bullet))) + (with-slots (url-string) entity + (display-parse-tree url-string syntax pane)))) + +(defmethod display-parse-tree ((entity url-string) (syntax slidemacs-gui-syntax) 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) + (present bullet-text 'slidemacs-url :stream pane)) + (present bullet-text 'slidemacs-url :stream pane)) + (terpri pane)))) + +(define-presentation-type reveal-button () :inherit-from t) + +(define-presentation-method present (object (type reveal-button) + stream (view textual-view) + &key &allow-other-keys) + (with-slots (button-label) object + (display-text-with-wrap-for-pane (slidemacs-entity-string button-label) + stream))) + +(define-command (com-reveal-text :name "Reveal Text In Window" + :command-table global-command-table + :menu t + :provide-output-destination-keyword t) + ((text 'string :prompt "text")) + (let ((stream (open-window-stream))) + (with-text-style (stream `(:sans-serif :roman ,(getf *slidemacs-sizes* :bullet))) + (write-string text stream)))) + +(define-presentation-to-command-translator reveal-text-translator + (reveal-button com-reveal-text global-command-table + :gesture :select + :documentation "Reveal Text In Window" + :pointer-documentation "Reveal Text In Window") + (presentation) + (with-slots (reveal-text) (presentation-object presentation) + (list (slidemacs-entity-string reveal-text)))) + +(defmethod display-parse-tree ((entity reveal-button-point) (syntax slidemacs-gui-syntax) pane) + (write-string " " pane) + (with-text-style (pane `(:sans-serif :roman ,(getf *slidemacs-sizes* :bullet))) + (present entity 'reveal-button :stream pane)) + (terpri pane)) + #+(or) (defun draw-picture (stream pattern) (multiple-value-bind (x y)

Index: climacs/slidemacs.lisp diff -u climacs/slidemacs.lisp:1.5 climacs/slidemacs.lisp:1.6 --- climacs/slidemacs.lisp:1.5 Sat Jun 18 15:58:49 2005 +++ climacs/slidemacs.lisp Tue Jun 21 18:51:05 2005 @@ -290,13 +290,20 @@ nonempty-list-of-bullets block-close) (:= slidemacs-slide-keyword "slide") (:= slidemacs-slide-name slidemacs-string) - (:= nonempty-list-of-bullets (nonempty-list-of slidemacs-bullet-or-picture)) - (:= slidemacs-bullet-or-picture (or slidemacs-bullet picture-node)) + (:= nonempty-list-of-bullets (nonempty-list-of slidemacs-bullet-types)) + (:= slidemacs-bullet-types (or slidemacs-bullet picture-node url-point reveal-button-point)) (:= slidemacs-bullet bullet talking-point) (:= talking-point slidemacs-string) (:= picture-node picture-keyword picture-pathname) (:= picture-keyword "picture") - (:= picture-pathname slidemacs-string)) + (:= picture-pathname slidemacs-string) + (:= url-point url-keyword url-string) + (:= url-keyword "url") + (:= url-string slidemacs-string) + (:= reveal-button-point reveal-keyword button-label reveal-text) + (:= reveal-keyword "reveal") + (:= button-label slidemacs-string) + (:= reveal-text slidemacs-string))

(defmethod display-parse-tree ((entity slidemacs-terminal) (syntax slidemacs-editor-syntax) pane) (with-slots (item) entity