' 自動実行マクロ   ver 1.50  5/13/1999  by itam
'

' IMEがON時に半角入力したい文字
const ZEN$          = "！”＃＄％＆’（）＝｜‘｛＋＊｝＜＞？＿−＾￥＠［；：］，．／￥"
const HAN$          = "!""#$%&'()=|`{+*}<>?_-^\@[;:],./\"
' 閉じ括弧を自動入力させたい括弧の組{}[]()''""$$
const begin_kakko$  = "{[(""$`"
const end_kakko$    = "}])""$`"

' 対応する括弧の位置を表示(する=1/しない=0)
const PairDisp=1
' 対応する括弧の位置を表示する時間(1/1000[sec])
const PairDispTime=200

' IME が ON  の時の行番号の背景の色 (紺)
const ImeOnColor  = &h800000
' IME が OFF の時の行番号の背景の色 (黒)
const ImeOffColor = &h000000

' ツールバーの表示のフォーマット、日にちと時間
const DATEFMT$="\y/\m/\d(\w)"
const TIMEFMT$="\H:\M:\S"

const DanStartLine  = 2
const DanEndLine    = 20
const DanPos        = 3

const FillSpaceForRegNUM = 5
const FillSpaceForExtent = ".mm .qx"


'--------------------------------------------------------------------------
proc AutoVKey           ' キーが押されたとき
    stopdestroykey 1
    print @@VKey
    if @hwnd then
        if @@VKey=KEY_RETURN and @Code=`}` then
            dim ext$
            ext$=lcase$(mid$(@Filename$, inrstr(@Filename$, ".")))+" "
            if instr(".mac .c .cpp .h .hpp .java .as .hsp .cgi .pl .prl ", ext$) then CloseKakkoMove
        end if
    end if
'     if @@GetHwnd2(@hwnd) then SetLineRefWin
end proc

'--------------------------------------------------------------------------
proc AutoKey            ' 文字キーが押されたときａ
    stopdestroykey 1
    if @hwnd=0 then exit proc
    dim key
    key=@@Key
'     if key=`\` and @Select=0 and @@Global$("9xLastIME1Letter")="\" then
'         @@Global$("9xLastIME1Letter")=""
'         imemode val(@@Global$("9xLastIMEStatus"))
'         @@Global$("9xLastIMEStatus")=""
'     end if

    if 0<instr(HAN$, chr$(key)) and @@Shift<2 then
        dim ext$
        ext$=lcase$(mid$(@Filename$, inrstr(@Filename$, ".")))+" "
        if instr(".tex .cls. sty ", ext$) or @Pathname$="(無題)" then
            TeX chr$(key), @Select, 0
        elseif ext$=".mac " then
            MAC chr$(key), @Select, 0
        elseif instr(".c .cpp. h. hpp .java ", ext$) then
            C chr$(key), @Select, 0
        elseif instr(".as .hsp ", ext$) then
            HSP chr$(key), @Select, 0
        elseif instr(".cgi .pl .prl ", ext$) then
            Perl chr$(key), @Select, 0
        end if
    end if
end proc

'--------------------------------------------------------------------------
proc AutoZKey2          ' IMEがON時で文字キーが押されたとき
    stopdestroykey 1
    if @hwnd=0 then exit proc
    if 1<len(@@ImeString$) then
        if left$(@@Global$("IMEHistory"), 1)=left$(@@ImeString$, 1) then
            @@Global$("IMEHistory")=@@ImeString$
        elseif @@Global$("IMEHistory")="" then
            @@Global$("IMEHistory")=@@ImeString$
        end if
    end if

    if 1<@@Shift then exit proc
    dim ext$
    ext$=lcase$(mid$(@Filename$, inrstr(@Filename$, ".")))+" "
    if instr(".tex .cls .sty .mac .c .cpp .h .hpp .java .as .hsp ", ext$)=0 and @Pathname$<>"(無題)" then exit proc

    dim t
    t=instr(ZEN$+HAN$, @@ImeString$)
    if t=0 then exit proc
    dim ime$, st
    ime$=mid$(HAN$+HAN$, t, 1)
    st=imestatus
    imemode 2
    imemode st
