aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--soon.conf.example21
-rw-r--r--soon.nimble1
-rw-r--r--src/soon.nim162
-rw-r--r--src/soon/agenda.nim58
-rw-r--r--src/soon/archive.nim60
-rw-r--r--src/soon/conditionchecker.nim25
-rw-r--r--src/soon/config.nim28
-rw-r--r--src/soon/todos.nim38
-rw-r--r--src/soon/tui.nim378
-rw-r--r--tests/tcolumnize.nim2
-rw-r--r--when.pl2013
11 files changed, 2683 insertions, 103 deletions
diff --git a/soon.conf.example b/soon.conf.example
new file mode 100644
index 0000000..af0d69f
--- /dev/null
+++ b/soon.conf.example
@@ -0,0 +1,21 @@
+[Calendar]
+path=/home/user/.config/soon
+defaultFile=calendar.soon
+past=0
+future=14
+editor=vim
+defaultCommand=atd
+
+[Todo List]
+alwaysPrint=true
+saveCompletedTodos=false
+completedTodoFile=/home/user/.config/soon/done
+
+[Archive]
+path=/home/user/.config/soon/archive
+showFutureArchivedEvents=true
+showPastArchivedEvents=false
+alwaysShowUnarchivedEvents=true
+startDate=2026-01-01
+deleteFromCalendarFile=true
+autoPurge=true
diff --git a/soon.nimble b/soon.nimble
index ec2e0c9..a038073 100644
--- a/soon.nimble
+++ b/soon.nimble
@@ -10,5 +10,6 @@ bin = @["soon"]
# Dependencies
requires "nim >= 2.0.4"
+requires "illwill >= 0.4.1"
diff --git a/src/soon.nim b/src/soon.nim
index 62dbfcf..e6c545d 100644
--- a/src/soon.nim
+++ b/src/soon.nim
@@ -1,5 +1,5 @@
import std/[os, strutils, strtabs, sequtils, osproc, parseopt]
-import soon/[config, agenda, todos]
+import soon/[config, agenda, todos, tui, archive]
const VERSION = "0.1"
@@ -10,19 +10,20 @@ proc printHelp(badCmd: string) =
Usage: soon [options]
Options:
--a print agenda
--c print reference calendar (using 'cal')
--t print todos
--d print deadlines
--e open default calendar file in $EDITOR
--i open TUI in interactive mode to schedule/archive events
--w, -m, -y print agenda for upcoming week, month, or year
--j print the modified julian day
--i, --date print today's date
--p, --past=DAYS days in past to print agenda (default: 1)
--f, --future=DAYS days in future to print agenda (default: 14)
--h, --help show this help
--v, --version print version
+-a print agenda
+-c print reference calendar (using 'cal')
+-t print todos
+-d print deadlines
+-e open default calendar file in $EDITOR
+-s open soon.conf in $EDITOR
+-i open TUI in interactive mode to schedule/archive events
+-w, -m, -y print agenda for upcoming week, month, or year
+-j print the modified julian day
+-p, --past=DAYS days in past to print agenda (default: 1)
+-f, --future=DAYS days in future to print agenda (default: 14)
+--config <path> use alternate config file
+-h, --help show this help
+-v, --version print version
Check the docs at https://codeberg.org/historia/soon
"""
@@ -55,12 +56,8 @@ proc readAllSoonFiles(path: string): seq[string] =
echo "Check your paths in ~/.config/soon/soon.conf"
quit()
-proc processCalendars(path: string, past: int, future: int) =
- var calendar = readAllSoonFiles(path)
- agenda.printAgenda(calendar, past, future)
- todos.printTodos(calendar)
-
-proc parseArgs(config: StringTableRef): seq[string] =
+proc parseArgs(config: StringTableRef): tuple[commands: seq[string], interactive: bool] =
+ var skipNext = false
for kind, key, val in getopt():
case kind
of cmdEnd: break
@@ -70,15 +67,37 @@ proc parseArgs(config: StringTableRef): seq[string] =
of "future", "f": config["future"] = val
of "help", "h": printHelp("")
of "version", "v": printVersion()
+ of "i":
+ result.interactive = true
+ of "config":
+ if val == "":
+ skipNext = true
else:
- result.add(key)
+ result.commands.add(key)
of cmdArgument:
- printHelp(key)
- if result.len == 0:
- result.add("a")
- result.add("t")
- result.add("d")
- echo "I'm running soon -atd, but I should've checked the user config and run that!"
+ if skipNext:
+ skipNext = false
+ else:
+ printHelp(key)
+
+ let printTodos = config.getOrDefault("printtodos", "true") == "true"
+
+ if result.commands.len == 0:
+ let defaultCmd = config.getOrDefault("defaultCommand", "atd")
+ if result.interactive:
+ for c in defaultCmd:
+ if c == 't' or c == 'd':
+ if printTodos:
+ result.commands.add($c)
+ elif c != ' ':
+ result.commands.add($c)
+ else:
+ for c in defaultCmd:
+ if c == 't' or c == 'd':
+ if printTodos:
+ result.commands.add($c)
+ elif c != ' ':
+ result.commands.add($c)
proc printReference() =
discard execCmd("cal -3")
@@ -89,36 +108,87 @@ proc sanitize(str: string): string =
if ch.isAlphaNumeric() or ch in {'/', '~', '.'}:
result.add(ch)
-proc openEditor(path: string, file: string) =
- var editor = getEnv("EDITOR").sanitize
+proc openFileInEditor(conf: StringTableRef, filePath: string) =
+ var editor = conf.getOrDefault("editor", getEnv("EDITOR")).sanitize
if editor.isEmptyOrWhitespace: editor = "vim"
- let sanePath = path.sanitize
- let saneFile = file.sanitize
- discard execCmd("$1 $2/$3" % [editor, sanePath, saneFile])
+ let saneFile = filePath.sanitize
+ discard execCmd("$1 $2" % [editor, saneFile])
+
+proc openEditor(conf: StringTableRef) =
+ let filePath = conf.getOrDefault("calendarPath",
+ conf.getOrDefault("path", "")) / conf.getOrDefault("defaultFile", "calendar.soon")
+ openFileInEditor(conf, filePath)
+
+proc openConfig(conf: StringTableRef) =
+ openFileInEditor(conf, conf.getOrDefault("configFile",
+ conf.getOrDefault("path", "") / "soon.conf"))
proc validateConfig(config: StringTableRef) =
createDefaultCalendarFile(config["path"] / config["defaultFile"])
-proc processCommands(commands: seq[string], conf: StringTableRef) =
+proc processCommands(commands: seq[string], conf: StringTableRef, interactive: bool) =
var calendar = readAllSoonFiles(conf["calendarPath"])
var past = 0 - parseInt(conf["past"])
var future = parseInt(conf["future"])
- for command in commands:
- case command
- of "a": agenda.printAgenda(calendar, past, future)
- of "w": agenda.printAgenda(calendar, 0, 7)
- of "m": agenda.printAgenda(calendar, 0, 28)
- of "y": agenda.printAgenda(calendar, 0, 365)
- of "t": todos.printTodos(calendar)
- of "d": todos.printDeadlineTodos(calendar)
- of "c": printReference()
- of "e": openEditor(conf["calendarPath"], conf["defaultFile"])
+ let arch = archive.loadArchive(conf.getOrDefault("archiveFile",
+ conf.getOrDefault("path", "") / "archive"))
+
+ if interactive:
+ var showAgenda = false
+ var showTodos = false
+ var showDeadlines = false
+ for cmd in commands:
+ case cmd
+ of "a": showAgenda = true
+ of "w":
+ showAgenda = true
+ past = 0
+ future = 7
+ of "m":
+ showAgenda = true
+ past = 0
+ future = 28
+ of "y":
+ showAgenda = true
+ past = 0
+ future = 365
+ of "t": showTodos = true
+ of "d": showDeadlines = true
+ else: discard
+ if not showAgenda and not showTodos and not showDeadlines:
+ showAgenda = true
+ showTodos = true
+ showDeadlines = true
+ tui.start(calendar, conf, past, future, showAgenda, showTodos, showDeadlines)
+ else:
+ for command in commands:
+ case command
+ of "a": agenda.printAgenda(calendar, past, future, conf, arch)
+ of "w": agenda.printAgenda(calendar, 0, 7, conf, arch)
+ of "m": agenda.printAgenda(calendar, 0, 28, conf, arch)
+ of "y": agenda.printAgenda(calendar, 0, 365, conf, arch)
+ of "t": todos.printTodos(calendar, arch)
+ of "d": todos.printDeadlineTodos(calendar, arch)
+ of "c": printReference()
+ of "e": openEditor(conf)
+ of "s": openConfig(conf)
+ else: discard
+
+proc findConfigArg(): string =
+ let params = commandLineParams()
+ var i = 0
+ while i < params.len:
+ if params[i] == "--config" and i + 1 < params.len:
+ return params[i + 1]
+ elif params[i].startsWith("--config="):
+ return params[i].split("=", maxsplit = 1)[1]
+ inc i
proc main() =
- var conf = config.loadConfig()
- let commands = parseArgs(conf)
+ var conf = config.loadConfig(findConfigArg())
+ let (commands, interactive) = parseArgs(conf)
validateConfig(conf)
- processCommands(commands, conf)
+ processCommands(commands, conf, interactive)
when isMainModule:
main()
diff --git a/src/soon/agenda.nim b/src/soon/agenda.nim
index 1c2ce11..8d43272 100644
--- a/src/soon/agenda.nim
+++ b/src/soon/agenda.nim
@@ -1,13 +1,13 @@
-import std/[times, strutils, sequtils, tables, algorithm]
-import conditionchecker, typechecker, parsetime, columnize
+import std/[times, strutils, sequtils, tables, terminal, strtabs]
+import conditionchecker, typechecker, parsetime, columnize, archive
-type Event = object
- name: string
- time: DateTime
- attachments: seq[string]
+type Event* = object
+ name*: string
+ time*: DateTime
+ attachments*: seq[string]
type Calendar = object
- events: seq[Event]
+ events*: seq[Event]
readyForAttachments: bool
type ConditionTable = Table[string, seq[string]]
@@ -75,18 +75,11 @@ proc processLine(line: string, date: DateTime, cal: Calendar): Calendar =
else:
result = processEventLine(line, date, cal)
-proc getCalendarForDate(cal: seq[string], date: DateTime): Calendar =
+proc getCalendarForDate*(cal: seq[string], date: DateTime): Calendar =
result.readyForAttachments = false
for line in cal:
result = processLine(line, date, result)
-#proc sortTable(t: ConditionTable) =
-# for
-
-# Check nim-lang algorithm basic usage
-proc compare(a, b: string): int =
- cmp(a.len, b.len)
-
proc startWithDate(datePrinted: bool, date: DateTime, format: string): seq[Column] =
if datePrinted:
result.add(Column(text: "", color: fgWhite))
@@ -100,21 +93,46 @@ proc eventTime(event: Event): string =
result = ""
# TODO: Sort me
-proc getDaysEvents(cal: seq[string], date: DateTime, format: string): seq[Line] =
+proc getDaysEvents(cal: seq[string], date: DateTime, format: string,
+ arch: archive.ArchiveData, conf: StringTableRef): seq[Line] =
var events = getCalendarForDate(cal, date).events
var datePrinted = false
+ let showPast = conf.getOrDefault("showPastArchived", "false") == "true"
+ let showFuture = conf.getOrDefault("showFutureArchived", "true") == "true"
+ let today = dateTime(now().year, now().month, now().monthday, 0, 0, 0, 0, local())
+ let isPast = date < today
+ let showArchived = if isPast: showPast else: showFuture
for event in events:
+ let archived = archive.isEventArchived(arch, date, event.name)
+ if archived and not showArchived:
+ continue
var columns = startWithDate(datePrinted, date, format)
datePrinted = true
columns.add(Column(text: eventTime(event), color: fgBlue))
- columns.add(Column(text: event.name, color: fgWhite))
+ var nameColor = fgWhite
+ var nameText = event.name
+ if archived:
+ nameColor = fgWhite
+ nameText = "(Archived) " & event.name
+ columns.add(Column(text: nameText, color: nameColor))
result.add(Line(columns: columns, attachments: event.attachments))
-proc printAgenda*(calendar: seq[string], past: int, future: int) =
+proc printAgenda*(calendar: seq[string], past: int, future: int,
+ conf: StringTableRef, arch: archive.ArchiveData) =
let now = now()
let today = dateTime(now.year, now.month, now.monthday, 00, 00, 00, 00, local())
var agenda = newSeq[Line]()
- for day in past..future:
+ var startDay = past
+ if conf.getOrDefault("alwaysShowUnarchived", "false") == "true":
+ let startDateStr = conf.getOrDefault("startDate", today.format("yyyy-MM-dd"))
+ try:
+ let sd = parse(startDateStr, "yyyy-MM-dd")
+ let daysDiff = (today - sd).inDays
+ if 0 - daysDiff < startDay:
+ startDay = 0 - daysDiff.int
+ except:
+ discard
+ for day in startDay..future:
let curDay = today + day.days
- agenda = agenda.concat(getDaysEvents(calendar, curDay, "ddd yyyy MMM dd"))
+ agenda = agenda.concat(getDaysEvents(calendar, curDay, "ddd yyyy MMM dd", arch, conf))
columnize.echo(agenda)
diff --git a/src/soon/archive.nim b/src/soon/archive.nim
new file mode 100644
index 0000000..fef59e2
--- /dev/null
+++ b/src/soon/archive.nim
@@ -0,0 +1,60 @@
+import std/[os, sets, strutils, times]
+
+type
+ ArchiveData* = object
+ events*: HashSet[string]
+ todos*: HashSet[string]
+
+proc loadArchive*(path: string): ArchiveData =
+ if not fileExists(path):
+ return
+ for line in lines(path):
+ let stripped = line.strip
+ if stripped.len == 0:
+ continue
+ if stripped.startsWith('-'):
+ result.todos.incl(stripped)
+ else:
+ result.events.incl(stripped)
+
+proc archiveEvent*(path: string, date: DateTime, eventName: string) =
+ let line = date.format("yyyy-MM-dd") & "|" & eventName
+ let f = open(path, fmAppend)
+ f.writeLine(line)
+ f.close()
+
+proc unarchiveEvent*(path: string, date: DateTime, eventName: string) =
+ let target = date.format("yyyy-MM-dd") & "|" & eventName
+ if not fileExists(path):
+ return
+ let content = readFile(path)
+ let f = open(path, fmWrite)
+ for line in content.splitLines():
+ if line.strip != target:
+ f.writeLine(line)
+ f.close()
+
+proc completeTodo*(path: string, todoName: string) =
+ let line = "- " & todoName
+ let f = open(path, fmAppend)
+ f.writeLine(line)
+ f.close()
+
+proc uncompleteTodo*(path: string, todoName: string) =
+ let target = "- " & todoName
+ if not fileExists(path):
+ return
+ let content = readFile(path)
+ let f = open(path, fmWrite)
+ for line in content.splitLines():
+ if line.strip != target:
+ f.writeLine(line)
+ f.close()
+
+proc isEventArchived*(archive: ArchiveData, date: DateTime, eventName: string): bool =
+ let key = date.format("yyyy-MM-dd") & "|" & eventName
+ return archive.events.contains(key)
+
+proc isTodoCompleted*(archive: ArchiveData, todoName: string): bool =
+ let key = "- " & todoName
+ return archive.todos.contains(key)
diff --git a/src/soon/conditionchecker.nim b/src/soon/conditionchecker.nim
index eea5afb..8c9284d 100644
--- a/src/soon/conditionchecker.nim
+++ b/src/soon/conditionchecker.nim
@@ -1,4 +1,4 @@
-import std/[times, strutils, tables, re, strtabs]
+import std/[times, strutils, tables, re]
import typechecker
# Forward declarations
@@ -14,7 +14,7 @@ proc expandWeekday(w: string): string =
return weekdays[weekday]
proc expandMonth(m: string): string =
- let month = m.fixcase
+ let month = m.fixCase
if month.len > 3: return month
return parse(month, "MMM").format("MMMM")
@@ -116,7 +116,7 @@ proc conditionToInt(c: string): int =
proc dateGroupStringToTable(s: string): Table[string, int] =
# This used to be s.len-2 for some reason and I don't know why, but it left off the last condition
- let conditions = s[1..s.len-1].splitWhitespace
+ let conditions = s[1..^2].splitWhitespace
var t = initTable[string, int]()
for c in conditions:
t[typechecker.checkType(c)] = conditionToInt(c)
@@ -129,18 +129,23 @@ proc dateGroupStringToDate*(s: string, comparisonDate: DateTime): DateTime =
t["year"] = comparisonDate.year
return dateTime(t["year"], Month(t["month"]), t["day"])
-proc isValidDateGroupRange(left: Table, right: Table): bool =
+proc isValidDateGroupRange(s: string): bool =
+ let dates = s.split('-')
+ let left = dateGroupStringToTable(dates[0])
+ let right = dateGroupStringToTable(dates[1])
for c in ["year", "month", "day"]:
if left.hasKey(c) != right.hasKey(c):
- echo "Error: Left group conditions don't match right group: ", string
+ echo "Error: Left group conditions don't match right group: ", s
return false
if c != "year" and (not left.hasKey(c) or not right.hasKey(c)):
- echo "Error: Missing ", c, " in groups: ", string
+ echo "Error: Missing ", c, " in groups: ", s
return false
return true
# Check that date falls in a range like (Jan 30 2025)-(Feb 2 2025)
proc checkRangeDateGroup(s: string, date: DateTime): bool =
+ if not isValidDateGroupRange(s):
+ return false
let dates = s.split('-')
var left = dateGroupStringToDate(dates[0], date)
var right = dateGroupStringToDate(dates[1], date)
@@ -170,9 +175,9 @@ proc checkOneSidedWeekday(s: string, date: DateTime): bool =
let (left, right) = s.splitRange
let datewd = ord(date.weekday)
if left == "":
- return datewd <= right.weekDayToInt
+ return datewd <= right.weekdayToInt
else:
- return datewd >= left.weekDayToInt
+ return datewd >= left.weekdayToInt
proc checkOneSidedMonth(s: string, date: DateTime): bool =
let (left, right) = s.splitRange
@@ -192,9 +197,9 @@ proc checkOneSidedYear(s: string, date: DateTime): bool =
proc checkOneSidedDateGroup(s: string, date: DateTime): bool =
let (left, right) = s.splitRange
if left == "":
- return date <= dateGroupStringToDate(s[1..s.len-1], date)
+ return date <= dateGroupStringToDate(right, date)
else:
- return date >= dateGroupStringToDate(s[0..s.len-2], date)
+ return date >= dateGroupStringToDate(left, date)
proc checkCond*(cond: string, date: DateTime): bool =
var condition = cond
diff --git a/src/soon/config.nim b/src/soon/config.nim
index 6421baa..38becf5 100644
--- a/src/soon/config.nim
+++ b/src/soon/config.nim
@@ -9,6 +9,7 @@ proc createDefaultConfigFile(path: string) =
config.setSectionKey("Calendar", "past", "0")
config.setSectionKey("Calendar", "future", "14")
config.setSectionKey("Calendar", "editor", getEnv("EDITOR"))
+ config.setSectionKey("Calendar", "defaultCommand", "atd")
config.setSectionKey("Calendar", "", "")
config.setSectionKey("Todo List", "alwaysPrint", "true")
config.setSectionKey("Todo List", "saveCompletedTodos", "false")
@@ -31,23 +32,28 @@ proc loadConfigFromFile(file: string): StringTableRef =
config["past"] = c.getSectionValue("Calendar", "past")
config["future"] = c.getSectionValue("Calendar", "future")
config["editor"] = c.getSectionValue("Calendar", "editor")
+ config["defaultCommand"] = c.getSectionValue("Calendar", "defaultCommand")
config["printtodos"] = c.getSectionValue("Todo List", "alwaysPrint")
config["saveCompletedTodos"] = c.getSectionValue("Todo List", "saveCompletedTodos")
- config["completedFile"] = c.getSectionValue("Todo List", "completedFile")
- config["archiveFile"] = c.getSectionValue("Archive", "file")
- config["showFutureArchived"] = c.getSectionValue("Archive", "showFutureArchived")
- config["showPastArchived"] = c.getSectionValue("Archive", "showPastArchived")
- config["alwaysShowUnarchived"] = c.getSectionValue("Archive", "alwaysShowUnarchived")
+ config["completedFile"] = c.getSectionValue("Todo List", "completedTodoFile")
+ config["archiveFile"] = c.getSectionValue("Archive", "path")
+ config["showFutureArchived"] = c.getSectionValue("Archive", "showFutureArchivedEvents")
+ config["showPastArchived"] = c.getSectionValue("Archive", "showPastArchivedEvents")
+ config["alwaysShowUnarchived"] = c.getSectionValue("Archive", "alwaysShowUnarchivedEvents")
config["startDate"] = c.getSectionValue("Archive", "startDate")
- config["deleteArchivedEvents"] = c.getSectionValue("Archive", "deleteArchivedEvents")
+ config["deleteArchivedEvents"] = c.getSectionValue("Archive", "deleteFromCalendarFile")
config["autoPurge"] = c.getSectionValue("Archive", "autoPurge")
return config
-proc loadConfig*(): StringTableRef =
- let path = expandTilde(getEnv("XDG_CONFIG_HOME", "~/.config")) / "soon"
- let file = path / "soon.conf"
+proc loadConfig*(configPath: string = ""): StringTableRef =
+ let dir = expandTilde(getEnv("XDG_CONFIG_HOME", "~/.config")) / "soon"
+ let file = if configPath != "": configPath else: dir / "soon.conf"
if not fileExists(file):
- createDefaultConfigFile(path)
+ if configPath != "":
+ echo "Config file not found: " & file
+ quit(1)
+ createDefaultConfigFile(dir)
result = loadConfigFromFile(file)
- result["path"] = path
+ result["path"] = dir
+ result["configFile"] = file
diff --git a/src/soon/todos.nim b/src/soon/todos.nim
index cac8c90..a0c1df6 100644
--- a/src/soon/todos.nim
+++ b/src/soon/todos.nim
@@ -1,13 +1,13 @@
import std/[times, strutils, re, options, terminal]
-import conditionchecker, columnize
+import conditionchecker, columnize, archive
type
- Todo = object
- name: string
- attachments: seq[string]
- deadline: DateTime
+ Todo* = object
+ name*: string
+ attachments*: seq[string]
+ deadline*: DateTime
-proc removeHyphen(s: string): string =
+proc removeHyphen*(s: string): string =
return s.strip(trailing = false, chars = {' ', '-'})
proc getFirstNonWhitespaceChar(s: string): char =
@@ -15,7 +15,7 @@ proc getFirstNonWhitespaceChar(s: string): char =
if not (c == ' '):
return c
-proc getTodosFromCalendar(calendar: seq[string]): seq[Todo] =
+proc getTodosFromCalendar*(calendar: seq[string]): seq[Todo] =
var readyForAttachments = false
for line in calendar:
let first = getFirstNonWhitespaceChar(line)
@@ -61,22 +61,30 @@ proc toLine(todo: Todo): Line =
result.attachments = todo.attachments
# TODO: Sort on deadlines
-proc printDeadlineTodos*(calendar: seq[string]) =
+proc printDeadlineTodos*(calendar: seq[string], arch: archive.ArchiveData) =
let todos = getTodosFromCalendar(calendar)
- var (regulars, deadlines) = splitRegularAndDeadlineTodos(todos)
- if deadlines.len == 0: return
+ let (regulars, deadlines) = splitRegularAndDeadlineTodos(todos)
+ var activeDeadlines = newSeq[Todo]()
+ for todo in deadlines:
+ if not archive.isTodoCompleted(arch, removeHyphen(todo.name)):
+ activeDeadlines.add(todo)
+ if activeDeadlines.len == 0: return
echo "\nUpcoming Deadlines:"
var lines = newSeq[Line]()
- for todo in deadlines:
+ for todo in activeDeadlines:
lines.add(todo.toLine)
columnize.echo(lines)
-proc printTodos*(calendar: seq[string]) =
+proc printTodos*(calendar: seq[string], arch: archive.ArchiveData) =
let todos = getTodosFromCalendar(calendar)
- var (regulars, deadlines) = splitRegularAndDeadlineTodos(todos)
- if todos.len == 0: return
- echo "\nTodo List:"
+ let (regulars, deadlines) = splitRegularAndDeadlineTodos(todos)
+ var activeTodos = newSeq[Todo]()
for todo in todos:
+ if not archive.isTodoCompleted(arch, removeHyphen(todo.name)):
+ activeTodos.add(todo)
+ if activeTodos.len == 0: return
+ echo "\nTodo List:"
+ for todo in activeTodos:
echo todo.name
for attachment in todo.attachments:
stdout.styledWriteLine(fgMagenta, attachment)
diff --git a/src/soon/tui.nim b/src/soon/tui.nim
new file mode 100644
index 0000000..67000fc
--- /dev/null
+++ b/src/soon/tui.nim
@@ -0,0 +1,378 @@
+import std/[times, strutils, os, sets, enumerate, strtabs]
+import illwill
+import agenda, todos, archive
+
+type
+ SelectableKind = enum
+ skEvent
+ skTodo
+
+ Selectable = object
+ kind: SelectableKind
+ date: DateTime
+ timeStr: string
+ name: string
+ attachments: seq[string]
+ isArchived: bool
+ newlyArchived: bool
+ newlyCompleted: bool
+
+ LayoutLine = object
+ isHeader: bool
+ isSpacer: bool
+ headerText: string
+ itemIndex: int
+ attachmentIdx: int
+ layoutY: int
+
+proc removeHyphen(s: string): string =
+ s.strip(trailing = false, chars = {' ', '-'})
+
+proc buildItems(cal: seq[string], past: int, future: int,
+ showAgenda: bool, showTodos: bool, showDeadlines: bool,
+ arch: archive.ArchiveData): seq[Selectable] =
+ let today = dateTime(now().year, now().month, now().monthday, 0, 0, 0, 0, local())
+
+ if showAgenda:
+ for day in past..future:
+ let curDay = today + day.days
+ let calForDay = agenda.getCalendarForDate(cal, curDay)
+ for event in calForDay.events:
+ let key = curDay.format("yyyy-MM-dd") & "|" & event.name
+ var ts = ""
+ if event.time.monthday != 1:
+ ts = event.time.format("HH:mm")
+ result.add(Selectable(
+ kind: skEvent,
+ date: curDay,
+ timeStr: ts,
+ name: event.name,
+ attachments: event.attachments,
+ isArchived: arch.events.contains(key),
+ ))
+
+ if showTodos or showDeadlines:
+ let todoList = todos.getTodosFromCalendar(cal)
+ for todo in todoList:
+ let name = removeHyphen(todo.name)
+ var hasDeadline = false
+ for att in todo.attachments:
+ if att.strip.toLower.startsWith("+ due:"):
+ hasDeadline = true
+ break
+ if hasDeadline and not showDeadlines:
+ continue
+ if not hasDeadline and not showTodos:
+ continue
+ result.add(Selectable(
+ kind: skTodo,
+ date: now(),
+ timeStr: "",
+ name: name,
+ attachments: todo.attachments,
+ isArchived: arch.todos.contains("- " & name),
+ ))
+
+# ---- Layout computation ----------------------------------------
+
+proc computeLayout(items: seq[Selectable]): seq[LayoutLine] =
+ var y = 0
+ var hasEvents = false
+ var hasTodos = false
+ for item in items:
+ if item.kind == skEvent: hasEvents = true
+ else: hasTodos = true
+
+ if hasEvents:
+ result.add(LayoutLine(isHeader: true, headerText: "Events:", itemIndex: -1, attachmentIdx: -1, layoutY: y))
+ y += 1
+
+ for i, item in enumerate(items):
+ if item.kind != skEvent: continue
+ result.add(LayoutLine(itemIndex: i, attachmentIdx: -1, layoutY: y))
+ y += 1
+ for j in 0..<item.attachments.len:
+ result.add(LayoutLine(itemIndex: i, attachmentIdx: j, layoutY: y))
+ y += 1
+
+ if hasEvents and hasTodos:
+ result.add(LayoutLine(isSpacer: true, itemIndex: -1, attachmentIdx: -1, layoutY: y))
+ y += 1
+
+ if hasTodos:
+ result.add(LayoutLine(isHeader: true, headerText: "Todo List:", itemIndex: -1, attachmentIdx: -1, layoutY: y))
+ y += 1
+
+ for i, item in enumerate(items):
+ if item.kind != skTodo: continue
+ result.add(LayoutLine(itemIndex: i, attachmentIdx: -1, layoutY: y))
+ y += 1
+ for j in 0..<item.attachments.len:
+ result.add(LayoutLine(itemIndex: i, attachmentIdx: j, layoutY: y))
+ y += 1
+
+proc itemLayoutY(layout: seq[LayoutLine], itemIndex: int): int =
+ for line in layout:
+ if line.itemIndex == itemIndex and line.attachmentIdx < 0:
+ return line.layoutY
+ return 0
+
+# ---- Rendering ------------------------------------------------
+
+const dateFormat = "ddd yyyy MMM dd"
+
+proc drawEventLine(tb: var TerminalBuffer, x, y: int, item: Selectable, active: bool) =
+ let archived = item.isArchived or item.newlyArchived
+ var cx = x
+
+ if active:
+ if archived:
+ tb.setForegroundColor(fgWhite)
+ tb.write(cx, y, "→ ")
+ else:
+ tb.setForegroundColor(fgWhite, bright=true)
+ tb.write(cx, y, "→ ")
+ else:
+ tb.write(cx, y, " ")
+ tb.setStyle({})
+ cx += 2
+
+ if archived and not active:
+ tb.setForegroundColor(fgYellow)
+ tb.setStyle({styleDim})
+ tb.write(cx, y, item.date.format(dateFormat) & " ")
+ tb.setStyle({})
+ else:
+ tb.setForegroundColor(fgYellow)
+ tb.write(cx, y, item.date.format(dateFormat) & " ")
+ cx += 20
+
+ if archived and not active:
+ tb.setForegroundColor(fgBlue)
+ tb.setStyle({styleDim})
+ tb.write(cx, y, item.timeStr & repeat(' ', 7 - item.timeStr.len))
+ tb.setStyle({})
+ else:
+ tb.setForegroundColor(fgBlue)
+ tb.write(cx, y, item.timeStr & repeat(' ', 7 - item.timeStr.len))
+ cx += 7
+
+ if archived:
+ tb.setForegroundColor(fgWhite)
+ tb.setStyle({styleDim})
+ tb.write(cx, y, "(DONE) ")
+ tb.setStyle({})
+ else:
+ tb.setForegroundColor(fgNone)
+ tb.write(cx, y, " ")
+ cx += 8
+
+ if active:
+ if archived:
+ tb.setForegroundColor(fgWhite)
+ tb.write(cx, y, item.name)
+ else:
+ tb.setForegroundColor(fgWhite, bright=true)
+ tb.write(cx, y, item.name)
+ elif archived:
+ tb.setForegroundColor(fgWhite)
+ tb.setStyle({styleDim})
+ tb.write(cx, y, item.name)
+ else:
+ tb.setForegroundColor(fgWhite)
+ tb.write(cx, y, item.name)
+ tb.setStyle({})
+
+proc drawTodoLine(tb: var TerminalBuffer, x, y: int, item: Selectable, active: bool) =
+ let completed = item.isArchived or item.newlyCompleted
+
+ if active:
+ if completed:
+ tb.setForegroundColor(fgWhite)
+ tb.setStyle({styleDim})
+ tb.write(x, y, "→ ")
+ tb.setStyle({})
+ else:
+ tb.setForegroundColor(fgWhite, bright=true)
+ tb.write(x, y, "→ ")
+ else:
+ tb.write(x, y, " ")
+
+ if completed:
+ tb.setForegroundColor(fgWhite)
+ tb.setStyle({styleDim})
+ tb.write(x + 2, y, "- " & item.name)
+ tb.setStyle({})
+ else:
+ tb.setForegroundColor(fgWhite)
+ tb.write(x + 2, y, "- " & item.name)
+
+proc drawAttachment(tb: var TerminalBuffer, x, y: int, text: string, archived: bool) =
+ if archived:
+ tb.setForegroundColor(fgMagenta)
+ tb.setStyle({styleDim})
+ else:
+ tb.setForegroundColor(fgMagenta)
+ tb.write(x, y, text)
+ tb.setStyle({})
+
+proc draw(tb: var TerminalBuffer, items: seq[Selectable], layout: seq[LayoutLine],
+ cursor: int, scrollY: var int) =
+ tb.clear()
+ tb.setForegroundColor(fgNone)
+ tb.setStyle({})
+
+ let screenH = terminalHeight()
+
+ if cursor >= 0:
+ let cy = itemLayoutY(layout, cursor)
+ if cy < scrollY:
+ scrollY = cy
+ elif cy >= scrollY + screenH:
+ scrollY = cy - screenH + 1
+ if scrollY < 0:
+ scrollY = 0
+
+ for line in layout:
+ let screenY = line.layoutY - scrollY
+ if screenY < 0: continue
+ if screenY >= screenH: break
+
+ if line.isHeader:
+ tb.setForegroundColor(fgWhite)
+ tb.write(0, screenY, line.headerText)
+ tb.setForegroundColor(fgNone)
+ elif line.isSpacer:
+ discard
+ elif line.attachmentIdx >= 0:
+ let item = items[line.itemIndex]
+ let archived = item.isArchived or item.newlyArchived
+ let completed = item.isArchived or item.newlyCompleted
+ let dimmed = (item.kind == skEvent and archived) or (item.kind == skTodo and completed)
+ if item.kind == skEvent:
+ drawAttachment(tb, 39, screenY, item.attachments[line.attachmentIdx], dimmed)
+ else:
+ drawAttachment(tb, 4, screenY, item.attachments[line.attachmentIdx], dimmed)
+ else:
+ let item = items[line.itemIndex]
+ let active = line.itemIndex == cursor
+ if item.kind == skEvent:
+ drawEventLine(tb, 0, screenY, item, active)
+ else:
+ drawTodoLine(tb, 0, screenY, item, active)
+
+ if items.len > 0 and cursor >= 0:
+ let posText = " " & $(cursor + 1) & "/" & $items.len & " "
+ tb.setForegroundColor(fgNone)
+ tb.write(max(0, terminalWidth() - posText.len), screenH - 1, posText)
+
+ tb.display()
+
+# ---- Persistence ----------------------------------------------
+
+proc getFirstNonWhitespaceChar(s: string): char =
+ for c in s:
+ if c != ' ':
+ return c
+ return '\0'
+
+proc findAndRemoveTodo(calDir: string, todoName: string) =
+ let strippedName = todoName.strip(chars = {' ', '-'})
+ for file in walkDirRec(calDir):
+ if not file.toLower().endsWith(".soon"):
+ continue
+ var lines = readFile(file).splitLines(keepEol = false)
+ var newLines: seq[string]
+ var skip = false
+ var found = false
+ for line in lines:
+ let stripped = line.strip
+ let first = getFirstNonWhitespaceChar(stripped)
+ if first == '-' and removeHyphen(stripped) == strippedName:
+ found = true
+ skip = true
+ continue
+ elif first == '+' and skip:
+ continue
+ else:
+ skip = false
+ newLines.add(line)
+ if found:
+ var f = open(file, fmWrite)
+ for nl in newLines:
+ f.writeLine(nl)
+ f.close()
+ return
+
+# ---- Main TUI loop --------------------------------------------
+
+proc start*(cal: seq[string], conf: StringTableRef,
+ past: int, future: int,
+ showAgenda: bool, showTodos: bool, showDeadlines: bool) =
+ illwillInit(fullScreen=true)
+ defer: illwillDeinit()
+
+ let archiveFile = conf.getOrDefault("archiveFile",
+ conf.getOrDefault("path", "") / "archive")
+ let calDir = conf.getOrDefault("calendarPath",
+ conf.getOrDefault("path", ""))
+
+ var arch = archive.loadArchive(archiveFile)
+
+ var items = buildItems(cal, past, future, showAgenda, showTodos, showDeadlines, arch)
+ var layout = computeLayout(items)
+
+ var cursor = 0
+ if items.len == 0:
+ cursor = -1
+
+ var scrollY = 0
+ var tb = newTerminalBuffer(terminalWidth(), terminalHeight())
+
+ if items.len == 0:
+ tb.clear()
+ tb.setForegroundColor(fgWhite)
+ tb.write(0, 0, "Nothing to display. Press q to quit.")
+ tb.display()
+ while getKey() != Key.Q and getKey() != Key.Escape:
+ discard
+ return
+
+ var running = true
+ while running:
+ if tb.width != terminalWidth() or tb.height != terminalHeight():
+ tb = newTerminalBuffer(terminalWidth(), terminalHeight())
+ draw(tb, items, layout, cursor, scrollY)
+
+ let key = getKeyWithTimeout(50)
+ case key:
+ of Key.None: discard
+ of Key.Q, Key.Escape:
+ running = false
+ of Key.Up, Key.K:
+ if cursor > 0: cursor -= 1
+ of Key.Down, Key.J:
+ if cursor < items.len - 1: cursor += 1
+ of Key.Space, Key.D, Key.X:
+ if cursor >= 0 and cursor < items.len:
+ case items[cursor].kind:
+ of skEvent:
+ if items[cursor].isArchived or items[cursor].newlyArchived:
+ items[cursor].newlyArchived = false
+ archive.unarchiveEvent(archiveFile, items[cursor].date, items[cursor].name)
+ else:
+ items[cursor].newlyArchived = true
+ archive.archiveEvent(archiveFile, items[cursor].date, items[cursor].name)
+ of skTodo:
+ if items[cursor].isArchived or items[cursor].newlyCompleted:
+ items[cursor].newlyCompleted = false
+ archive.uncompleteTodo(archiveFile, items[cursor].name)
+ else:
+ items[cursor].newlyCompleted = true
+ archive.completeTodo(archiveFile, items[cursor].name)
+ else:
+ discard
+
+ for item in items:
+ if item.kind == skTodo and item.newlyCompleted:
+ findAndRemoveTodo(calDir, item.name)
diff --git a/tests/tcolumnize.nim b/tests/tcolumnize.nim
index 15f0171..94f1d31 100644
--- a/tests/tcolumnize.nim
+++ b/tests/tcolumnize.nim
@@ -1,5 +1,5 @@
import soon/columnize
-import std/[unittest]
+import std/[unittest, terminal]
test "Testing columnize":
var table = newSeq[Line]()
diff --git a/when.pl b/when.pl
new file mode 100644
index 0000000..f5197c1
--- /dev/null
+++ b/when.pl
@@ -0,0 +1,2013 @@
+#!/usr/bin/perl
+
+binmode STDOUT, ":utf8"; # eliminates "Wide character in print" error in Czech
+use open ":encoding(utf8)"; # otherwise utf8 in input files is read as if 1 character==1 byte
+
+use utf8; # Indicates that source can contain utf8, which we use for the Greek translation.
+use locale;
+
+use strict;
+use Getopt::Long; # Comes with the Perl distribution.
+
+#----------------------------------------------------------------
+# Defaults for the preferences:
+#----------------------------------------------------------------
+
+our %preferences=(
+ 'language'=>'en', # user's language; this is normally overridden by $LANG environment var.
+ 'past'=>-1, # how many days into the past the report extends
+ 'future'=>14, # ...and how far into the future
+ 'calendar'=>'~/.when/calendar', # where to find the calendar file
+ 'wrap'=>80, # 0 means don't wrap; otherwise, wrap display to this many columns
+ 'wrap_auto'=>0, # Try to detect width of terminal automatically, if it's a TTY.
+ 'wrap_max'=>-1, # If positive, sets a maximum with, overriding wrap_auto if necessary.
+ 'rows'=>40, # try to limit output to less than this number of lines
+ 'rows_auto'=>1, # Try to detect width of terminal automatically, if it's a TTY.
+ 'paging'=>1, # Use a pager, if it's a TTY and the output is too long.
+ 'header'=>1, # Print headers.
+ 'paging_less_options'=>'-rXFE', # Extra options for the pager, if the pager is "less."
+ 'editor'=>'emacs -nw', # editor
+ 'now'=>'', # pretend it's some other day today
+ 'filter_accents_on_output'=>!($ENV{TERM}=~m/(mlterm|xterm)/),
+ # ...since most Unix terminals show accented Unicode chars as garbage.
+ # Testing with rxvt 2.7.10 shows that this does seem necessary for rxvt;
+ # see https://github.com/bcrowell/when/pull/10 .
+ 'styled_output'=>1, # Do they want ANSI styling if the output is a TTY?
+ 'styled_output_if_not_tty'=>0, # Do they want ANSI styling if the output isn't a TTY?
+ 'calendar_today_style'=>'bold', # ANSI styling for today's date on the calendar.
+ 'items_today_style'=>'bold', # ANSI styling for today's items on the calendar.
+ 'prefilter'=>'', # pipe calendar file through this program before feeding it to When
+ 'monday_first'=>0, # display Monday rather than Sunday as the first day of the week?
+ 'orthodox_easter'=>0, # use Orthodox Eastern Church's date for easter?
+ 'neighboring_months'=>1, # print 3 months when doing a "when c"?
+ 'ampm'=>1, # use 12-hour time?
+ 'auto_pm'=>0, # if nonzero, then times with hours less than this are assumed to be PM
+ 'literal_only'=>0, # only display items given as literal dates?
+ 'test_expression'=>0, # used by 'make test'
+);
+
+our %options=(
+ 'help'=>0, # print documentation
+ 'version'=>0, # print version number, and other info
+ 'bare_version'=>0, # print version number
+ 'make_filter_regex'=>0, # to make unicode filtering efficient
+ 'test_accent_filtering'=>0, # to make sure it really catches all the accented characters that are present in the translations
+);
+
+# The following is for use by Getopt::Long. ! means negatable. =s means it requires a string value, =i an integer.
+our %command_line_options = (
+ 'help'=>\$options{'help'},
+ 'version'=>\$options{'version'},
+ 'bare_version'=>\$options{'bare_version'},
+ 'make_filter_regex'=>\$options{'make_filter_regex'},
+ 'test_accent_filtering'=>\$options{'test_accent_filtering'},
+ 'language=s'=>\$preferences{'language'},
+ 'past=i'=>\$preferences{'past'},
+ 'future=i'=>\$preferences{'future'},
+ 'calendar=s'=>\$preferences{'calendar'},
+ 'wrap=i'=>\$preferences{'wrap'},
+ 'wrap_auto!'=>\$preferences{'wrap_auto'},
+ 'wrap_max=i'=>\$preferences{'wrap_max'},
+ 'rows=i'=>\$preferences{'rows'},
+ 'rows_auto!'=>\$preferences{'rows_auto'},
+ 'paging!'=>\$preferences{'paging'},
+ 'header!'=>\$preferences{'header'},
+ 'paging_less_options=s'=>\$preferences{'paging_less_options'},
+ 'editor=s'=>\$preferences{'editor'},
+ 'now=s'=>\$preferences{'now'},
+ 'calendar_today_style=s'=>\$preferences{'calendar_today_style'},
+ 'items_today_style=s'=>\$preferences{'items_today_style'},
+ 'prefilter=s'=>\$preferences{'prefilter'},
+ 'filter_accents_on_output!'=>\$preferences{'filter_accents_on_output'},
+ 'styled_output!'=>\$preferences{'styled_output'},
+ 'styled_output_if_not_tty!'=>\$preferences{'styled_output_if_not_tty'},
+ 'monday_first!'=>\$preferences{'monday_first'},
+ 'orthodox_easter!'=>\$preferences{'orthodox_easter'},
+ 'neighboring_months!'=>\$preferences{'neighboring_months'},
+ 'ampm!'=>\$preferences{'ampm'},
+ 'auto_pm=i'=>\$preferences{'auto_pm'},
+ 'literal_only!'=>\$preferences{'literal_only'},
+ 'test_expression=s'=>\$preferences{'test_expression'},
+ 'test_mode!'=>\$preferences{'test_mode'},
+);
+
+#----------------------------------------------------------------
+# Strings are all collected here for ease of internationalization:
+#----------------------------------------------------------------
+
+# When adding characters to the following list, make sure to add them to
+# UnicodeTools::filter(), then run "./when --make_filter_regex" and cut and paste the output into UnicodeTools::filter_out_accents().
+our $e_acute = "\x{e9}";
+our $u_circumflex = "\x{fb}";
+
+# German characters:
+our $A_uml = "\x{c4}";
+our $a_uml = "\x{e4}";
+our $O_uml = "\x{d6}";
+our $o_uml = "\x{f6}";
+our $U_uml = "\x{dc}";
+our $u_uml = "\x{fc}";
+our $s_zlig = "\x{df}";
+
+# Polish characters:
+our $a_polish = "\x{105}";
+our $c_polish = "\x{107}";
+our $e_polish = "\x{119}";
+our $l_polish = "\x{142}";
+our $n_polish = "\x{144}";
+our $o_polish = "\x{0f3}";
+our $s_polish = "\x{15b}";
+our $z_polish = "\x{17a}";
+our $zz_polish = "\x{17c}";
+
+# Czech characters:
+our $a_acute = "\x{e1}";
+our $i_acute = "\x{ed}";
+our $u_acute = "\x{fa}";
+our $y_acute = "\x{fd}";
+our $U_acute = "\x{da}";
+our $C_wedge = "\x{10c}";
+our $c_wedge = "\x{10d}";
+our $e_wedge = "\x{11b}";
+our $R_wedge = "\x{158}";
+our $r_wedge = "\x{159}";
+
+# Danish characters:
+our $a_ring = "\x{e5}";
+our $A_ring = "\x{c5}";
+our $o_slash = "\x{f8}";
+our $O_slash = "\x{d8}";
+our $ae = "\x{e6}";
+our $AE = "\x{c6}";
+
+# Swedish characters:
+our $a_ring = "\x{e5}";
+our $A_ring = "\x{c5}";
+our $a_uml = "\x{e4}";
+our $A_uml = "\x{c4}";
+our $o_uml = "\x{f6}";
+our $O_uml = "\x{d6}";
+
+# Spanish characters:
+our $A_acute = "\x{c1}";
+our $E_acute = "\x{c9}";
+our $I_acute = "\x{cd}";
+our $O_acute = "\x{d3}";
+our $U_acute = "\x{da}";
+our $a_acute = "\x{e1}";
+our $e_acute = "\x{e9}";
+our $i_acute = "\x{ed}";
+our $o_acute = "\x{f3}";
+our $u_acute = "\x{fa}";
+our $n_tilde = "\x{f1}";
+
+# French characters:
+our $a_grave = "\x{e0}";
+
+# Romanian diacritics
+our $A_breve = "\x{102}";
+our $A_circumflex = "\x{c2}" ;
+our $I_circumflex = "\x{ce}" ;
+our $S_commabelow = "\x{218}" ;
+our $T_commabelow = "\x{21a}" ;
+our $a_breve = "\x{103}";
+our $a_circumflex = "\x{e2}" ;
+our $i_circumflex = "\x{ee}" ;
+our $s_commabelow = "\x{219}" ;
+our $t_commabelow = "\x{21b}" ;
+# Some time S and T with comma below are not present in the font.
+# Some people are using the cedilla gliphs instead. They are wrong
+# (the gliphs).
+our $quot_open = "\x{201e}" ;
+our $quot_close = "\x{201c}" ;
+our $quotalt_open = "\x{ab}" ;
+our $quotalt_close = "\x{bb}" ;
+our $nonbreaking_hyphen = "\x{2011}" ;
+
+
+#**********************************************************************
+# When adding a language, make sure to update the list of languages
+# in the man page as well!
+#**********************************************************************
+
+our %month_name =
+ (
+ 'en'=>'Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec', # English
+ );
+our %month_name_long =
+ (
+ # English:
+ 'en'=>'January February March April May June July August September October November December',
+ # Polish:
+ );
+our %wday_name =
+ (
+ 'en'=>'Sun Mon Tue Wed Thu Fri Sat', # English
+ );
+
+#------------------------------------------------------------------------
+# This subroutine is used every time we need to print out some text in the
+# user's chosen language.
+#------------------------------------------------------------------------
+sub w {
+ my $what = shift; # can be either a string representing a key, or [key,language]
+ my @stuff = @_;
+ my $lingo = $preferences{'language'};
+ my %strings;
+ if (ref $what) {
+ $lingo = $what->[1];
+ $what = $what->[0];
+ }
+ %strings =
+ (
+ 'date_syntax_error'=>"The date %s is not in the required format, which is 'y m d', with blanks separating the three parts.",
+ 'multiple_wildcards_in_date'=>"The date %s contains more than one wildcard character *. Try testing variables instead of using wildcards.",
+ 'error_opening_prefs'=>"The preferences file %s exists, but there was an error opening it for input.",
+ 'syntax_err_in_prefs'=>"Syntax error in preferences file %s:\n%s",
+ 'prefs_file_not_found'=>"Preferences file %s not found.\n",
+ 'illegal_command'=>"Illegal command, %s\n",
+ 'error_opening_calendar'=>"Couldn't open the file %s for input\n",
+ 'error_prefiltering'=>"Couldn't execute the prefilter %s\n",
+ 'not_utf8'=>"The file %s does not appear to be encoded in utf8 (or ascii, which is a subset of utf8). The unix 'file' utility can probably tell you what its encoding is.\n",
+ 'yesterday'=>'yesterday',
+ 'today'=>'today',
+ 'tomorrow'=>'tomorrow',
+ 'syntax_error_in_calendar'=>"Syntax error in calendar: %s\n",
+ 'illegal_year'=>"Illegal year: %s\n",
+ 'illegal_month'=>"Illegal month: %s\n",
+ 'illegal_day_of_month'=>"Illegal day of the month: %s\n",
+ 'first_time_not_tty'=>"To set up your calendar, do the command ``when'' in an interactive terminal window.\n",
+ 'ask_if_set_up'=>("You can now set up your calendar. This involves creating a directory ~/.when\n".
+ "(or somewhere else as set by an environment variable, see documentation), and making\n".
+ "a couple of files in it. If you want to do this, type y and hit return.\n"),
+ 'error_creating_dir'=>"Error creating the directory %s\n",
+ 'ask_for_editor'=>("You can edit your calendar file using your favorite editor. Please enter the command you\n"
+ ."want to use to run your editor, or hit return to accept this default:\n"),
+ 'error_creating_prefs'=>"Error creating the file %s\n",
+ 'error_creating_cal'=>"Error creating the file %s\n",
+ 'getting_started'=>("You can now add items to your calendar file. Do ``when --help'' for more information.\n"),
+ 'not_unique_w_match'=>'%s does not match a unique day of the week from %s',
+ 'no_w_match'=>'%s does not match any day of the week from %s',
+ 'not_valid_expression'=>'%s is not a valid date or expression',
+ 'illegal_var'=>'illegal variable: %s',
+ 'illegal_month_in_expression'=>'illegal month in expression: %s',
+ 'expression_syntax_error'=>'syntax error: %s',
+ 'error_running_editor'=>"Error executing command %s, %s. Perhaps %s isn't installed?\nYou selected this command in the file %s.\n",
+ 'describe_julian_day'=>"The date %s corresponds to modified julian day %d.\n",
+ )
+ }
+ if ($what eq '__give_all_strings') {return values %strings} # used by UnicodeTools::collect_all_strings()
+ if (exists $strings{$what}) {$what = $strings{$what}} else {$what = w([$what,'en'],@stuff)} # fall back to English
+ return sprintf($what,@stuff);
+}
+
+
+#----------------------------------------------------------------
+# Some constants for ANSI terminal styling.
+#----------------------------------------------------------------
+our %ansi_terminal_styling = (
+ 'bold'=>1, 'underlined'=>4,'flashing'=>5,
+ 'fgblack'=>30,'fgred'=>31,'fggreen'=>32,'fgyellow'=>33,'fgblue'=>34,'fgpurple'=>35,'fgcyan'=>36,'fgwhite'=>37,
+ 'bgblack'=>40,'bgred'=>41,'bggreen'=>42,'bgyellow'=>43,'bgblue'=>44,'bgpurple'=>45,'bgcyan'=>46,'bgwhite'=>47,
+);
+
+
+#----------------------------------------------------------------
+# Read the preferences file.
+#----------------------------------------------------------------
+sub find_config_dir() {
+ my @locations = (); # follow XDG standard, https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html
+ if ($ENV{WHEN_CONFIG_HOME}) { push @locations,$ENV{WHEN_CONFIG_HOME} }
+ if ($ENV{XDG_CONFIG_HOME}) { push @locations,"$ENV{XDG_CONFIG_HOME}/when" }
+ push @locations,glob "~/.config/when";
+ push @locations,glob "~/.when";
+ foreach my $loc(@locations) {
+ if (-d $loc) { return $loc }
+ }
+ return $locations[-1]; # doesn't exist, but it's the typical location, so return it and expect an error
+}
+
+my $dir = find_config_dir();
+my $prefs_file = glob "$dir/preferences";
+our $quickie = 0;
+our $got_command_line_options = 0;
+
+our $explicitly_set_future = 0;
+ # ...This is set in two places, and used in one place -- see there for an explanation of what it's for.
+
+if (! -e $prefs_file) {
+ # Normally we read command-line options after reading the prefs file, to
+ # allow them to override the file. However, if the prefs file doesn't exist,
+ # we want to do that now, and find out if this is a run where all we need to
+ # do is a --version or something. The reason for this complication is that we
+ # need to handle the case where the root user (who doesn't want to set up his
+ # own calendar file) is installing when, and when is being run from inside the
+ # makefile in order to find out what version it is.
+ my $old_future = $preferences{'future'};
+ GetOptions(%command_line_options); # from Getops::Long
+ my $new_future = $preferences{'future'};
+ $explicitly_set_future ||= ($old_future != $new_future);
+ $got_command_line_options = 1;
+ $quickie =
+ ($options{'version'} || $options{'bare_version'} || $options{'make_filter_regex'} || $options{'test_accent_filtering'} || $options{'help'} || $options{'test_expressions'});
+}
+
+# Note that $ENV{LANG} won't exist on non-Linux systems (e.g., doesn't exist on BSD). Debian
+# systems have it set to, e.g., "en_US", but apparently Red Hat does something like "en_US.utf8".
+if (exists $ENV{LANG}) {
+ if ($ENV{LANG} =~ m/^(..)/) {
+ my $l = lc($1);
+ $preferences{'language'} = $l;
+ }
+}
+# Later on, we check whether the language has been set in the preferences
+# file or in a command line option. If the end result is that the language
+# is set to something goofy (e.g., because we failed to parse $LANG correctly,
+# or because the user's language isn't one we support), then the language defaults
+# back to English anyway.
+
+if (!$quickie && (! -e $dir or ! -e $prefs_file) && !$preferences{'test_mode'}) {
+ run_first_time($preferences{'calendar'});
+}
+if (-e $prefs_file) {
+ UnicodeTools::file_is_valid_utf8($prefs_file) or die w('not_utf8',$prefs_file);
+ open (FILE,"<$prefs_file") or die w('error_opening_prefs',$prefs_file);
+ while (my $line = <FILE>) {
+ if ($line =~ m/^\s*(\w+)\s*\=\s*([^\s].*)*/) {
+ my ($option,$value) = ($1,$2);
+ $value =~ s/#.*$//; # strip comment marked by #
+ $value =~ s/\s+$//; # strip trailing blanks
+ $preferences{lc($option)} = $value;
+ if (lc($option) eq 'future') {$explicitly_set_future=1}
+ }
+ else {
+ if (!($line =~ m/^\s*(#.*)?$/)) {die w('syntax_err_in_prefs',$prefs_file,$line)}
+ # The (#.*)? is to allow lines consisting of only a comment prefaced by #.
+ }
+ }
+ close FILE;
+}
+else {
+ do_output(w('prefs_file_not_found',$prefs_file)) if !($quickie || $preferences{'test_mode'});
+}
+
+#----------------------------------------------------------------
+# Some global variables.
+#----------------------------------------------------------------
+our $date_delimiter = ' '; # e.g. 2003 Feb 1
+our $use_month_names = 1;
+
+our @month_length = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
+
+#----------------------------------------------------------------
+# Figure out what the user wants to do.
+#----------------------------------------------------------------
+
+my $cmds = '';
+
+foreach my $arg(@ARGV) {
+ if (! ($arg =~ m/^\-/)) {
+ $cmds = $cmds . lc($arg);
+ }
+}
+
+if (!$got_command_line_options) {
+ my $old_future = $preferences{'future'};
+ GetOptions(%command_line_options); # from Getops::Long
+ my $new_future = $preferences{'future'};
+ $explicitly_set_future ||= ($old_future != $new_future);
+}
+
+if ($preferences{'rows_auto'} && -t STDOUT) {
+ $preferences{'rows'} = Terminal::rows();
+}
+if ($explicitly_set_future) {
+ $preferences{'rows'} = 9999; # They explicitly set number of days into future, so don't chop it off.
+}
+
+my $want_styling = ($preferences{'styled_output'} && -t STDOUT) || ($preferences{'styled_output_if_not_tty'} && ! -t STDOUT);
+
+my @do_what = ();
+
+if ($cmds eq '') {$cmds = 'i'}
+
+my %periods = ('w'=>7,'m'=>31,'y'=>366);
+#loop over chars in arg:
+while ($cmds =~ m/(.)/g) {
+ my $cmd = $1;
+ my $recognized = 0;
+ if (exists $periods{$cmd}) {
+ $recognized = 1;
+ push @do_what,'normal';
+ $preferences{'future'} = $periods{$cmd};
+ $preferences{'rows'} = 9999; # If they say they want a year in advance, don't chop it off.
+ }
+ else {
+ if ($cmd eq 'd') {
+ $recognized = 1;
+ push @do_what,'date';
+ }
+ if ($cmd eq 'i') {
+ $recognized = 1;
+ push @do_what,'normal';
+ }
+ if ($cmd eq 'c') {
+ $recognized = 1;
+ push @do_what,'calendar';
+ }
+ if ($cmd eq 'e') {
+ $recognized = 1;
+ push @do_what,'edit';
+ }
+ if ($cmd eq 'j') {
+ $recognized = 1;
+ push @do_what,'modified_julian_day';
+ }
+ }
+ if (!$recognized) {
+ die w('illegal_command',$cmd);
+ }
+}
+
+# Setting the calendar file after the command-line options have been read
+my $file = glob $preferences{'calendar'};
+if (!$quickie && ! -e $file && !$preferences{'test_mode'}) {
+ run_first_time($file);
+}
+
+#----------------------------------------------------------------
+# Do it.
+#----------------------------------------------------------------
+
+my $now = When::current_date();
+if ($preferences{'now'} ne '') {
+ my $r = When::parse_blank_delimited($preferences{'now'});
+ if ($r->[0]) {
+ die $r->[0];
+ }
+ $now = $r->[1];
+}
+
+if ($options{'help'}) {
+ print documentation();
+ exit(0);
+}
+
+if ($preferences{'test_expression'}) {
+ $preferences{'test_expression'} =~ m/^([^,]+),([^,]+),([^,]+),(.*)$/;
+ my ($date,$result,$expr,$comment) = ($1,$2,$3,$4);
+ # result is 0, 1, or e if an error is expected
+ my $expect_err = ($result=~m/e/i);
+ my $failure = sub {
+ my $info = shift;
+ print "Failed test\n $comment\n";
+ print " date=$date\n expect_err=$expect_err\n result=$result\n expr=$expr\n";
+ print "$info\n";
+ exit(-1);
+ };
+ my $match = DateMatch->new('condition',$expr);
+ if ($match->{ERR} && ! $expect_err) {
+ my $err = $match->{ERR};
+ $failure->("unexpected error, $err");
+ }
+ if ((!($match->{ERR})) && $expect_err) {
+ $failure->("error expected, but none occurred");
+ }
+ if (!($match->{ERR})) {
+ my $x = When::parse_blank_delimited($date);
+ my $err = $x->[0];
+ $failure->("error parsing date $date, $err") if $err;
+ my $when = $x->[1];
+ my $got_result = $match->evaluate($when,{},$when->day_of_week);
+ $failure->("expected result '$result', got '$got_result'") if ($got_result xor $result);
+ }
+ exit(0);
+}
+
+if ($options{'version'}) {
+ print "When version $version, (c) 2003-2011 Benjamin Crowell.\nDo 'when --help' for help and copyleft information.\n";
+ exit(0);
+}
+if ($options{'bare_version'}) {
+ print $version;
+ exit(0);
+}
+if ($options{'make_filter_regex'}) {
+ print UnicodeTools::make_filter_regex()."\n";
+ exit(0);
+}
+if ($options{'test_accent_filtering'}) {
+ my @lingos = keys %month_name;
+ my @strings = ();
+ foreach my $lingo(@lingos) {
+ @strings = (@strings,$month_name{$lingo},$month_name_long{$lingo},$wday_name{$lingo});
+ my $save = $preferences{'language'};
+ $preferences{'language'} = $lingo;
+ @strings = (@strings,w('__give_all_strings'));
+ $preferences{'language'} = $save;
+ }
+ my $result = UnicodeTools::test_accent_filtering(@strings); # All this does is make sure it ends up pure ascii.
+ if ($result eq '') {
+ exit(0);
+ }
+ else {
+ print STDERR $result;
+ exit(-1);
+ }
+}
+
+my $first_one = 1;
+foreach my $cmd(@do_what) {
+ if (!$first_one) {
+ do_output("\n");
+ }
+ $first_one = 0;
+ if ($cmd eq 'date') {
+ do_output(describe_date()."\n");
+ }
+ if ($cmd eq 'normal') {
+ if (normal_behavior($now,$want_styling)!=0) {exit(-1)};
+ }
+ if ($cmd eq 'calendar') {
+ calendar(NOW=>$now,WANT_STYLING=>$want_styling,TODAY_STYLE=>$preferences{'calendar_today_style'},PAST=>$preferences{'past'},FUTURE=>$preferences{'future'});
+ }
+ if ($cmd eq 'edit') {
+ my $c = $preferences{'editor'}." ".$preferences{'calendar'};
+ unless(system($c)==0) {
+ print STDERR w('error_running_editor',$c,$!,$preferences{editor},$prefs_file);
+ exit(-1);
+ }
+ }
+ if ($cmd eq 'modified_julian_day') {
+ #print "The date ".$now->string_human()." corresponds to modified julian day ".$now->modified_julian_day().".\n";
+ print w('describe_julian_day',$now->string_human(),$now->modified_julian_day());
+ }
+}
+
+sub describe_date {
+ my $describe_wday = $now->day_of_week_name;
+ my $describe_today = $now->string_human();
+ my @tm = localtime;
+ my ($hour,$minute) = ($tm[2],$tm[1]);
+ $hour = (($hour-1) % 12)+1 if ($preferences{'ampm'});
+ my $describe_time = sprintf "%d:%02d",$hour,$minute;
+ return "$describe_wday $describe_today $describe_time";
+}
+
+sub do_output {
+ my $x = shift;
+ print filter_accents_if_desired($x);
+}
+
+sub do_output_to_stderr {
+ my $x = shift;
+ print STDERR filter_accents_if_desired($x);
+}
+
+sub filter_accents_if_desired {
+ my $x = shift;
+ if ($preferences{'filter_accents_on_output'}) {
+ $x = UnicodeTools::filter_out_accents($x);
+ }
+ return $x;
+}
+
+#----------------------------------------------------------------
+# The program's normal behavior is to print out all your appointments
+# for a certain period (by default, the next two weeks).
+#----------------------------------------------------------------
+
+sub normal_behavior {
+ my $now = shift->clone;
+ my $want_styling = shift;
+
+ my $complete_output = '';
+ my $lines_done = 2; # header and blank line under it
+
+ if ($preferences{'header'}) {
+ $complete_output = $complete_output . filter_accents_if_desired(describe_date())."\n\n";
+ $lines_done += 2; # header and blank line under it
+ }
+
+ my @find_longest = (w('yesterday'),w('today'),w('tomorrow'));
+ for (my $day_num=1; $day_num<=7; $day_num++) {
+ push @find_longest,When::short_wday_name($day_num);
+ }
+ my $max_wday_length = 8;
+ foreach my $day(@find_longest) {
+ my $length = AnsiTerminalStyling::length(filter_accents_if_desired($day)); # filter_accents_if_desired may change length of string
+ $max_wday_length = $length if $length>$max_wday_length;
+ }
+
+ -r $file or die w('error_opening_calendar',$file);
+
+ # Make sure the calendar file is utf8. Horrible things happen if, e.g., it's iso-8859.
+ # This involves reading the file again. We do this after the original reading of the file,
+ # since that's where the error handling is if the file doesn't exist, etc.
+ UnicodeTools::file_is_valid_utf8($file) or die w('not_utf8',$file);
+
+ my $prefilter = $preferences{'prefilter'};
+ my $calendar_input;
+ if ($prefilter eq '') {
+ $calendar_input = "<$file";
+ }
+ else {
+ $calendar_input = "$prefilter <$file |";
+ }
+
+ open (FILE, $calendar_input) or die w('error_opening_calendar',$file);
+ my @lines = <FILE>; # in array context, returns all lines from file
+ close FILE or die w("error_prefiltering",$calendar_input);
+
+ my @show;
+ my @condition_lines;
+
+ my $list_one = sub {
+ my $when = shift;
+ my $delta = shift;
+ my $what = shift;
+ my $describe = $when->day_of_week_name;
+ if ($delta == -1) {$describe = w('yesterday')}
+ if ($delta == 0) {$describe = AnsiTerminalStyling::style_text(w('today'),$preferences{'items_today_style'},$want_styling)}
+ if ($delta == 1) {$describe = w('tomorrow')}
+ $describe = filter_accents_if_desired($describe);
+ $describe = AnsiTerminalStyling::pad_to_desired_length($describe,$max_wday_length+1,' ');
+ my $say = sprintf "%s %s %s\n",$describe,$when->string_human,$what;
+ push @show,[$when->clone,$say,$what];
+ };
+ foreach my $line(@lines) {
+ chomp $line;
+ if ($line =~ m/^\s*([^,#]*)\s*,\s*(([^\s].*)?)/) {
+ my ($date,$what) = ($1,$3);
+ my $match;
+ my $exact = !($date=~m/[=<>%]/); # exact includes both dates of the form "2008 jul 4" and those like "2008* jul 4" and "* jul 4"
+ my $literal = $exact && !($date=~/\*/); # literal means only dates of the form "2008 jul 4"
+ my $only_if_literal = $preferences{literal_only};
+ my $ignore = (!$literal) && $only_if_literal;
+ if (!$ignore) {
+ if ($exact) {
+ $match = DateMatch->new('exact',$date);
+ if ($match->{ERR} ne '') {
+ my $err = $match->{ERR};
+ do_output_to_stderr("****** $err\n****** $line\n\n");
+ return -1;
+ }
+ }
+ else {
+ $match = DateMatch->new('condition',$date);
+ if ($match->{ERR}) {
+ my $err = $match->{ERR};
+ do_output_to_stderr("****** $err\n****** $line\n\n");
+ return -1;
+ }
+ }
+ if ($match->{TYPE} eq 'condition') {
+ push @condition_lines,[$match,$what];
+ }
+ if ($match->{TYPE} eq 'exact') {
+ my $when = $match->{WHEN};
+ if ($when->y =~ m/\*/) {
+ my $that_year = '';
+ if ($when->y =~ m/(\d+)/) {$that_year=$1}; # "1996*" syntax
+ $when->y($now->y);
+ if ($when->delta_days($now)<$preferences{'past'}) {$when->y($when->y+1)}
+ if ($when->delta_days($now)>$preferences{'future'}) {$when->y($when->y-1)}
+ if ($when->y =~ m/(\d+)/) {
+ my $years_since = $when->y()-$that_year;
+ $what =~ s/\\a/$years_since/g;
+ $what =~ s/\\y/$that_year/g;
+ }
+ }
+ my $delta = $when->delta_days($now);
+ if ($delta >= $preferences{'past'} && $delta <=$preferences{'future'}) {
+ &$list_one($when,$delta,$what);
+ }
+ }
+ } # end if not ignored
+ } # end if line has the syntax of a calendar entry
+ else { # Ignore lines consisting only of whitespace and lines that begin with # (comments).
+ if (!($line =~ m/^\s*$/ || $line =~ m/^#/)) {die w('syntax_error_in_calendar',$line)}
+ }
+ }
+
+ if (@condition_lines) {
+ my $then = $now->clone;
+ my ($d1,$d2) = ($preferences{'past'},$preferences{'future'});
+ $then->add_delta_days_in_place($d1);
+ my $day_of_week = $then->day_of_week;
+ for (my $delta=$d1; $delta<=$d2; $delta++) {
+ my %vars = ();
+ foreach my $cond(@condition_lines) {
+ my ($match,$what) = @$cond;
+ my $result = $match->evaluate($then,\%vars,$day_of_week);
+ &$list_one($then,$delta,$what) if $result;
+ } # end loop over condition lines
+ $then->increment_day_in_place();
+ $day_of_week = ($day_of_week%7)+1; # we go 1..7, not 0..6; this is like ((x-1+1)%7)+1
+ } # end loop over days
+ } # end if condition lines
+
+ # For purposes of sorting entries, we recognize when the text of an entry begins with a time in h:mm format, with an optional a or p for am or pm.
+ # This subroutine returns 9999 if the string doesn't begin with a time, or the time in minutes otherwise.
+ my $get_time = sub {
+ my $x = shift;
+ my $match_ampm = $preferences{'ampm'} ? '[ap]?' : '';
+ return 9999 unless $x =~ /^\s*(\d+):(\d+)($match_ampm)/i;
+ my ($h,$m,$am_pm) = ($1,$2,$3);
+ if (!$am_pm && $h<$preferences{'auto_pm'}) {$h+=12}
+ if ($am_pm=~/p/ && $h != 12 ) {$h+=12}
+ if ($am_pm=~/a/ && $h == 12) { $h-=12 }
+ return 9999 unless ($h<=23 && $m<=59);
+ return $h*60+$m;
+ };
+ @show = sort {
+ my $time_order = $a->[0]->compare($b->[0]);
+ return $time_order if $time_order;
+ my ($txt_a,$txt_b) = ($a->[2],$b->[2]); # the texts of the two calendar entries
+ &$get_time($txt_a) <=> &$get_time($txt_b)
+ # In the case where they're both times, this makes the earlier one come first.
+ # In the case where one is a time and one isn't, the timed one comes first.
+ # In the case where neither is timed, this also does the right thing.
+ } @show;
+
+ my $wrap = $preferences{'wrap'};
+ if ($wrap==0) {$wrap=9999}
+ if ($preferences{'wrap_auto'}) {
+ my $terminal_width = Terminal::columns();
+ if ($terminal_width>0) {$wrap=$terminal_width}
+ }
+ if ($preferences{'wrap_max'}>0 && $wrap>$preferences{'wrap_max'}) {
+ $wrap=$preferences{'wrap_max'}
+ }
+ my $rows = $preferences{'rows'};
+ if ($rows==0) {$rows=9999}
+ my $margin = $max_wday_length+14; # This is the width of the column containing the date.
+ if ($wrap<$margin+10) {$wrap=$margin+10} # otherwise you get an endless loop
+ foreach my $thing(@show) {
+ my ($when,$say) = @$thing;
+ my $output = format_item($say,$wrap,$margin);
+ $lines_done += split /\n/,$output;
+ last if $lines_done>$rows && $when->delta_days($now)>3;
+ $complete_output = $complete_output . filter_accents_if_desired($output);
+ }
+ my $did_it = 0;
+ if ($preferences{'paging'} && -t STDOUT && Terminal::rows()>0 && $lines_done>Terminal::rows()-1) {
+ my $pager = $ENV{PAGER};
+ if (!defined $pager) {$pager = "less"}
+ if ($pager eq 'less') {$pager = "$pager ".$preferences{'paging_less_options'}}
+ if (open(FILE,"| $pager")) {
+ print FILE $complete_output;
+ close FILE;
+ $did_it = 1;
+ }
+ }
+ if (!$did_it) {print $complete_output}
+ return 0;
+}
+
+#----------------------------------------------------------------
+# Print a calendar.
+#----------------------------------------------------------------
+sub calendar {
+ my %args = (
+ NOW=>'',
+ WANT_STYLING=>0,
+ TODAY_STYLE=>'',
+ PAST=>0,
+ FUTURE=>0,
+ @_,
+ );
+
+ my $now = $args{NOW}->clone;
+ my $past = $args{PAST};
+ my $future = $args{FUTURE};
+
+ # Normally we just print out three months, next to each other horizontally.
+ # However, if the user specified some other time period than the default, we
+ # print out multiple rows, e.g., they may want a full year's worth of calendars (four lines).
+ # The following are generous limits -- we check more carefully later:
+ my $row_start = int($past/90)-2;
+ my $row_end = int($future/90)+2;
+
+ for (my $row=$row_start; $row<=$row_end; $row++) {
+
+ my $middle_month = $now->clone;
+ for (my $i=1; $i<=abs($row); $i++) {
+ if ($row<0) {
+ $middle_month->decrement_month_in_place();
+ $middle_month->decrement_month_in_place();
+ $middle_month->decrement_month_in_place();
+ }
+ if ($row>0) {
+ $middle_month->increment_month_in_place();
+ $middle_month->increment_month_in_place();
+ $middle_month->increment_month_in_place();
+ }
+ }
+ my $last_month = $middle_month->clone;
+ my $next_month = $middle_month->clone;
+ $last_month->decrement_month_in_place();
+ $next_month->increment_month_in_place();
+
+ # Check whether we really need to print this row in order to cover their chosen time period:
+ my $range_lo = $last_month->clone;
+ my $range_hi = $next_month->clone;
+ $range_lo->d(1);
+ $range_hi->d($range_hi->days_in_month);
+ my $needed = $range_hi->delta_days($now)-$past>=0 && $range_lo->delta_days($now)-$future<=0;
+
+ if ($needed) {
+ my @cals;
+ for (my $i=-1; $i<=1; $i++) {
+ my $month = [$last_month,$middle_month,$next_month]->[$i+1];
+ my @cal = make_one_month_calendar(WHEN=>$month,WANT_STYLING=>$args{WANT_STYLING},TODAY_STYLE=>$args{TODAY_STYLE},MARK_TODAY=>($i==0 && $row==0));
+ my $month_needed = 1;
+ if (!$preferences{'neighboring_months'}) {
+ my $first_day_of_month = $month->clone;
+ $first_day_of_month->d(1);
+ my $last_day_of_month = $month->clone;
+ $last_day_of_month->d($month->days_in_month);
+ $month_needed=0 if $first_day_of_month->delta_days($now)-$future>0 || $last_day_of_month->delta_days($now)-$past<0;
+ }
+ push @cals,\@cal if $month_needed;
+ }
+ do_output(combine_calendars_for_several_months(@cals));
+ } # end if $needed
+
+ } # end loop over $row
+
+}
+
+sub combine_calendars_for_several_months {
+ my @cals = @_;
+ my $output = '';
+ for (my $line_num=0; $line_num<=10; $line_num++) {
+ my $have_one = 0;
+ foreach my $cal(@cals) {
+ $have_one = $have_one || exists $cal->[$line_num];
+ }
+ if ($have_one) {
+ my $full_line = '';
+ foreach my $cal(@cals) {
+ my $part;
+ if (exists $cal->[$line_num]) {
+ $part = $cal->[$line_num];
+ }
+ else {
+ $part = (' ' x 21); #### constant shouldn't be hardcoded
+ }
+ if ($full_line ne '') {$full_line = "$full_line "}
+ $full_line = $full_line . $part;
+ }
+ $output = $output . $full_line . "\n";
+ }
+ else {
+ last
+ }
+ } # end loop over $line_num
+ return $output;
+}
+
+sub make_one_month_calendar {
+ my %args = (
+ MARK_TODAY=>0,
+ WANT_STYLING=>0,
+ TODAY_STYLE=>'',
+ @_,
+ );
+ my $when = $args{WHEN}->clone;
+ my $mark_today = $args{MARK_TODAY};
+ my @cal = ();
+
+ my $today = $when->clone;
+
+ my $columns = 21; # 3 columns for each day of the week
+
+ my $month_name_long = When::month_name_long($when->m);
+ # Pad it on the front and back so it's roughly centered:
+ my $pad_character = '-';
+ while (AnsiTerminalStyling::length($month_name_long)<$columns) {
+ if (AnsiTerminalStyling::length($month_name_long)%2==0) {
+ $month_name_long = "$month_name_long$pad_character";
+ }
+ else {
+ $month_name_long = "$pad_character$month_name_long";
+ }
+ }
+ push @cal,$month_name_long if $preferences{'header'};
+
+ my $line = '';
+ for (my $wday=1; $wday<=7; $wday++) {
+ $line = $line . ' '.When::short_wday_name($wday).' ';
+ }
+ push @cal,$line if $preferences{'header'};
+
+ $line = '';
+ $when->d(1);
+ for (my $wday=1; $wday<$when->day_of_week && $wday<=7; $wday++) {
+ $line = $line . ' ';
+ }
+ my $this_month = $when->m;
+ while ($when->m == $this_month) {
+ my $display = sprintf('%2d',$when->d);
+ if ($when->compare($today)==0 && $mark_today) {
+ if ($args{WANT_STYLING} && $args{TODAY_STYLE} ne '') {
+ $display = AnsiTerminalStyling::style_text($display,$args{TODAY_STYLE},$args{WANT_STYLING});
+ }
+ else {
+ $display = ' *';
+ }
+ }
+ $line = "$line$display ";
+ $when->increment_day_in_place();
+ # The first day of a second and the subsequent weeks in this month
+ # will be printed on the next line in the calendar
+ if ($when->day_of_week==1) {push @cal,$line; $line = ''}
+ }
+ if ($line ne '') {push @cal,$line; $line = ''}
+
+ # Make sure all the lines are equal in length:
+ for (my $i=0; $i<=$#cal; $i++) {
+ my $line = $cal[$i];
+ while (AnsiTerminalStyling::length($line)<$columns) {
+ $line = "$line ";
+ }
+ $cal[$i] = $line;
+ }
+
+ return @cal;
+}
+
+
+#----------------------------------------------------------------
+# Help them set up the first time through.
+#----------------------------------------------------------------
+sub run_first_time {
+ my $cal_file = glob shift;
+
+ if (!(-t STDIN && -t STDOUT)) {
+ die w('first_time_not_tty');
+ }
+
+ print w('ask_if_set_up');
+ my $want_to = <STDIN>;
+ chomp $want_to;
+ if (lc($want_to) ne 'y') {exit(-1)}
+
+ my $dir = glob "~/.when";
+ if (! -d $dir) {
+ mkdir($dir) or die sprintf w('error_creating_dir'),$dir;
+ }
+
+ my $editor = $preferences{'editor'};
+ print w('ask_for_editor');
+ print " $editor\n";
+ my $want_editor = <STDIN>;
+ chomp $want_editor;
+ if ($want_editor ne '') {$editor=$want_editor}
+
+ my $prefs = glob "~/.when/preferences";
+ if (! -e $prefs) {
+ open(PREFS,">$prefs") or die sprintf w('error_creating_prefs'),$prefs;
+ print PREFS "calendar = $cal_file\n";
+ print PREFS "editor = $editor\n";
+ close(PREFS);
+ }
+ if (! -e $cal_file) {
+ open(CAL,">$cal_file") or die w('error_creating_cal'),$cal_file;
+ close(CAL);
+ }
+
+ print w('getting_started');
+}
+
+#----------------------------------------------------------------
+# Routines for wrapping long lines:
+#----------------------------------------------------------------
+
+# Format a line of text for output. Wrap long lines nicely.
+sub format_item {
+ my $text = shift;
+ my $wrap = shift;
+ my $margin = shift;
+ chomp $text;
+ my @stuff = split_a_line($text,$wrap,2);
+ my $result = (shift @stuff)."\n";
+ my @the_rest = ();
+ if (@stuff) {
+ @the_rest = split_a_line((shift @stuff),$wrap-$margin,9999);
+ }
+ foreach my $line(@the_rest) {
+ $result = $result . (' ' x $margin) . "$line\n";
+ }
+ return $result;
+}
+
+# Split a long line into shorter pieces, preferably at word breaks. Do unicode->ascii
+# filtering here (if it's turned on), because sometimes filtering turns a single
+# unicode character to two ascii characters (e.g., Danish o_slash => oe).
+sub split_a_line {
+ my $text = shift;
+ my $width = shift;
+ my $max_pieces = shift;
+ if ($preferences{'filter_accents_on_output'}) {
+ $text = UnicodeTools::filter_out_accents($text); # see comment above
+ }
+ if (AnsiTerminalStyling::length($text)<=$width || $max_pieces==1) {return ($text,)}
+ if ($text =~ m/^(.{0,$width})(\s+(.*))?$/) {
+ my ($a,$b) = ($1,$3);
+ return ($a,split_a_line($b,$width,$max_pieces-1))
+ }
+ # The only reason we'd get to this point is if the input starts with an extremely long line
+ # consisting of one extremely long word with no blanks in it. This means we can't
+ # break at a word boundary. This typically happens with URLs.
+ $text =~ m/^(.{0,$width})(.*)$/;
+ my ($a,$b) = ($1,$2);
+ return ($a,split_a_line($b,$width,$max_pieces-1));
+}
+
+
+#----------------------------------------------------------------
+# A DateMatch object knows how to test whether a given date
+# matches it or not.
+#----------------------------------------------------------------
+package DateMatch;
+
+# Error handling: ERR field is set to a null string or a string containing a fully processed, internationalized error message
+sub new {
+ my $class = shift;
+ my $self = {};
+ bless($self,$class);
+ $self->{TYPE} = shift; # can be 'exact' or 'condition'
+ $self->{ERR} = undef;
+ my $source = shift;
+ if ($self->{TYPE} eq 'exact') {
+ my $parsed_date = When::parse_blank_delimited($source);
+ my ($err,$when) = @$parsed_date;
+ $self->{WHEN} = $when;
+ $err =~ s/\n$//;
+ $self->{ERR} = $err;
+ return $self;
+ }
+ if ($self->{TYPE} eq 'condition') {
+ $self->{SOURCE} = $source;
+ my $expr = compile_expression($source);
+ my $e = $expr->[0];
+ if (!defined $e) {$e = ''}
+ if (ref $e) {$e = main::w(@$e)}
+ $self->{ERR} = $e;
+ $self->{PARSED} = $expr->[1];
+ return $self;
+ } # end if it's a condition
+}
+
+sub evaluate {
+ my $self = shift;
+ my $when = shift;
+ my $vars = shift; # for efficiency; avoid recalculating these if possible
+ my $day_of_week = shift; # for efficiency, must be provided by caller
+ my @stack = ();
+ my $parsed = $self->{PARSED};
+ foreach my $rpn (@$parsed) {
+ #---- push variable onto stack
+ if ($rpn =~ m/^[a-z]$/) {
+ if ($rpn =~ m/^[abdjmywcnez]$/) {
+ if (!exists $vars->{$rpn}) {
+ # parser should have caught it if it wasn't one of these vars:
+ if ($rpn eq 'w') {$vars->{$rpn}=$day_of_week}
+ if ($rpn eq 'y') {$vars->{$rpn}=$when->y}
+ if ($rpn eq 'm') {$vars->{$rpn}=$when->m}
+ if ($rpn eq 'd') {$vars->{$rpn}=$when->d}
+ if ($rpn eq 'j') {$vars->{$rpn}=$when->modified_julian_day}
+ if ($rpn eq 'a') {$vars->{$rpn}=$when->week_a}
+ if ($rpn eq 'b') {$vars->{$rpn}=$when->week_b}
+ if ($rpn eq 'c') {$vars->{$rpn}=$when->adjacent_weekend_day}
+ if ($rpn eq 'n') {$vars->{$rpn}=$when->days_in_month}
+ if ($rpn eq 'e') {$vars->{$rpn}=Easter::easter($when->y)->delta_days($when)}
+ if ($rpn eq 'z') {$vars->{$rpn}=$when->day_of_year}
+ }
+ push @stack,$vars->{$rpn};
+ }
+ else {
+ die "Illegal variable $rpn in expression @$parsed"; # kludge, not internationalized; parser should have caught it before this anyway
+ }
+ }
+ #---- push constant onto stack
+ elsif ($rpn =~ m/^\d+$/) { push @stack, $rpn }
+ #---- unary op: !
+ elsif ($rpn eq '!') {
+ my $a = pop @stack;
+ push @stack, !$a;
+ }
+ #---- binary op: =, <, etc.
+ else {
+ my $b = pop @stack;
+ my $a = pop @stack;
+ # the one that came first in the source is second to come off the stack
+ my $result;
+ if ($rpn eq '=') { $result = $a == $b }
+ elsif ($rpn eq '<') { $result = $a < $b }
+ elsif ($rpn eq '>') { $result = $a > $b }
+ elsif ($rpn eq '<=') { $result = $a <= $b }
+ elsif ($rpn eq '>=') { $result = $a >= $b }
+ elsif ($rpn eq '!=') { $result = $a != $b }
+ elsif ($rpn eq '%') { $result = $a % $b }
+ elsif ($rpn eq '-') { $result = $a - $b }
+ elsif ($rpn eq '&') { $result = $a && $b }
+ elsif ($rpn eq '|') { $result = $a || $b }
+ push @stack, $result;
+ }
+ } # end loop over RPN
+ return pop @stack;
+}
+
+sub priority($) {
+ my $op = shift;
+ #if ($op eq '!') { return 1 }
+ if ($op eq '%') { return 2 }
+ if ($op eq '-') { return 3 }
+ if ($op eq '>' || $op eq '<' || $op eq '<=' || $op eq '>=') { return 4 }
+ if ($op eq '=' || $op eq '!=') { return 5 }
+ if ($op eq '!') { return 6 }
+ if ($op eq '&') { return 7 }
+ if ($op eq '|') { return 8 }
+ if ($op eq '(') { return 9 }
+ return 0;
+}
+
+# Error handling: first element of return value is either undef or an array to be passed to w() for internationalization.
+sub compile_expression { # a test such as 'm=dec & d=25'
+ my $source = lc shift;
+ my @ex = split / */, $source; # split into individual characters, stripping whitespace
+ my @rpn;
+ my @opst = ('('); # bottom for the stack
+ my ($op, $op2, $pr, $err);
+
+ my $i = 0;
+ while ($i < @ex) {
+ my $single_alpha_token = ($ex[$i] =~ /[[:alpha:]]/ && $ex[$i+1] !~ /[[:alpha:]]/); # this char is alphabetic but the next char is not, i.e., we're looking at a one-character token
+ my $multiple_alpha_token = ($ex[$i] =~ /[[:alpha:]]/ && $ex[$i+1] =~ /[[:alpha:]]/);
+ my $left = $rpn[-1];
+ my $testing_equality = $i>0 && $ex[$i-1] =~ /^[=<>]$/;
+ my $expect_literal = ($left=~/^[mw]$/) && $testing_equality && $ex[$i] ne '='; # we're parsing the right-hand-side of something like m=jan or w=thu
+ if ($ex[$i] =~ /\d/) {
+ my $num = 0;
+ while ($i < @ex && $ex[$i] =~ /\d/) {
+ $num = 10 * $num + $ex[$i];
+ $i++;
+ }
+ push @rpn, $num;
+ }
+ elsif ($single_alpha_token && !$expect_literal) {
+ if ($ex[$i] =~ /[abcdjmnywez]/) { push @rpn, $ex[$i++] }
+ else {$err = ['illegal_var', $ex[$i++]] }
+ }
+ elsif ($multiple_alpha_token || $expect_literal) { # this is or should be a month or weekday literal like jan or thu
+ if ($multiple_alpha_token && !$expect_literal) {return [['expression_syntax_error',$source],undef]} # literals like jan or thu can only appear on r.h.s. of m= or w=
+ my $lvar;
+ while ($i < @ex && $ex[$i] =~ /[[:alpha:]]/) {
+ $lvar .= $ex[$i];
+ $i++;
+ }
+ # $left is guaranteed to be m or w at this point
+ if ($left eq 'm') {
+ my $parsed_month = When::parse_month_name($lvar);
+ if (!$parsed_month) {$err = ['illegal_month_in_expression',$lvar]}
+ $lvar = $parsed_month;
+ }
+ if ($left eq 'w') {
+ my $r = When::parse_wday_name($lvar);
+ if ($r->{'err'}) {
+ $err = [$r->{'err'},$lvar, $wday_name{$preferences{'language'}}];
+ }
+ $lvar = $r->{'match'};
+ }
+ push @rpn, $lvar; # $lvar may be null in cases like w=t, where t is ambiguous and causes an error
+ }
+ elsif ($ex[$i] eq '(') {
+ push @opst, '(';
+ $i++;
+ }
+ elsif ($ex[$i] eq ')') {
+ $op = pop @opst;
+ while ($op ne '(') {
+ push @rpn, $op;
+ $op = pop @opst;
+ }
+ $i++;
+ }
+ elsif ($ex[$i] eq '!' && $ex[$i+1] ne '=') {
+ # '!' has right associativity, so it is in a separate case
+ $pr = priority '!';
+ $op2 = pop @opst;
+ while ($pr > priority $op2) {
+ push @rpn, $op2;
+ $op2 = pop @opst;
+ }
+ push @opst, $op2;
+ push @opst, '!';
+ $i++;
+ }
+ elsif ($ex[$i] =~ /[!%\-\&\|<>=]/) {
+ $op = $ex[$i];
+ if ($op =~ /[\!<>]/ && $ex[$i+1] eq '=') {
+ $op .= '=';
+ $i++;
+ }
+ $pr = priority $op;
+ $op2 = pop @opst;
+ while ($pr >= priority $op2) {
+ push @rpn, $op2;
+ $op2 = pop @opst;
+ }
+ push @opst, $op2;
+ push @opst, $op;
+ $i++;
+ }
+ else { return [['not_valid_expression',$source]] }
+ }
+ while ($op = pop @opst and $op ne '(') { push @rpn, $op }
+ if (@opst) { $err = ['not_valid_expression',$source] }
+ return [$err, \@rpn];
+}
+
+#----------------------------------------------------------------
+# A When object stores year, month, day, time (ymdt).
+# Month is 1..12
+# Time is null, or hour, or hour:min; hour is on 24-hour time.
+# There are methods for doing calculations with the Gregorian calendar.
+#----------------------------------------------------------------
+
+package When;
+
+
+sub new {
+ my $class = shift;
+ my $self = {};
+ bless($self,$class);
+ $self->{Y} = shift;
+ $self->{M} = shift;
+ $self->{D} = shift;
+ if (@_) {
+ $self->{T}=shift
+ }
+ else {
+ $self->{T} = '';
+ }
+ return $self;
+}
+
+# Returns [e,w], where w is a When object and e is a null string or a fully processed, internationalized error message
+sub parse_blank_delimited {
+ my $date = shift;
+ chomp $date;
+ my @a = split / +/,$date;
+ if ($date=~/\*.*\*/) {return [main::w('multiple_wildcards_in_date',$date)]}
+ if ($#a+1!=3) {return [main::w('date_syntax_error',$date)]} # should have exactly three parts, y m d
+ if ($a[0] ne '*' && ($a[0]<1900 || $a[0]>2200)) {return [main::w('illegal_year',$a[0])]}
+ $a[1] = parse_month_name($a[1]);
+ if ($a[1] eq '' || $a[1]<1 || $a[1]>12) {return [main::w('illegal_month',$a[1])]}
+ my $w = When->new(@a);
+ my $len = $w->days_in_month; # returns 29 if input is * feb 29
+ if ($a[2]<1 || $a[2]>$len) {return [main::w('illegal_day_of_month',$date)]}
+ return ['',$w];
+}
+
+# can be number or name
+# if it's a name, ignores case, trailing dot, and extra characters not needed for uniqueness
+BEGIN {
+my %cache = (); # cache results, because this routine tends to be a cpu hog
+sub parse_month_name {
+ my $name = shift;
+ my $orig_name = $name;
+ if ($name =~ m/\d+/) {return $name}
+ return $cache{$name} if exists $cache{$name};
+ $name = UnicodeTools::filter_out_accents($name);
+ $name =~ s/\.$//; # remove trailing dot
+ my $language = $preferences{'language'};
+ # Special case for czech, where Cerven/Cervenec tie us up in knots:
+ if ($language eq 'cs') {
+ return 6 if lc($name) eq 'cer';
+ return 7 if lc($name) eq 'cec';
+ }
+ my @try_langs = ();
+ push @try_langs,$language if exists $month_name{$language};
+ if ($language ne 'en') {
+ push @try_langs,'en';
+ }
+ my %matches = ();
+ foreach my $try_lang(@try_langs) {
+ for (my $m=1; $m<=12; $m++) {
+ my $n = UnicodeTools::filter_out_accents(month_name_long($m,$try_lang));
+ if ($name =~ m/^$n/i || $n =~ m/^$name/i) {$matches{$m}=1}
+ }
+ my @matches = keys %matches;
+ if (@matches==1) {my $result = $matches[0]; $cache{$orig_name}=$result; return $result}
+ if (@matches>1) {return ''} # ambiguous
+ }
+ return '';
+}
+}
+
+# ignores case, trailing dot, and extra characters not needed for uniqueness
+sub parse_wday_name {
+ my $name = shift;
+ $name = UnicodeTools::filter_out_accents($name);
+ $name =~ s/\.$//; # remove trailing dot
+ my $language = $preferences{'language'};
+ my @try_langs = ();
+ push @try_langs,$language if exists $wday_name{$language};
+ if ($language ne 'en' || @try_langs==0) {
+ push @try_langs,'en';
+ }
+ my @matches = ();
+ my $n_matches = 0;
+ foreach my $try_lang(@try_langs) {
+ for (my $w=1; $w<=7; $w++) {
+ my $n = UnicodeTools::filter_out_accents(wday_name($w,$try_lang));
+ if ($name =~ m/^$n/i || $n =~ m/^$name/i) {push @matches,$w; ++$n_matches;}
+ }
+ if ($n_matches==1) { return {'match'=>$matches[0]}}
+ if ($n_matches>1) { return {'err'=>'not_unique_w_match'} } # ambiguous
+ }
+ return {'err'=>'no_w_match'};
+}
+
+sub clone {
+ my $self = shift;
+ return When->new($self->array);
+}
+
+sub array {
+ my $self = shift;
+ return ($self->y,$self->m,$self->d,$self->t);
+}
+
+sub y {
+ my $self = shift;
+ if (@_) {$self->{Y} = shift}
+ return $self->{Y};
+}
+
+sub m {
+ my $self = shift;
+ if (@_) {$self->{M} = shift}
+ return $self->{M};
+}
+
+sub d {
+ my $self = shift;
+ if (@_) {$self->{D} = shift}
+ return $self->{D};
+}
+
+sub t {
+ my $self = shift;
+ if (@_) {$self->{T} = shift}
+ return $self->{T};
+}
+
+sub hour {
+ my $self = shift;
+ my $t = $self->t;
+ $t =~ m/^\d+/;
+ return $1;
+}
+
+# returns null string if not set
+sub min {
+ my $self = shift;
+ my $t = $self->t;
+ if ($t =~ m/\d+\:(\d_)/) {
+ return $1;
+ }
+ else {
+ return '';
+ }
+}
+
+sub min_no_null {
+ my $self = shift;
+ my $m = $self->min;
+ if ($m eq '') {$m=0}
+ return $m;
+}
+
+sub current_date {
+ my @tm = localtime;
+ my $y = $tm[5];
+ my $m = $tm[4]+1;
+ my $d = $tm[3];
+ if ($y<1900) {$y=$y+1900} # works in Perl 5 and 6
+ return When->new($y,$m,$d);
+}
+
+
+sub string_sortable {
+ my $self = shift;
+ return sprintf "%04d-%02d-%02d %02d:%02d", $self->y,$self->m,$self->d,$self->hour,$self->min_no_null;
+}
+
+# y,m,d = numbers, m=1..12; t is h or h:m, on 24-hour time
+sub string_human {
+ my $when = shift;
+ my ($y,$m,$d,$t) = $when->array;
+ if ($use_month_names) {$m=month_name($m)}
+ if (length($d)==1) {$d=" $d"}
+ my $result = $y.$date_delimiter.$m.$date_delimiter.$d;
+ if ($t ne '') {$result = $result . ' '.time_string_human($t)}
+ return $result;
+}
+
+sub time_string_human {
+ my $self = shift;
+ my ($h,$m) = ($self->hour,$self->min);
+ my $suffix = '';
+ if ($preferences{ampm}) {
+ if ($h>12) {
+ $h=$h-12;
+ $suffix = 'pm'
+ }
+ else {
+ $suffix = 'am';
+ }
+ }
+ if ($m ne '') {
+ return sprintf '%d:%02d%s',$h,$m,$suffix;
+ }
+ else {
+ return sprintf '%d%s',$h,$suffix;
+ }
+}
+
+sub month_name {
+ my $m = shift;
+ return month_name_short_or_long($m,'short',@_);
+}
+
+sub month_name_long {
+ my $m = shift;
+ return month_name_short_or_long($m,'long',@_);
+}
+
+sub month_name_short_or_long {
+ my $m = shift;
+ my $short_or_long = shift;
+ my $list_of_names;
+ if ($short_or_long eq 'short') {
+ $list_of_names = \%month_name;
+ }
+ if ($short_or_long eq 'long') {
+ $list_of_names = \%month_name_long;
+ }
+ if (! ref $list_of_names) {return ''}
+ my $language = $preferences{'language'};
+ if (@_) {$language = shift}
+ if ($m<1 || $m>12) {return ''}
+ my $names;
+ if (exists $list_of_names->{$language}) {
+ $names = $list_of_names->{$language}
+ }
+ else {
+ $names = $list_of_names->{'en'};
+ }
+ my @names = split / /,$names;
+ return $names[$m-1];
+}
+
+sub wday_name {
+ my $d = shift;
+ my $lang;
+ if (@_) {
+ $lang = shift;
+ }
+ else {
+ $lang = $preferences{'language'};
+ }
+ if (!exists $wday_name{$lang}) {$lang='en'}
+ my $names = $wday_name{$lang};
+ if ($d<1 || $d>7) {return ''}
+ my @names = split / /,$names;
+ my $offset = $preferences{'monday_first'} ? 1 : 0;
+ # FIXME -- shouldn't really be referring to this global
+ return $names[($d-1+$offset)%7];
+}
+
+sub short_wday_name {
+ my $d = shift;
+ if ($d<1 || $d>7) {return ''}
+ wday_name($d) =~ m/^(.)/; # extract first character
+ return $1;
+}
+
+sub compare {
+ my $a = shift;
+ my $b = shift;
+ if ($a->y != $b->y) {return $a->y <=> $b->y}
+ if ($a->m != $b->m) {return $a->m <=> $b->m}
+ return $a->d <=> $b->d;
+}
+
+sub increment_day_in_place {
+ my $self = shift;
+ $self->d($self->d+1);
+ if ($self->d <= $self->days_in_month()) {return}
+ $self->m($self->m+1);
+ $self->d(1);
+ if ($self->m <= 12) {return}
+ $self->y($self->y+1);
+ $self->m(1);
+}
+
+sub add_delta_days_in_place {
+ my $self = shift;
+ my $d = shift;
+ $self->d($self->d+$d);
+ while ($self->d > $self->days_in_month()) {
+ $self->d($self->d - $self->days_in_month());
+ $self->m($self->m+1);
+ if ($self->m > 12) {
+ $self->m(1);
+ $self->y($self->y+1);
+ }
+ }
+ while ($self->d < 1) {
+ $self->m($self->m-1);
+ if ($self->m < 1) {
+ $self->m(12);
+ $self->y($self->y-1);
+ }
+ $self->d($self->d + $self->days_in_month());
+ }
+}
+
+sub increment_month_in_place {
+ my $self = shift;
+ $self->m($self->m+1);
+ if ($self->m > 12) {
+ $self->y($self->y+1);
+ $self->m(1);
+ }
+ while ($self->d > $self->days_in_month()) {
+ $self->d($self->d-1)
+ }
+}
+
+sub decrement_month_in_place {
+ my $self = shift;
+ $self->m($self->m-1);
+ if ($self->m < 1) {
+ $self->y($self->y-1);
+ $self->m(12);
+ }
+ while ($self->d > $self->days_in_month()) {
+ $self->d($self->d-1)
+ }
+}
+
+sub modified_julian_day {
+ my $self = shift;
+ return $self->delta_days(When->new(2003,2,14))+52685;
+}
+
+sub day_of_year {
+ my $self = shift;
+ return $self->delta_days(When->new($self->y,1,1))+1;
+}
+
+sub week_a {
+ my $self = shift;
+ return int((($self->d)-1)/7)+1;
+}
+
+sub week_b {
+ my $self = shift;
+ return int(($self->days_in_month()-($self->d))/7)+1;
+}
+
+sub adjacent_weekend_day {
+ my $self = shift;
+ my $w = $self->day_of_week();
+ if ($w==2) {return ($self->d)-1}
+ if ($w==6) {return ($self->d)+1}
+ return -1;
+}
+
+sub delta_days {
+ my $a = shift;
+ my $b = shift;
+ my $compared = $a->compare($b);
+ if ($compared == 0) {return 0}
+ if ($compared == -1) {return -($b->delta_days($a))}
+ if ($a->d != 1 || $b->d !=1) {
+ my $aa = $a->clone;
+ my $bb = $b->clone;
+ $aa->{D} = 1;
+ $bb->{D} = 1;
+ return ($aa->delta_days($bb))+($a->d)-($b->d);
+ }
+ if ($a->m != 1 || $b->m !=1) {
+ my $aa = $a->clone;
+ my $bb = $b->clone;
+ my $correction = 0;
+ while ($aa->m > 1) {
+ $aa->m($aa->m-1);
+ $correction = $correction + $aa->days_in_month;
+ }
+ while ($bb->m > 1) {
+ $bb->m($bb->m-1);
+ $correction = $correction - $bb->days_in_month;
+ }
+ return ($aa->delta_days($bb))+$correction;
+ }
+ # From Jan 1 of one year to Jan 1 of another; $a is after $b
+ my $aa = $a->clone;
+ my $result = 0;
+ while ($aa->y > $b->y) {
+ $aa->y($aa->y-1);
+ if ($aa->is_leap_year) {
+ $result = $result+366;
+ }
+ else {
+ $result = $result+365;
+ }
+ }
+ return $result;
+}
+
+sub days_in_month {
+ my $self = shift;
+ if ($self->m != 2) {return $month_length[($self->m)-1]}
+ if ($self->y eq '*' || $self->is_leap_year) { # I use this routine for error checking; * feb 29 is OK.
+ return 29;
+ }
+ else {
+ return 28;
+ }
+}
+
+sub is_leap_year {
+ my $self = shift;
+ my $y = $self->y;
+ if ($y%4!=0) {return 0}
+ if ($y%100!=0) {return 1}
+ if ($y%400!=0) {return 0}
+ return 1;
+}
+
+# Sun=1, ... Sat=7
+sub day_of_week {
+ my $self =shift;
+ my $offset = $preferences{'monday_first'} ? -1 : 0; # FIXME -- shouldn't really be referring to this global
+ return (($self->delta_days(When->new(2003,2,2))+$offset)%7)+1; # Compare against Feb. 2, 2003, which we know was a Sunday.
+}
+
+sub day_of_week_name {
+ my $self =shift;
+ return wday_name($self->day_of_week);
+}
+
+#----------------------------------------------------------------
+# ANSI terminal styling
+#----------------------------------------------------------------
+
+package AnsiTerminalStyling;
+
+sub style_text {
+ my $x = shift;
+ my $style = lc(shift);
+ my $are_you_sure = shift;
+ if (!$are_you_sure) {return $x}
+ my ($before,$after) = ('','');
+ while ($style =~ m/([a-z]+)/g) {
+ my $this_style = $1;
+ if (exists $ansi_terminal_styling{$this_style}) {
+ my $code=$ansi_terminal_styling{$this_style};
+ $before = "$before\e[${code}m";
+ }
+ }
+ if ($before ne '') {$after="\e[0m"}
+ return "$before$x$after";
+}
+
+sub length {
+ my $x = shift;
+ if (!($x =~ m/\e/)) {return length $x}
+ $x =~ s/\e\[\d+m//g;
+ return length $x;
+}
+
+sub pad_to_desired_length {
+ my $x = shift;
+ my $desired_length = shift;
+ my $pad_with = shift;
+ my $current_length = AnsiTerminalStyling::length($x);
+ if ($current_length>=$desired_length) {return $x}
+ return $x . ($pad_with x ($desired_length-$current_length));
+}
+
+#----------------------------------------------------------------
+# Unicode helper routines:
+#----------------------------------------------------------------
+
+package UnicodeTools;
+
+# Note that this may turn a single unicode character into two characters, e.g., with Danish o_slash going to 'oe'.
+# It doesn't just do what it says, it basically transliterates everything into ascii, e.g., Greek
+# lambda becomes l.
+# This gets tested by "when --test_accent_filtering", which is done by "make test".
+# Doesn't do anything to Cyrillic.
+sub filter_out_accents {
+ my $x = shift;
+
+
+ # First do everything that translates into a single character:
+
+ my @t = (
+ ["\x{c2}",'A'],["\x{c4}",'A'],["\x{ce}",'I'],["\x{d6}",'O'],["\x{da}",'U'],
+ ["\x{dc}",'U'],["\x{df}",'s'],["\x{e0}",'a'],["\x{e1}",'a'],["\x{e2}",'a'],
+ ["\x{e4}",'a'],["\x{e3}",'a'],["\x{e7}",'c'],
+ ["\x{e9}",'e'],["\x{ea}",'e'],["\x{ed}",'i'],["\x{ee}",'i'],["\x{f1}",'n'],
+ ["\x{f3}",'o'],["\x{f5}",'e'],["\x{f6}",'o'],["\x{fa}",'u'],["\x{fb}",'u'],["\x{fc}",'u'],
+ ["\x{fd}",'y'],["\x{2011}",'-'],["\x{105}",'a'],["\x{103}",'a'],["\x{102}",'A'],
+ ["\x{107}",'c'],["\x{10d}",'c'],["\x{10c}",'C'],["\x{11b}",'e'],["\x{119}",'e'],
+ ["\x{142}",'l'],["\x{144}",'n'],["\x{159}",'r'],["\x{158}",'r'],["\x{15b}",'s'],
+ ["\x{219}",'s'],["\x{218}",'S'],["\x{21b}",'t'],["\x{21a}",'T'],["\x{17a}",'z'],
+ ["\x{391}",'A'],["\x{3b1}",'a'],["\x{3ac}",'a'],["\x{392}",'B'],["\x{3b2}",'b'],
+ ["\x{393}",'g'],["\x{3b3}",'g'],["\x{394}",'D'],["\x{3b4}",'d'],["\x{395}",'E'],
+ ["\x{3b5}",'e'],["\x{3ad}",'e'],["\x{396}",'Z'],["\x{3b6}",'z'],["\x{397}",'H'],
+ ["\x{3b7}",'n'],["\x{3ae}",'n'],["\x{399}",'I'],["\x{3b9}",'i'],["\x{3af}",'i'],
+ ["\x{39a}",'K'],["\x{3ba}",'k'],["\x{39b}",'L'],["\x{3bb}",'l'],["\x{39c}",'M'],
+ ["\x{3bc}",'m'],["\x{39d}",'N'],["\x{3bd}",'v'],["\x{39f}",'O'],["\x{3bf}",'o'],
+ ["\x{3cc}",'o'],["\x{3a0}",'P'],["\x{3c0}",'p'],["\x{3a1}",'R'],["\x{3c1}",'r'],
+ ["\x{3a3}",'S'],["\x{3c3}",'s'],["\x{3c2}",'s'],["\x{3a4}",'T'],["\x{3c4}",'t'],
+ ["\x{3a5}",'Y'],["\x{3c5}",'u'],["\x{3cd}",'u'],["\x{3a6}",'F'],["\x{3c6}",'f'],
+ ["\x{3a7}",'X'],["\x{3c7}",'x'],["\x{3a9}",'W'],["\x{3c9}",'w'],["\x{3ce}",'w']
+ );
+
+ my $b = '';
+ foreach my $c(split('',$x)) {
+ foreach my $t(@t) {
+ if ($c eq $t->[0]) {$c=$t->[1]}
+ }
+ $b = $b . $c;
+ }
+ $x = $b;
+
+ $x =~ s/\x{201c}/''/go;
+ $x =~ s/\x{ab}/<</go;
+ $x =~ s/\x{bb}/>>/go;
+ $x =~ s/\x{c5}/AA/go;
+ $x =~ s/\x{c6}/AE/go;
+ $x =~ s/\x{d8}/OE/go;
+ $x =~ s/\x{e5}/aa/go;
+ $x =~ s/\x{e6}/ae/go;
+ $x =~ s/\x{f8}/oe/go;
+ $x =~ s/\x{201e}/,,/go;
+ $x =~ s/\x{17c}/zz/go;
+ $x =~ s/\x{398}/Th/go;
+ $x =~ s/\x{3b8}/th/go;
+ $x =~ s/\x{39e}/Ks/go;
+ $x =~ s/\x{3be}/ks/go;
+ $x =~ s/\x{3a8}/Ps/go;
+ $x =~ s/\x{3c8}/ps/go;
+ return $x;
+}
+
+sub test_accent_filtering {
+ my @strings = @_;
+ my $result = '';
+ foreach my $x(@strings) {
+ chomp $x;
+ my $y = filter_out_accents($x);
+ while ($y=~/(\P{IsASCII})/g) {
+ my $c = $1;
+ if (is_cyrillic($c)) {next}
+ my $describe_c = sprintf("%04x", ord($c));
+ $result = $result . "In the string '$x', the character $1, character code 0x$describe_c, was not properly filtered by UnicodeTools::filter_out_accents().\n";
+ }
+ }
+ return $result;
+}
+
+sub is_cyrillic {
+ # tests a single character
+ my $x = shift;
+ if ($x=~/[АаБбВвГгДдЕеЁёЖжЗзИиЙйКкЛлМмНнОоПпРрСсТтУуФфХхЦцЧчШшЩщЪъЫыЬьЭэЮюЯяієћњјљї]/) {return 1} else {return 0}
+ # list from https://codegolf.stackexchange.com/questions/127677/print-the-russian-cyrillic-alphabet , plus a few more in strings people submitted
+}
+
+sub make_filter_regex {
+ my $filter = filter();
+ my @a = sort keys %$filter;
+
+ my $from = '';
+ my $to = '';
+ my $doubles = '';
+ foreach my $a(@a) {
+ my $b = $filter->{$a};
+ my $hex = sprintf('%x',ord($a));
+ if ($a eq $b) {print "Warning, $a and $b are the same, in make_filter_regex.\n"}
+ if (length($b)==1) {
+ $from = $from . "\\x{$hex}";
+ $to = $to . $b;
+ }
+ else {
+ $doubles = $doubles . " \$x =~ s/\\x{$hex}/$b/go;\n";
+ }
+ }
+ return " \$x =~ tr/$from/$to/;\n # ... everything that translates into a single character\n$doubles";
+}
+
+BEGIN {
+ my $filter;
+ sub filter {
+ return $filter if $filter;
+ my %filter = (
+ $e_acute=>'e',$A_uml=>'A',$a_uml=>'a',$O_uml=>'O',$o_uml=>'o',$U_uml=>'U',$u_uml=>'u',$s_zlig=>'s',$u_circumflex=>'u',
+ $a_polish=>'a',$c_polish=>'c',$e_polish=>'e',$l_polish=>'l',$n_polish=>'n',$o_polish=>'o',$s_polish=>'s',$z_polish=>'z',$zz_polish=>'zz',
+ $a_acute=>'a',$i_acute=>'i',$u_acute=>'u',$U_acute=>'U',$y_acute=>'y',$C_wedge=>'C',$c_wedge=>'c',$e_wedge=>'e',$R_wedge=>'r',$r_wedge=>'r',
+ $a_ring=>'aa',$A_ring=>'AA',$o_slash=>'oe',$O_slash=>'OE',$ae=>'ae',$AE=>'AE',$n_tilde=>'n',
+ # Greek. Note that some letters that look like latin really aren't.
+ 'Α'=>'A','α'=>'a','ά'=>'a','Β'=>'B','β'=>'b','Γ'=>'g','γ'=>'g','Δ'=>'D','δ'=>'d','Ε'=>'E','ε'=>'e','έ'=>'e',
+ 'Ζ'=>'Z','ζ'=>'z',
+ 'Η'=>'H','η'=>'n','ή'=>'n','Θ'=>'Th','θ'=>'th',
+ 'Ι'=>'I','ι'=>'i','ί'=>'i','Κ'=>'K','κ'=>'k','Λ'=>'L','λ'=>'l','Μ'=>'M','μ'=>'m','Ν'=>'N','ν'=>'v',
+ 'Ξ'=>'Ks','ξ'=>'ks','Ο'=>'O','ο'=>'o','ό'=>'o',
+ 'Π'=>'P','π'=>'p','Ρ'=>'R','ρ'=>'r','Σ'=>'S','σ'=>'s','ς'=>'s','Τ'=>'T','τ'=>'t','Υ'=>'Y','υ'=>'u','ύ'=>'u',
+ 'Φ'=>'F','φ'=>'f','Χ'=>'X','χ'=>'x',
+ 'Ψ'=>'Ps','ψ'=>'ps','Ω'=>'W','ω'=>'w','ώ'=>'w',
+ # Romanian
+ $A_breve=>'A',$A_circumflex=>'A',$I_circumflex=>'I',$S_commabelow=>'S',$T_commabelow=>'T',
+ $a_breve=>'a',$a_circumflex=>'a',$i_circumflex=>'i',$s_commabelow=>'s',$t_commabelow=>'t',
+ $nonbreaking_hyphen=>'-',$quot_open=>',,',$quot_close=>"''",$quotalt_open=>'<<',$quotalt_close=>'>>'
+ );
+ $filter = \%filter;
+ return $filter;
+ }
+}
+
+sub file_is_valid_utf8 {
+ my $f = shift;
+ open(F,"<:raw",$f) or return 0;
+ local $/;
+ my $x=<F>;
+ close F;
+ return is_valid_utf8($x);
+}
+
+# What's passed to this routine has to be a stream of bytes, not a utf8 string in which the characters are complete utf8 characters.
+# That's why you typically want to call file_is_valid_utf8 rather than calling this directly.
+sub is_valid_utf8 {
+ my $x = shift;
+ return utf8::decode(my $dummy = $x);
+}
+
+#-----------------------------------------
+# Easter
+#-----------------------------------------
+
+package Easter;
+
+sub easter {
+ my $year = shift;
+ my $sub = $preferences{'orthodox_easter'} ? \&eastern_easter : \&western_easter;
+ return &$sub($year);
+}
+
+# The following code for Easter is based on Rick Measham's DateTime::Event::Easter module,
+# http://search.cpan.org/dist/DateTime-Event-Easter/lib/DateTime/Event/Easter.pm ,
+# which is available under the same license as Perl itself, and therefore compatible with
+# the licensing scheme of When.
+# For testing, see: http://en.wikipedia.org/wiki/Easter#Date_of_Easter
+
+sub western_easter {
+ my $year = shift;
+ my $golden_number = $year % 19;
+ my $quasicentury = int($year / 100);
+ my $epact = ($quasicentury - int($quasicentury/4) - int(($quasicentury * 8 + 13)/25) + ($golden_number*19) + 15) % 30;
+ my $interval = $epact - int($epact/28)*(1 - int(29/($epact+1)) * int((21 - $golden_number)/11) );
+ my $weekday = ($year + int($year/4) + $interval + 2 - $quasicentury + int($quasicentury/4)) % 7;
+ my $offset = $interval - $weekday;
+ my $month = 3 + int(($offset+40)/44);
+ my $day = $offset + 28 - 31* int($month/4);
+ return When->new($year,$month,$day);
+}
+
+# The following algorithm for Eastern Orthodox Easter is from George Vlahavas:
+# If you put this in a
+# spreadsheet cell (gnumeric or openoffice calc will do):
+# =MOD(19*MOD(A1;19)+16;30)+MOD(2*MOD(A1;4)+4*MOD(A1;7)+6*MOD(19*MOD(A1;19)+16;30);7)+3
+# and you put the year in cell A1 you will get a number. If this number
+# is <=30 then that's the April day that Easter is for that year. If the
+# number is >30 then you need to subtract 30 from it and you will find
+# the day in May Easter is.
+
+sub eastern_easter {
+ my $year = shift;
+ my $day=
+ (19*($year%19)+16)%30
+ +(
+ 2*($year%4)
+ +4*($year%7)
+ +6*(
+ (
+ 19*($year%19)+16
+ )%30
+ )
+ )%7
+ +3;
+ my $month;
+ if ($day<=30) {$month=4} else {$month=5; $day=$day-30}
+ return When->new($year,$month,$day);
+}
+
+#-----------------------------------------
+# Terminal
+#-----------------------------------------
+
+package Terminal;
+
+# Normally returns the number of columns on the output tty.
+# Return 0 if output isn't a tty.
+# Returns undef if it's unable to find the width.
+# Tries several methods, in an attempt to work on any platform, while being as
+# efficient as possible in most cases, and avoiding dependencies. This does *not*
+# introduce any dependencies on Term::ReadKey or Term::ReadLine unless you're
+# using a non-POSIX system; those are used only as last-ditch backup methods in
+# case, e.g., we're running Windows.
+sub columns {
+ return (get_data())[1];
+}
+
+sub rows {
+ return (get_data())[0];
+}
+
+BEGIN {
+my ($rows,$columns);
+my $initialized = 0;
+
+sub get_data {
+ initialize_data() unless $initialized;
+ return ($rows,$columns);
+}
+
+sub initialize_data {
+ $initialized = 1;
+ ($rows,$columns) = get_data_for_initialization();
+ $SIG{WINCH} = sub{$initialized=0}; # If the window gets resized, we get this signal.
+}
+
+# Return the number of rows and columns on the terminal.
+sub get_data_for_initialization {
+
+ return (0,0) unless -t STDOUT;
+
+ my ($r, $c, $dummy);
+
+ # The following works on linux, but seems to fail on freebsd.
+ # It works properly if the user resizes the terminal window while the program is running.
+ # No longer works in perl 5.10, so disabled with "0 &&".
+ # http://search.cpan.org/src/RGARCIA/perl-5.10.0/h2pl/README
+ if (0 && eval "require 'sys/ioctl.ph'") {
+ eval {
+ # All of the dies on the next few lines will be caught by the eval{}.
+ die unless defined &TIOCGWINSZ;
+ open(TTY, "+</dev/tty") or die;
+ my $winsize;
+ die unless ioctl(TTY, &TIOCGWINSZ, $winsize='');
+ ($r, $c, $dummy, $dummy) = unpack('S4', $winsize);
+ return ($r,$c);
+ }
+ }
+
+ # A less efficient fallback, should work on anything unixy.
+ chomp(my @lines = `stty -a`);
+ for (@lines) {
+ $r = $1 if /rows (\d+);/; # linux
+ $r = $1 if /(\d+) rows;/; # FreeBSD
+ $c = $1 if /columns (\d+);/; # linux
+ $c = $1 if /(\d+) columns;/; # FreeBSD
+ }
+ return ($r,$c) if ((defined $c) && (defined $r));
+
+ # The following two methods give us a fighting chance on a non-POSIX system. I don't use them as the defaults
+ # because I don't want to introduce dependencies.
+
+ # http://search.cpan.org/~kjalb/TermReadKey/ReadKey.pm
+ # Term::ReadKey is not a standard Perl module, and may not be installed. If the user resizes the terminal
+ # while the program is running, this will correctly reflect the resizing.
+ eval 'use Term::ReadKey; ($c, $r, $dummy, $dummy) = GetTerminalSize();';
+ return ($r,$c) if ((defined $c) && (defined $r));
+
+ # http://search.cpan.org/~nwclark/perl-5.8.8/lib/Term/ReadLine.pm
+ # Term::ReadLine is a standard Perl module, but exists in different implementations under the hood. On a Linux
+ # system, it's implemented using Term::ReadLine::Gnu, which supports get_screen_size(). On a default FreeBSD system,
+ # however, the following won't work; you'd have to install the p5-ReadLine-Gnu package to get support for this function.
+ eval 'use Term::ReadLine; $term = new Term::ReadLine("foo"); ($r,$c)= Term::ReadLine::get_screen_size();';
+ return ($r,$c) if ((defined $c) && (defined $r));
+
+ return undef;
+}
+}
generated by cgit v1.2.3 (git 2.25.1) at 2026-09-08 09:29:08 +0000