"

 COPYRIGHT (c) 2002 by eXept Software AG 

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libtool' }"

"{ NameSpace: Tools }"

List subclass:#TagList

	instanceVariableNames:'rawList filteredList filter sortCriteria groupBy showOnly

		hideStatic hideStructMembers hideClasses hideMethods hideDefines

		hideTypedefs hideVariables hideStructures hideFunctions

		hideFunctionProtoTypes hideJavaClasses hideJavaMethods

		hideJavaInterfaces hideJavaFields hideJavaPackages hideLispMacros

		hideLispEvaluations hideLispMethods hideLispConstants

		hideLocalLabels hideLocalLabels2 hideDataLabels hideTextLabels

		tagTypesPresent hidePythonClasses hidePythonMethods

		hidePythonFunctions hideOzClasses hideOzMethods hideOzFunctions

		hideHTMLTextArea hideHTMLInput hideHTMLTable hideHTMLScript

		hideHTMLForm usingDefaultCTags ctagsCommand ctagsIsExCtags

	classVariableNames:'Sorted CachedTagListsPerFile DefaultSortCriteria DefaultShowOnly

		TagsSuffixes DefaultGroupBy'

	poolDictionaries:''

	category:'Interface-Tools-File-Tags'

!

!TagList class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 2002 by eXept Software AG 

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    a list of tags as read & generated from parsing a source file.

    For some languages, naive parsing is supported right here;

    for other languages, external tools (ctags) are used.

    The tags are used bz the tagList or to navigate quickly to some

    function in the C-browser.

"

! !

!TagList class methodsFor:'accessing'!

tagsSuffixes

"flush with:

TagsSuffixes := nil

"

    TagsSuffixes notNil ifTrue:[

        ^ TagsSuffixes

    ].

    TagsSuffixes := IdentityDictionary new.

    TagsSuffixes at:#'text/asm'                 put:#( 's' 'asm' ).

    TagsSuffixes at:#'text/c'                   put:#( 'c' 'h' 'ci' 'hi' 'sc').

    TagsSuffixes at:#'text/cpp'                 put:#( 'cc' 'cpp' 'cxx' 'c++' 'hxx' 'hpp' 'h++').

    TagsSuffixes at:#'text/eiffel'              put:#( 'e' 'eif' ).

    TagsSuffixes at:#'text/fortran'             put:#( 'f' 'for' 'ftn' 'f77' 'f90' ).

    TagsSuffixes at:#'text/html'                put:#( 'htm' 'html').

    TagsSuffixes at:#'text/java'                put:#( 'java' 'jav').

    TagsSuffixes at:#'text/javaScript'          put:#( 'js' ).

    TagsSuffixes at:#'text/javascript'          put:#( 'js' ).

    TagsSuffixes at:#'application/x-javascript' put:#( 'js' ).

    TagsSuffixes at:#'text/make'                put:#( 'makefile' 'make.proto' 'makefile.*' '*.mak' '*.bpr').

    TagsSuffixes at:#'text/prolog'              put:#( 'pl' ).

    TagsSuffixes at:#'text/python'              put:#( 'py' ).

    TagsSuffixes at:#'text/php'                 put:#( 'php' ).

    TagsSuffixes at:#'text/lisp'                put:#( 'lisp' 'el' 'lsp' 'cl').

    TagsSuffixes at:#'text/lisp-arc'            put:#( 'arc' ).

    TagsSuffixes at:#'text/scheme'              put:#( 'scm' 'ss' 'brg').

    TagsSuffixes at:#'text/oz'                  put:#( 'oz').

    TagsSuffixes at:#'text/smalltalk'           put:#( 'st' ).

    TagsSuffixes at:#'text/tcl'                 put:#( 'tcl' ).

    TagsSuffixes at:#'text/ruby'                put:#( 'rb' ).

    TagsSuffixes at:#'text/yacc'                put:#( 'y' ).

    ^ TagsSuffixes

    "Modified: / 20-04-2011 / 19:27:53 / cg"

! !

!TagList class methodsFor:'defaults'!

