CLIM mail archive
[Prev][Next][Index][Thread]
Caching CLIM generated menus?
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
Message-Id: <26841.9406022214@tigris.harlequin.com>
To: clarisse@iexist.att.com
Cc: swm@harlequin.com, clim@BBN.COM, bugs@franz.com
In-Reply-To: clarisse@iexist.att.com's message of Wed, 1 Jun 94 17:51:10 CDT <9406012251.AA08267@tenet.lab5523>
Subject: Caching CLIM generated menus?
Content-Length: 5436
X-Lines: 120
Status: RO
From: clarisse@iexist.att.com
Date: Wed, 1 Jun 94 17:51:10 CDT
>
> The Sparc 10 I have generates such menus with 15 to 20 items in about
> 1 second. How big are your menus?
>
Our longest menus are 15 items long. After mouse-right selection, they
take 2-3 seconds to appear the first time. If all I do is a lot of
right selection, the lapse time seems to go down to 1 second. Even
1 second for these feels slow in this case.
[...]
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.
||#
--------------------
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
(in-package :clim-internals)
;; This is like CALL-PRESENTATION-MENU, except that it caches the menu
;; it computes and then reuses it later. The fact that we are caching
;; stuff means that we have to use a much simpler model than the normal
;; presentation-menu translator. In particular, we can't assume that
;; we're doing any of the presentation-with-shared-box stuff, and we
;; can't even search up input contexts. Too bad, at least it's fast.
(defun call-cached-presentation-menu (presentation the-context frame window x y
&key (for-menu t) label)
(let* ((context-type (input-context-type the-context))
(tag (input-context-tag the-context))
;;--- Should we cache the result of this?
;;--- If so, the cache value for MENU-CHOOSE should be constant
(translators (find-translators-for-context-type
presentation context-type frame window x y
:for-menu for-menu)))
(when translators
(flet ((translator-documentation (translator stream)
(document-presentation-translator translator presentation context-type
frame nil window x y
:stream stream
:documentation-type :pointer)))
(declare (dynamic-extent #'translator-documentation))
(let ((translator (menu-choose translators
:associated-window window
:label label
:printer #'translator-documentation
:cache t
:unique-id (list (presentation-type presentation)
(evacuate-list context-type))
:id-test #'equal
:cache-value translators
:cache-test #'equal)))
(when translator
(multiple-value-bind (translated-object translated-type options)
(call-presentation-translator translator presentation context-type
frame nil window x y)
(throw tag (values translated-object
(or translated-type context-type)
nil
options)))))))))
(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.
(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.
(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]
---------------------------------------------------------------------
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):
||#
Follow-Ups:
Main Index |
Thread Index