'     @@Global$("9xLastIME1Letter")=ime$
'     @@Global$("9xLastIMEStatus")=str$(st)
    if instr(".tex .cls .sty ", ext$) or @Pathname$="(無題)" then
        TeX ime$, @Select, 1
    elseif instr(".c .cpp .h .hpp .java ", ext$) then
        C ime$, @Select, 1
    elseif instr(".mac ", ext$) then
        MAC ime$, @Select, 1
    elseif instr(".as .hsp ", ext$) then
        HSP ime$, @Select, 1
    elseif instr(".cgi .pl .prl ", ext$) then
        Perl ime$, @Select, 1
    end if
end proc

'--------------------------------------------------------------------------
proc AutoZKey           ' ＩＭＥで文字が入力確定されたとき
    stopdestroykey 1
    dim i
    for i=19 to 1
        writeprofile "IMEHistory", cformat$("H%02d", i+1), _
            getprofile$("IMEHistory", cformat$("H%02d", i), _
            @@QxDirectory$+"\IMEHist.INI"), @@QxDirectory$+"\IMEHist.INI"
    next
    writeprofile "IMEHistory", "H01", @@Global$("IMEHistory"), @@QxDirectory$+"\IMEHist.INI"
    @@Global$("IMEHistory")=""
    dim ext$
    ext$=lcase$(mid$(@Filename$, inrstr(@Filename$, ".")))
    if @hwnd then
        if @CanEditSel then
            if @@RegistrySaveNum=FillSpaceForRegNUM and _
               instr(FillSpaceForExtent+" ", ext$+" ") then
                dim l, c
                if 1<@BytePosCr and @@ImeString$<>" " then
                    @Redraw=0
                    @MoveLeftChar
                    c=@Code
                    @MoveRightChar
                    if lenb(chr$(c))<>lenb(left$(@@ImeString$, 1)) and c<>&h20 then @@ImeString$=" "+@@ImeString$
                end if
                l=len(@@ImeString$)
                if l>1 then
                    dim s$, t
                    i=1
                    do while i<l
                        s$=mid$(@@ImeString$, i,   1)
                        t=lenb(mid$(@@ImeString$, i+1, 1))
                        if lenb(s$)<>t and s$<>" "then
                            @@ImeString$=left$(@@ImeString$, i)+" "+mid$(@@ImeString$, i+1)
                            i++
                        end if
                        i++
                        l=len(@@ImeString$)
                    loop
                end if
            end if
        end if
    end if
end proc

'--------------------------------------------------------------------------
proc AutoOpen           ' ファイルが開かれる直前
'     @WindowAppMaximize
end proc

'--------------------------------------------------------------------------
proc AutoOpened         ' ファイルが開かれた直後
    if instr(".cpp .hpp .java ", lcase$(right$(@Filename$, 4))+" ") then
        @TextMode=1
        @CCommentTwoSlashes=TRUE
    elseif lcase$(right$(@Filename$, 2))=".c" then
        @TextMode=1
        @CCommentTwoSlashes=FALSE
    end if
'     if @@PrintToolList=TRUE then Caption2ToolList 1
end proc

'--------------------------------------------------------------------------
proc AutoClosed         ' ファイルが閉じられた直後
end proc

'--------------------------------------------------------------------------
proc AutoInit           ' ＱＸ起動直後
    @@PreviewSize = 30                  ' 最大は58 (でもエラーがあることも)
    @@PreviewSizeAuto = 30              ' 最大は58 (でもエラーがあることも)
end proc

'--------------------------------------------------------------------------
proc AutoExit           ' ＱＸ終了直前
'     EndQTClip
end proc

'--------------------------------------------------------------------------
proc AutoActivate
    dim st
