5.0 FOCUS: Code Blocks for Blockheads, Part 1
By Greg Lief

Introduction

Now that we have all had more time to play with Clipper 5.0, this
is an appropriate time to talk more about code blocks, along with some
5.0 functions that use them.

Last month we talked about code block basics. We also looked at some
of the basic code block functions (EVAL(), AEVAL(), ASORT(), ASCAN(),
and DBEVAL()). There are several other new functions that use these
creatures, and we will look at them now in excruciating detail. We
will also discuss an intriguing method of passing local variables to
another function with code blocks.


Code Blocks Laid Bare

Code blocks are a new datatype that contains compiled Clipper code.
They can be compiled either at compile-time with the rest of your
Clipper code, or at run-time with the use of the & operator.
(Yes, Virginia, I know this does not make a lot of sense, but there
are plenty of examples to follow.)

This is a code block in its rawest form:

{ | [] | }

Code blocks look quite similar to Clipper 5.0 arrays. Both code
blocks and arrays begin with an open curly brace ("{") and end with a
closed curly brace ("}"). But code blocks differentiate themselves by
including two "pipe" characters ("|") directly after the opening
brace. You may optionally include an between these
pipe characters, which would then be passed to the code block upon
evaluation. The should be comma delimited (e.g.,
"a, b, c...").

Although white space between the pipe characters and braces is purely
optional, I highly recommend you use it for the sake of readability.

The is, obviously enough, a comma-delimited list of
any valid Clipper expressions. These can run the gamut, as you
will quickly discover.


How to Write a Code Block

There are three methods in which to write a code block:

a) To be compiled into a code block at compile-time, for example:

local myblock := { | | fname }

b) As a character string, which can be compiled to a code block at
run time. For such compilation you can use the & operator
(yes, the same one that is used for macros). But remember that
this is not the same thing as macro substitution!

Suppose that we wanted to set up a TBrowse() object to browse a
database. We would need to establish a column for each field in
the database. When setting up TBrowse() columns, we must
specify a code block, which when evaluated, contains the
contents of that column. If we knew in advance that our
database contained the fields FNAME, LNAME, and SSN, it would be
a simple matter to write the code blocks so that they could be
compiled at compile-time:

local x, browse := TBrowseNew(3, 19, 15, 60), column
use test
column := TBColumnNew("FNAME", { | | fname } )
browse:AddColumn( column )
column := TBColumnNew("LNAME", { | | lname } )
browse:AddColumn( column )
column := TBColumnNew("SSN", { | | ssn } )
browse:AddColumn( column )

However, let us further suppose that we wish this routine to be
generic. We therefore cannot hard-code field names, because the
structure will be unknown until run-time. Here's how we would
approach it:

local x, browse := TBrowseNew(3, 19, 15, 60), column
use test
for x := 1 to fcount()
column := TBColumnNew(field(x), &("{ | | " + field(x) + "}"))
browse:AddColumn( column )
next

The Clipper FIELD() function returns the name of the field based
at the ordinal position in the database structure. For example,
FIELD(2) will return the name of the second field in the
database ("LNAME" in our little example).

c) Cower in fear at the mention of the words "code block", and let
the preprocessor write them all for you. For example, if you
write the following code:

index on fname to customer

lo and behold! The preprocessor will dedicate a code block in
your honor:

__dbCreatIndex( "temp", "fname", {|| fname}, if(.F., .T., NIL))

Code blocks have much in common with inner city cockroaches: you
cannot neither run nor hide from them. Thankfully, code blocks
are a lot more fun and a million times more useful than
cockroaches, which is why if you have read this far, you should
keep reading and stop playing with your pet cockroach.


Evaluating Code Blocks

The only operation that you can perform on a code block is evaluation.
You can think of evaluation as being analagous to calling a function
and returning a value from it. Code blocks are evaluated by the
EVAL(), AEVAL(), or DBEVAL() functions. They are also evaluated
internally when you pass them as parameters to functions that can use
them. When evaluated, code blocks return the value of the rightmost
expression within them. For example, if you create the following code
block:

local myblock := { | | mvar }

when you EVALuate this code block, it will return the value of MVAR.

local myblock := { | | mvar }, mvar := 500, x
x := eval(myblock)
? x // output: 500