arcLispSuffixes

    "returns a list of supported arc-lisp-suffixes"

    ^ self tagsSuffixes at:#'text/lisp-arc'

!

assemblerSuffixes

    "returns a list of supported assembler-suffixes"

    ^ self tagsSuffixes at:#'text/asm'

!

cPlusPlusSuffixes

    "returns a list of supported c-suffixes"

    ^ self tagsSuffixes at:#'text/cpp'

!

cSuffixes

    "returns a list of supported c-suffixes"

    ^ self tagsSuffixes at:#'text/c'

!

commonLispSuffixes

    "returns a list of supported common-lisp-suffixes"

    ^ self tagsSuffixes at:#'text/lisp'

!

eiffelSuffixes

    "returns a list of supported eiffel-suffixes

    "

    ^ self tagsSuffixes at:#'text/eiffel'

!

fortranSuffixes

    "returns a list of supported fortran-suffixes

    "

    ^ self tagsSuffixes at:#'text/fortran'

!

htmlSuffixes

    "returns a list of supported html-suffixes

    "

    ^ self tagsSuffixes at:#'text/html'

    "Created: / 20-04-2011 / 19:03:39 / cg"

!

isTagSearchableSuffix:aSuffix

    "returns true, if aSuffix looks ok for ctags

    "

    self tagsSuffixes keysAndValuesDo:[:tag :suffixes |

        (suffixes includes:aSuffix) ifTrue:[^ true].

    ].

"/    (self cSuffixes includes:aSuffix) ifTrue:[^ true].

"/    (self javaSuffixes includes:aSuffix) ifTrue:[^ true].

"/    (self fortranSuffixes includes:aSuffix) ifTrue:[^ true].

"/    (self eiffelSuffixes includes:aSuffix) ifTrue:[^ true].

"/    (self commonLispSuffixes includes:aSuffix) ifTrue:[^ true].

"/    (self schemeSuffixes includes:aSuffix) ifTrue:[^ true].

    ^ false

!

javaScriptSuffixes

    "returns a list of supported javaScript-suffixes"

    ^ self tagsSuffixes at:#'text/javaScript'

    "Created: / 28-06-2010 / 12:44:58 / cg"

!

javaSuffixes

    "returns a list of supported java-suffixes

    "

    ^ self tagsSuffixes at:#'text/java'

!

makeFilePatterns

    "returns a list of makefile match patterns

    "

    ^ self tagsSuffixes at:#'text/make'

!

ozSuffixes

    "returns a list of supported oz-suffixes

    "

    ^ self tagsSuffixes at:#'text/oz'

!

phpSuffixes

    "returns a list of supported php-suffixes"

    ^ self tagsSuffixes at:#'text/php'

!

pltSchemeLispSuffixes

    ^ #('plt')

    "Created: / 21-10-2011 / 09:32:20 / cg"

!

prologSuffixes

    "returns a list of supported prolog-suffixes

    "

    ^ self tagsSuffixes at:#'text/prolog'

!

pythonSuffixes

    "returns a list of supported python-suffixes

    "

    ^ self tagsSuffixes at:#'text/python'

!

racketSchemeLispSuffixes

    ^ #('rkt')

    "Created: / 21-10-2011 / 09:32:27 / cg"

!

rubySuffixes

    "returns a list of supported ruby-suffixes

    "

    ^ self tagsSuffixes at:#'text/ruby'

!

schemeSuffixes

    "returns a list of supported scheme-lisp-suffixes

    "

    ^ self tagsSuffixes at:#'text/scheme'

!

smalltalkSuffixes

    "returns a list of supported smalltalk-suffixes

    "

    ^ self tagsSuffixes at:#'text/smalltalk'

!

tclSuffixes

    "returns a list of supported tcl-suffixes

    "

    ^ self tagsSuffixes at:#'text/tcl'

!

yaccSuffixes

    "returns a list of supported yacc-suffixes

    "

    ^ self tagsSuffixes at:#'text/yacc'

! !

!TagList class methodsFor:'queries'!

