source: tol/tolsh/tolsh.vfs/lib/tcllib1.10/doctools/changelog.tcl @ 8597867d

1941-docker-image-to-testdevel
Last change on this file since 8597867d was 8597867d, checked in by Jorge Pérez <josp.jorge@…>, 16 years ago

closes #976, se incluye tcllib1.10, base64 debe eliminarse del raiz de lib ya que esta incluido en tcllib

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@2556 be4846ae-f051-483a-831f-b64e7d08527f

  • Property mode set to 100644
File size: 6.3 KB
Line 
1# changelog.tcl --
2#
3#       Handling of ChangeLog's.
4#
5# Copyright (c) 2003 Andreas Kupries <andreas_kupries@sourceforge.net>
6#
7# See the file "license.terms" for information on usage and redistribution
8# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
9#
10# RCS: @(#) $Id: changelog.tcl,v 1.5 2005/09/28 04:51:19 andreas_kupries Exp $
11
12
13# FUTURE -- Expand pre-parsed log (nested lists) into flat structures
14# FUTURE --  => date/author/file/cref + cref/text
15# FUTURE -- I.e. relational/tabular structure, useable in table displays,
16# FUTURE -- sort by date, author, file to see aggregated changes
17# FUTURE --  => Connectivity to 'struct::matrix', Reports!
18
19
20package require Tcl 8.2
21package require textutil
22
23namespace eval ::doctools {}
24namespace eval ::doctools::changelog {
25    namespace export scan toDoctools
26}
27
28# ::doctools::changelog::scan --
29#
30#       Scan a ChangeLog generated by 'emacs' and extract the relevant information.
31#
32# Result
33#       List of entries. Each entry is a list of three elements. These
34#       are date, author, and commentary. The commentary is a list of
35#       sections. Each section is a list of two elements, a list of
36#       files, and the associated text.
37
38
39proc ::doctools::changelog::scan {text} {
40    set text [split $text \n]
41    set n    [llength $text]
42
43    set entries [list]
44    set clist [list]
45    set files [list]
46    set comment ""
47    set first 1
48
49    for {set i 0} {$i < $n} {incr i} {
50        set line [lindex $text $i]
51
52        if {[regexp "^\[^ \t\]" $line]} {
53            # No whitespace at the front, start a new entry
54
55            closeEntry
56
57            # For the upcoming entry. Quick extraction first, string
58            # based in case of failure.
59
60            if {[catch {
61                set date    [string trim [lindex $line 0]]
62                set author  [string trim [lrange $line 1 end]]
63            }]} {
64                set pos    [string first " " $line]
65                set date   [string trim [string range $line 0   $pos]]
66                set author [string trim [string range $line $pos end]]
67            }
68            continue
69        }
70
71        # Inside of an entry.
72
73        set line [string trim $line]
74
75        if {[string length $line] == 0} {
76            # Next comment section
77            closeSection
78            continue
79        }
80
81        # Line is not empty. Split into file and comment parts,
82        # remember the data.
83
84        if {[string first "* " $line] == 0} {
85            if {[regexp {^\* (.*):[     ]} $line full fname]} {
86                set line [string range $line [string length $full] end]
87            } elseif {[regexp {^\* (.*):$} $line full fname]} {
88                set line ""
89            } else {
90                # There is no filename
91                set fname ""
92                set line [string range $line 2 end] ; # Get rid of "* ".
93            }
94
95            set detail ""
96            while {[string first "(" $fname] >= 0} {
97                if {[regexp {\([^)]*\)} $fname detailx]} {
98                    regsub {\([^)]*\)} $fname {} fnameNew
99                } elseif {[regexp {\([^)]*} $fname detailx]} {
100                    regsub {\([^)]*} $fname {} fnameNew
101                } else {
102                    break
103                }
104                append detail " " $detailx
105                set fname [string trim $fnameNew]
106            }
107            if {$detail != {}} {set line "$detail $line"}
108            if {$fname  != {}} {lappend files $fname}
109        }
110
111        append comment $line\n
112    }
113
114    closeEntry
115    return $entries
116}
117
118
119proc ::doctools::changelog::closeSection {} {
120    upvar clist clist comment comment files files
121
122    if {
123        ([string length $comment] > 0) ||
124        ([llength $files] > 0)
125    } {
126        lappend clist   [list $files [string trim $comment]]
127        set     files   [list]
128        set     comment ""     
129    }
130    return
131}
132
133proc ::doctools::changelog::closeEntry {} {
134    upvar clist clist comment comment files files first first
135    upvar date date author author entries entries
136
137    if {!$first} {
138        closeSection
139        lappend entries [list $date $author $clist]
140    }
141    set first 0
142    set clist [list]
143    set files [list]
144    set comment ""
145    return
146}
147
148# ::doctools::changelog::merge --
149#
150#       Merge several preprocessed changelogs (see scan) into one structure.
151
152
153proc ::doctools::changelog::merge {args} {
154
155    if {[llength $args] == 0} {return {}}
156    if {[llength $args] == 1} {return [lindex $args 0]}
157
158    set res [list]
159    array set tmp {}
160
161    # Merge up ...
162
163    foreach entries $args {
164        foreach e $entries {
165            foreach {date author comments} $e break
166            if {![info exists tmp($date,$author)]} {
167                lappend res [list $date $author]
168                set tmp($date,$author) $comments
169            } else {
170                foreach section $comments {
171                    lappend tmp($date,$author) $section
172                }
173            }
174        }
175    }
176
177    # ... And construct the final result
178
179    set args $res
180    set res [list]
181    foreach key [lsort -decreasing $args] {
182        foreach {date author} $key break
183        lappend res [list $date $author $tmp($date,$author)]
184    }
185    return $res
186}
187
188
189# ::doctools::changelog::toDoctools --
190#
191#       Convert a preprocessed changelog log (see scan) into a doctools page.
192#
193# Arguments:
194#       evar, cvar, fvar: Name of the variables containing the preprocessed log.
195#
196# Results:
197#       A string containing a properly formatted ChangeLog.
198#
199
200proc ::doctools::changelog::q {text} {return "\[$text\]"}
201
202proc ::doctools::changelog::toDoctools {title module version entries} {
203
204    set     linebuffer [list]
205    lappend linebuffer [q "manpage_begin [list ${title}-changelog n $version]"]
206    lappend linebuffer [q "titledesc [list "$title ChangeLog"]"]
207    lappend linebuffer [q "moddesc [list $module]"]
208    lappend linebuffer [q description]
209    lappend linebuffer [q "list_begin definitions compact"]
210
211    foreach entry $entries {
212        foreach {date author commentary} $entry break
213
214        lappend linebuffer [q "lst_item \"[q "emph [list $date]"] -- [string map {{"} {\"} {\"} {\\\"}} $author]\""]
215
216        if {[llength $commentary] > 0} {
217            lappend linebuffer [q nl]
218        }
219
220        foreach section $commentary {
221            foreach {files text} $section break
222            if {$text != {}} {
223                set text [string map {[ [lb] ] [rb]} [textutil::adjust $text]]
224            }
225
226            if {[llength $files] > 0} {
227                lappend linebuffer [q "list_begin definitions"]
228
229                foreach f $files {
230                    lappend linebuffer [q "lst_item [q "file [list $f]"]"]
231                }
232                if {$text != {}} {
233                    lappend linebuffer ""
234                    lappend linebuffer $text
235                    lappend linebuffer ""
236                }
237
238                lappend linebuffer [q list_end]
239            } elseif {$text != {}} {
240                # No files
241                lappend linebuffer [q "list_begin bullet"]
242                lappend linebuffer [q bullet]
243                lappend linebuffer ""
244                lappend linebuffer $text
245                lappend linebuffer ""
246                lappend linebuffer [q list_end]
247            }
248        }
249        lappend linebuffer [q nl]
250    }
251
252    lappend linebuffer [q list_end]
253    lappend linebuffer [q manpage_end]
254    return [join $linebuffer \n]
255}
256
257#------------------------------------
258# Module initialization
259
260package provide doctools::changelog 0.1.1
Note: See TracBrowser for help on using the repository browser.