Remember that code blocks can contain any valid Clipper expressions.
This means that you can get considerably fancier with them. For
example:

local myblock := { | | qout(var1), qqout(var2), 500 }
local var1 := "Mister ", var2 := "Grump"
x := eval(myblock) // output: "Mister Grump"
? x // output: 500

Look again at that last statement. How does X get the value of 500?
When you evaluate a code block, it returns the value of the last (or
rightmost) expression within it. Because the last expression in
MYBLOCK was 500, the variable X assumed that value.


Using Code Blocks Without Parameters

These are examples of simple code blocks that do not use parameters:

local myblock := { | | qout(mvar) }, mvar := "testing"
eval(myblock) // output: "testing"

local myblock := { | | 5000 }
x := eval(myblock)
? x // output: 5000

local myblock := { | | x++ }
for y := 1 to 100
eval(myblock) // crashes because X has not been defined
next
? x

local myblock := { | | x++ }, x := 1 // much nicer thanks
for y := 1 to 100
eval(myblock)
next
? x // output: 101

local myblock := { | | BlueFunc() }
eval(myblock) // calls BlueFunc() which displays a message
return nil

static function bluefunc
? "here we are in a BlueFunc() - will we ever escape?"
inkey(5)
return nil


Using Code Blocks with Parameters

Just as with functions, there is far greater power to harness with
code blocks when you begin passing parameters. Writing a parameter
list for a code block is nearly identical to writing one for a
function. However, because it is harder to conceptualize in the
linear world of a code block, let's write a simple code block and then
rewrite it as a function:

local myblock := { | a, b, c | max(a, max(b, c)) }

function mmax(a, b, c)
return max(a, max(b, c))

As you can readily see, the function MMax() returns the highest of the
three parameters passed to it. Evaluating the code block MyBlock will
return exactly the same thing. However, we must first slip past
another stumbling block: namely, how to pass parameters to a code
block. It is actually quite simple; the EVAL() function accepts
optional parameters after the name of the code block. Each such
optional parameter represents a parameter to be passed to the code
block. For example, if you write:

eval(myblock, 20)

you are passing the numeric parameter 20 to the code block defined as
MyBlock. Let's have another look at our MMAX() function and code
block so that you can get a feel for passing parameters with EVAL():

local myblock := { | a, b, c | max(a, max(b, c)) }
? mmax(20, 100, 30) // output: 100
? eval(myblock, 20, 100, 30) // output: 100

Do you remember the BlueFunc() that we were just in? (I'm feeling
much better now, thank you.) Whaddaya say we modify the function and
the code block to accept a parameter which will dictate how long to
wait for a keypress?

local myblock := { | x | BlueFunc(x) }
eval(myblock, 20) // calls BlueFunc() and will wait 20 seconds
return nil

static function bluefunc(delay)
? "we're in a BlueFunc() for " + ltrim(str(delay)) + " seconds"
inkey(delay)
return nil

Here is a code block that accepts up to three parameters and displays
them on the screen.

local myblock := { | a, b, c | qout(a, b, c) }
eval(myblock, 1, 2, 3) // output: 1 2 3
x := eval(myblock, 1, 2) // output: 1 2 NIL
? x // output: NIL

You already know why the second EVAL() statement outputs 1, 2, and
NIL, right? It is because any declared parameters that are not
received are initialized to NIL (see my article in the December 1990
Aquarium on the subject of NIL). Because MyBlock expects three
parameters (A, B, C), and we only pass two, C gets initialized to NIL.
Trick question: do you know why X takes the value of NIL? No, it has
nothing to do with the fact that we passed too few parameters. Rather,
it is because the code block returns the value of the expression
QOut(a, b, c). The QOut() function always returns NIL. (If you
already knew this, give yourself a pat on the back but do not break
your arm in the process!)

Important Note: any arguments that you specify in a code block
are automatically given LOCAL scope. Such arguments will not be
visible to any nested code blocks! This merits another example:

local firstblock := { | | qout(x) }
local myblock := { | x | x++, eval(firstblock) }
eval(myblock, 3)

This program will crash when you attempt to EVALuate FirstBlock().
It does seem that the argument X in MyBlock() should be visible within
FirstBlock(). But X is LOCAL to MyBlock() and is therefore NOT
visible to FirstBlock().


