CLIM mail archive
[Prev][Next][Index][Thread]

help for editing text. (cont'd)

;;; -*- Mode: LISP; Syntax: Common-lisp; Package: ALEPS-USER; Base: 10 -*-

;; The following function is based on code from chee@isi.edu, "John G. Aspinall" <JGA@stony-brook.scrc.symbolics.com>,
;; and "Mike Brady" <mike@hsvaic.boeing.com>.
;; Some changes were made for flexibility.  Others were necessary to get
it to work from a button on an accepting-values dialog.

(defun EDIT-POPUP (text &KEY
		   (title "Hit <Return> when finished editing.") (width 60) (height 10)
		   (associated-window (frame-top-level-window *application-frame*)))
  "Creates an edit popup window with the string TEXT to be edited.  Returns the edited string.
   :TITLE is centered at the top of the window, :WIDTH and :HEIGHT are the window size in characters.
   If used in the context of ACCEPTING-VALUES, :ASSOCIATED-WINDOW must specify the a `real'
   frame-top-level-window, i.e., one from a real application-frame."
  (with-menu (stream associated-window)
    ;; Set up the pop-up window the way we want to see it
    (setf (clim::cursor-visibility (clim::stream-text-cursor stream)) :off) ;kludge
    (setq width (* width (stream-character-width stream #\Space))
	  height (* height (stream-line-height stream)))
    (clim::window-set-inside-size stream width height)
    (setf (stream-text-margin stream) (bounding-rectangle-width (window-viewport stream)))
    (when title
      (loop as pos = (position #\Return title)
	  while pos
	  as line = (subseq title 0 pos)
	  finally (format stream "~A~2%" (centerable-string title stream :stream-width width))
	  do
	    (setq title (subseq title (1+ pos)))
	    (format stream (centerable-string line stream))))
    (setf (stream-text-margin stream) (bounding-rectangle-width (window-viewport stream)))
    (window-expose stream)
    (unwind-protect
	(with-input-editing (stream)
	  ;; Put the text into the input buffer and ensure that we never do it again
	  ;; Code inside with-input-editing will restart any time the user edits
	  ;; (e.g. types <rubout>).  Therefore you must make sure that replace-input
	  ;; only gets called the first time.
	  (when text
	    ;; fill the input buffer of the input-editing stream
	    (replace-input stream text :rescan t)
	    (setq text nil))
	  ;; kludge to get the contents displayed
	  #+excl (window-refresh stream)
	  ;; sometimes the simple window-refresh happens too soon...
	  #+excl (mp::process-run-function "edit-popup-kludge"
					   #'(lambda (stream)
					       (sleep 1) (clim::window-refresh stream))
					   stream)
	  ;; Now get the input from the user
	  (with-activation-characters ('(#\Newline) :override t)
	    (unwind-protect
		(read-token stream)
	      ;; Eat the activation character
	      (read-gesture :stream stream :timeout 0))))
      ;; for some reason, the following line doesn't seem to work.
      (stream-set-cursor-position* stream (1- width) (1- height)) ;so we don't lose text after the cursor
      (setf (clim::cursor-visibility (clim::stream-text-cursor stream)) :inactive)))) ;kludge

#|
George Williams            BCS Huntsville Artificial Intelligence Center
Boeing Computer Services   Internet: george@hsvaic.boeing.com
POBox 240002, M/S JY-58    UUCP: ...!uw-beaver!bcsaic!hsvaic!george
Huntsville AL 35824-6402   Phone: 205+464-4968 FAX: 205+464-4930 |#
Main Index | Thread Index