[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Select wish
Date: Mon, 7 Dec 1992 11:04 EST
From: Paul Cross <paul@PERSEPHONE.aegean-sea.dialnet.symbolics.com>
I would like the select mechanism to ask for confirmation the first time
I select an activity. That way, when I do a typo on the select gesture,
the program frame will not get built. After the first selection, I don't
want to confirm anymore for that activity.
I didn't see any other responses to this, so I hacked up the enclosed
patch. It includes an option global to enable the confirmation feature
(default disabled, same behavior as without the patch). This will pop
up a confirmation menu whenever a new activity/window is created by any
interface (SELECT <char>, SELECT c-<char>, :Select Activity, etc.).
Tested in 8.1.1; no guarantees for any older release.
I like this idea so much that I'm going to submit it as a new feature
for a future release of Genera. Thanks for the inspiration. Enjoy.
Douglas Dodds (dodds@symbolics.com)
Symbolics, Inc.
Concord, Mass.
-----------------------------------------------------
;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10; Patch-File: T -*-
;;; Patch file for Private version 0.0
;;; Reason: Variable CLI::*CONFIRM-ACTIVITY-CREATION*: Global to control whether confirmation is demanded
;;; if a selection interface, e.g., SELECT <char>, is creating a new instance of the activity.
;;; Function CLI::FIND-FRAME-FOR-ACTIVITY: If the variable says to confirm, pop up a confirming
;;; query whenever a new instance is being created.
;;; Function (FLAVOR:METHOD SYS:SELECT-ACTIVITY CLI::COMPATIBLE-ACTIVITY): Pass down the activity
;;; name, for possible use in a confirming query.
;;; Function (FLAVOR:METHOD SYS:SELECT-ACTIVITY CLI::PROGRAM-ACTIVITY): ..
;;; Function (FLAVOR:METHOD SYS:SELECT-ACTIVITY CLI::PROGRAM-CHOICE-ACTIVITY): ..
;;; Written by dodds, 12/10/92 13:20:35
;========================
(SI:BEGIN-PATCH-SECTION)
(SI:PATCH-SECTION-SOURCE-FILE "SYS:WINDOW;ACTIVITIES.LISP.36")
(SI:PATCH-SECTION-ATTRIBUTES
"-*- Mode: LISP; Syntax: Common-lisp; Package: COMMON-LISP-INTERNALS; Lowercase: Yes -*-")
(defvar *confirm-activity-creation* nil
:documentation "Whether to pop up a confirming query before creating an activity frame.")
(defun find-frame-for-activity (console superior predicate creator
&rest keys
&key selected-ok
select
expose
activate
force-create
beep-if-only-one-selected
frame-name)
(declare (sys:downward-funarg predicate creator))
(declare (values frame created-p))
(when (null console)
(setf console (if superior (tv:sheet-console superior) sys:*console*))
(when (null console)
(return-from find-frame-for-activity nil)))
(flet ((predicate (window)
(and (tv:window-is-selectable window)
(or (null superior)
(tv:sheet-me-or-my-kid-p window superior))
(funcall predicate window)))
(creator (&rest initargs)
(if (or (null *confirm-activity-creation*)
(tv:mouse-y-or-n-p
(format nil "Create ~@[~A ~]activity?" frame-name)))
(apply creator initargs)
(beep))))
(let* ((current-selected-window (console-selected-window console))
(current-activity (and current-selected-window
(send current-selected-window :alias-for-selected-windows)))
(current-matches (and current-activity
(predicate current-activity))))
(labels ((select-it (window bury-old &optional new-activity)
(when (or select expose activate)
(tv:delaying-screen-management ;Inhibit auto selection
(when current-selected-window
(send current-selected-window :deselect nil)
(when bury-old
(tv:add-to-previously-selected-windows current-selected-window t)))
(let ((exposable (tv:window-is-exposable-inferior window t)))
(if exposable
(if (and select (or (not new-activity )
(neq select :unless-created)))
(send window :select-shadowed-activity current-activity)
(if expose
(send window :expose)))
(send window :activate)))))
window)
(let-some-window-do-it (creator force-create)
;; permit the selected window and its superiors to participate
;; in the selection process.
(loop for window first current-activity then (tv:sheet-superior window)
when (not (instancep window))
do (return nil)
do (multiple-value-bind (found-thing created-p)
(si:with-rem-keywords (keys keys '(:frame-name))
(lexpr-send-if-handles window
:select-key-find-window-of-flavor
:error-p nil
:creator creator
:console console
:predicate #'predicate
:force-create force-create
keys))
(when found-thing
(return-from let-some-window-do-it
(values found-thing created-p)))))))
(unless superior
;; If the superior was specified, don't let the selected window
;; affect the choice.
(when (and creator (not force-create))
;; Give everyone a chance to find one, but never create one.
(multiple-value-bind (found-thing created-p)
(let-some-window-do-it nil nil)
(when found-thing
(return-from find-frame-for-activity
(values (select-it found-thing current-matches) created-p)))))
;; Optional creation. Never complain about unfound.
(multiple-value-bind (found-thing created-p)
(let-some-window-do-it #'creator force-create)
(when found-thing
(return-from find-frame-for-activity
(values (select-it found-thing current-matches) created-p)))))
(unless force-create
(when current-matches
(when selected-ok
(return-from find-frame-for-activity
(values current-activity nil)))
(when (not (null (assoc current-activity tv:*windows-shadowed-for-selection*)))
(return-from find-frame-for-activity
(values (select-it current-activity nil) nil))))
(let ((window (find-if #'predicate (console-previously-selected-windows console))))
(when window
(return-from find-frame-for-activity
(values (select-it window current-matches) nil))))
(dolist (screen (tv:console-screens-for-selection console))
(dolist (window (tv:sheet-inferiors screen))
(when (and (not (eql window current-activity))
(tv:window-is-exposable-inferior window t)
(funcall predicate window))
(cond ((null superior)
(tv:set-window-on-usable-screen window (sys:console-screen console)))
((not (eql superior (send window :superior)))
(tv:set-window-on-usable-screen window superior nil :force-move t)))
(return-from find-frame-for-activity
(values (select-it window current-matches) nil)))))
(when current-matches
(cond ((null beep-if-only-one-selected)
;no beep
)
((eq beep-if-only-one-selected t)
;simple default beep
(send (console-screen console) :beep))
((keywordp beep-if-only-one-selected)
;beep or flash or whatever
(send (console-screen console) :beep beep-if-only-one-selected))
((listp beep-if-only-one-selected)
;a form to be evaluated
(eval beep-if-only-one-selected))
(t ;a function to be called
(funcall beep-if-only-one-selected)))
(return-from find-frame-for-activity (values nil nil))))
(when creator
(let ((new-window (funcall #'creator
:superior (or superior (sys:console-screen console)))))
(when new-window
(return-from find-frame-for-activity
(values (select-it new-window nil t) t)))))
(values nil nil)))))
(defmethod (select-activity compatible-activity) (&key console superior
force-create beep-if-only-one-selected)
;; If FLAVOR is a list, it needs to be evaluated.
(let ((flavor-or-window (if (consp flavor)
(eval `(let ((tv:always-make-new ',force-create))
,flavor))
flavor)))
(cond ((instancep flavor-or-window)
;; If the activity list has a specific window indicated, use that.
(tv:set-window-on-usable-screen flavor-or-window
(or superior
(sys:console-screen
(or console sys:*console*))))
(send flavor-or-window :activate)
(find-frame-for-activity
console superior
#'(lambda (window) (eql window flavor-or-window))
nil
:select t
:beep-if-only-one-selected beep-if-only-one-selected))
(t
(let ((created-window nil))
(or (find-frame-for-activity
console superior
#'(lambda (window) (window-reusable-for-flavor-spec window flavor-or-window))
#'(lambda (&rest init-keywords &key superior &allow-other-keys)
(when create-p
(cond ((atom create-p)
(cl:apply #'tv:make-window
(if (eql create-p t)
(window-creation-flavor-from-flavor-spec
flavor-or-window)
create-p)
init-keywords))
(t
(setf (process:process-name *current-process*)
(activity-description self))
(let ((created (eval create-p)))
(cond ((typep created 'tv:sheet)
created)
(t
(console-selected-window (tv:sheet-console superior)))))))))
:select t
:force-create force-create
:beep-if-only-one-selected beep-if-only-one-selected
:frame-name flavor-or-window)
created-window))))))
(defmethod (select-activity program-activity) (&key console superior
force-create beep-if-only-one-selected)
(find-frame-for-activity console superior
#'(lambda (window)
(and (typep window 'dw::program-frame)
(eql (dw::program-name (send window :program))
program-name)))
#'(lambda (&rest init-keywords)
(apply #'tv:make-window 'dw::program-frame
:program program-name
init-keywords))
:select t
:force-create force-create
:beep-if-only-one-selected beep-if-only-one-selected
:frame-name program-name))
;;; The choosing is done at selection time, so that it is based on run-time conditions
(defmethod (select-activity program-choice-activity)
(&key console superior force-create beep-if-only-one-selected)
(let* ((program-name-to-use
(funcall choice-predicate
(or superior (sys:console-screen (or console sys:*console*))))))
(typecase program-name-to-use
(string
(tv:notify nil program-name-to-use))
(null)
(t
(find-frame-for-activity console superior
#'(lambda (window)
(and (typep window 'dw::program-frame)
(eql (dw::program-name (send window :program))
program-name-to-use)))
#'(lambda (&rest init-keywords)
(apply #'tv:make-window 'dw::program-frame
:program program-name-to-use
init-keywords))
:select t
:force-create force-create
:beep-if-only-one-selected beep-if-only-one-selected
:frame-name program-name-to-use)))))
- References:
- Select wish
- From: Paul Cross <paul@PERSEPHONE.aegean-sea.dialnet.symbolics.com>