Functions That Crave Code Blocks

EVAL(, [])

You should have already surmised that EVAL() evaluates a code
block, which you pass to it as the parameter. The optional
parameter is a comma-delimited list of parameters to be
passed to the code block when you evaluate it.

Return value: EVAL() returns the value of the last (rightmost)
expression within the block.

AEVAL(, , [], [])

AEVAL() is similar to EVAL() but is specially designed to work with
arrays. It evaluates a code block (specified by the
parameter) for each element in the array (specified by the
parameter). You may optionally specify a element, and a
number of elements () to process. If you do not use these
optional parameters, AEVAL() will begin with the first element in
the array and process all of them.

The following AEVAL() is a real workhorse; it determines the
maximum, minimum, and sum of all elements in the array MyArray:

local myarray := { 75, 100, 2, 200, .25, -25, 40, 52 }, ;
nmax, nmin, nsum := 0
nmax := nmin := myarray[1]
aeval(myarray, { | a | nmax := max(nmax, a), nmin := min(nmin, a),;
nsum += a } )
? "Maximum value:", nmax // 200
? "Minimum value:", nmin // -25
? "Total amount: ", nsum // 444.25

AEVAL() automatically passes two parameters to the code block:
and . is the value of the array element
being processed. is the number of the array element being
processed. You have already seen how is used, but why
should we bother with ? Suppose that you want to increment
each element in MyArray. You would probably write your code block
like this:

aeval(myarray, { | a | a++ } )
aeval(myarray, { | a | qout(a) } )

Surprise, surprise! This will not do a single thing to the
elements of the array, because they are passed by value (not
reference) to the code block. Passing by value means that the
code block makes a copy of the array element, and any manipulation
done within the code block is performed on the copy rather than the
genuine article. Let's try it again with the parameter:

aeval(myarray, { | a, b | myarray[b]++ } )
aeval(myarray, { | a | qout(a) } )

Return value: AEVAL() returns a reference to the array you ask it
to process.

DBEVAL(, [], [], [], [], [])

DBEVAL() is similar to AEVAL(), except that it deals with databases
rather than arrays. It also provides far greater control,
including FOR, WHILE, NEXT, RECORD, and REST clauses. If you look
at the STD.CH header file, you will see that the COUNT, SUM, and
AVERAGE commands, as well as the iterator versions of DELETE,
RECALL, and REPLACE, are all preprocessed into calls to DBEVAL().
For example, if you want to sum the field BALANCE for all records in
your database, the following DBEVAL() would do the trick:

ntotal := 0
DBEval( { | | ntotal += balance} )

You could easily modify this to keep track of the highest balance:

ntotal := nmax := 0
DBEval( { | | ntotal += balance, nmax := max(nmax, balance) } )
? "Total: ", ntotal
? "Maximum:", nmax

is the code block to evaluate for each database record.
There are a plethora of optional parameters.

and are code blocks that correspond directly to the
FOR and WHILE clauses. Basically, if you use either or both of
these clauses, DBEVAL() will process records until the code blocks
return False (.F.).

and are both numerics; specifies how many
records to process from the current record, and specifies
which record number to process.

is a logical that determines whether the DBEVAL() scope will
be from the current record to the end-of-file, or all records. If
you pass True (.T.), DBEVAL() will assume that you prefer the
former (i.e., start from current record). If you pass False or
ignore this parameter, DBEVAL() will process all records.

Return Value: DBEVAL() always returns NIL.

ASCAN(, , [], [])

As in Summer '87, ASCAN() scans an array for a given .
However, the big difference is that you can now pass a code block
as the ! "Why would I want to do that?" you moan. Off the
top of my head comes one example: the case-insensitive ASCAN().
Try it in Summer '87. (I don't know how to simulate the passage of
time in an article like this, but I'll give it my best shot!)

(Three Hours Later)

What? You mean to tell me that you cannot do a case-insensitive
ASCAN() in Summer '87? Gee whiz, no wonder my users were having
problems! Thank goodness it takes nothing more than a well-placed
code block in Clipper 5.0:

ascan(myarray, { | a | upper(a) = upper("search value")} )

