Mops List Manager
Gregory A. Haverkamp
Mac toolbox) classes for Mops. The code follows.
You should note a couple of things. First, I kept all of the classes in
one file, so if you want to separate them, be sure to appropriately
insert NEEDs.
Second, some of the lines were wrapped by my mail client. Be sure to
watch this.
I think most of using this is pretty self-explanatory, and I have
commented more heavily than I think I ever have. However, please feel
free to contact me if you have questions... or bugs.
Greg
------
\ The following classes provide support for the Mac Toolbox List
\ Manager package. Unfortunately, some of this support is less than
\ elegant, so please be sure to read the accompanying explanatory
\ info before using the routines.
\ Greg Haverkamp
\ Class MyPtrList
\
\ Okay, this is almost entirely a ripoff of Class PtrList from View. All I
\ did was add a remove: method so that when a list is killed, we can rid
\ ourselves of it.
:CLASS MyPtrList super{ string+ sequence } \ With lots stolen from PtrList
:m Add: \ ( ptr -- )
pad ! pad 4 add: super ;m
:m First?:
size: super nif false exit then \ No elements - return false
reset: super ^1st: super @ true ;m
:m Next?: \ ( -- ptr T | -- F )
4 skip: super len: super NIF false exit THEN
^1st: super @ true ;m
:m Remove: ( ptr -- b ) \ Returns true if found, false if not.
pad ! pad 4
search: self
if
step: self
4 deleteN: self
true
else
false
then
;m
:m Length?: ( -- n )
size: super
;m
;CLASS
\ Class ListWindow
\
\ This class provides support for lists, especially for controlling the
\ actions of List Manager-created scroll bars.
\ Greg Haverkamp
:CLASS ListWindow super{ window+ }
\ Content: This method is necessary for a number of reasons. However,
\ in talking to Mike, its necessity might change. If you look at the
\ content: method in Window+, then you'll notice that the first
\ thing it does is to check to see if a control was hit, and if it was,
\ it tries to find the control's handler. This did not sit well with
\ the List Manager, as it like to control its own scroll bar.
\ Therefore, this content: checks through the ptrlist of Lists to
\ to see if they should handle it.
:m CONTENT: \ Handles a content click, checking for lists first.
active: self \ Find out if this window is active
IF
get: ^contView ListCheck: ** \ Check any lists in the contView
NIF
^base ctlHit? \ Not in a list; was it a control?
NIF
get: ^contView click: ** drop \ Or just a click
in a view
THEN
ELSE
select: self
THEN
THEN
;m
;CLASS
\ Class List
\
\ This class provides for the basic structure and needs of a list.
\ Greg Haverkamp 6 August 93
\
\ Note that I attempted, when possible, to use the Mops naming scheme for
\ everything. However, that was not always practical, so many things are
\ named for their toolbox calls.
\
\ Here is the process for creating a list and a listView:
\ 1) Create a contView of class ListView
\ ListView MyContView
\ 2) Create any objects of class ListView
\ ListView MyListView
\ 3) Create any other views you might have
\ view MyRegularView
\ 4) Create the list you want
\ List MyList
\ 5) Add all of the sub-views to the contView
\ MyListView addListView: MyContView
\ MyRegularView addView: MyContView
\ (NOTE: You use addListView: for sub-views of type ListView, but continue
\ to use the method addView: for regular views. The class ListView will
\ handle the differentiation.)
\ 6) Set up all of the parameters as described for NewList:
\ 7) Execute ^theView NewList:
\ 8) Add the lists to the appropriate view
\ MyList addList: MyListView
\ 9) Serve hot and enjoy. :)
:CLASS List super{ object }
handle ListHandle
handle ListRegion \ Needed for updating
ptr ListPointer
rect rView
rect dataBounds
point cSize
int theProc
ptr WindowPtr
bool drawIt
bool hasGrow
bool scrollHoriz
bool scrollVert
bool List?
ptr MyView
\ My flag hacks. Sorry about the pain in the butt these cause.
\ List: should be set true as soon as a list is successfully started.
\ List?: can be used to see if there is a list present. This might
\ seem odd, but it became necessary in the list checking for the
\ writing of ListWindow's Content: method.
\
\ Well, these are not such a pain now, as the list creation methods now
\ take care of setting them. GAH 6 Aug 93
:m List: ( bool -- ) \ put true in here after you have called NewList:
put: List? \ for the pertinent list.
;m
:m List?: ( -- bool ) \ I dunno if you'll ever need to use this, but
get: List? \ this can be used to check to make sure a list
;m \ exists prior to calling List Manager routines.
\ If you don't, you can get some very nasty
\ results. (I don't much care for the way
\ MacsBug fills up my screen.)
\ We use explicit names here to make it very clear which portions
\ of the list parameters we are modifying. As I say later, I also
\ prefer this to having a HUGE list of unnamed parameters.
:m PutrView: ( l t r b -- )
put: rView
;m
:m PutDataBounds: ( l t r b -- )
put: dataBounds
;m
:m PutcSize: ( x y -- ) \ 0 0 will force auto-calc by toolbox
put: cSize
;m
:m PuttheProc: ( n -- ) \ 0 for default List Manager LDEF
put: theProc
;m
:m PutWindowPtr: ( ptr -- )
put: WindowPtr
;m
:m PutdrawIt: ( bool -- ) \ Drawing on?
put: drawIt
;m
:m PutHasGrow: ( bool -- ) \ Does the window have a grow box?
put: hasGrow
;m
:m PutScrollHoriz: ( bool -- ) \ Do we want a horiz scrollbar?
put: ScrollHoriz
;m
:m PutScrollVert: ( bool -- ) \ Do we want a vert scrollbar?
put: ScrollVert
;m
:m PutRegion: ( rgnHandle -- )
put: ListRegion
;m
\ I'm not sure why I put this in here... but we'll leave it should
\ we ever decide we need it.
:m Handle: ( -- handle )
get: ListHandle
;m
\ Creating and Disposing of Lists
:m New: { ^View -- } \ Call this to create a new list, but
\ Be sure that you first make sure you have
\ set up all the parameters.
\ I just prefer doing it this way so that all of the
\ items are well known, and the placement order
\ doesn't matter.
0 \ Leave room for return handle
addr: rView
addr: dataBounds
int: cSize
int: theProc
get: WindowPtr
get: drawIt tbool
get: hasGrow tbool
get: scrollHoriz tbool
get: scrollVert tbool
call lNew
put: ListHandle
true
List: self
^View put: MyView
;m
:m Dispose: ( -- ) \ Call this when you're done to clean
\ things up. (these lists can really
\ suck memory when they get big.)
get: ListHandle
call lDispose
false
List: self
^base get: myView removeList: **
;m
\ Adding and Deleting Rows and Columns
:m AddColumn: { count colNum -- } \ this returns the col # added
0 \ make room
count colNum pack
get: ListHandle
call lAddColumn
;m
:m AddRow: { count rowNum -- } \ this returns to row # added
0 \ make room
count rowNum pack
get: ListHandle
call lAddRow
;m
:m DeleteColumn: ( count colNum -- ) \ See ya buddy.
get: ListHandle
call lDelColumn
;m
:m DeleteRow: ( count rowNum -- ) \ And your friend, too.
get: ListHandle
call lDelRow
;m
\ Operations on Cells
:m Add: { addr len theCell -- } \ This will add information to
\ what is currently contained
\ in the cell.
addr
len makeint
theCell
get: ListHandle
call lAddToCell
;m
:m Clear: ( theCell -- ) \ This, of course, clears the cell.
get: ListHandle
call lClrCell
;m
:m Get: ( addr ^len theCell -- ) \ This will give you the string
\ from a cell.
get: ListHandle
call lGetCell
;m
:m put: { addr len theCell -- } \ Use this to store info into a
\ cell. Note that this will
\ overwrite anything that was
\ already there.
addr
len makeint
theCell
get: ListHandle
call lSetCell
;m
:m CellSize: ( cSize -- )
get: ListHandle
call lCellSize
;m
:m Selected?: { next ^theCell -- }
word0 \ make room for return
next
^theCell
get: ListHandle
call lGetSelect
;m
:m Deselect: { theCell -- }
false tbool
theCell
get: ListHandle
call lSetSelect
;m
:m Select: { theCell -- }
true tbool
theCell
get: ListHandle
call lSetSelect
;m
\ Mouse Location
:m Click: { pt modifiers -- b } \ Handles a click in the list's view.
\ Returns true if double click.
word0 \ make room
pt
modifiers makeint
get: ListHandle
call lClick
;m
:m WhichCell?: ( -- theCell ) \ Which was the last cell clicked in?
\ The key here is that this was actually
\ just the last cell that was clicked
\ in... no necessarily the selected cell.
\ Primarily, though, it will probably
\ be the same thing.
0 \ make room
get: ListHandle
call lLastClick
;m
\ Accessing Cells
\ These are all untested. I can't verify that they work.
:m Find: ( ^offset ^ length theCell -- )
get: listHandle
call lFind
;m
:m NextCell: { hNext vNext ^theCell -- b }
word0
hNext tbool
vNext tbool
^theCell
get: ListHandle
call lNextCell
;m
:m Rect: ( ^cellRect theCell -- )
get: listHandle
call lRect
;m
:m Search: { addr len ^searchProc ^theCell -- b }
word0
addr
len makeint
^searchProc
^theCell
get: ListHandle
call lSearch
;m
:m Size: { width height -- }
width makeint
height makeint
get: ListHandle
call lSize
;m
\ List Display
:m DrawCell: ( theCell -- ) \ Draw a particular cell.
get: ListHandle
call lDraw
;m
:m DoDraw: ( drawIt -- ) \ turns on drawing.
tbool
get: ListHandle
call lDoDraw
;m
:m Scroll: ( dcols dRows -- ) \ In case you want to scroll this puppy
\ by yourself.
get: ListHandle
call lScroll
;m
:m AutoScroll: ( -- ) \ Will scroll the first highlighted item.
get: ListHandle
call lAutoScroll
;m
:m Update: ( theRgn -- ) \ Redraws the list.
get: ListRegion
get: ListHandle
call lUpdate
;m
:m Activate: ( -- )
true tbool
get: ListHandle
call lActivate
;m
:m Deactivate: ( -- )
false tbool
get: ListHandle
call lActivate
;m
;CLASS
\ Class ListView
\
\ This class provides list manager support for views under Mops.
\ Greg Haverkamp
\ need ListRecord
\ need ListBlock
:CLASS ListView super{ view }
bool Lists?
bool List?
MyPtrList Lists
MyPtrList SubListViews
\ * The following are adaptations that allow easier use
\ * of lists... including checking for clicks in the content
\ * and the like.
:m List:
put: List?
;m
:m List?:
get: List?
;m
:m Lists:
put: Lists?
;m
\ ListCheck: is called by the ListWindow's content: method to see if
\ the click occurred inside of a list.
:m ListCheck: \ ( -- b ) Returns true if we've handled the click.
get: Lists? \ Do we have listViews in this view?
NIF
false
EXIT
THEN
BEGIN each: subListviews
WHILE
ListCheck: **
IF
uneach: subListviews
true
EXIT
THEN
REPEAT
0
where: fEvent g->l
addr: viewRect
call PtInRect
IF
exec: clickHndlr
list?: self \ Is there really a list in this view?
ELSE
false
THEN
;m
:m addListView: { ptr -- } \ Call this to add a view that possesses a list
ptr add: SubListViews
ptr addView: super
false Lists: self
false List: self
;m
:m AddList: ( ^list -- ) \ Call this to add a list to a listview...
but only after calling Newlist:
add: Lists
true Lists: self
true List: self
;m
:m RemoveList: ( ^list -- ) \ Call this to get rid of a list
remove: lists drop
length?: lists 0 =
if
false Lists: self
false List: self
then
;m
;CLASS
_____________________
Greg Haverkamp -- gh...@andrew.cmu.edu, diet...@cmu.edu
Industrial Management - '94
Carnegie Mellon University, Pittsburgh, Pennsylvania
"Sometimes I think life is just a rodeo. The trick is to ride and make
it to the bell." John Fogerty, "Rock and Roll Girls"