CLIM mail archive
[Prev][Next][Index][Thread]
Caching CLIM generated menus?
From: clarisse@iexist.att.com
Date: Thu, 2 Jun 94 21:16:51 CDT
Thanks for the solution, IT ALMOST WORKS for me.
With a few heuristic code changes to your initial code (marked with ***)
I have almost gotten your solution to work for our application
under Franz CLIM2.0. And there is a very noticeable performance
improvement to bring up presentation menus. However the command selected
from these faster menus end-up breaking at a low level (error and
some trace is included at end of this mail), it seems the
values returned from (throw tag ...) don't work everywhere.
From: Scott McKay <swm@harlequin.com>
Date: Thu, 2 Jun 94 18:14:44 EDT
Check this out. There's a sample usage at the end of the file. It
appears to be 2 or 3 times faster than the general case. It could be
made somewhat faster by caching the translators, too, but then it
would be even more static.
(defun find-translators-for-context-type (presentation context-type frame window x y
&key modifier-state (for-menu nil for-menu-p))
(let* ((applicable-translators nil)
(from-type (presentation-type presentation))
;;; *** Without this change no menu appears for our application
;;; With the change a simpler form of the menu appears 3 times faster
;;; than the default menu.
I think this change is probably a bad idea. It can cause this
function to return presentation translators for the wrong
presentation. Think about the case where there are two nested
presentations that have exactly the same bounding rectangle.
(translators #+Allegro
(mapcar #'first (find-applicable-translators presentation *input-context* frame window x y :for-menu for-menu))
#-Allegro
(find-presentation-translators
from-type context-type (frame-command-table frame))))
(setf xx (find-presentation-translators
from-type context-type (frame-command-table frame)))
(setf xxx translators)
(when translators
(dolist (translator translators)
(when (and (or (not for-menu-p)
(eq (presentation-translator-menu translator) for-menu))
(test-presentation-translator translator
presentation context-type
frame window x y
:event nil
:modifier-state modifier-state
:for-menu for-menu))
(push translator applicable-translators))))
(nreverse (delete-duplicates applicable-translators))))
#||
;;; Justification for the above change at least for our application
;;; in Allegro, is that in general invoking FIND-PRESENTATION-TRANSLATOR
;;; returns a useless list of translators (usually (T -> NIL)) only as follows:
;;;
;;; The result of invoking:
;;;
(find-presentation-translators from-type context-type (frame-command-table frame))
;;; is:
(#<PRESENTATION-ACTION SF::ACTOR-PRESENTATION-MENU (CLIK::ACTOR -> NIL) @
#x1377e32>
#<PRESENTATION-TRANSLATOR IDENTITY (T -> NIL) @ #x8ce74a>)
;;; The result of invoking (more meaningful):
(mapcar #'first (find-applicable-translators presentation *input-context* frame window x y :for-menu for-menu))
;;; is:
(#<PRESENTATION-TO-COMMAND-TRANSLATOR
CLIK::COMPONENT-TO-COM-MOVE-COMPONENT-TRANSLATOR (CLIK:COMPONENT -> (COMMAND
:COMMAND-TABLE
CLIK:ACTOR-COMMANDS))
@ #xecb922>
#<PRESENTATION-TO-COMMAND-TRANSLATOR
CLIK::COMPONENT-TO-COM-GROUP-COMPONENT-TRANSLATOR (CLIK:COMPONENT -> (COMMAND
:COMMAND-TABLE
CLIK:ACTOR-COMMANDS))
@ #xecb942>
...)
||#
#||
(define-presentation-action pathname-presentation-menu
(pathname command clim-env::lisp-listener
:documentation "Pathname menu"
:menu nil ;this doesn't go into any menu
:gesture :menu
:priority 1)
(object presentation frame window x y context-type)
;; *** Change required here :test #'equal else the-context is NIL.
This should't really need the EQUAL test, since the context type
should have been gotten out of *INPUT-CONTEXT* -- EQ should suffice.
But that is a pretty internal assumption, so EQUAL is fine.
(let ((the-context (assoc context-type *input-context* :test #'equal)))
(call-cached-presentation-menu presentation the-context
frame window x y
;; *** there seems to be a problem
;; with this the menu label is cached
;; and appears unchanged for all
;; instances of pathname (unfortunately).
:label (file-namestring object))))
#+ignore (remove-presentation-translator 'pathname-presentation-menu)
||#
#||
;;; With the above changes although the menus appear much faster
;;; the menu command selected errors instantly as follows.
;;; [I have been unsuccessful at returning different arguments
;;; via (throw tag ...) as above to let the command parser proceed
;;; properly, or at invoking EXECUTE-FRAME-COMMAND on
;;; partial commands instead of throwing the results... to tag]
I'm afraid you're on your own here.
---------------------------------------------------------------------
Error: Attempt to access the plist field of
(SF::COM-RENAME-COMPONENT [ACTOR MOVIES]) which is not a symbol.
[condition type: SIMPLE-ERROR]
Restart actions (select using :continue):
0: Return to tof-1 command level
1: tof-1 top level
2: Exit tof-1
[changing package from "COMMON-LISP-USER" to "CLIM-INTERNALS"]
[Current process: tof-1]
[1] CLIM-INTERNALS(1): :bt
Evaluation stack:
INVOKE-COMMAND-NAME-PARSER-AND-COLLECT-1 <-
(FLET INVOKE-COMMAND-PARSER-AND-COLLECT BODY-CONTINUATION) <-
INVOKE-WITH-INPUT-CONTEXT <- INVOKE-COMMAND-PARSER-AND-COLLECT <-
(FLET MENU-COMMAND-PARSER BODY-CONTINUATION) <- INVOKE-WITH-INPUT-CONTEXT <-
MENU-COMMAND-PARSER <- (FLET (METHOD ACCEPT-METHOD #) BODY-CONTINUATION) <-
INVOKE-WITH-INPUT-CONTEXT <- (METHOD ACCEPT-METHOD (# T T ...)) <-
(... ACCEPT-METHOD) <-
(FLET (FLET ACCEPT-1 WITH-INPUT-EDITING-BODY) BODY-CONTINUATION) <-
INVOKE-WITH-INPUT-CONTEXT <- (FLET ACCEPT-1 WITH-INPUT-EDITING-BODY) <-
INVOKE-WITH-INPUT-CONTEXT <-
(FLET INVOKE-WITH-INPUT-EDITING WITH-OUTPUT-RECORDING-OPTIONS-BODY) <-
(METHOD INVOKE-WITH-OUTPUT-RECORDING-OPTIONS
(OUTPUT-RECORDING-MIXIN T T ...)) <-
(... INVOKE-WITH-OUTPUT-RECORDING-OPTIONS) <-
(METHOD INVOKE-WITH-OUTPUT-RECORDING-OPTIONS
(STANDARD-ENCAPSULATING-STREAM T T ...)) <-
(... INVOKE-WITH-OUTPUT-RECORDING-OPTIONS) <- INVOKE-WITH-INPUT-EDITING <-
ACCEPT-1 <- (METHOD STREAM-ACCEPT (INPUT-PROTOCOL-MIXIN T)) <- ACCEPT <-
READ-COMMAND <- (METHOD READ-FRAME-COMMAND (STANDARD-APPLICATION-FRAME)) <-
(METHOD READ-FRAME-COMMAND :AROUND ...) <- :EFFECTIVE-METHOD <-
(... READ-FRAME-COMMAND) <-
(METHOD DEFAULT-FRAME-TOP-LEVEL (STANDARD-APPLICATION-FRAME)) <-
:EFFECTIVE-METHOD <-
(METHOD RUN-FRAME-TOP-LEVEL (STANDARD-APPLICATION-FRAME)) <-
(METHOD RUN-FRAME-TOP-LEVEL :AROUND ...) <-
(FLET (:INTERNAL # 0) CLIM-UTILS::WITH-DRAWING-OPTIONS-BODY)
(METHOD INVOKE-WITH-DRAWING-OPTIONS (BASIC-MEDIUM T)) <-
(... INVOKE-WITH-DRAWING-OPTIONS) <- ...
[Current process: tof-1]
[1] CLIM-INTERNALS(2): :loc
:loc
Compiled lexical environment:
0(REQUIRED): COMMAND-NAME: (SF::COM-RENAME-COMPONENT [ACTOR MOVIES])
1(REQUIRED): ARG-PARSER: #<Closure (FLET # MENU-PARSER) @ #x16c6b7a>
2(REQUIRED): DELIMITER-PARSER: #<Function (FLET # MENU-DELIMITER)>
3(REQUIRED): STREAM: #<STANDARD-INPUT-EDITING-STREAM @ #x136cbaa>
4(LOCAL): :UNKNOWN: #<Function (FLET # MENU-DELIMITER)>
5(LOCAL): :UNKNOWN: #(#(NIL #) NIL)
6(LOCAL): :UNKNOWN: NIL
7(LOCAL): :UNKNOWN: 103
8(LOCAL): :UNKNOWN: #(NIL NIL NIL NIL NIL NIL ...)
9(LOCAL): :UNKNOWN: 47
10(LOCAL): :UNKNOWN: (:EMPTY)
11(LOCAL): :UNKNOWN: 47
[Current process: tof-1]
[1] CLIM-INTERNALS(3):
||#
References:
Main Index |
Thread Index