isArcLispSuffix:suffix

    ^ self isSuffix:suffix in:self arcLispSuffixes

!

isAssemblerSuffix:suffix

    ^ self isSuffix:suffix in:self assemblerSuffixes

!

isCPlusPlusSuffix:suffix

    ^ self isSuffix:suffix in:self cPlusPlusSuffixes

!

isCSuffix:suffix

    ^ self isSuffix:suffix in:self cSuffixes

!

isCommonLispSuffix:suffix

    ^ self isSuffix:suffix in:self commonLispSuffixes

!

isEiffelSuffix:suffix

    ^ self isSuffix:suffix in:self eiffelSuffixes

!

isFortranSuffix:suffix

    ^ self isSuffix:suffix in:self fortranSuffixes

!

isHTMLSuffix:suffix

    ^ self isSuffix:suffix in:self htmlSuffixes

    "Created: / 20-04-2011 / 19:03:26 / cg"

!

isJavaScriptSuffix:suffix

    ^ self isSuffix:suffix in:self javaScriptSuffixes

    "Created: / 28-06-2010 / 12:44:47 / cg"

!

isJavaSuffix:suffix

    ^ self isSuffix:suffix in:self javaSuffixes

!

isLispSuffix:suffix

    ^ (self isCommonLispSuffix:suffix) 

    or:[(self isSchemeSuffix:suffix)

    or:[(self isArcLispSuffix:suffix)

    or:[(self isPltSchemeLispSuffix:suffix)

    or:[(self isRacketSchemeLispSuffix:suffix)]]]]

    "Modified: / 21-10-2011 / 09:31:30 / cg"

!

isMakefileName:fileName

    |lcName|

    lcName := fileName asFilename baseName asLowercase.

    self makeFilePatterns do:[:aPattern |

        (aPattern match:lcName) ifTrue:[ ^ true ].

    ].

    ^ false

!

isOzSuffix:suffix

    ^ self isSuffix:suffix in:self ozSuffixes

!

isPhpSuffix:suffix

    ^ self isSuffix:suffix in:self phpSuffixes

!

isPltSchemeLispSuffix:suffix

    ^ self isSuffix:suffix in:self pltSchemeLispSuffixes

    "Created: / 21-10-2011 / 09:30:56 / cg"

!

isPrologSuffix:suffix

    ^ self isSuffix:suffix in:self prologSuffixes

!

isPythonSuffix:suffix

    ^ self isSuffix:suffix in:self pythonSuffixes

!

isRacketSchemeLispSuffix:suffix

    ^ self isSuffix:suffix in:self racketSchemeLispSuffixes

    "Created: / 21-10-2011 / 09:31:04 / cg"

!

isRubySuffix:suffix

    ^ self isSuffix:suffix in:self rubySuffixes

!

isSchemeSuffix:suffix

    ^ self isSuffix:suffix in:self schemeSuffixes

!

isSmalltalkSuffix:suffix

    ^ self isSuffix:suffix in:self smalltalkSuffixes

!

isTCLSuffix:suffix

    ^ self isSuffix:suffix in:self tclSuffixes

!

isYaccSuffix:suffix

    ^ self isSuffix:suffix in:self yaccSuffixes

! !

!TagList class methodsFor:'queries basic'!

isSuffix:suffix in:patterns

    |lcSuffix|

    lcSuffix := suffix asLowercase.

    ^ patterns contains:[:pattern | pattern match:lcSuffix].

!

tagMimeTypeForFile:aFile

    "returns the tag-mimetype for a file or nil

    "

    |suff file list name mimeMake|

    aFile isNil ifTrue:[^ nil].

    file := aFile asFilename.

    suff := aFile asFilename suffix.

    suff size ~~ 0 ifTrue:[

        suff := suff asLowercase.

        (suff = 'bak' or:[suff = 'sav']) ifTrue:[

            file := file asFilename withoutSuffix.

            suff := file suffix.

            suff size ~~ 0 ifTrue:[

                suff := suff asLowercase

            ]

        ]

    ].

    list := self tagsSuffixes.

    " hack to test for make-file patterns "

    name := file baseName asLowercase.

    mimeMake := #'text/make'.

    ((list at:mimeMake) contains:[:pattern | pattern match:name]) ifTrue:[

        ^ mimeMake

    ].

    self tagsSuffixes keysAndValuesDo:[:mimeType :suffixes|

        (suffixes includes:suff) ifTrue:[ ^ mimeType ]

    ].

    ^ nil