This will scan MyArray and test the upper-case equivalent of each
array element against the upper-case search value. But before we
move on, let's bullet-proof this code block. Do you know what
happens if you try to convert a non-character value with UPPER()?
(The answer is... an unexpected DOS holiday.) So let us ensure
that each element thus tested is indeed a character string:

ascan(array, { | a | if(valtype(a) == "C", ;
upper(a) = upper(value), .F.) } )

An ounce of prevention is worth a day of debugging!

ASORT(, [], [], [])

As in Summer '87, ASORT() sorts an array. The optional parameters
and are the same here as in AEVAL(). However, as
with ASORT(), code blocks let you dramatically change the shape of
things. You could come up with any manner of arcane sorts: put
all elements containing the word "Grump" at the top of the array
(where they should rightfully be); descending order; alphabetical
order based on the last letter in the word (!).

Each time your code block is evaluated by ASORT(), the function
passes two array elements to the block. The block is then expected
to compare them in some fashion that you specify, and return either
True (.T.) if the elements are in proper order or False (.F.) if
they are not.

Here's a descending sort:

local myarray := { "GREG", "JUSTIN", "JENNIFER", "TRACI", "DON" }
asort(myarray,,, { | x, y | x > y } )
aeval(myarray, { | a | qout(a) } ) // so you can see it worked!

One situation where a code block sort would save the day is when
you must sort a multi-dimensional array. Let's fill an array with
DIRECTORY() information, and then sort it by filename. Bear in
mind that DIRECTORY() returns an array containing one array for
each file:

Array Element Information Manifest Constant
(in DIRECTRY.CH)
1 file name F_NAME
2 file size F_SIZE
3 file date F_DATE
4 file time F_TIME
5 attribute F_ATTR

In Summer '87, we must rely upon the soon-to-be-put-out-to-pasture
ADIR() function, which requires that we establish an array for each
piece of information that we want to capture.

* sort a directory listing by filename
* first in Summer '87
private files_[adir("*.*")]
adir("*.*", files_)
asort(files_)

* then in 5.0
local files_ := directory("*.*")
asort(files_,,, { | x, y | x[1] < y[1] } )

Now let's sort the directory by date:

* Summer '87
private files_[adir("*.*")], dates_[adir("*.*")]
adir("*.*", files_, "", dates_)
asort(dates_)

* 5.0
local files_ := directory("*.*")
asort(files_,,, { | x, y | x[3] < y[3] } )

You can see that the Summer '87 code has become increasingly
convoluted as we add arrays to capture the other information.
Not only that, but when we sort the DATES_ array, the FILES_ array
(which contains the filenames) is left unchanged, thus undercutting
our best efforts. By stark contrast, we only needed to change two
digits in the 5.0 code, and did not have to worry about sorting one
array while leaving another untouched.

For the grand finale, let's sort them again by date and name.

* Summer '87
* I give up!

* 5.0
local files_ := directory("*.*")
asort(files_,,, { | x, y | if( x[3] = y[3], x[1] < y[1], ;
x[3] < y[3] ) } )
aeval(files_, { | a | qout(padr(a[1], 14), a[3]) } )

(Note the use of PADR() to ensure that all the filenames line up!)

Because of the wonderful DIRECTORY() function, we can easily
determine if the dates are the same (x[3] = y[3]). If they
are, then we will compare the file names (x[1] < y[1]).
Otherwise, we compare the file dates (x[3] < y[3]). Yes, it
can be done in Summer '87, but it would be such a mess that I would
be afraid to!

FIELDBLOCK()

FIELDBLOCK() is the first of three new functions that return
"set-get" code blocks. One of the biggest reasons to use this trio
of functions is to preclude the use of the macro operator. (As you
might already know, swearing off macros will make your programs run
faster and look more svelte.)

FIELDBLOCK() returns a code block for a specified field. The
parameter is a character string representing the field name
to refer to. You can then either retrieve (get) or assign (set)
the value of by evaluating the code block returned by
FIELDBLOCK(). If does not exist in the currently active
work area, FIELDBLOCK() will return NIL.

Note: if the that you pass to FIELDBLOCK() exists in more
than one work area, FIELDBLOCK()'s return value will correspond
only to the in the current area.