'     @@Redraw=0
    @WindowChange
    @@Global$("9xSetImeStatusWhenActive - "+@Pathname$)=str$(imestatus)
    @WindowChange
    st=val(@@Global$("9xSetImeStatusWhenActive - "+@Pathname$))
    if st=0 then
        @@Global$("9xSetImeStatusWhenActive - "+@Pathname$)=str$(imestatus)
    else
        imemode st
    end if
end proc

'--------------------------------------------------------------------------
proc AutoTimer
          ' 1秒毎に呼ばれる
    @@Global$("DATE")=@@Format$(DATEFMT$)
    @@Global$("TIME")=@@Format$(TIMEFMT$)
    dim t$
    if @hwnd then
        t$=chr$(95+20*@RuleProtect)
    else
        t$="_"
    end if
    @@Global$("ONOFF")=chr$(95+14*@@ResidentQX)+t$+midb$("_____A__あア_ｱＡ", imestatus*2+1, 2)
    if @hwnd and @@Global$("_IMEStatus")<>str$(imestatus) then
        if imestatus <> 2 then
            @ColorSet @@ColorIndex("NumBack"), ImeOnColor   'この色にしたい。
        elseif imestatus = 2 then
            @ColorSet @@ColorIndex("NumBack"), ImeOffColor  '元の色
        end if
        @@Global$("_IMEStatus")=str$(imestatus)
    end if
    if @hwnd then
        if val(@@Global$("_StyleNo"))<>@StyleNo then
            @@Global$("_StyleNo")=str$(@StyleNo)
            @@ColorSet @@ColorIndex("ToolList"), &hFFFFFF
            @@ColorSet @@ColorIndex("ToolListBack"), @ColorGet(@@ColorIndex("TextBack")+2000)
        end if
    end if
'     if @@PrintToolList then CloseToolList
#comment
    if @hwnd then
        if @@PrintToolList then
            if _gettickcount()/1000-val(@@Global$("9xCaption2ToolListLast"))>2 then
                Caption2ToolList 1
            end if
        end if
    end if
#comment
'     if @@GetHwnd2(@hwnd) then SetLineRefWin
end proc