! !

!TagList class methodsFor:'tag generation'!

cachedTagsFromFile:aFilename in:aTempDirectory

    "retrieve a cached tagList for a file"

    |tagList cached fileTime suffix|

    fileTime := aFilename modificationTime.

    CachedTagListsPerFile isNil ifTrue:[

        CachedTagListsPerFile := Dictionary new.

    ].

    cached := CachedTagListsPerFile at:aFilename ifAbsent:nil.

    cached notNil ifTrue:[

        fileTime > cached tagTimestamp ifFalse:[

            ^ cached tagList

        ]

    ].

    suffix := aFilename suffix.

"/    ((self isCSuffix:suffix) 

"/    or:[(self isJavaSuffix:suffix)

"/    or:[(self isFortranSuffix:suffix)

"/    or:[(self isEiffelSuffix:suffix)]]])

"/    ifFalse:[

"/        ^ #()

"/    ].

    tagList := self new.

    tagList showOnly:nil.

    tagList fromFile:aFilename in:aTempDirectory.

    CachedTagListsPerFile at:aFilename put:(CachedTags new tagList:tagList; tagTimestamp:fileTime; yourself).

    ^ tagList

    "Modified: / 07-06-2010 / 12:13:25 / cg"

!

cachedTagsFromFile:aFilename in:aTempDirectory buildTargetHandler:aTargetHandler remote:aBoolean

    "retrieve a cached tagList for a file"

    ^ self cachedTagsFromFile:aFilename in:aTempDirectory.

!

flushCachedTags

    CachedTagListsPerFile := nil

    "

     self flushCachedTags

    "

!

makeTargetTagsInFile:aMakefilePath

    "makefile tags:

     naive, q&d scan for lines ending with a colon

    "

    ^ self makeTargetTagsInFile:aMakefilePath filter:nil

!

makeTargetTagsInFile:aMakefilePath filter:showOnly

    "makefile tags:

     naive, q&d scan for lines ending with a colon

    "

    |targets|

    Tag autoload.

    targets := OrderedCollection new.

    aMakefilePath asFilename contents keysAndValuesDo:[:lnr :line |

        |idxColon idxAssign varName target|

        line size > 0 ifTrue:[

            line first isSeparator ifFalse:[

                (line startsWith:$#) ifFalse:[

                    idxAssign := line indexOf:$=.

                    idxAssign ~~ 0 ifTrue:[

                        showOnly ~~ #targets ifTrue:[

                            varName := line copyFrom:1 to:idxAssign - 1.

                            targets add:(Tag::TVariable 

                                            label:varName 

                                            pattern:('/^',varName,'=')

                                            type:nil

                                            lineNumber:lnr)

                        ]

                    ] ifFalse:[

                        idxColon := line indexOf:$:.

                        idxColon ~~ 0 ifTrue:[

                            target := line copyFrom:1 to:idxColon - 1.

                            "/ ignore macro-targets

                            (target includes:$$) ifFalse:[

                                (target startsWith:$.) ifFalse:[

                                    "/ normal targets

                                    targets add:(Tag::TMakeTarget 

                                                    label:target 

                                                    pattern:('/^',target,':')

                                                    type:nil

                                                    lineNumber:lnr)

                                ] ifTrue:[

                                    "/ rule-targets

                                    targets add:(Tag::TMakeRule 

                                                    label:target 

                                                    pattern:('/^',target,':')

                                                    type:nil

                                                    lineNumber:lnr)

                                ]

                            ] ifTrue:[

                                "/ rule-targets

                                targets add:(Tag::TMakeTarget 

                                                label:target 

                                                pattern:('/^',target,':')

                                                type:nil