RECENTFILESMENU update

Not a very funny topic. This last version is simpler, it
should replace the previous one, when the tutorial web page
will be repaired.

Regards,
Charles Melice
___________

OPTIONAL RECENTFILESMENU.F

{ ==================================================================
  Recently used files menu revision 1.1 - 32jan2001

    RFM-OPEN ( hwnd menu-id0 zRegKey -- )
        To do in the WM_CREATE msg, after the 'SetMenu' command.

        hwnd : handle of the window that hold the menu.
        menu-id0 : first identifier in the recent-files menu list.
        zRegKey : Address of a static registry path string, for
                   instance: Z" SOFTWARE\MyComp\MyProd\Recent-Files"

        NB: menu IDs to reserve: [menu-id0 ... menu-id0+6[

    RFM-CLOSE ( -- )
        Use it before ending the program, to save recent files list.

    RFM-PUT ( zFullPath -- )
        Notifies 'zFullPath' become the more recent file.

    RFM-GET ( idmenu -- zFullPath -1 | 0 )
        Retrieves a 'zFullPath' and make it the more recent file.

    RFM-REMOVE ( zFullPath -- )
        Deletes 'zFullPath' from the recent files list.

===================================================================}

Function: RegDeleteValue ( hKey zValue -- long )
Function: DeleteMenu ( hMenu hPos uFlags -- bool )
Function: DrawMenuBar ( hwnd -- bool )

LIBRARY SHLWAPI.DLL

Function: PathCompactPathEx ( zOut zSrc cchMax uFlags -- bool )

\ ------------------------------------------------------------------

PACKAGE RECENTFILESMENU

PRIVATE

    6 CONSTANT MAX-RF \ max count of r.f. to remember - max=9
    0 VALUE hwnd \ window that hold the menu
    0 VALUE cmdid0 \ first menu-id.
    0 VALUE zREGPATH \ registry string pointer

    CREATE ZKEY \ registry zkey buffer
        10 ALLOT

    CREATE RFBUFFER \ hold MAX-RF recents filenames
        MAX_PATH CHARS MAX-RF * /ALLOT

    CREATE MPAD
        MAX_PATH CHARS CELL+ /ALLOT

    \ ---------- registry -----------

    : getregkey ( -- handle )
        HKEY_CURRENT_USER zREGPATH 0 >R RP@
        RegCreateKey DROP R> ;

    : make-key ( i -- zKey )
        S" FILE-" ZKEY ZPLACE (.) ZKEY ZAPPEND ZKEY ;

    : reg-getstr[] ( buffer index -- flag )
        make-key getregkey >R \ s: buffer zkey
        OVER MAX_PATH ERASE
        SWAP MAX_PATH ROT R@ READ-REG NIP ERROR_SUCCESS =
        R> RegCloseKey DROP ;

    : reg-putstr[] ( zstr index -- flag )
        make-key getregkey >R \ s: zstr zkey
        SWAP ZCOUNT 1+ ROT R@ WRITE-REG ERROR_SUCCESS =
        R> RegCloseKey DROP ;

    \ ---------- recent filenames stack -----------

    : rf[] ( index -- zaddr )
        MAX_PATH CHARS * RFBUFFER + ;

    : find-rf ( zPath -- n -1 | 0 )
        ZCOUNT
        MAX-RF 0 DO
            2DUP I rf[] ZCOUNT COMPARE(NC) 0=
            IF 2DROP I TRUE UNLOOP EXIT THEN
        LOOP
        2DROP FALSE ;

    : remove-rf ( i -- )
        MAX-RF 1- SWAP ?DO
            I 1+ rf[] ZCOUNT I rf[] ZPLACE
        LOOP
        MAX-RF 1- rf[] OFF ;

    : push-rf ( zpath -- )
        MAX-RF 1 DO
            MAX-RF I - DUP 1- \ 5 4 ... 1 0
            rf[] ZCOUNT ROT rf[] ZPLACE
        LOOP
        ZCOUNT 0 rf[] ZPLACE ;

    : maketop-rf ( index -- )
        DUP rf[] ZCOUNT MPAD ZPLACE
        remove-rf
        MPAD push-rf ;

    \ ---------- menu updates -----------

    : format-mpadstr ( i zpath -- )
        S" &0 " MPAD ZPLACE SWAP ( i) [CHAR] 1 + MPAD CHAR+ C!
        MPAD 3 CHARS + SWAP 40 0 PathCompactPathEx DROP ;

    : refresh-menu ( -- )
        hwnd GetMenu 0 GetSubMenu ?DUP -EXIT \ s: hmenu
        MAX-RF 0 DO
            DUP ( hmenu) I cmdid0 + MF_BYCOMMAND DeleteMenu DROP
        LOOP
        MAX-RF 0 DO
            I rf[] C@ 0= IF LEAVE THEN
            I DUP rf[] format-mpadstr
            DUP ( hmenu) MF_STRING I cmdid0 + MPAD AppendMenu DROP
        LOOP
        DROP hwnd DrawMenuBar DROP ;

PUBLIC \ -------- package interface --------------------------------

    : RFM-OPEN ( hwnd id0 zRegKey -- )
        TO zREGPATH
        TO cmdid0
        TO hwnd
        MAX-RF 0 DO I rf[] I reg-getstr[] DROP LOOP
        refresh-menu ;

    : RFM-PUT ( zFullPath -- )
        DUP find-rf IF maketop-rf DROP ELSE push-rf THEN
        refresh-menu ;

    : RFM-GET ( idmenu -- zFullPath -1 | 0 )
        cmdid0 - DUP MAX-RF U< 0= IF DROP FALSE EXIT THEN
        DUP rf[] C@ 0= IF DROP FALSE EXIT THEN
        maketop-rf
        refresh-menu
        0 rf[] TRUE ;

    : RFM-REMOVE ( zFullPath -- )
        find-rf -EXIT remove-rf refresh-menu ;

    : RFM-CLOSE ( -- )
        MAX-RF 0 DO I rf[] I reg-putstr[] DROP LOOP ;

END-PACKAGE

\\ --- tests -------------------------------------------------------

CREATE zMyRegKey ( -- z ) ,Z" SOFTWARE\MyCompany\MySoft\Recent-files"

( see SwiftForth file menu )

: t1
    hwnd 10 zMyRegKey RFM-OPEN
    z" hello" RFM-PUT
    z" abcd" RFM-PUT
    z" ab" RFM-PUT
    RFM-CLOSE ;

: t2
    hwnd 10 zMyRegKey RFM-OPEN
    z" abcd" RFM-PUT
    RFM-CLOSE ;

: t3
    hwnd 10 zMyRegKey RFM-OPEN
    z" abcd" RFM-REMOVE
    RFM-CLOSE ;

: t4
    hwnd 10 zMyRegKey RFM-OPEN
    11 RFM-GET IF ZCOUNT ELSE S" ? ?" THEN TYPE
    RFM-CLOSE ;

\ eof
Received on Fri Feb 02 2001 - 06:47:24 PST