Here's an example of retrieving the value:

local bblock, mfield := "FNAME"
dbcreate("customer", { { "FNAME", "C", 10, 0 } })
use customer
append blank
customer->fname := "JOE"
bblock := fieldblock(mfield)
? eval(bblock) // displays "JOE"
/* note the dreaded macro alternative */
? &mfield // slow, and simply no longer chic

To assign a value to a field, you merely evaluate the code block
and pass the desired value as a parameter. For example:

local bblock, mfield := "FNAME"
use customer
bblock := fieldblock(mfield)
eval(fieldblock(mfield), "Jennifer")
? customer->fname // output: "Jennifer"
/* note the dreaded macro alternative */
replace &mfield with "Jennifer" // ugh!

The function STRUCT() loops through the structure array created by
DBSTRUCT() and uses FIELDBLOCK() to retrieve the value for each
field in your database.

function struct(dbf_file)
local struct, x
if dbf_file == NIL
qout("Syntax: struct ")
elseif ! file(dbf_file) .and. ! file(dbf_file + ".dbf")
qout("Could not open " + dbf_file)
else
use (dbf_file)
struct := dbstruct()
qout("Field Name Type Len Dec Contents of First Record")
for x := 1 to len(struct)
qout(padr(struct[x, 1], 10), padr(struct[x, 2], 4), ;
str(struct[x, 3], 3), str(struct[x, 4], 3), ;
eval(fieldblock(struct[x, 1])) )
next
use
endif
return nil

FLYPAPER: Version 1.03 (currently available at press time) requires
the to be defined at the time that you call FIELDBLOCK().
This means that if you changed the code to create the block before
opening the database that contained the field:

* assume no databases are open
bblock := fieldblock("FNAME")
use customer

your program will crash with an EVAL() error. However, you should
expect this situation to be corrected with the next release.

FIELDWBLOCK(, )

FIELDWBLOCK() is quite similar to FIELDBLOCK(). However, as you
may have already surmised from the "W" in its name, it allows you
to refer to a different work area to retrieve or assign the
value. As with FIELDBLOCK(), the parameter is a character
string representing the field name to refer to.

The new parameter is a numeric indicating which work
area to look for the .

Once again, you can then either retrieve or assign the value of
by evaluating the code block returned by FIELDWBLOCK(). If
does not exist in the specified , FIELDWBLOCK()
will return NIL. (Note: FIELDWBLOCK() does not change the active
work area.)

Here's FIELDWBLOCK() in action. Note the use of the SELECT()
function to determine the work areas; this is infinitely preferable
to hard-coding (and then having to remember) work area numbers.

dbcreate("customer", { { "LNAME", "C", 10, 0 } })
dbcreate("vendor", { { "LNAME", "C", 10, 0 } })
use customer new
append blank
customer->lname := "CUSTOMER1"
use vendor new
append blank
vendor->lname := "VENDOR1"
? eval(fieldwblock("LNAME", select("customer"))) // CUSTOMER1
? eval(fieldwblock("LNAME", select("vendor"))) // VENDOR1
? eval(fieldwblock("LNAME", select("vendor")), "Grumpfish")
? vendor->lname // Grumpfish

As with FIELDBLOCK(), it is quite easy to assign a value to a
field. Simply evaluate the code block returned by FIELDWBLOCK()
and pass the desired value as a parameter. This is how I changed
the field LNAME in VENDOR.DBF in the next-to-last line above.

Last month we showed an example of creating a generic TBrowse object
to browse a database. FIELDWBLOCK() offers a different solution:

local x, browse := TBrowseDB(3, 19, 15, 60), column
use test
for x := 1 to fcount()
column := TBColumnNew(field(x), fieldwblock(field(x), select()))
browse:AddColumn( column )
next

FLYPAPER: In exactly the same fashion as for FIELDBLOCK(),
version 1.03 (currently available at press time) requires the
to be defined at the time that you call FIELDWBLOCK().
If not, your program will crash with an EVAL() error. However, you
should expect this situation to be corrected with the next release.

In addition to this idiosyncrasy, FIELDWBLOCK() has problems when
the is not available in the current work area (regardless
of which you specified). If you specify a
other than the current work area, and the is not defined in
the current work area but is defined in the specified ,
FIELDWBLOCK() will mistakenly return NIL. I admit that this is a
bit confusing, so let me illustrate it with a code snippet:

