home *** CD-ROM | disk | FTP | other *** search
- const
- FIND_NEXT_ATTR_SUBOP = 1
- FIND_PREV_ATTR_SUBOP = 2
- FIND_MATCH_ATTR_SUBOP = 3
- DELETE_ATTR_SUBOP = 16
- ANY_CLASS = 0
- COLORCLASS = 1
- HIDNCLASS = 2
- ASSOCCLASS = 3
- BUTTONCLASS= 4
- CALCSTACK_CLASS = 10
-
- /*
- ShowMessage is a handy procedure that has nothing to do with attribute
- support. It simply displays (multi-line) messages in a simulated dialog box
- without causing the editor to update the text on the screen. The message is
- simply pumpped directly to the screen. The user must hit a key to
- remove the message from the screen.
- This can be very handy for debugging. When used with the MessageNWait()
- function, this function can facilitate the debugging of E macro code. It
- also provides a nice way to present messages to users.
-
- */
- ; LAM - SAYAT is broken on 5.50 and above, so do this as a WinMessageBox.
-
- defproc showmessage()
- compile if EVERSION >= '5.50'
- msgtext = ''
- do i=1 to arg()
- msgtext = msgtext || strip(arg(i))' '
- enddo
- call winmessagebox("ShowMessage", msgtext, 16454) -- CANCEL + ICONHAND + MOVEABLE
- compile else
- compile if EVERSION < 5
- display 0;
- compile else
- display -1; -- disablethe refresh of text
- compile endif
- color = 57;
- sayat "┌──────────────────────────────────────────────────────────────┐",8, 2, color;
- for i = 1 to ARG()
- sayat "│ " ,8+i, 2, color;
- sayat substr(ARG(i), 1, 60) ,8+i, 4, color+2;
- sayat " │",8+i, 64, color;
- endfor
- sayat "│ │",9 +ARG(),2, color;
- compile if EVERSION < 5
- sayat "│" ,10+ARG(),2, color;
- sayat " Hit any key to continue... " ,10+ARG(),3, color+1;
- compile else
- sayat "│" ,10+ARG(),2, color;
- sayat " " ,10+ARG(),3, color+1;
- compile endif
- sayat "│",10+ARG(),65, color;
- sayat "└──────────────────────────────────────────────────────────────┘",11+ARG(),2, color;
- .line=.line; .col=.col; /* Sideeffect of this assignment insures */
- /* message disappears after getkey(). */
- compile if EVERSION < 5
- thekey = getkey();
- compile else
- Dumb = 1;
- for i = 1 to 500;
- Dumb = (Dumb * 31) // 113;
- endfor
- compile endif
-
- compile if EVERSION < 5
- display 1;
- return thekey;
- compile else
- display 1; -- reenable the refresh of text
- compile endif
- compile endif
-
-
-
-
-
- /**********************************************************************
- What's it called : allocate_attr(model)
-
- What's its parameters : char : a flag that indicates what attribute
- model is to be used for the attribute
- class being allocated. As of now, this field
- is unused, but in the future... registering the
- model of an attribute class will simplify
- some of our move/copy/delete problems. The
- attribute models that are supported are
- '1' : tag model.
- '2' : "set until next set" model
- '3' : push/pop model.
-
- What's it return: number : the attribute class granted to the caller.
- If no attribute class is available,
- the class returned will be 0.
-
- What's it do: allocates a attribute class to the caller. This is useful
- because it helps avoid situations where several utilities
- are (accidently) using the same attribute for different
- uses. Attribute class 0 is reserved as an error flag or
- wild card indicator. Attribute classes in the range
- 1..63 are reserved for internal purposes within E. (We have
- already used attribute class 1 to bind colors into text.)
- That leaves 192 attribute classes for new uses within the
- macro language.
- */
- defproc allocate_attr(model) =
- universal allocated_attrclasses
- universal allocated_attrmodels
- i=pos(' ',allocated_attrclasses)
- if i then
- allocated_attrclasses = overlay('A', allocated_attrclasses, i)
- i = i+63
- allocated_attrmodels = overlay(model, allocated_attrmodels, i, 1)
- return i
- endif
-
-
- /**********************************************************************
- What's it called : deallocate_attr(class)
-
- What's its parameters : number : a flag that indicates what attribute
- class is to be deallocated.
-
- What's it return: nothing
-
- What's it do: deallocates an attribute class number so that it can be resused
- by other applications.
-
- warning : All occurances of the attribute records having this class should
- be removed from all files in the editor. Failure to do this could
- result in an old (unremoved) attribute record being interpretted
- to have a new meaning if that attribute class is ever reallocated
- to another application.
- 'deallocate_attr' does not delete all occurances of an attribute
- class for you. It is the macro programmer's responsibility to do
- this.
- */
- defproc deallocate_attr(TheClass) =
- universal allocated_attrclasses
- universal allocated_attrmodels
- allocated_attrclasses = overlay(' ', allocated_attrclasses, TheClass-63)
-
-
- /*****************************************************************************
- The next few procedures implement hidden text. See CBlock.e for an example
- of the use of these functions.
- */
-
-
- /***********************************************************************
- What's it called: next_pos_in_stream
-
- What's its parameters: 1) OldPos : that expresses the old position
- The format of that string is three
- numbers: fileid, line, column. These
- numbers are separated by a space.
-
- What's it return: a string representing the next position
- in a character stream. The string is in
- the same format of as the input parameter.
-
- What's it do: For the most part, this function is obvious, but in
- the case of postions beyond the end of line it is not.
- If the input parameter specifies a character in the middle
- of a line, this function returns the position directly
- to the right of the former position. If the input parameter
- specifies the last character in a line, this function will
- return a pointer to the line terminator of that line. If the
- input parameter points beyond the last character of a line or
- at the line terminator character, it will next point to the
- first character of the next line. (If the next line only has
- a line terminator, then the first character of the next line
- is the line terminator.) If there are no more characters in
- the file, this function will return a value specifying line
- zero.
- */
- defproc next_pos_in_stream(OldPos) =
- parse value OldPos with OldFile OldLine OldCol;
- rc = 0
- compile if EVERSION > 5
- display -2
- compile endif
- OldLast = OldFile.last
- compile if EVERSION > 5
- display 2
- compile endif
- if rc then
- sayerror 'Old fileid is invalid.'
- stop
- endif
- if (OldLine>OldFile.last) then
- return OldFile" 0 "OldCol
- endif
- getline TextOfLine, OldLine, OldFile
- if (OldLine=OldFile.last) then
- if OldCol>length(TextOfLine) then
- return OldFile" 0 "OldCol
- endif
- endif
- if OldCol>=length(TextOfLine) then
- OldLine = OldLine + 1
- NewCol = OldCol>length(TextOfLine)
- else
- NewCol = OldCol + 1
- endif
- return OldFile OldLine NewCol
-
-
-
- /***********************************************************************
- What's it called: prev_pos_in_stream
-
- What's its parameters: 1) OldPos : that expresses the old position
- The format of that string is three
- numbers: fileid, line, column. These
- numbers are separated by a space.
-
- What's it return: a string representing the next position
- in a character stream. The string is in
- the same format of as the input parameter.
-
- What's it do: For the most part, this function is obvious, but in
- the case of postions beyond the end of line it is not.
- If the input parameter specifies a character in the middle
- of a line, this function returns the position directly
- to the left of the former position. If the input parameter
- specifies the first character in a line, this function will
- return a pointer to the line terminator of the previous line.
- If the input parameter points beyond the last character of a
- line or at the line terminator character, this function will
- return a pointer to the last character on the line. (If there are
- no characters on the line, then it will return a pointer to
- the line terminator character of the previous line.)
- If there are no more characters in the file, this function
- will return a value specifying line zero.
- */
- defproc prev_pos_in_stream(OldPos) =
- parse value OldPos with OldFile OldLine OldCol;
- rc = 0
- compile if EVERSION > 5
- display -2
- compile endif
- OldLast = OldFile.last
- compile if EVERSION > 5
- display 2
- compile endif
- if rc then
- sayerror 'Old fileid is invalid.'
- stop
- endif
- -- I may need to add code here to check for an empty file.
- if OldFile.last==0 then
- return OldFile '0' OldCol
- endif
- if (OldLine>OldFile.last) then
- return OldFile OldFile.last+1 '0'
- endif
- -- eliminate cases that result in values prior to top of file.
- if not OldLine then
- return OldFile 0 OldCol
- endif
- if OldLine<3 then
- getline TextOfLine, 1, OldFile
- if not length(TextOfLine) and ((OldLine=1) or not OldCol) then
- return OldFile 0 OldCol
- endif
- endif
- -- handle cases that change lines.
- getline TextOfLine, OldLine, OldFile
- if not (OldCol and length(TextOfLine)) then
- getline TextOfLine, OldLine-1, OldFile
- NewCol = length(TextOfLine)
- NewLine = OldLine - 1
- else
- if OldCol>length(TextOfLine) then
- NewCol = length(TextOfLine)
- else
- NewCol = OldCol - 1
- endif
- NewLine = OldLine
- endif
- return OldFile NewLine NewCol
-
-
- /***********************************************************************
- What's it called: highlight_phrase
-
- What's its parameters: 1) string : the phrase to be highlighted
- 2) number : the color of the highlighting
-
- What's it do: colors all occurances of a specified set of characters
- in a specified color. It does not attempt to
- uncolor the results of any previous calls to this
- procedure.
-
- */
- defc highlight_phrase
- parse arg Arg1 thecolor
- if thecolor='' then
- thecolor = 92
- endif
- getfileid ThisFileID
- call psave_pos(OldCursorPos)
- OldRC = RC
- 0
- display -2
- "l /"Arg1"/"
- while not rc do
- insert_attribute COLORCLASS, 23, 0, 1, .col+length(Arg1)-1, .line
- insert_attribute COLORCLASS, thecolor, 1, -1, .col, .line
- repeat_find
- endwhile
- rc = OldRC
- display 2
- call prestore_pos(OldCursorPos)
- if .levelofattributesupport = 0 then .levelofattributesupport = 1; endif
-
- /***********************************************************************
- What's it called: highlight_identifier
-
- What's its parameters: 1) string : the identifier to be highlighted
- 2) number : the color of the highlighting
-
- What's it do: colors all occurances of a specified set of characters
- in a specified color. It does not attempt to
- uncolor the results of any previous calls to this
- procedure.
-
- Uses grep search to recognize identifiers. Grep
- searching is relatively slow, so I also use normal
- search to speed up searching.
-
- */
- defc highlight_identifier
- parse arg TheIdentName thecolor .
-
- if (TheIdentName='') or (TheIdentName='.') then
- if find_token(startcol, endcol) then
- TheIdentName = substr(textline(.line), startcol, (endcol-startcol)+1)
- else
- call showmessage(" Cursor was not on a valid identifier. Place ",
- " the cursor over a procedure name and ",
- " try again.")
- RC = 0
- return
- endif
- endif
- if thecolor=='' then
- thecolor = 26
- endif
- getfileid ThisFileID
- call psave_pos(OldCursorPos)
- OldRC = RC
- 0
- display -2; -- prevent "Not Found" error messages.
- "l /"TheIdentName"/e" /* do exact search first to increase speed. Grep is slow */
- if not RC then
- if .col>1 then .col=.col-1; endif
- "l /[^_a-zA-Z0-9]"TheIdentName"[^_a-zA-Z0-9]/g"
- endif
- while rc==0 do
- insert_attribute COLORCLASS, 23, 0, 1, .col+length(TheIdentName), .line
- insert_attribute COLORCLASS, thecolor, 1, -1, .col+1, .line
- .col = .col+length(TheIdentName)+2
- "l /"TheIdentName"/e" /* do exact search first to increase speed of grep search. */
- if RC==0 then
- if .col>1 then .col=.col-1
- endif
- "l /[^_a-zA-Z0-9]"TheIdentName"[^_a-zA-Z0-9]/g"
- endif
- endwhile
- RC = OldRC
- display 2 -- allow error messages again
- call prestore_pos(OldCursorPos)
- if .levelofattributesupport = 0 then .levelofattributesupport = 1; endif
-
-
- /***********************************************************************
- What's it called: find_insertion_points_for_region
-
- What's its parameters: 1) number : The first line of the region
- 2) number : The first col of the region
- 3) number : The last line of the region
- 4) number : The last col of the region
- 5) number : The fileid of the file.
- 5) var number : The offset of first position
- 6) var number : The offset of second position
-
- What's it do: It finds the offsets where matching attribute records should
- be placed to encompass the specified region. The Line and
- Column numbers need not be returned because they
- have the same values as the input parameters.
-
- crossref: see comment at the top of this file.
-
- comment: line marks are not handled very well.
-
- */
- defproc find_insertion_points_for_region(fline, fcol, lline, lcol, fileid, var BeginOffset, var EndOffset)
- -- Start at the top first.
- TheLine = fline
- TheCol = fcol
- TheOffset = -1
- TheOffset2 = TheOffset
- attribute_action FIND_MATCH_ATTR_SUBOP, TheClass, TheOffset2, TheCol, TheLine, fileid
- while (TheClass<>0) and ((TheLine<lline) or ((TheLine==lline) and (TheCol<=lcol))) do
- TheLine = fline
- TheCol = fcol
- TheOffset = TheOffset-1
- TheOffset2 = TheOffset
- attribute_action FIND_MATCH_ATTR_SUBOP, TheClass, TheOffset2, TheCol, TheLine, fileid
- endwhile
- BeginOffset = TheOffset
- TheLine = lline
- TheCol = lcol
- TheOffset = 1
- TheOffset2 = TheOffset
- attribute_action FIND_MATCH_ATTR_SUBOP, TheClass, TheOffset2, TheCol, TheLine, fileid
- while (TheClass<>0) and ((TheLine>fline) or ((TheLine==fline) and (TheCol>fcol)) or
- ((TheLine==fline)and(TheCol==fcol)and(TheOffset>BeginOffset))) do
- TheLine = lline
- TheCol = lcol
- TheOffset = TheOffset+1
- TheOffset2 = TheOffset
- attribute_action FIND_MATCH_ATTR_SUBOP, TheClass, TheOffset2, TheCol, TheLine, fileid
- endwhile
- EndOffset = TheOffset
-
-
- /***********************************************************************
- What's it called: bind_attr_to_region
-
- What's its parameters: 1) number : The Class of the attribute records
- that will encompass the marked area.
- 2) number : The Value of the attribute records
- that will encompass the marked area.
- 3) number : The first line of the region
- 4) number : The first col of the region
- 5) number : The last line of the region
- 6) number : The last col of the region
- 7) number : The fileid of the region.
-
- What's it do: It puts push/pop style attributes around the marked
- region. If other attribute records are already
- at positions where it will place attribute records,
- it will insert the new records inside the existing
- attribute records.
- The attribute records will have a class and value
- specified on the command line.
-
- crossref: see comment at the top of this file.
-
- comment: line marks are not handled very well.
-
- */
- defc bind_attr_to_region
- parse arg setclass setvalue fline fcol lline lcol fileid rest
- -- Start at the top first.
- call find_insertion_points_for_region(fline, fcol, lline, lcol, fileid,
- BeginOffset, TheOffset)
- insert_attribute setclass, setvalue, 1/*push*/, BeginOffset, fcol, fline, fileid
- insert_attribute setclass, setvalue, 0/*pop*/, TheOffset, lcol, lline, fileid
-
-
- /***********************************************************************
- What's it called: bind_attr_to_marked_region
-
- What's its parameters: 1) number : The Class of the attribute records
- that will encompass the marked area.
- 2) number : The Value of the attribute records
- that will encompass the marked area.
-
- What's it do: It puts push/pop style attributes around the marked
- region. If other attribute records are already
- at positions where it will place attribute records,
- it will insert the new records inside the existing
- attribute records.
- The attribute records will have a class and value
- specified on the command line.
-
- crossref: see comment at the top of this file.
-
- comment: line marks are not handled very well.
-
- */
- defc bind_attr_to_marked_region
- themarktype = marktype()
- if themarktype=='' then -- there is no mark
- call messageNwait("Error, a mark must exist before it can be colored.")
- else
- getfileid thisfileid
- getmark firstmline, lastmline,firstmcol,lastmcol,mkfileid
- parse arg TheClass TheValue .
- if mkfileid==thisfileid then
- if themarktype=="CHAR" then
- "bind_attr_to_region" TheClass TheValue firstmline firstmcol lastmline lastmcol mkfileid
- --insert_attribute TheClass, TheValue, 1, -300, firstmcol, firstmline, mkfileid
- --insert_attribute TheClass, 23, 0, 300, lastmcol, lastmline, mkfileid
- elseif themarktype=="BLOCK" then
- for i = firstmline to lastmline
- "bind_attr_to_region" TheClass TheValue i firstmcol i lastmcol mkfileid
- --insert_attribute TheClass, TheValue, 1, -300, firstmcol, i, mkfileid
- --insert_attribute TheClass, 23, 0, 300, lastmcol, i, mkfileid
- endfor
- elseif themarktype=="LINE" then
- "bind_attr_to_region" TheClass TheValue firstmline 1 lastmline+1 0 mkfileid
- --insert_attribute TheClass, TheValue, 1, -300, 1, firstmline, mkfileid
- --insert_attribute TheClass, 23, 0, 300, 255, lastmline, mkfileid
- else
- sayerror "Internal Error: weird mark type." themarktype
- endif
- else
- call messageNwait("Error, marked region must be in current window before coloring.")
- endif
- endif
-
-
- /***********************************************************************
- What's it called: set_marked_region_to_color
-
- What's its parameters: number : the color
-
- What's it do: it colors the marked region in the color specifed by
- the first parameter.
-
- crossref: see comment at the top of this file.
-
- comment: line marks are not handled very well.
-
- */
- defc set_marked_region_to_color
- themarktype = marktype()
- if themarktype=='' then --there is no mark
- call messageNwait("Error, a mark must exist before it can be colored.")
- else
- if arg(1)=='' then
- sayerror "Error: set_marked_region_to_color requires a color parameter"
- else
- "bind_attr_to_marked_region" 1 arg(1) -- COLORCLASS key
- endif
- endif
- if .levelofattributesupport = 0 then .levelofattributesupport = 1; endif
-
- /****************************************************************************
- What's it called: reveal_attrs_on_line
-
- What's its parameters: 1) number: linenumber of line to be revealed.
-
- What's it do: appends a line to the current file that textually describes
- the contents of the specified line of the current file.
- */
- defc reveal_attrs_on_line
- TheOffset = -300
- TheColumn = 0
- if arg(1) then
- TheALine = arg(1)
- else
- TheALine = .line
- endif
- TheLine = TheALine
- TheClass = ANY_CLASS
- TheOutString = "" /* The line to be created. */
- attribute_action FIND_NEXT_ATTR_SUBOP, TheClass, TheOffset, TheColumn, TheLine
- while (TheClass) and (TheLine=TheALine) do
- query_attribute TheClass, TheValue, IsPush, TheOffset, TheColumn, TheLine
-
- TheOutString = TheOutString"[c."TheColumn",of."TheOffset","
-
- if TheClass==COLORCLASS then
- TheOutString = TheOutString"COLOR,v."TheValue
- elseif TheClass==HIDNCLASS then
- TheOutString = TheOutString"HIDN,v."TheValue
- elseif TheClass==ASSOCCLASS then
- TheOutString = TheOutString"ASSOC,v."TheValue
- elseif TheClass==BUTTONCLASS then
- TheOutString = TheOutString"BUTTN,v."TheValue
- elseif TheClass==14 then
- TheOutString = TheOutString"STYLE,v."TheValue
- elseif TheClass==16 then
- TheOutString = TheOutString"FONT,v."TheValue
- else
- TheOutString = TheOutString"Cls."TheClass",v."TheValue
- endif
-
- if IsPush==1 then
- TheOutString = TheOutString",PUSH"
- elseif IsPush==0 then
- TheOutString = TheOutString",POP"
- elseif IsPush==2 then
- TheOutString = TheOutString",TAG"
- else
- TheOutString = TheOutString",P"IsPush
- endif
-
- TheOutString = TheOutString"]"
- TheClass = ANY_CLASS
- attribute_action FIND_NEXT_ATTR_SUBOP, TheClass, TheOffset, TheColumn, TheLine
- endwhile
- insertline TheOutString, .last+1
-
-
- -------------------------------------------------------------------------------
- defc test_attr_search
- 0; .col=1
- TheOffset = -300
- TheColumn = 1
- TheLine = 0
- TheClass = ANY_CLASS
- attribute_action FIND_NEXT_ATTR_SUBOP, TheClass, TheOffset, TheColumn, TheLine
- --TheOffset = signit(TheOffset)
- while TheClass<>0 do
- TheLine
- .col = TheColumn
- query_attribute TheClass, TheValue, IsPush, TheOffset, TheColumn, TheLine
- call messageNwait("Found one. Class="TheClass" IsPush="IsPush" Offset="TheOffset" Value="TheValue" (L,C)=("TheLine","TheColumn")")
- TheClass = ANY_CLASS
-
- attribute_action FIND_NEXT_ATTR_SUBOP, TheClass, TheOffset, TheColumn, TheLine
- --TheOffset = signit(TheOffset)
- endwhile
- .last+1
- endline
- call messageNwait("None found. Starting reverse search for attributes.")
- TheOffset = 300
- TheColumn = 255
- TheLine = .last+1
- TheClass = ANY_CLASS
- attribute_action FIND_PREV_ATTR_SUBOP, TheClass, TheOffset, TheColumn, TheLine
- --TheOffset = signit(TheOffset)
- while TheClass<>0 do
- TheLine
- .col = TheColumn
- query_attribute TheClass, TheValue, IsPush, TheOffset, TheColumn, TheLine
- call messageNwait("Found one. Class="TheClass" IsPush="IsPush" Offset="TheOffset" Value="TheValue" (L,C)=("TheLine","TheColumn")")
- TheClass = ANY_CLASS
- attribute_action FIND_PREV_ATTR_SUBOP, TheClass, TheOffset, TheColumn, TheLine
- --TheOffset = signit(TheOffset)
- endwhile
- sayerror "No more found while searching backwards."
-
-
- defc enable_attr_keys
- -- Button 1, Second Click, Alt
- call register_mousehandler(1, '1 SECONDCLK 4', 'MH_executeclick')
- -- Button 2, Second Click, Alt
- call register_mousehandler(1, '2 SECONDCLK 4', 'blkexpansion_Expand_Blk')
- -- Button 2, Second Click, Ctrl
- call register_mousehandler(1, '2 SECONDCLK 2', 'blkexpansion_Compress_Blk')
-
-
-
- defproc signit(TheNumString)
-
- if (length(TheNumString)<>10) then
- return TheNumString
- elseif ('y'TheNumString<='y2147483648') then
- -- warning:
- -- E converts the numbers to floating point numbers with
- -- 9 significant digits. To avoid this, a string compare
- -- is done above.
- --
- /* We are positive so just return the given value */
- return TheNumString
- else
- FourGig = '4294967296'
- HiDiff = substr(FourGig, 1, 5) - substr(TheNumString, 1, 5)
- LoDiff = substr(FourGig, 6, 5) - substr(TheNumString, 6, 5)
- if (HiDiff<0) or ((HiDiff=0) and (LoDiff<0)) then
- -- TheNumString>FourGig
- return TheNumString
- endif
- if LoDiff<0 then
- LoDiff = '100000' + LoDiff
- HiDiff = HiDiff - 1
- endif
- if not HiDiff then
- HiDiff=''
- endif
- return '-'HiDiff||LoDiff
- endif
-
- definit
- universal allocated_attrclasses
- universal allocated_attrmodels
- universal ATTR_installed
- if ATTR_installed=="" then
- ATTR_installed = "0"
- allocated_attrclasses = substr(' ',1,192)
- allocated_attrmodels = substr('3',1,255)
-
- /* indicates color class uses push/pop model */
- if filetype()='TST' then
- keys attr_keys
- endif
- endif
-
-