/[mcclim]/mcclim/frames.lisp
ViewVC logotype

Diff of /mcclim/frames.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.136 by crhodes, Sat Feb 28 16:49:40 2009 UTC revision 1.137 by gbaumann, Sat Aug 1 16:10:31 2009 UTC
# Line 466  documentation produced by presentations. Line 466  documentation produced by presentations.
466  (defmethod default-frame-top-level  (defmethod default-frame-top-level
467      ((frame application-frame)      ((frame application-frame)
468       &key (command-parser 'command-line-command-parser)       &key (command-parser 'command-line-command-parser)
469            (command-unparser 'command-line-command-unparser)            (command-unparser 'command-line-command-unparser)
470            (partial-command-parser            (partial-command-parser
471             'command-line-read-remaining-arguments-for-partial-command)             'command-line-read-remaining-arguments-for-partial-command)
472            (prompt "Command: "))            (prompt "Command: "))
473    ;; Give each pane a fresh start first time through.    ;; Give each pane a fresh start first time through.
474    (let ((first-time t))    (let ((first-time t))
475      (loop      (loop
476         ;; The variables are rebound each time through the loop because the         ;; The variables are rebound each time through the loop because the
477         ;; values of frame-standard-input et al. might be changed by a command.         ;; values of frame-standard-input et al. might be changed by a command.
478         (let* ((*standard-input*  (or (frame-standard-input frame)         (let* ((*standard-input*  (or (frame-standard-input frame)
479                                       *standard-input*))                                       *standard-input*))
480                (*standard-output* (or (frame-standard-output frame)                (*standard-output* (or (frame-standard-output frame)
481                                       *standard-output*))                                       *standard-output*))
482                (query-io  (frame-query-io frame))                (query-io  (frame-query-io frame))
483                (*query-io* (or query-io *query-io*))                (*query-io* (or query-io *query-io*))
484                (*pointer-documentation-output*                (*pointer-documentation-output*
485                 (frame-pointer-documentation-output frame))                 (frame-pointer-documentation-output frame))
486                ;; during development, don't alter *error-output*                ;; during development, don't alter *error-output*
487                ;; (*error-output* (frame-error-output frame))                ;; (*error-output* (frame-error-output frame))
488                (*command-parser* command-parser)                (*command-parser* command-parser)
489                (*command-unparser* command-unparser)                (*command-unparser* command-unparser)
490                (*partial-command-parser* partial-command-parser)                (*partial-command-parser* partial-command-parser)
491                (interactorp (typep *query-io* 'interactor-pane)))                (interactorp (typep *query-io* 'interactor-pane)))
492           (restart-case           (restart-case
493               (progn               (progn
494                 (redisplay-frame-panes frame :force-p first-time)                 (redisplay-frame-panes frame :force-p first-time)
495                 (setq first-time nil)                 (setq first-time nil)
496                 (if query-io                 (if query-io
497                     ;; For frames with an interactor:                     ;; For frames with an interactor:
498                     (progn                     (progn
499                       ;; Hide cursor, so we don't need to toggle it during                       ;; Hide cursor, so we don't need to toggle it during
500                       ;; command output.                       ;; command output.
501                       (setf (cursor-visibility (stream-text-cursor *query-io*))                       (setf (cursor-visibility (stream-text-cursor *query-io*))
502                             nil)                             nil)
503                       (when (and prompt interactorp)                       (when (and prompt interactorp)
504                         (with-text-style (*query-io* +default-prompt-style+)                         (with-text-style (*query-io* +default-prompt-style+)
505                           (if (stringp prompt)                           (if (stringp prompt)
506                               (write-string prompt *query-io*)                               (write-string prompt *query-io*)
507                               (funcall prompt *query-io* frame))                               (funcall prompt *query-io* frame))
508                           (finish-output *query-io*)))                           (force-output *query-io*)))
509                       (let ((command (read-frame-command frame                       (let ((command (read-frame-command frame
510                                                          :stream *query-io*)))                                                          :stream *query-io*)))
511                         (when interactorp                         (when interactorp
512                           (fresh-line *query-io*))                           (fresh-line *query-io*))
513                         (when command                         (when command
514                           (execute-frame-command frame command))                           (execute-frame-command frame command))
515                         (when interactorp                         (when interactorp
516                           (fresh-line *query-io*))))                           (fresh-line *query-io*))))
517                     ;; Frames without an interactor:                     ;; Frames without an interactor:
518                     (let ((command (read-frame-command frame :stream nil)))                     (let ((command (read-frame-command frame :stream nil)))
519                       (when command (execute-frame-command frame command)))))                       (when command (execute-frame-command frame command)))))
520             (abort ()             (abort ()
521               :report "Return to application command loop"               :report "Return to application command loop"
522               (if interactorp               (if interactorp
523                   (format *query-io* "~&Command aborted.~&")                   (format *query-io* "~&Command aborted.~&")
524                   (beep))))))))                   (beep))))))))
525    
526  (defmethod read-frame-command :around ((frame application-frame)  (defmethod read-frame-command :around ((frame application-frame)
527                                         &key (stream *standard-input*))                                         &key (stream *standard-input*))

Legend:
Removed from v.1.136  
changed lines
  Added in v.1.137

  ViewVC Help
Powered by ViewVC 1.1.5