dbcreate("customer", { { "LNAME", "C", 10, 0 } })
dbcreate("vendor", { { "LNAME", "C", 10, 0 } })
use customer new // we are now in area 1
use vendor new // we are now in area 2
? eval(fieldwblock("LNAME", 1)) // this works flawlessly
select 0 // we are now in area 3
? eval(fieldwblock("LNAME", 1)) // ouch!!

When you attempt to EVALuate that last line, your program will
crash gracelessly with the soon-to-be-infamous EVAL() internal
error 612.

However, expect both of these problems to be corrected with the
next release of Clipper 5.0.

MEMVARBLOCK()

MEMVARBLOCK() is also quite similar to FIELDBLOCK(), except that it
operates upon memory variables rather than database fields.
MEMVARBLOCK() returns a code block for a memory variable as
specified by the parameter. You can then either retrieve
the value of by evaluating the code block returned by
MEMVARBLOCK(), or assign a value by evaluating the code
block and passing the value as a parameter.

If the does not exist, MEMVARBLOCK() will return NIL.
Important Note: if the is either STATIC or LOCAL,
MEMVARBLOCK() will also return NIL. This is because MEMVARBLOCK()
can only operate on variables whose names are known at run-time
(namely, PRIVATEs and PUBLICs).

In this example, MEMVARBLOCK() retrieves the value of each of four
memory variables.

// note PRIVATE declaration -- MEMVARBLOCK() doesn't like LOCALs
private mtot1 := 75, mtot2 := 400, mtot3 := 30, mtot4 := 205, x
for x := 1 to 4
? eval(memvarblock("mtot" + str(x, 1)))
next

SETKEY(, [])

If you used the Summer '87 SET KEY command to establish "hot-key"
procedures, you may have been frustrated at the inability to
elegantly manage your hot keys. For example, if you wanted to turn
off all hot keys while the user was in a hot key procedure, it
required a certain degree of tedious coding.

Hot key procedures are yet another area where Clipper 5.0 gives you
unprecedented control. Whenever you establish a "hot-key"
procedure with the SET KEY command, you are basically attaching a
code block to that keypress with the new SETKEY() function.

SETKEY() allows you to poll any INKEY() value to determine whether
a code block is attached to it. Like the other SET() functions, it
also permits you to change the current setting, i.e., attach a code
block to any key.

The parameter is a numeric corresponding to the INKEY() value
of the keypress. (Please refer to your Clipper documentation, or
header file INKEY.CH, for a complete listing of INKEY() values.)

The optional parameter is the code block to be evaluated if
the is pressed during a wait state. Wait states include
ACHOICE(), DBEDIT(), MEMOEDIT(), ACCEPT, INPUT, READ, WAIT, and
MENU TO. (See below for discussion on INKEY(), the black sheep of
the wait state family.)

SETKEY() either returns a code block if one is tied to the ,
or NIL. If you pass the parameter, it will attach that
code block to the .

The SET KEY command

Before I show you any SETKEY() examples, let us first look at how
the SET KEY command is handled in 5.0:

set key 28 to helpdev

gets translated by the preprocessor into the following:

SetKey( 28, {|p, l, v| helpdev(p, l, v)} )

