#! /usr/bin/env tclsh
#
# genchanges - Generate changelog (doc/Changes and ChangeLog) files.
#
# Copyright (C) 2017 - 2025 Eggheads Development Team
#
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
# As a special exception to the GNU General Public License, if you
# distribute this file as part of a program that contains a
# configuration script generated by Autoconf, you may include it under
# the same distribution terms that you use for the rest of that program.

package require Tcl 8.6
package require textutil::adjust
package require base64

# TODO: automatic -i/-e arguments. sort order of git tag --list --sort=v:refname is stable.
# TODO: performance improvements (by reading .git/ directly?)

proc get_usage {} {
	return [subst [join {
		{Syntax: $::argv0 \[options\] <command>} {} {Commands:}
		{short        - Generate short changelog (doc/ChangesX.Y)}
		{full         - Generate full changelog (ChangeLog)}
		{release      - OVERWRITE ChangeLog and doc/ChangesX.Y (don't use, not done)}
		{} {Options (general):}
		{-d           - Verbose debug logging}
		{-r <remote>  - Specify remote for tags and public branches}
		{-l           - Skip fetching from remote. ONLY use this on a fresh clone!}
		{} {Options (short):}
		{-e <version> - Specify ref to exclude with ancestors}
		{-i <version> - Specify ref to include with ancestors (use ./XXX to force local ref XXX, e.g. -i ./release/1.8.2}
		{-v <version> - Specify the upcoming version}
		{} {Examples:}
		{  Generate doc/Changes1.8 for v1.8.2rc3 (exclude v1.8.0 because of the static 1.8.0 blob):}
		{    $::argv0 -e v1.6.21 -e v1.8.0 -i v1.8.1 -i v1.8.2 -i stable/1.8 -v 1.8.2rc3 short}
		{  Generate ChangeLog for v1.8.3 final:}
		{    $::argv0 -i stable/1.8 full}
	} \n]]
}

proc commands {} {
	lmap cmd [info commands cmd:*] {
		string range $cmd 4 end
	}
}

proc fatal {msg {showusage 0}} {
	if {$msg ne ""} {
		puts stderr $msg
		if {$showusage} {
			puts stderr ""
		}
	}
	if {$showusage} {
		puts stderr [get_usage]
	}
	exit 1
}

proc pop {listVar} {
	upvar 1 $listVar list
	set e [lindex $list 0]
	set list [lrange $list 1 end]
	return $e
}

proc dict_lappend {dictVar args} {
	upvar 1 $dictVar dict
	set add [lindex $args end]
	set path [lrange $args 0 end-1]
	if {[dict exists $dict {*}$path]} {
		set old [dict get $dict {*}$path]
	} else {
		set old ""
	}
	dict set dict {*}$path [list {*}$old $add]
}

proc log {text} {
	puts stderr $text
}

proc vlog {text} {
	if {$::verbose} {
		log $text
	}
}

proc mustexec {cmd msg} {
	vlog "Attempting execute: [join $cmd]"
	if {[catch [list exec {*}$cmd] result]} {
		fatal "Execution failed. $msg: $result"
	}
	vlog "Execution successful: $result"
	set result [regsub -all -- {\n\n\n+} [string trim $result] "\n\n"]
	return $result
}

proc parsecmdline {argv} {
	global verbose local
	if {![llength $argv]} {
		fatal "" 1
	}
	foreach var {remote command version includes excludes} {
		set $var ""
	}
	set verbose 0
	set local 0
	while {[llength $argv]} {
		set arg [pop argv]
		if {[string index $arg 0] eq "-"} {
			for {set i 1} {$i < [string length $arg]} {incr i} {
				set c [string index $arg $i]
				switch -exact -- $c {
					"l" { set local 1 }
					"r" { set remote [pop argv] }
					"d" { set verbose 1 }
					"v" { set version [pop argv] }
					"i" { lappend includes [pop argv] }
					"e" { lappend excludes [pop argv] }
					default {
						fatal "Unknown option: -$c" 1
					}
				}
				vlog "OptParse: $c (left: $argv)"
			}
		} else {
			set command $arg
			break
		}
	}
	if {$command eq ""} {
		fatal "No command specified." 1
		show_usage
	}
	if {![llength $includes]} {
		fatal "No -i includes specified." 1
	}
	foreach var {remote version includes excludes} {
		cfg$var [set $var]
	}
	foreach file [textutil::adjust::listPredefined] {
		textutil::adjust::readPatterns [textutil::adjust::getPredefined $file]
	}
	fetchremote
	return $command
}

proc indent {text indent} {
	textutil::adjust::indent $text [string repeat " " $indent]
}

proc adjust {text {len 120}} {
	textutil::adjust::adjust $text -hyphenate true -justify left -length $len -strictlength true
}

interp alias {} cfgincludes {} cfgtags includes
interp alias {} cfgexcludes {} cfgtags excludes

proc cfgtags {varName patterns} {
	global remote tags
	upvar #0 $varName thesetags
	set thesetags ""
	if {![info exists tags]} {
		set taglist [regexp -all -inline -- {\S+} [mustexec {git tag --list} "Failed getting tag list"]]
		set tags ""
		foreach tag $taglist {
			set commit [string trim [mustexec [list git rev-parse $tag] "Could not rev-parse tag $tag"]]
			dict lappend tags $commit $tag
			vlog "$tag <- $commit"
		}
	}
	foreach pattern $patterns {
		set tmp [dict values $tags $pattern]
		if {![llength $tmp]} {
			# no matching tags, must be a branch
			if {[string range $pattern 0 1] eq "./"} {
				# force local branch, illegal branch name
				set path [string range $pattern 2 end]
			} else {
				set path $remote/$pattern
			}
			mustexec [list git rev-parse --verify -q $path] "Could not find revision '$path'."
			set tmp [list $path]
		}
		lappend thesetags {*}$tmp
	}
}

proc cfgversion {version} {
	global major
	if {$version ne "" && ![regexp {^(\d+\.\d+)\.\d+} $version -> major]} {
		fatal "Invalid version number: $version. Try 1.8.1 or 1.8.1rc1 or similar."
	}
	set ::version $version
}

proc cfgremote {remote} {
	set remotes [regexp -all -inline -- {\S+} [exec git remote]]
	if {![llength $remotes]} {
		fatal "No git remotes configured."
		exit 1
	}
	if {$remote eq ""} {
		if {[llength $remotes] == 1} {
			set remote [lindex $remotes 0]
		} else {
			fatal "Multiple remotes available, must specify -r. Available: [join $remotes {, }]"
		}
	}
	if {[llength $remotes] == 1 && $remote eq ""} {
		set remote [lindex $remotes 0]
	}
	if {$remote ni $remotes} {
		fatal "Unknown remote: $remote. Available: [join $remotes {, }]"
		exit 1
	}
	vlog "Remotes: '[join $remotes ',']'. Using '$remote'"
	set ::remote $remote
}

proc fetchremote {} {
	global remote local
	if {$local} {
		log "Operating locally only, skipping branches/tags-fetch."
		return
	}
	log "Updating tags and branches from remote '$remote'. Branches first..."
	mustexec [list -ignorestderr git fetch $remote] "Could not fetch from remote"
	log "Branches updated. Fetching tags..."
	mustexec [list -ignorestderr git fetch -t $remote] "Could not fetch tags from remote"
	log "Tags updated."
}

proc start {} {
	global remote
	set command [parsecmdline $::argv]
	if {$command ni [commands]} {
		fatal "Unknown command: $command. Available: [join [commands] {, }]" 1
	}
	log "Working with remote $remote..."
	puts [cmd:$command]
}

proc revlist {excludes includes} {
	set includestr $includes
	set excludestr [lmap x $excludes { return -level 0 ^$x }]
	return [list {*}$includestr {*}$excludestr]
}

proc commitlist {{full 0}} {
	global version includes excludes verbose
	set commits ""
	for {set i 0} {$i < [llength $includes]} {incr i} {
		set cmd [list git rev-list --reverse --date-order {*}[revlist [expr {($i == 0 && $full) ? "" : $excludes}] [lrange $includes $i $i]]]
		set mycommits [mustexec $cmd "Failed to get revlist"]
		foreach commit $mycommits {
			dict set commits $commit 1
		}
	}
	# exclude cherry-picked commits, assumes correct order, WIP, assumes chronic order of -i
	# --cherry-pick is only relevant when using symmetric difference which is A...B
	# the above method of gather commits by manually grabbing all EXCLUDE..INCLUDE does not use it
	for {set i 0} {$i < [llength $includes] - 1} {incr i} {
		for {set j [expr {1+$i}]} {$j < [llength $includes]} {incr j} {
			set i1 [lindex $includes $i]
			set i2 [lindex $includes $j]
			set cmd [list git rev-list --cherry-mark --no-merges --right-only --reverse --date-order $i1...$i2]
			set mycommits [mustexec $cmd "Failed to get revlist"]
			foreach commit $mycommits {
				if {[string index $commit 0] eq "=" && [dict exists $commits [string range $commit 1 end]]} {
					dict unset commits [string range $commit 1 end]
				}
			}
		}
	}
	return [lreverse [dict keys $commits]]
}

proc cmd:release {} {
	global major version
	if {![info exists major] || $version eq ""} {
		fatal "Need version number (-v) for short changelog."
	}
	if {![file exists ChangeLog.gz] || ![file exists doc/Changes$major]} {
		fatal "ChangeLog or doc/Changes$major don't exist, are we in the right directory? Then please create them empty if necessary."
	}
	set short [cmd:short]
	set full [cmd:full]
	log "Writing ChangeLog.gz"
	set fs [open ChangeLog.gz w]
	zlib push gzip $fs -level 9
	puts $fs [string trim $full \n]
	close $fs
	log "Exiting, TODO: remove this when shortlog is done!"
	exit 0
	log "Writing doc/Changes$major"
	set fs [open doc/Changes$major w]
	puts $fs [string trim $short \n]
	close $fs
}

proc clean {data} {
	regsub -all -- {(\r)} $data {} data
	regsub -all -- {\t} $data { } data
	regsub -all -- { +\n} $data "\n" data
	regsub -all -- {\n{4,}} $data "\n\n\n" data
	return $data
}

proc getcommitinfo:date {commit} {
	clock format [getcommitinfo:time $commit] -gmt 1 -format "%Y-%m-%d"
}

proc getcommitinfo:files {commit} {
	set data [mustexec [list git show --pretty= --numstat $commit] "Failed to get commit info for $commit"]
	set result ""
	foreach line [split $data \n] {
		if {$line eq ""} {
			continue
		}
		if {![regexp -- {^(\d+|-)\t(\d+|-)\t(.+)$} $line - add del file]} {
			error "ERROR ON '$line'"
		}
		if {$add eq "-" && $del eq "-"} {
			lappend result [format "%13s %s" (binary) $file]
		} else {
			lappend result [format "%6s %6s %s" +$add -$del $file]
		}
	}
	join $result \n
}

proc getcommitinfo:tags {commit} {
	global tags
	if {![dict exists $tags $commit]} {
		return ""
	}
	dict get $tags $commit
}

proc getcommitinfo:body {commit} {
	# roughly where we started using subject/body split messages after cvs->git
	if {[getcommitinfo:time $commit] > 1451487300} {
		return [getcommitinfofield body $commit]
	}
	return ""
}

proc getcommitinfo:subject {commit} {
	if {[getcommitinfo:time $commit] > 1451487300} {
		set msg [string trim [getcommitinfofield subject $commit]]
		if {[string index $msg 0] in {"*" "-"}} {
			set lines [lmap x [split $msg [string index $msg 0]] { set x [string totitle [string trim $x]]; expr {$x eq "" ? [continue] : "$x"} }]
			return [join $lines ". "]
		}

		return [getcommitinfofield subject $commit]
	}
	set msg [getcommitinfofield fullbody $commit]
	# yes, really (14c25840)
	set msg [string map {---------------------------------------------------------------------- ""} $msg]
	set lines [lmap l [split $msg \n] { expr {[set l [string trim $l]] eq "" ? [continue] : [string totitle "$l"]} }]
	if {![llength $lines]} {
		return "*** EMPTY COMMIT MESSAGE ***"
	}
	return [join $lines ". "]
}

proc getcommitinfo:fullbody {commit} {
	set msg [getcommitinfofield fullbody $commit]
	set msg [string trim $msg]
	if {[string index $msg 0] in {"*" "-"}} {
		set lines [lmap x [split $msg [string index $msg 0]] { set x [string trim $x]; expr {$x eq "" ? [continue] : "* $x"} }]
		return [join $lines \n]
	}
	return $msg
}

proc getcommitinfofield {field commit} {
	global commitinfocache commitinfofields
#	vlog "Getting $commit ($field)"
	if {![dict exists $commitinfocache $commit]} {
		set result [split [mustexec [list git show -s --pretty=format:[join [dict values $commitinfofields] %x00] $commit] "Failed to get commit info for $commit"] \x00]
		for {set i 0} {$i < [dict size $commitinfofields]} {incr i} {
			dict set commitinfocache $commit [lindex [dict keys $commitinfofields] $i] [string trim [lindex $result $i]]
		}
		dict set commitinfocache $commit filelist [split [mustexec [list git show --name-only --format= $commit] "Failed to get commit files for $commit"] \n]
	}
	regsub -all -- {\r\n?} [dict get $commitinfocache $commit $field] "\n"
}

set commitinfocache ""
set commitinfofields {fullbody %B time %ct authorname %aN authoremail %aE shorthash %h hash %H authordate %aI subject %s body %b}
foreach field [list {*}[dict keys $commitinfofields] filelist] {
	if {![llength [info commands getcommitinfo:$field]]} {
		interp alias {} getcommitinfo:$field {} getcommitinfofield $field
	}
}

proc getcommitinfo {commit args} {
	global commitinfocache commitinfofields

	set data ""
	foreach info $args {
		dict set data $info [getcommitinfo:$info $commit]
	}
	return $data
}

proc reportstatus {what i max} {
	if {($i & 0xF) == 0 || $i == $max - 1} {
		puts -nonewline stderr "\u001b\[1000D$what ... [format %3d [expr {$i == $max ? 100 : 100*(1+$i)/$max}]] %"
	}
	if {$i == $max - 1} {
		puts ""
	}
}

proc cmd:full {} {
	global excludes includes tags
	set commits [commitlist 1]
	set result {""}
	for {set i 0} {$i < [llength $commits]} {incr i} {
		reportstatus "Generating ChangeLog info" $i [llength $commits]
		set commit [lindex $commits $i]
		set commitinfo [getcommitinfo $commit body subject authorname authoremail shorthash authordate files]
		dict with commitinfo {
			set this ""
			lappend this "Commit $shorthash ($authordate) by $authorname <$authoremail>" ""
			if {[string index $subject 0] in {* -} && [string index $subject 1] eq " "} {
				set body [getcommitinfo:fullbody $commit]
			} elseif {$subject ne ""} {
				lappend this [adjust $subject] ""
			}
			if {$body ne ""} {
				set thisbody ""
				foreach line [split $body \n] {
					lappend thisbody [indent [adjust $line] 2]
				}
				lappend this [join $thisbody \n] ""
			}
			if {$files ne ""} {
				lappend this $files ""
			}
		}
		lappend result [join $this \n]
	}
	log ""
	return [clean [join $result \n[string repeat - 120]\n]]
}

proc dateindent {commits date} {
	set result ""
	for {set i 0} {$i < [llength $commits]} {incr i} {
		set msg [lindex $commits $i]
		if {$i == 0} {
			lappend result "$date $msg"
		} else {
			lappend result "[string repeat " " [string length $date]] $msg"
		}
	}
	return $result
}

proc versionindent {lines} {
	lmap l $lines { return -level 0 "  $l" }
}

proc finalformatshortlog {commits} {
	set versionresult ""
	foreach version [lreverse [dict keys $commits]] {
		set versioncommits [dict get $commits $version]
		set dateresult ""
		foreach date [lreverse [dict keys $versioncommits]] {
			set datecommits [dict get $versioncommits $date]
			set byresult ""
			# force unattributed commits to come first
#			if {[dict exists $datecommits ""]} {
#				set unattrib [dict get $datecommits ""]
#				dict unset datecommits ""
#				dict set datecommits "" $unattrib
#			}
#			foreach by [lreverse [dict keys $datecommits]] {}
			foreach datecommit $datecommits {
				lassign $datecommit by bycommits
				set bycommits [list $bycommits]
#				set bycommits [lreverse [dict get $datecommits $by]]
				set this [lmap c $bycommits {
					set rest [lassign [split [adjust $c 100] \n] first]
					set rest [lmap r $rest { return -level 0 "  $r" }]
					set rest [list "* $first" {*}$rest]
					if {$by ne ""} {
						lappend rest "    \[$by\]"
					}
					join $rest \n
				}]
				if {$by ne ""} {
#					lappend this "  $by"
				}
				lappend byresult $this
			}
			vlog "BYRESULT: $byresult"
			lappend dateresult "[join [dateindent [split [join [lmap x $byresult { join $x \n }] \n] \n] $date] \n]"
		}
		vlog "DATERESULT: $dateresult"
		lappend versionresult "[expr {$version ne "" ? "Eggdrop $version:" : ""}]\n\n[join [versionindent [split [join $dateresult \n] \n]] \n]"
	}
	join $versionresult \n\n
}

proc cmd:short {} {
	global version verbose tags major
	set commits [lreverse [commitlist]]
	if {$verbose} {
		vlog "--- Start of History ---"
		foreach commit $commits {
			vlog "* $commit[expr {[dict exists $tags $commit] ? " ([dict get $tags $commit])" : ""}]"
		}
		vlog "---- End of History ----"
	}
	foreach key {version date foundby patchby} {
		dict set last $key ""
	}
	set result ""
	set thisversion ""
	for {set i 0} {$i < [llength $commits]} {incr i} {
		reportstatus "Generating doc/Changes info" $i [llength $commits]
		set commit [lindex $commits $i]
		# skip merge commits unless they have a tag associated to them (e.g. v1.8.1 is a merge commit with a tag)
		if {![dict exists $tags $commit] && ![catch {exec git cat-file -t $commit^2}]} {
			continue
		}
		set commitinfo [getcommitinfo $commit fullbody subject date body filelist]
		set body [dict get $commitinfo body]
		set fullmsg [dict get $commitinfo fullbody]
		set shortmsg [dict get $commitinfo subject]
		set date [dict get $commitinfo date]
		set files [dict get $commitinfo filelist]
		set found ""
		set patch ""
		set newfiles ""
		foreach file $files {
			set fn [lindex [file split $file] end]
			if {$file in {src/patch.h src/version.h ChangeLog.gz ChangeLog} || [string match doc/Changes?.* $file] || $fn in {configure}} {
				continue
			}
			lappend newfiles $file
		}
		if {![dict exists $tags $commit] && [llength $files] && ![llength $newfiles]} {
			vlog "Skipping $commit ($files)"
			continue
		}
		# Subject can contain this information too, scan the whole body, then replace in subject
		foreach {- category names} [regexp -nocase -all -inline -- {(found|patch) by:([^\r\n/]+)} $fullmsg] {
			foreach nick [split $names {, }] {
				set nick [string trim $nick ""]
				if {$nick ne ""} {
					# dict to deduplicate
					dict set [string tolower $category] $nick 1
				}
			}
		}
		# Only at the end
		regsub -all -nocase -- {(found|patch) by:.*$} $shortmsg {} shortmsg
		set by ""
		if {[dict size $found]} {
			lappend by "Found by: [join [dict keys $found] {, }]"
		}
		if {[dict size $patch]} {
			lappend by "Patch by: [join [dict keys $patch] {, }]"
		}
		set by [join $by { / }]
#		dict_lappend thisversion $date $by $shortmsg
		dict_lappend thisversion $date [list $by $shortmsg]
		if {[dict exists $tags $commit]} {
			# got version tag, everything up to here belongs to that version
			dict set result "[dict get $tags $commit] ($date)" $thisversion
			set thisversion ""
		}
	}
	log ""
	dict set result [expr {$version eq "" ? "" : "v$version"}] $thisversion
	set log [finalformatshortlog $result]
	return [clean "Eggdrop Changes (Last Updated [clock format [clock seconds] -gmt 1 -format "%Y-%m-%d"]):\n__________________________________________\n\n$log"]
}


start