'--------------------------------------------------------------------------
' 関数など
'--------------------------------------------------------------------------
sub TeX(c$, sel, Z)         ' TeXファイル編集時
    dim n1, n2
    n1=instr(begin_kakko$, c$)
    n2=instr(end_kakko$, c$)

    if (midb$(@TextCr$(@Line), @BytePosCr-1, 1)="\" and 1<@BytePosCr) and \
       instr("%$""`'", c$) then exit sub
    if c$="\" then
        if Z then
            @@Key=`\`
            @Insert "\"
            imemode 2
'             @CompListWord$="\"
'             @CharCompList
        end if
'         @CompListWord$=""
    elseif c$="%" then
        Comment "% ", sel, Z
    elseif n1 then
        Insert c$, mid$(end_kakko$, n1, 1), sel, Z
    elseif n2 then
        Pair c$, sel, Z
    elseif Z then
        @Redraw=0
        @UndoBlock=1
        if @Select then @BlockDelete
        @Input c$
        @UndoBlock=0
        @Redraw=1
    end if
end sub

'--------------------------------------------------------------------------
sub C(c$, sel, Z)           ' Cファイル編集時
    dim n1, n2
    n1=instr(begin_kakko$, c$)
    n2=instr(end_kakko$, c$)

    if n1 and c$<>"$" then
        Insert c$, mid$(end_kakko$, n1, 1), sel, Z
    elseif n2 and c$<>"$" then
        Pair c$, sel, Z
    elseif c$="*" then
        @Redraw=0
        if @Select then @BlockSelect
        @MoveLeftChar
        if @Code=asc("/") then
            @MoveRightChar
            Insert ""," */", sel, Z
'             @MoveLeftChar
'             @MoveLeftChar
            @@Key=-1
            @Insert "* "
        else
            @MoveRightChar
            @@Key=-1
            @Input c$
        end if
        @Redraw=1
    elseif c$="/" then
        @Redraw=0
        @@Key=-1
        if @Select then
            dim spos, sline, stop
            sline=@SelectStartLine
            spos=@SelectStartBytePosCr
            stop=@TopLine
            @BlockSelect
            @Line=sline
            @BytePosCr=spos
            @TopLine=stop
        end if
        @MoveLeftChar
        if @Code=asc("/") then
            @MoveRightChar
            Comment "/ ", sel, Z
         else
            @redraw=1
            @MoveRightChar
            @Input c$
         end if
    elseif Z then
        @Redraw=0
        @UndoBlock=1
        if @Select then @BlockDelete
        @Input c$
        @UndoBlock=0
        @Redraw=1
    end if
end sub

'--------------------------------------------------------------------------
sub MAC(c$, sel, Z)         ' マクロファイル編集時
    dim n1, n2
    n1=instr(begin_kakko$, c$)
    n2=instr(end_kakko$, c$)

    if c$="'" then
        Comment "' ", sel, Z
    elseif n1 and c$<>"$" then
        Insert c$, mid$(end_kakko$, n1, 1), sel, Z
    elseif n2 and c$<>"$"then
        Pair c$, sel, Z
    elseif Z then
        @Redraw=0
        @UndoBlock=1
        if @Select then @BlockDelete
        @Input c$
        @UndoBlock=0
        @Redraw=1
    end if
end sub

'--------------------------------------------------------------------------
sub HSP(c$, sel, Z)         ' HSPファイル編集時
    dim n1, n2
    n1=instr(begin_kakko$, c$)
    n2=instr(end_kakko$, c$)

    if c$=";" then
        Comment "; ", sel, Z
    elseif n1 and c$<>"$" then
        Insert c$, mid$(end_kakko$, n1, 1), sel, Z
    elseif n2 and c$<>"$"then
        Pair c$, sel, Z
    elseif Z then
        @Redraw=0
        @UndoBlock=1
        if @Select then @BlockDelete
        @Input c$
        @UndoBlock=0
        @Redraw=1
    end if
end sub

'--------------------------------------------------------------------------
sub Perl(c$, sel, Z)        ' Perlファイル編集時
    dim n1, n2
    n1=instr(begin_kakko$, c$)
    n2=instr(end_kakko$, c$)

    if c$="#" then
        Comment "# ", sel, Z
    elseif n1 and c$<>"$" then
        Insert c$, mid$(end_kakko$, n1, 1), sel, Z
    elseif n2 and c$<>"$"then
        Pair c$, sel, Z
    elseif Z then
        @Redraw=0
        @UndoBlock=1
        if @Select then @BlockDelete
        @Input c$
        @UndoBlock=0
        @Redraw=1
    end if
end sub
' "* "," */", sel, Z
'--------------------------------------------------------------------------
sub Insert(s$, t$, sel, Z) ' 開き括弧挿入
    if Z then
        dim st
        st=imestatus
        imemode 2
        imemode st
    end if
'     @@Key=-1
    @Redraw=0
    @UndoBlock=1
    if Z then @Input s$
    dim Line, BytePosCr, TopLine
    Line=@Line: BytePosCr=@BytePosCr: TopLine=@TopLine
    if sel then
        Line=@SelectStartLine: BytePosCr=@SelectStartBytePosCr: TopLine=@TopLine
        @BlockCut
    end if
    if sel then @BlockPaste
    @Input t$
    if sel=0 then @MoveLeftChar
    if s$="$" then imemode 2
    @Line=Line: @BytePosCr=BytePosCr: @TopLine=TopLine
    @Redraw=1
end sub

'--------------------------------------------------------------------------
sub Pair(s$, sel, Z)       ' 閉じ括弧挿入
    if Z then
        dim st
        st=imestatus
        imemode 2
        imemode st
    end if
    @@Key=-1
    @Redraw=0
    @UndoBlock=1
    if sel then @BlockDelete
    @Input s$
    dim x, y
    x=@BytePosCr: y=@Line
    if PairDisp then
        @MoveLeftChar
        @SearchPair         '開き括弧へ移動
        @BlockSelect
        @MoveRightChar
        @Redraw=1
        doevents
        call _sleep(PairDispTime)
        @BlockSelect
        @Redraw=0
        @MoveLeftChar
        @Line=y: @BytePosCr=x
    end if
    @UndoBlock=0
    @Redraw=1
end sub

'--------------------------------------------------------------------------
sub Comment(s$, sel, Z)    ' コメント
    if Z then
        dim st
        st=imestatus
        imemode 2
        imemode st
    end if
    @@Key=-1
    print s$
    @Redraw=0
    @UndoBlock=1
    if sel then
        @BlockCut
        @Insert s$
        @BlockPaste
    else
        @Input s$
        if @XDisplay<>2 and @Code<>-224 and @Code<>-223 then
            @CharReturn2
            @MoveLeftChar
        end if
    end if
    @UndoBlock=0
    @Redraw=1
end sub

sub CloseKakkoMove
    @SearchPair
    if @@SearchFound then
        dim s$, t$, i
        @UndoBlock=1
        s$=@TextCr$(@Line)
        for i=1 to len(s$)
            if instr(chr$(9)+" ", left$(s$, 1)) then
                s$=mid$(s$, 2)
            else
                exit for
            end if
        next
        t$=@TextCr$(@Line)
        @SearchPair
        @CharReturn
        dim l, p, t
        l=@Line: p=@BytePosCr: t=@TopLine
        @CharReturn2
        @Insert left$(t$, len(t$)-len(s$))
        @@VKey=-1
        @UndoBlock=0
        @Line=l: @BytePosCr=p: @TopLine=t
    end if
    @Redraw=1
end sub


const OpenOnlyOneBinder=TRUE

dllname USER
cdeclare HWND GetFocus(void)
cdeclare int  SendMessage(HWND, int, long, long)
const LB_SETCURSEL      = &h0186
const LB_GETCURSEL      = &h0188
const LB_GETTEXT        = &h0189
const LB_GETANCHORINDEX = &h019D
sub CloseToolList
    if @@ToolListType=4 or @@ToolListType=6 then exit sub
    if GetFocus()=@hwnd then
        @ModePrintToolList
        exit sub
    end if
    if OpenOnlyOneBinder=FALSE then exit sub
    if @@ToolListType<>5 or GetFocus()<>@@hwndToolListL then exit sub
    dim i, c, x$ as string[10000], index, s$
    index=SendMessage(@@hwndToolListL, LB_GETCURSEL, 0, 0)
    if -1<index then
        SendMessage(@@hwndToolListL, LB_GETTEXT, index, varptr(x$))
        s$=left$(x$, 1)
        for i=index to 0
            SendMessage(@@hwndToolListL, LB_GETTEXT, i, varptr(x$))
            if left$(x$, 1)="■" then c++
        next
    end if
    for i=1 to 10
        @@BinderSetCurrent i
        if @@BinderName$="" then
            exit for
        elseif i<>c and @@BinderState=TRUE then
            @@BinderState=FALSE
        end if
    next
    if s$="■" then SendMessage(@@hwndToolListL, LB_SETCURSEL, c-1, 0)
end sub

sub Caption2ToolList(flag)
    if GetFocus()=@@hwndToolListL then exit sub
    if flag=1 then
        if @@Global$("No9xCaption2ToolList")="" then
            @@ToolListType=4
            @@ListAutoClose=TRUE
            @ListCaption
            @@Global$("9xCaption2ToolListLast")=str$(_gettickcount()/1000)
        end if
    elseif @@Global$("No9xCaption2ToolList")="" then
        @@Global$("No9xCaption2ToolList")="1"
    else
        @@Global$("No9xCaption2ToolList")=""
    end if
end sub

sub SetLineRefWin
    dim hwnd0, hwnd1
    hwnd0=@hwnd
    hwnd1=@@GetHwnd2(@hwnd)
    dim topline, line
    line=@Line
    topline=@TopLine
    @@Activehwnd2 hwnd1
    @Line=line+@ScreenHeight
    @TopLine=topline+@ScreenHeight
    @@Activehwnd2 hwnd0
end sub