Tools__TagList.st
changeset 15855 e8cd02427e78
parent 15852 005d6c483bfa
child 15856 8436d7f427c9
child 15912 6edd447ce2c8
equal deleted inserted replaced
15853:00d7a229b2f0 15855:e8cd02427e78
  2218 
  2218 
  2219 !TagList methodsFor:'tag generation'!
  2219 !TagList methodsFor:'tag generation'!
  2220 
  2220 
  2221 fromFile:aFile in:aTempDirectory
  2221 fromFile:aFile in:aTempDirectory
  2222     "create tags from a file;
  2222     "create tags from a file;
  2223      either use the ctags/etags command, or an intenral naive, simple method."
  2223      either use the ctags/etags command, or an internal naive, simple method."
  2224 
  2224 
  2225     |forceSimpleTagList list shellCmd numTags fileContents|
  2225     |forceSimpleTagList list shellCmd numTags fileContents|
  2226 
  2226 
  2227     rawList := nil.
  2227     rawList := nil.
  2228     tagsValidForFile := nil.
  2228     tagsValidForFile := nil.
  2236     forceSimpleTagList ifFalse:[
  2236     forceSimpleTagList ifFalse:[
  2237         shellCmd := (self shellCommandFor:aFile pathName).
  2237         shellCmd := (self shellCommandFor:aFile pathName).
  2238         shellCmd notNil ifTrue:[
  2238         shellCmd notNil ifTrue:[
  2239             tagTypesPresent := false.     "/ will be set again, when ctags command provides types
  2239             tagTypesPresent := false.     "/ will be set again, when ctags command provides types
  2240             list := self getTagListFromFile:aFile usingCommand:shellCmd mode:nil in:aTempDirectory.
  2240             list := self getTagListFromFile:aFile usingCommand:shellCmd mode:nil in:aTempDirectory.
  2241             (self class isCSuffix:(aFile suffix)) ifTrue:[
  2241             list addAll:(self getAdditionalCTagsInFile:aFile withList:list)
  2242                 list addAll:(self additionalCTagsInFile:aFile)
       
  2243             ]
       
  2244         ].
  2242         ].
  2245     ].
  2243     ].
  2246 
  2244 
  2247     "/ in case ctags could not find anything, try our own, naive fallback (not too bad either)
  2245     "/ in case ctags could not find anything, try our own, naive fallback (not too bad either)
  2248     list isEmptyOrNil ifTrue:[
  2246     list isEmptyOrNil ifTrue:[
  2711     "Created: / 28-09-2012 / 14:45:35 / cg"
  2709     "Created: / 28-09-2012 / 14:45:35 / cg"
  2712 ! !
  2710 ! !
  2713 
  2711 
  2714 !TagList methodsFor:'tag generation - simple'!
  2712 !TagList methodsFor:'tag generation - simple'!
  2715 
  2713 
  2716 additionalCTagsInFile:aFilePath
       
  2717     "additional tags, which are not found by the standard ctags utility:
       
  2718         case foo:   - case label tags
       
  2719         switch:     - case label tags
       
  2720         label:      - label tags (if there is a corresponding goto)
       
  2721     "
       
  2722 
       
  2723     |targets line lineNr s caseLabel l gotoTargets possibleLabels|
       
  2724 
       
  2725     self hideLabels ifTrue:[^ #()].
       
  2726     showOnly notNil ifTrue:[^ #()].
       
  2727 
       
  2728     Tag autoload.
       
  2729 
       
  2730     targets := OrderedCollection new.
       
  2731     gotoTargets := Set new.
       
  2732     possibleLabels := OrderedCollection new.
       
  2733 
       
  2734     s := aFilePath asFilename readStream.
       
  2735     s notNil ifTrue:[
       
  2736         lineNr := 0.
       
  2737         s := LineNumberReadStream readingFrom:s.
       
  2738         [s atEnd] whileFalse:[
       
  2739             lineNr := lineNr + 1.
       
  2740             line := s nextLine withoutSeparators.
       
  2741             ((line startsWith:'case ') and:[line includes:$:]) ifTrue:[
       
  2742                 l := line readStream. 
       
  2743                 l skip:5.
       
  2744                 caseLabel := l upTo:$:.
       
  2745                 targets add:(Tag::TCaseLabel
       
  2746                                 label:'case ' allItalic , caseLabel",' <case>' allItalic"
       
  2747                                 pattern:nil
       
  2748                                 type:nil
       
  2749                                 lineNumber:lineNr).
       
  2750             ] ifFalse:[
       
  2751                 (line startsWith:'default:') ifTrue:[
       
  2752                     targets add:(Tag::TCaseLabel
       
  2753                                     label:'case ' allItalic, 'default'
       
  2754                                     pattern:nil
       
  2755                                     type:nil
       
  2756                                     lineNumber:lineNr).
       
  2757                 ] ifFalse:[
       
  2758                     ((line startsWith:'switch') and:[line includes:$(]) ifTrue:[
       
  2759                         l := line readStream. 
       
  2760                         l skip:6.
       
  2761                         l skipSeparators.
       
  2762                         l peek == $( ifTrue:[
       
  2763                             l next.
       
  2764                             caseLabel := (l upTo:$)) withoutSeparators.
       
  2765                             caseLabel notEmpty ifTrue:[
       
  2766                                 caseLabel := 'switch (',caseLabel,')'.
       
  2767                                 targets add:(Tag::TCaseLabel
       
  2768                                             label:'case ' allItalic , caseLabel
       
  2769                                             pattern:nil
       
  2770                                             type:nil
       
  2771                                             lineNumber:lineNr).
       
  2772                             ]
       
  2773                         ]
       
  2774                     ] ifFalse:[
       
  2775                         (line startsWith:'goto ') ifTrue:[
       
  2776                             |targetLabel|
       
  2777                             l := line readStream. 
       
  2778                             l skip:5.
       
  2779                             l skipSeparators.
       
  2780                             targetLabel := (l upTo:$; ) withoutSeparators.
       
  2781                             targetLabel notEmpty ifTrue:[
       
  2782                                 gotoTargets add:targetLabel.
       
  2783                             ]
       
  2784                         ] ifFalse:[
       
  2785                             (line includes:$:) ifTrue:[
       
  2786                                 |label|
       
  2787                                 label := (line upTo:$:) withoutSeparators.
       
  2788                                 label notEmpty ifTrue:[
       
  2789                                     ((label first isLetter or:[label first = $_])
       
  2790                                     and:[ label conform:[:ch | ch isLetterOrDigit or:[ch = $_]]]) ifTrue:[
       
  2791                                         possibleLabels 
       
  2792                                             add:(Tag::TCaseLabel
       
  2793                                                 label:'label ' allItalic , label
       
  2794                                                 pattern:label
       
  2795                                                 type:nil
       
  2796                                                 lineNumber:lineNr)
       
  2797                                     ].
       
  2798                                 ].
       
  2799                             ].
       
  2800                         ].
       
  2801                     ]
       
  2802                 ]
       
  2803             ].
       
  2804         ].
       
  2805         s close
       
  2806     ].
       
  2807     possibleLabels 
       
  2808         select:[:lbl | gotoTargets includes:lbl pattern]
       
  2809         thenDo:[:lbl | targets add:lbl].
       
  2810     ^ targets
       
  2811 !
       
  2812 
       
  2813 assemblerTagsInFile:aFilePath
  2714 assemblerTagsInFile:aFilePath
  2814     "assembler tags:
  2715     "assembler tags:
  2815      naive, q&d scan for lines matching:
  2716      naive, q&d scan for lines matching:
  2816         <anything>:
  2717         <anything>:
  2817      CAVEAT:
  2718      CAVEAT:
  2980 
  2881 
  2981     "Created: / 28-06-2010 / 12:44:25 / cg"
  2882     "Created: / 28-06-2010 / 12:44:25 / cg"
  2982     "Modified: / 22-08-2012 / 21:32:33 / cg"
  2883     "Modified: / 22-08-2012 / 21:32:33 / cg"
  2983 !
  2884 !
  2984 
  2885 
       
  2886 getAdditionalCTagsInFile:aFilePath withList:ctagsList
       
  2887     "additional tags, which are not found by the standard ctags utility:
       
  2888         case foo:   - case label tags
       
  2889         switch:     - case label tags
       
  2890         label:      - label tags (if there is a corresponding goto)
       
  2891 
       
  2892      The already generated ctagsList is passed as argument,
       
  2893      so duplicates etc. can be detected"
       
  2894 
       
  2895     |targets line lineNr s caseLabel l gotoTargets possibleLabels 
       
  2896      addLabelTag findCurrentFunctionPrefix|
       
  2897 
       
  2898     self hideLabels ifTrue:[^ #()].
       
  2899     showOnly notNil ifTrue:[^ #()].
       
  2900 
       
  2901     Tag autoload.
       
  2902 
       
  2903     targets := OrderedCollection new.
       
  2904     gotoTargets := Set new.
       
  2905     possibleLabels := OrderedCollection new.
       
  2906 
       
  2907     findCurrentFunctionPrefix :=
       
  2908         [:lineNr |
       
  2909             |bestSoFar|
       
  2910 
       
  2911             ctagsList do:[:each |
       
  2912                 each isFunctionOrMethodTag ifTrue:[
       
  2913                     each lineNumber <= lineNr ifTrue:[
       
  2914                         (bestSoFar isNil or:[ each lineNumber > bestSoFar lineNumber]) ifTrue:[
       
  2915                             bestSoFar := each
       
  2916                         ]
       
  2917                     ].
       
  2918                 ].
       
  2919             ].
       
  2920             bestSoFar isNil
       
  2921                 ifTrue:[ '' ]
       
  2922                 ifFalse:[ bestSoFar label, ' ' ]
       
  2923         ].
       
  2924 
       
  2925     addLabelTag := 
       
  2926         [:tagType :lineNr :label |
       
  2927             |fnPrefix|
       
  2928 
       
  2929             fnPrefix := findCurrentFunctionPrefix value:lineNr.
       
  2930             targets add:(tagType
       
  2931                             label:(fnPrefix,label)
       
  2932                             pattern:nil
       
  2933                             type:nil
       
  2934                             lineNumber:lineNr).
       
  2935         ].
       
  2936 
       
  2937     s := aFilePath asFilename readStream.
       
  2938     s notNil ifTrue:[
       
  2939         lineNr := 0.
       
  2940         s := LineNumberReadStream readingFrom:s.
       
  2941         [s atEnd] whileFalse:[
       
  2942             lineNr := lineNr + 1.
       
  2943             line := s nextLine withoutSeparators.
       
  2944             ((line startsWith:'case ') and:[line includes:$:]) ifTrue:[
       
  2945                 l := line readStream. 
       
  2946                 l skip:5.
       
  2947                 caseLabel := l upTo:$:.
       
  2948                 addLabelTag value:(Tag::TCaseLabel) value:lineNr 
       
  2949                             value:('case ' allItalic , caseLabel",' <case>' allItalic").
       
  2950             ] ifFalse:[
       
  2951                 (line startsWith:'default:') ifTrue:[
       
  2952                     addLabelTag value:(Tag::TCaseLabel) value:lineNr 
       
  2953                                 value:('case ' allItalic, 'default').
       
  2954                 ] ifFalse:[
       
  2955                     ((line startsWith:'switch') and:[line includes:$(]) ifTrue:[
       
  2956                         l := line readStream. 
       
  2957                         l skip:6.
       
  2958                         l skipSeparators.
       
  2959                         l peek == $( ifTrue:[
       
  2960                             l next.
       
  2961                             caseLabel := (l upTo:$)) withoutSeparators.
       
  2962                             caseLabel notEmpty ifTrue:[
       
  2963                                 caseLabel := 'switch (',caseLabel,')'.
       
  2964                                 addLabelTag value:(Tag::TCaseLabel) value:lineNr 
       
  2965                                             value:('case ' allItalic , caseLabel).
       
  2966                             ]
       
  2967                         ]
       
  2968                     ] ifFalse:[
       
  2969                         (line startsWith:'goto ') ifTrue:[
       
  2970                             |targetLabel|
       
  2971                             l := line readStream. 
       
  2972                             l skip:5.
       
  2973                             l skipSeparators.
       
  2974                             targetLabel := (l upTo:$; ) withoutSeparators.
       
  2975                             targetLabel notEmpty ifTrue:[
       
  2976                                 gotoTargets add:targetLabel.
       
  2977                             ]
       
  2978                         ] ifFalse:[
       
  2979                             (line includes:$:) ifTrue:[
       
  2980                                 |label|
       
  2981                                 label := (line upTo:$:) withoutSeparators.
       
  2982                                 label notEmpty ifTrue:[
       
  2983                                     ((label first isLetter or:[label first = $_])
       
  2984                                     and:[ label conform:[:ch | ch isLetterOrDigit or:[ch = $_]]]) ifTrue:[
       
  2985                                         |fnPrefix|
       
  2986                                         fnPrefix := findCurrentFunctionPrefix value:lineNr.
       
  2987                                         possibleLabels 
       
  2988                                             add:(Tag::TCaseLabel
       
  2989                                                 label:(fnPrefix,('label ' allItalic , label))
       
  2990                                                 pattern:label
       
  2991                                                 type:nil
       
  2992                                                 lineNumber:lineNr)
       
  2993                                     ].
       
  2994                                 ].
       
  2995                             ].
       
  2996                         ].
       
  2997                     ]
       
  2998                 ]
       
  2999             ].
       
  3000         ].
       
  3001         s close
       
  3002     ].
       
  3003     possibleLabels 
       
  3004         select:[:lbl | gotoTargets includes:lbl pattern]
       
  3005         thenDo:[:lbl | targets add:lbl].
       
  3006     ^ targets
       
  3007 !
       
  3008 
       
  3009 getAdditionalTagsInFile:aFile withList:ctagsList
       
  3010     "a chance to generate a list of additional tags,    
       
  3011      which are not found by the standard ctags utility.
       
  3012      For example, for C, labels and switches are detected and added.
       
  3013      The already generated ctagsList is passed as argument,
       
  3014      so duplicates etc. can be detected"
       
  3015 
       
  3016     (self class isCSuffix:(aFile suffix)) ifTrue:[
       
  3017         ^ self getAdditionalCTagsInFile:aFile withList:ctagsList
       
  3018     ].
       
  3019     ^ #()
       
  3020 !
       
  3021 
  2985 getSimpleTagListFromFile:aFileOrString in:aTempDirectory
  3022 getSimpleTagListFromFile:aFileOrString in:aTempDirectory
  2986     "fallback, if no ctags is present, or if the file is not a c-file.
  3023     "fallback, if no ctags is present, or if the file is not a c-file.
  2987      Implemented here for some other file types (Makefiles)
  3024      Implemented here for some other file types (Makefiles)
  2988     "
  3025     "
  2989     |file lcName pathName suffix mime|
  3026     |file lcName pathName suffix mime|