The P, L, and V parameters correspond to PROCNAME() (procedure
name), PROCLINE() (current source code line number), and READVAR()
(variable name), which will automatically be passed to the code
block when it is evaluated. (Yes indeed, these are the same
parameters passed to hot key procedures in Summer '87.) However,
you can omit these arguments in your code block declaration if you
will not be using them therein. By the same token, you are
completely free to pass entirely different parameters to the
function. (I'll use this technique to pass local variables via code
blocks a bit later.)

Whenever you come to a Clipper wait state, your keypress will be
evaluated in approximately this fashion to determine whether or not
there is a hot-key procedure tied to it:

keypress := inkey(0)
if setkey(keypress) != NIL
eval(setkey(keypress))
endif

SETKEY() := Better Housekeeping

Here is a good example. Suppose that within a hot key procedure
you wish to temporarily attach a hot key definition to the F10
keypress. However, you may have F10 activating various different
procedures throughout the course of your program. In Summer '87,
this presented a big problem because you were unable to determine
what procedure was tied to F10, and you would therefore be unable
to change it and expect to reset it properly. This is no longer a
problem with SETKEY(). In this example, we redefine F10 to call
BLAHBLAH(), and reset it when we are finished.

#include "inkey.ch" // for INKEY() constants
function test(p, l, v)
local old_f10 := setkey(K_F10, { | p,l,v | blahblah(p, l, v)} )
* main code goes here
setkey(K_F10, old_f10) // restore F10 hot key
return nil

OLD_F10 is assigned the code block (if any) that is attached to
F10. F10 is then reassigned to trigger BLAHBLAH(). When we
prepare to exit, we re-attach the previous code block (stored in
OLD_F10) to the F10 keypress. (Once again, please remember that
you can omit the P, L, V arguments in your code block declaration
if you will not be using them in the hot key function.)

Important Note: before you go hog wild with hot keys, you should
know that there are a limit of 32 SETKEY() (or SET KEY, same
difference) procedures at any given time.

INKEY() := Wait State?

As with Summer '87, INKEY() is not a bona fide wait state. But as
you have just seen, SETKEY() makes it very easy to create your own
INKEY() wait state. Here's GINKEY() from the Grumpfish Library:

// GINKEY() - INKEY() wait state
// Copyright (c) 1990 Greg Lief
function ginkey(waittime)
local key := inkey(waittime), cblock
cblock := setkey(key)
if cblock != NIL // there is a code block for this key
eval(cblock, procname(1), procline(1), 'ginkey')
endif
return key

As mentioned earlier, the third parameter passed to hot key
procedures is the name of the variable being read. In this
function, "GINKEY" is serving as a dummy variable name. Please feel
free to change it to anything you desire. If you really wanted to,
you could pass a variable name as a second parameter to GINKEY(),
and in turn pass that to the code block if/when it was evaluated.

Notice that when the code block is evaluated, instead of passing it
the current procedure name and line number, I pass it the
information that is one level previous on the activation stack.
(I'll discuss the activation stack in more detail in the March
Aquarium.) Otherwise, the hot key procedure would always think
that it had just come from GINKEY(). This would in turn louse
things up by forcing you to have the same help screen for every
GINKEY() wait state. In fact, there is a problem in Clipper 5.0
related to the MENU TO wait state, which brings us to the next
topic of discussion.

MENU TO Caveat

When you trigger a hot-key procedure from a MENU TO statement, the
wrong PROCNAME() will be sent to the code block.

function main
local sel
set key 28 to test
cls
@ 12,0 prompt "option 1"
@ 13,0 prompt "option 2"
@ 14,0 prompt "option 3"
@ 15,0 prompt "option 4"
menu to sel
return nil

function test(p,l,v)
? p // __MENUTO (wrong)
? procname(1) // (b)MAIN
? procname(2) // __MODALKEY
? procname(3) // __MENUTO
? procname(4) // MAIN (right)
inkey(0)
return nil

To determine the proper name where the MENU TO statement is
located, you must jump back by four levels of nesting. You can see
that the procedure name is off by one level of nesting. Instead of
PROCNAME(3), the MENU wait state should be sending PROCNAME(4) to
the code block.

Let's have a closer look at the callstack created by the MENU TO
command. The first procedure name represents where the code block
was actually created. The "(b)" prefix denotes that the procedure
name is part of the callstack only because Clipper had to jump back
momentarily to review the definition of the code block. (Remember
this when you see "(b)" in conjunction with a run-time error.)

The second procedure name is __MODALKEY, an internal Clipper
function that apparently processes keystrokes. The third is
__MENUTO, which is mistakenly passed to any hot key procedures
triggered from its wait state.

Here is the official Nantucket workaround. Place this at the top
of any procedure that is likely to be executed from setkey():

function whatever(cproc, nline, cvar)
if procname(3) == "__MENUTO"
cproc := procname(4)
else
cproc := procname(3)
endif

Here is another suggestion that makes use of the preprocessor.
Place the following in a header (.CH) file:

#translate FIXMENU(, ) => ;
:= procname(if(procname(3) = '__MENUTO', 4, 3)) ;;
:= procline(if(procname(3) = '__MENUTO', 4, 3))

Then be sure to include this header file and the following line at
the top of your setkey() procedures:

#include "whatever.ch"

function help(p, l, v)
FIXMENU(p, l)
etcetera

Passing LOCAL Variables in a Code Block

You and I both know that the scope of a LOCAL variable is the
procedure or function in which it is declared. But there is actually
a way to pass a LOCAL to a different function. It requires the use of
a code block. Watch this!

function main
local bblock := { | | x }, x := 500
test1(bblock)
return nil

function test1(b)
? eval(b) // output: 500
return nil

When BBLOCK is compiled in MAIN(), it will contain a reference to X,
which is a variable local to MAIN(). However, when the block BBLOCK
is passed as a parameter to TEST1(), and subsequently evaluated
therein, X's value will indeed be available.

Mind you, I do not advocate the unmitigated use of this technique.
It does not seem to be exactly what the architects had in mind for
LOCAL variables, eh? But one situation comes to mind where this
method saved the day for me. I wanted to GET a variable, and allow
the user to press a hot key to pop up a list of valid entries. This
sounds pretty simple, doesn't it? It would be, except that the
variable in question was LOCAL and thus restricted in scope to the
function in which I was GETting it. What to do... what to do? Here
is how I solved the problem with the clever use of a code block:

#include "inkey.ch"
#include "box.ch"

function test
local mvalue := space(7), oldaltv, x
memvar getlist
if ! file("lookup.dbf")
dbcreate("lookup", { { "LNAME", "C", 7, 0 } } )
use lookup
for x := 1 to 9
append blank
/* note use of unnamed array -- it works just fine this way */
replace lookup->lname with { "BOOTH", "DONNAY", "FORCIER", ;
"LIEF", "MAIER", "MEANS", "NEFF", "ROUTH", "YELLICK" }[x]
next
else
use lookup
endif
/* note that I pass MVALUE by reference to VIEW_VALS() below */
oldaltv := setkey( K_ALT_V, {| | View_Vals(@mvalue)} )
setcolor('+gr/b')
cls
@ 4, 28 say "Enter last name:" get mvalue
setcolor('+w/b')
@ 5, 23 say '(press Alt-V for available authors)'
read
quit

static function view_vals(v)
local browse, column, key, marker := recno(), ;
oldscrn := savescreen(8, 35, 20, 44, 2), ;
oldcolor := setcolor("+W/RB"), oldcursor := setcursor(0), ;
oldblock := setkey( K_ALT_V, NIL ) // turn off ALT-V
@ 8, 35, 20, 44 box B_SINGLE + chr(32)
browse := TBrowseDB(9, 36, 19, 43)
browse:headSep := ""
browse:colorSpec := '+W/RB, +W/N'
column := TBColumnNew( "Author", FieldBlock("lname") )
browse:addColumn(column)
go top
do while .t.
do while ! browse:stabilize() .and. (key := inkey()) = 0
enddo
if browse:stable
key := inkey(0)
endif
do case
case key == K_UP
browse:up()
case key == K_DOWN
browse:down()
case key == K_ESC .or. key == K_ENTER
exit
endcase
enddo
if lastkey() != K_ESC
/*
because we passed the variable BY REFERENCE in the code block,
any changes we make here are being made to the actual variable,
and that is the key to this whole mess working the way it does!
*/
v := eval(fieldblock('lname'))
endif
go marker
restscreen(8, 35, 20, 44, oldscrn)
setcolor(oldcolor)
setcursor(oldcursor)
setkey(K_ALT_V, oldblock) // reset Alt-V for next time
return nil

Conclusion

I certainly hope that this article has shattered any mental blocks that
you may have had about code blocks. Like it or not, code blocks are an
integral (and inescapable) part of Clipper 5.0. Even if you never
explicitly write a code block in your code, you can bet that the
preprocessor will be turning your commands into code blocks, so you
might as well grin and bear it, and learn how to use code blocks to your
great advantage. As with most things in Clipper 5.0, your imagination
should be your only limit when dealing with code blocks.

About The Author

Greg Lief is co-authoring a book on Clipper 5.0 with Craig Yellick and
Joe Booth for Howard Sams.