diff --git a/CHANGELOG.md b/CHANGELOG.md index 540e2c6..564247f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,31 @@ All notable changes to PaperRoute Tracker will be documented here. +## [Unreleased] — v0.8 Insights & Reports + +v0.8.0-rc.1 is available on the Preview channel. Development is tracked in [PR #80](https://github.com/JUhalt/PaperRoute-Tracker/pull/80) and the [v0.8 milestone](https://github.com/JUhalt/PaperRoute-Tracker/milestone/10); certification in [#85](https://github.com/JUhalt/PaperRoute-Tracker/issues/85). + +### Added + +- An **Insights** page (Ctrl+5) with route statistics from your own records ([#30](https://github.com/JUhalt/PaperRoute-Tracker/issues/30)): median time to a first decision and from first submission to acceptance, each with its sample size, and **Your Routes**: journals, revision rounds, and days to acceptance and publication for every submitted manuscript. Missing dates are left out, never estimated. +- **Your Journals** ([#62](https://github.com/JUhalt/PaperRoute-Tracker/issues/62)): submissions, outcomes, and median days to a first decision and in review for each journal you have used, grouped by Journal Library record or exact name, never by guess. The Journals page shows the same history for the selected journal. +- **Pipeline Report...** and **Route Report...** ([#63](https://github.com/JUhalt/PaperRoute-Tracker/issues/63), [#30](https://github.com/JUhalt/PaperRoute-Tracker/issues/30)): self-contained web pages to print or save as PDF, previewed before saving. They never include notes, correspondence, reviewer comments, file paths, or contact details. + +- **Route maps** ([#82](https://github.com/JUhalt/PaperRoute-Tracker/issues/82)): a manuscript's Route opens on its whole route drawn to scale, each stretch colored by who held it (the journal, you, or production), journals named above, and every event numbered and explained ("after 48 days of rerouting"). Insights gains **Route Map**, every published route lined up at day 0 with the median time to publication and the share spent waiting on journals versus revising; work not yet published can be included, drawn to today. Time the record does not assign is hatched as not recorded, never estimated. +- **Work types and tags** ([#64](https://github.com/JUhalt/PaperRoute-Tracker/issues/64)): a type (journal article, preprint, conference paper or abstract, poster, book chapter, thesis, other) and your own colored tags on each manuscript's Overview. Tags show on board cards and in the Library, and both are searchable. Imports set the type when the source states it; nothing is inferred. CV export can group by type, and the Excel workbook keeps both. + +### Changed + +- Import & Export moves to **Ctrl+6**; Insights takes Ctrl+5. + +### Fixed + +- A second launch of PaperRoute brings the open window forward instead of opening another window on the same library, where a save in one could overwrite the other ([#77](https://github.com/JUhalt/PaperRoute-Tracker/issues/77)). + +### Storage + +- **Schema 8** adds work types, tags, and tag colors. As with Schema 7, the upgrade validates the library and changes only the schema marker; records start with no type and no tags. + ## [0.7.0] - 2026-09-28 PaperRoute v0.7.0 — **Deadline Center** — was released on September 28, 2026 from [PR #78](https://github.com/JUhalt/PaperRoute-Tracker/pull/78), after the v0.7.0-rc.1 Preview. Certification is recorded in [#79](https://github.com/JUhalt/PaperRoute-Tracker/issues/79). v0.7 upgrades the library to Schema 7. diff --git a/ManualCertification/V04Demo/BoardDemo.cs b/ManualCertification/V04Demo/BoardDemo.cs index ca11843..07d7d56 100644 --- a/ManualCertification/V04Demo/BoardDemo.cs +++ b/ManualCertification/V04Demo/BoardDemo.cs @@ -159,6 +159,15 @@ internal static void CreateSamples(string sessionRoot, bool empty = false) draft.Versions.Add(draftVersion); draft.SubmissionPackets.Add(new SubmissionPacket { ReadinessProfileId = readiness.Id, JournalName = readiness.JournalName, Label = "Initial submission", ManuscriptVersionId = draftVersion.Id }); manuscripts[0].Reminders.Add(new ManuscriptReminder { Title = "Outline the introduction", DueDate = today.AddDays(12) }); + // Types and tags (#64) on a few cards. + manuscripts[0].Tags.Add("grant"); + manuscripts[3].WorkType = WorkType.JournalArticle; + manuscripts[3].Tags.AddRange(new[] { "preregistered", "lab project" }); + manuscripts[4].WorkType = WorkType.JournalArticle; + manuscripts[4].Tags.AddRange(new[] { "teaching", "mixed methods", "nursing" }); + manuscripts[5].WorkType = WorkType.JournalArticle; + manuscripts[6].WorkType = WorkType.JournalArticle; + manuscripts[8].WorkType = WorkType.ConferencePaper; var library = new AuthorLibraryData(); library.Journals.Add(openPsychology); diff --git a/ManualCertification/V04Demo/Program.cs b/ManualCertification/V04Demo/Program.cs index 7d08f44..ca97d12 100644 --- a/ManualCertification/V04Demo/Program.cs +++ b/ManualCertification/V04Demo/Program.cs @@ -8,7 +8,7 @@ namespace PaperRoute.V04Demo; internal static class Program { private const string Usage = "PaperRoute workflow manual demo\n\n" + - "Surfaces: vault (default), readiness, packet, packet-new, file, file-new, notes, submission, responses, workflow, board, publications, fill\n" + + "Surfaces: vault (default), readiness, packet, packet-new, file, file-new, notes, submission, responses, workflow, board, publications, fill, about, route\n" + "Options: --minimum, --primary, --empty (vault/readiness/board), --integrity (populated vault only), --dark or --system, --help\n\n" + "Default surfaces discard manuscript changes when the window closes.\n" + "workflow and board save only in a new disposable temporary session.\n" + @@ -27,7 +27,7 @@ private static void Main(string[] args) return; } - var surfaces = new[] { "vault", "readiness", "packet", "packet-new", "file", "file-new", "notes", "submission", "responses", "workflow", "board", "publications", "fill", "about" }; + var surfaces = new[] { "vault", "readiness", "packet", "packet-new", "file", "file-new", "notes", "submission", "responses", "workflow", "board", "publications", "fill", "about", "route" }; var positional = args.Where(argument => !argument.StartsWith("--")).ToArray(); var surface = positional.FirstOrDefault()?.ToLowerInvariant() ?? "vault"; var minimum = args.Contains("--minimum", StringComparer.OrdinalIgnoreCase); @@ -86,6 +86,15 @@ private static void Main(string[] args) return; } + if (surface == "route") + { + using var route = RouteMapDemo.Create(); + route.Text += " [DEMO - fictional route; nothing saved]"; + ConfigureDisplayEvidence(route, primary); + route.ShowDialog(); + return; + } + if (surface == "publications" || surface == "fill") { using var check = PublicationDemo.Create(surface); diff --git a/ManualCertification/V04Demo/RouteMapDemo.cs b/ManualCertification/V04Demo/RouteMapDemo.cs new file mode 100644 index 0000000..c198ca4 --- /dev/null +++ b/ManualCertification/V04Demo/RouteMapDemo.cs @@ -0,0 +1,40 @@ +using ManuscriptPipeline.Forms; +using ManuscriptPipeline.Models; + +namespace PaperRoute.V04Demo; + +// One route drawn to scale (#82) on a fictional manuscript: a desk +// rejection, rerouting, two revision rounds with recorded returns to +// review, acceptance, and publication. Nothing is saved. +internal static class RouteMapDemo +{ + internal static Form Create() + { + var manuscript = new Manuscript + { + Title = "DEMO A preregistered replication of anchoring effects in clinical risk estimates", + CurrentStage = PaperStage.Published, + Location = ManuscriptLocation.Published, + TargetJournal = "Fictional Open Psychology" + }; + manuscript.Submissions.Add(Submission("Fictional Psychological Letters", new DateTime(2026, 1, 5), + (EditorialDecision.DeskRejected, new DateTime(2026, 1, 12)))); + manuscript.Submissions.Add(Submission("Fictional Open Psychology", new DateTime(2026, 3, 1), + (EditorialDecision.MajorRevision, new DateTime(2026, 4, 2)), + (EditorialDecision.MinorRevision, new DateTime(2026, 7, 22)), + (EditorialDecision.Accepted, new DateTime(2026, 8, 29)))); + manuscript.History.Add(new HistoryEvent { Stage = PaperStage.UnderReview, EventDate = new DateTime(2026, 6, 10), Note = "Resubmitted after major revision" }); + manuscript.History.Add(new HistoryEvent { Stage = PaperStage.UnderReview, EventDate = new DateTime(2026, 8, 5), Note = "Resubmitted after minor revision" }); + manuscript.Metadata.PublishedDate = new DateTime(2026, 9, 26); + manuscript.Metadata.PublicationJournal = "Fictional Open Psychology"; + return new ManuscriptRouteViewForm(manuscript); + } + + private static JournalSubmission Submission(string journal, DateTime submitted, params (EditorialDecision Decision, DateTime Date)[] decisions) + { + var submission = new JournalSubmission { JournalName = journal, SubmittedDate = submitted }; + foreach (var decision in decisions) + submission.Decisions.Add(new EditorialDecisionEvent { Decision = decision.Decision, DecisionDate = decision.Date }); + return submission; + } +} diff --git a/ManuscriptPipeline/Controls/RailItems.vb b/ManuscriptPipeline/Controls/RailItems.vb index 7e25b2b..6a6b6cb 100644 --- a/ManuscriptPipeline/Controls/RailItems.vb +++ b/ManuscriptPipeline/Controls/RailItems.vb @@ -21,6 +21,7 @@ Namespace Controls FollowUp Checklist Publication + Insights End Enum ' Paints one left-rail item: an icon, its label, and an optional count. @@ -162,6 +163,12 @@ Namespace Controls Case RailGlyph.Checklist g.DrawRectangle(pen, Rectangle.Round(r(3, 3, 10, 10))) g.DrawLines(pen, {p(5.5F, 8.2F), p(7.3F, 10), p(10.7F, 6)}) + Case RailGlyph.Insights + ' Three bars on a baseline. + g.DrawLine(pen, p(2, 13.5F), p(14, 13.5F)) + g.DrawRectangle(pen, Rectangle.Round(r(3.5F, 8, 2, 5))) + g.DrawRectangle(pen, Rectangle.Round(r(7, 3, 2, 10))) + g.DrawRectangle(pen, Rectangle.Round(r(10.5F, 6, 2, 7))) Case RailGlyph.Publication ' An open book. g.DrawLines(pen, {p(8, 4.5F), p(3, 3.5F), p(3, 12), p(8, 13)}) diff --git a/ManuscriptPipeline/Controls/RouteMapControls.vb b/ManuscriptPipeline/Controls/RouteMapControls.vb new file mode 100644 index 0000000..64cd7cb --- /dev/null +++ b/ManuscriptPipeline/Controls/RouteMapControls.vb @@ -0,0 +1,656 @@ +Imports System +Imports System.Collections.Generic +Imports System.ComponentModel +Imports System.Drawing +Imports System.Drawing.Drawing2D +Imports System.Globalization +Imports System.Linq +Imports System.Windows.Forms +Imports ManuscriptPipeline.Models +Imports ManuscriptPipeline.Services + +Namespace Controls + + ' Colors and wording shared by the route map views (#82). The three + ' kinds differ in lightness as well as hue, and white text on each fill + ' meets 4.5:1. + Friend NotInheritable Class RouteMapStyle + + Private Sub New() + End Sub + + Public Shared Function Fill(kind As RouteSegmentKind) As Color + Select Case kind + Case RouteSegmentKind.Journal : Return Color.FromArgb(15, 118, 110) + Case RouteSegmentKind.Author : Return Color.FromArgb(180, 83, 9) + Case RouteSegmentKind.Production : Return If(UiTheme.IsDark(), Color.FromArgb(100, 116, 139), Color.FromArgb(71, 85, 105)) + Case Else : Return If(UiTheme.IsDark(), Color.FromArgb(92, 112, 118), Color.FromArgb(160, 176, 181)) + End Select + End Function + + Public Shared Sub FillSegment(g As Graphics, bounds As RectangleF, kind As RouteSegmentKind, background As Color) + If kind = RouteSegmentKind.NotRecorded Then + Using hatch As New HatchBrush(HatchStyle.WideUpwardDiagonal, Fill(kind), background), edge As New Pen(Fill(kind)) + g.FillRectangle(hatch, bounds) + g.DrawRectangle(edge, bounds.X, bounds.Y, Math.Max(0, bounds.Width - 1), Math.Max(0, bounds.Height - 1)) + End Using + Else + Using brush As New SolidBrush(Fill(kind)) + g.FillRectangle(brush, bounds) + End Using + End If + End Sub + + Public Shared Function MarkerColor(marker As RouteMarker) As Color + Select Case marker.Kind + Case RouteMarkerKind.Published : Return Color.FromArgb(15, 118, 110) + Case RouteMarkerKind.Decision + Select Case RouteAnalyticsService.OutcomeOf(marker.Decision) + Case SubmissionOutcome.Accepted : Return Color.FromArgb(21, 128, 61) + Case SubmissionOutcome.Open : Return Color.FromArgb(180, 83, 9) + Case SubmissionOutcome.Withdrawn : Return Color.FromArgb(71, 85, 105) + Case Else : Return Color.FromArgb(185, 28, 28) + End Select + Case Else : Return Color.FromArgb(29, 78, 216) + End Select + End Function + + ' "105 days with the journals", one per kind on the route. + Public Shared Function DayTotals(map As RouteMap) As List(Of (Kind As RouteSegmentKind, Text As String)) + Dim result As New List(Of (Kind As RouteSegmentKind, Text As String))() + For Each kind As RouteSegmentKind In [Enum].GetValues(GetType(RouteSegmentKind)) + Dim days As Integer = map.DaysOf(kind) + If days > 0 Then result.Add((kind, days.ToString(CultureInfo.CurrentCulture) & If(days = 1, " day ", " days ") & + If(kind = RouteSegmentKind.Journal AndAlso map.Journals.Count > 1, "with the journals", RouteMapService.KindName(kind)))) + Next + Return result + End Function + + Public Shared Function Summary(map As RouteMap) As String + If map.IsEmpty Then Return "No submissions are recorded yet, so there is no route to draw." + Dim ending As String = If(map.Ongoing, "today", If(map.Markers.Any(Function(item) item.Kind = RouteMarkerKind.Published), "publication", "the last decision")) + Return map.TotalDays.ToString(CultureInfo.CurrentCulture) & " days from first submission to " & ending & ": " & + String.Join(", ", DayTotals(map).Select(Function(item) item.Text)) & "." + End Function + + Public Shared Function ShortDate(value As DateTime) As String + Return value.ToString("MMM d", CultureInfo.CurrentCulture) + End Function + + End Class + + + ' Color swatches with their meaning, wrapping to the width it is given. + Friend Class RouteMapLegend + Inherits Control + + Private _items As New List(Of (Kind As RouteSegmentKind, Text As String))() + + Public Sub New() + SetStyle(ControlStyles.UserPaint Or ControlStyles.AllPaintingInWmPaint Or ControlStyles.OptimizedDoubleBuffer Or ControlStyles.ResizeRedraw, True) + AccessibleRole = AccessibleRole.StaticText + End Sub + + + Public Property Items As List(Of (Kind As RouteSegmentKind, Text As String)) + Get + Return _items + End Get + Set(value As List(Of (Kind As RouteSegmentKind, Text As String))) + _items = If(value, New List(Of (Kind As RouteSegmentKind, Text As String))()) + AccessibleName = String.Join(", ", _items.Select(Function(item) item.Text)) + FitHeight() + Invalidate() + End Set + End Property + + Private Function Place() As List(Of Rectangle) + Dim unit As Integer = UiTheme.Px(1, DeviceDpi) + Dim line As Integer = TextRenderer.MeasureText("Ag", Font).Height + Dim result As New List(Of Rectangle)() + Dim x As Integer = 0 + Dim y As Integer = 0 + For Each item In _items + Dim width As Integer = 18 * unit + TextRenderer.MeasureText(item.Text, Font, Size.Empty, TextFormatFlags.NoPrefix Or TextFormatFlags.NoPadding).Width + If x > 0 AndAlso x + width > Me.Width Then + x = 0 + y += line + 4 * unit + End If + result.Add(New Rectangle(x, y, width, line)) + x += width + 20 * unit + Next + Return result + End Function + + Private Sub FitHeight() + Dim places As List(Of Rectangle) = Place() + Dim wanted As Integer = If(places.Count = 0, 0, places.Max(Function(item) item.Bottom)) + If Height <> wanted Then Height = wanted + End Sub + + Protected Overrides Sub OnResize(e As EventArgs) + MyBase.OnResize(e) + FitHeight() + End Sub + + Protected Overrides Sub OnFontChanged(e As EventArgs) + MyBase.OnFontChanged(e) + FitHeight() + End Sub + + Protected Overrides Sub OnPaint(e As PaintEventArgs) + e.Graphics.Clear(BackColor) + Dim unit As Integer = UiTheme.Px(1, DeviceDpi) + Dim places As List(Of Rectangle) = Place() + For index As Integer = 0 To _items.Count - 1 + Dim place As Rectangle = places(index) + Dim swatch As Integer = 12 * unit + RouteMapStyle.FillSegment(e.Graphics, New RectangleF(place.X, place.Y + (place.Height - swatch) \ 2, swatch, swatch), _items(index).Kind, BackColor) + TextRenderer.DrawText(e.Graphics, _items(index).Text, Font, New Point(place.X + 18 * unit, place.Y), UiTheme.PrimaryText(), TextFormatFlags.NoPrefix Or TextFormatFlags.NoPadding) + Next + End Sub + + End Class + + + ' One manuscript's route drawn to scale (#82): journals above, the + ' colored route with numbered events on it, months below, and the + ' numbered key underneath. Its height follows its width. + Friend Class RouteMapBar + Inherits Control + + Private _map As New RouteMap() + Private _steps As New List(Of RouteStep)() + + Public Sub New() + SetStyle(ControlStyles.UserPaint Or ControlStyles.AllPaintingInWmPaint Or ControlStyles.OptimizedDoubleBuffer Or ControlStyles.ResizeRedraw, True) + AccessibleRole = AccessibleRole.Graphic + End Sub + + + Public Property Map As RouteMap + Get + Return _map + End Get + Set(value As RouteMap) + _map = If(value, New RouteMap()) + _steps = RouteMapService.Steps(_map) + AccessibleName = "Route drawn to scale. " & RouteMapStyle.Summary(_map) + AccessibleDescription = String.Join(". ", _steps.Select(Function(item) item.Number.ToString(CultureInfo.CurrentCulture) & ": " & item.Title & ", " & + RouteMapStyle.ShortDate(item.Marker.MarkerDate) & ", " & item.Note)) + FitHeight() + Invalidate() + End Set + End Property + + Public ReadOnly Property Steps As List(Of RouteStep) + Get + Return _steps + End Get + End Property + + ' Where each part sits, for painting and for the height. + Private Structure Frame + Public Line As Integer + Public Bar As Rectangle + Public AxisTop As Integer + Public KeyTop As Integer + Public KeyColumns As Integer + Public KeyRow As Integer + Public NoteTop As Integer + Public NoteHeight As Integer + Public Bottom As Integer + End Structure + + Private Function Measure(width As Integer) As Frame + Dim unit As Integer = UiTheme.Px(1, DeviceDpi) + Dim frame As New Frame With {.Line = TextRenderer.MeasureText("Ag", Font).Height} + If _map.IsEmpty Then + frame.Bottom = frame.Line * 2 + Return frame + End If + Dim inset As Integer = 10 * unit + frame.Bar = New Rectangle(inset, frame.Line + 16 * unit, Math.Max(20, width - inset * 2), 30 * unit) + frame.AxisTop = frame.Bar.Bottom + 8 * unit + frame.KeyTop = frame.AxisTop + frame.Line + 16 * unit + frame.KeyColumns = If(width >= 620 * unit, 2, 1) + frame.KeyRow = frame.Line + 8 * unit + Dim keyRows As Integer = CInt(Math.Ceiling(_steps.Count / CDbl(frame.KeyColumns))) + frame.NoteTop = frame.KeyTop + keyRows * frame.KeyRow + 4 * unit + If _map.Segments.Any(Function(item) item.Kind = RouteSegmentKind.NotRecorded) Then + frame.NoteHeight = TextRenderer.MeasureText(HatchNote, Font, New Size(Math.Max(20, width), 0), TextFormatFlags.WordBreak Or TextFormatFlags.NoPrefix).Height + End If + frame.Bottom = frame.NoteTop + frame.NoteHeight + Return frame + End Function + + Private Const HatchNote As String = + "A hatched stretch is time the record does not assign, such as a revision whose resubmission date was never entered. It is shown as not recorded, never estimated." + + Private Sub FitHeight() + Dim wanted As Integer = Measure(Width).Bottom + If Height <> wanted Then Height = wanted + End Sub + + Protected Overrides Sub OnResize(e As EventArgs) + MyBase.OnResize(e) + FitHeight() + End Sub + + Protected Overrides Sub OnFontChanged(e As EventArgs) + MyBase.OnFontChanged(e) + FitHeight() + End Sub + + Private Function X(day As DateTime, bar As Rectangle) As Single + Dim total As Double = Math.Max(1, _map.TotalDays) + Return CSng(bar.Left + bar.Width * (day.Date - _map.Start.Date).TotalDays / total) + End Function + + Protected Overrides Sub OnPaint(e As PaintEventArgs) + + Dim g As Graphics = e.Graphics + g.Clear(BackColor) + Dim frame As Frame = Measure(Width) + If _map.IsEmpty Then + TextRenderer.DrawText(g, RouteMapStyle.Summary(_map), Font, ClientRectangle, UiTheme.SecondaryText(), TextFormatFlags.VerticalCenter Or TextFormatFlags.Left Or TextFormatFlags.WordBreak) + Return + End If + + Dim unit As Integer = UiTheme.Px(1, DeviceDpi) + Dim bar As Rectangle = frame.Bar + Dim flags As TextFormatFlags = TextFormatFlags.NoPrefix Or TextFormatFlags.SingleLine Or TextFormatFlags.NoPadding + + ' Who held the route: each journal over its stretch, then the publisher. + Using bold As New Font(Font, FontStyle.Bold) + Dim holders As New List(Of (Name As String, Left As Single, Right As Single))() + For Each journal As String In _map.Journals + Dim spans As List(Of RouteSegment) = _map.Segments.Where(Function(item) item.JournalName = journal).ToList() + holders.Add((journal, X(spans.First().Start, bar), X(spans.Last().Finish, bar))) + Next + Dim production As List(Of RouteSegment) = _map.Segments.Where(Function(item) item.Kind = RouteSegmentKind.Production).ToList() + If production.Count > 0 Then holders.Add(("Publisher", X(production.First().Start, bar), X(production.Last().Finish, bar))) + + Dim lastRight As Single = -1 + For index As Integer = 0 To holders.Count - 1 + Dim holder = holders(index) + Dim left As Single = Math.Max(holder.Left, lastRight + 10 * unit) + Dim limit As Single = If(index < holders.Count - 1, Math.Max(holder.Right, holders(index + 1).Left) - 6 * unit, Width) + Dim room As Integer = CInt(Math.Max(0, Math.Min(limit, Width) - left)) + If room < 24 * unit Then Continue For + Dim text As New Rectangle(CInt(left), 0, room, frame.Line) + TextRenderer.DrawText(g, holder.Name, bold, text, UiTheme.PrimaryText(), flags Or TextFormatFlags.EndEllipsis) + Using tick As New Pen(UiTheme.CardBorder(), unit) + g.DrawLine(tick, holder.Left, frame.Line + 3 * unit, Math.Max(holder.Left + 1, holder.Right - 2 * unit), frame.Line + 3 * unit) + End Using + lastRight = left + Math.Min(room, TextRenderer.MeasureText(holder.Name, bold, Size.Empty, flags).Width) + Next + End Using + + ' The route. + For Each segment As RouteSegment In _map.Segments + Dim left As Single = X(segment.Start, bar) + Dim right As Single = X(segment.Finish, bar) + Dim bounds As New RectangleF(left, bar.Top, Math.Max(1, right - left - unit), bar.Height) + RouteMapStyle.FillSegment(g, bounds, segment.Kind, BackColor) + If segment.Kind <> RouteSegmentKind.NotRecorded Then + Dim label As String = segment.Days.ToString(CultureInfo.CurrentCulture) & If(segment.Days = 1, " day", " days") + If TextRenderer.MeasureText(label, Font).Width + 6 * unit > bounds.Width Then label = segment.Days.ToString(CultureInfo.CurrentCulture) & "d" + If TextRenderer.MeasureText(label, Font).Width + 2 * unit <= bounds.Width Then + TextRenderer.DrawText(g, label, Font, Rectangle.Round(bounds), Color.White, + TextFormatFlags.HorizontalCenter Or TextFormatFlags.VerticalCenter Or flags) + End If + End If + If segment.Ongoing Then + Using pen As New Pen(RouteMapStyle.Fill(segment.Kind), 3 * unit) With {.DashStyle = DashStyle.Dot} + Dim middle As Single = bar.Top + bar.Height / 2.0F + g.DrawLine(pen, Math.Min(bounds.Right + 3 * unit, Width - 16 * unit), middle, Math.Min(bounds.Right + 16 * unit, Width - 2 * unit), middle) + End Using + End If + Next + + ' Numbered events on the route's top edge. + g.SmoothingMode = SmoothingMode.AntiAlias + Dim diameter As Integer = 20 * unit + Using small As New Font(Font.FontFamily, Math.Max(7.0F, Font.SizeInPoints - 1.5F), FontStyle.Bold) + For Each item As RouteStep In _steps + Dim center As Single = Math.Min(Math.Max(X(item.Marker.MarkerDate, bar), bar.Left), bar.Right) + Dim circle As New RectangleF(center - diameter / 2.0F, bar.Top - diameter / 2.0F, diameter, diameter) + DrawNumber(g, circle, item, small, unit) + Next + + ' Months along the bottom, or years on a long route. + g.SmoothingMode = SmoothingMode.None + Using border As New Pen(UiTheme.CardBorder(), unit) + g.DrawLine(border, bar.Left, frame.AxisTop - 3 * unit, bar.Right, frame.AxisTop - 3 * unit) + End Using + Dim yearly As Boolean = _map.TotalDays > 730 + Dim tick As New DateTime(_map.Start.Year, If(yearly, 1, _map.Start.Month), 1) + Dim lastLabel As Single = -1000 + Dim first As Boolean = True + While tick <= _map.Finish + If tick >= _map.Start.Date.AddDays(-3) OrElse first Then + Dim position As Single = X(If(tick < _map.Start, _map.Start, tick), bar) + Dim text As String = If(yearly, tick.ToString("yyyy", CultureInfo.CurrentCulture), + If(first OrElse tick.Month = 1, tick.ToString("MMM yyyy", CultureInfo.CurrentCulture), tick.ToString("MMM", CultureInfo.CurrentCulture))) + Dim width As Integer = TextRenderer.MeasureText(text, Font, Size.Empty, flags).Width + position = Math.Max(bar.Left, position) + If position >= lastLabel + 8 * unit AndAlso position + width <= Me.Width Then + Using mark As New Pen(UiTheme.CardBorder(), unit) + g.DrawLine(mark, position, frame.AxisTop - 6 * unit, position, frame.AxisTop - 3 * unit) + End Using + TextRenderer.DrawText(g, text, Font, New Point(CInt(position), frame.AxisTop), UiTheme.SecondaryText(), flags) + lastLabel = position + width + first = False + End If + End If + tick = If(yearly, tick.AddYears(1), tick.AddMonths(1)) + End While + + ' The key. + g.SmoothingMode = SmoothingMode.AntiAlias + Dim columnWidth As Integer = Width \ frame.KeyColumns + Dim rows As Integer = Math.Max(1, CInt(Math.Ceiling(_steps.Count / CDbl(frame.KeyColumns)))) + Using bold As New Font(Font, FontStyle.Bold) + For index As Integer = 0 To _steps.Count - 1 + Dim item As RouteStep = _steps(index) + Dim left As Integer = (index \ rows) * columnWidth + Dim top As Integer = frame.KeyTop + (index Mod rows) * frame.KeyRow + Dim keyDiameter As Integer = 18 * unit + DrawNumber(g, New RectangleF(left, top + (frame.Line - keyDiameter) / 2.0F, keyDiameter, keyDiameter), item, small, unit) + Dim textLeft As Integer = left + keyDiameter + 8 * unit + Dim title As String = item.Title & ", " & RouteMapStyle.ShortDate(item.Marker.MarkerDate) + Dim room As Integer = Math.Max(0, left + columnWidth - 12 * unit - textLeft) + Dim titleWidth As Integer = Math.Min(room, TextRenderer.MeasureText(title, bold, Size.Empty, flags).Width) + TextRenderer.DrawText(g, title, bold, New Rectangle(textLeft, top, titleWidth, frame.Line), UiTheme.PrimaryText(), flags Or TextFormatFlags.EndEllipsis) + Dim noteLeft As Integer = textLeft + titleWidth + 8 * unit + If noteLeft < left + columnWidth - 40 * unit Then + TextRenderer.DrawText(g, item.Note, Font, New Rectangle(noteLeft, top, left + columnWidth - 12 * unit - noteLeft, frame.Line), UiTheme.SecondaryText(), flags Or TextFormatFlags.EndEllipsis) + End If + Next + End Using + End Using + + If frame.NoteHeight > 0 Then + TextRenderer.DrawText(g, HatchNote, Font, New Rectangle(0, frame.NoteTop, Width, frame.NoteHeight), UiTheme.SecondaryText(), TextFormatFlags.WordBreak Or TextFormatFlags.NoPrefix) + End If + + End Sub + + Private Sub DrawNumber(g As Graphics, circle As RectangleF, item As RouteStep, numberFont As Font, unit As Integer) + Using fill As New SolidBrush(RouteMapStyle.MarkerColor(item.Marker)), ring As New Pen(BackColor, 2 * unit) + g.FillEllipse(fill, circle) + g.DrawEllipse(ring, circle) + End Using + TextRenderer.DrawText(g, item.Number.ToString(CultureInfo.CurrentCulture), numberFont, Rectangle.Round(circle), Color.White, + TextFormatFlags.HorizontalCenter Or TextFormatFlags.VerticalCenter Or TextFormatFlags.NoPadding Or TextFormatFlags.NoPrefix) + End Sub + + End Class + + + ' Every route side by side from day 0 on one scale (#82). Up and Down + ' choose a route; Enter or a click opens it. + Friend Class RouteMapChart + Inherits Control + + Private _routes As New List(Of RouteMapEntry)() + Private _selected As Integer = -1 + Private _hot As Integer = -1 + + Public Event RouteOpened As EventHandler(Of RouteMapEntry) + + Public Sub New() + SetStyle(ControlStyles.UserPaint Or ControlStyles.AllPaintingInWmPaint Or ControlStyles.OptimizedDoubleBuffer Or ControlStyles.ResizeRedraw Or ControlStyles.Selectable, True) + TabStop = True + AccessibleRole = AccessibleRole.List + End Sub + + + Public Property Routes As List(Of RouteMapEntry) + Get + Return _routes + End Get + Set(value As List(Of RouteMapEntry)) + _routes = If(value, New List(Of RouteMapEntry)()) + _selected = If(_routes.Count > 0, 0, -1) + AccessibleName = "Routes side by side, " & _routes.Count.ToString(CultureInfo.CurrentCulture) & If(_routes.Count = 1, " route", " routes") & ". Press Enter to open the selected route." + DescribeSelection() + FitHeight() + Invalidate() + End Set + End Property + + + Public Property SelectedIndex As Integer + Get + Return _selected + End Get + Set(value As Integer) + _selected = Math.Max(-1, Math.Min(_routes.Count - 1, value)) + DescribeSelection() + Invalidate() + End Set + End Property + + Private ReadOnly Property Line As Integer + Get + Return TextRenderer.MeasureText("Ag", Font).Height + End Get + End Property + + Private ReadOnly Property RowHeight As Integer + Get + Return Line * 2 + UiTheme.Px(14, DeviceDpi) + End Get + End Property + + Private ReadOnly Property HeaderHeight As Integer + Get + Return Line + UiTheme.Px(10, DeviceDpi) + End Get + End Property + + Private Sub FitHeight() + Dim wanted As Integer = HeaderHeight + Math.Max(1, _routes.Count) * RowHeight + UiTheme.Px(4, DeviceDpi) + If Height <> wanted Then Height = wanted + End Sub + + Protected Overrides Sub OnFontChanged(e As EventArgs) + MyBase.OnFontChanged(e) + FitHeight() + End Sub + + Protected Overrides Sub OnDpiChangedAfterParent(e As EventArgs) + MyBase.OnDpiChangedAfterParent(e) + FitHeight() + End Sub + + Private Function Columns() As (TitleWidth As Integer, Bar As Rectangle, TotalWidth As Integer) + Dim dpi As Integer = DeviceDpi + Dim titleWidth As Integer = Math.Min(UiTheme.Px(300, dpi), Width \ 3) + Dim totalWidth As Integer + Using bold As New Font(Font, FontStyle.Bold) + totalWidth = TextRenderer.MeasureText("0000+", bold).Width + UiTheme.Px(8, dpi) + End Using + Dim left As Integer = titleWidth + UiTheme.Px(16, dpi) + Return (titleWidth, New Rectangle(left, HeaderHeight, Math.Max(10, Width - left - totalWidth - UiTheme.Px(24, dpi)), 0), totalWidth) + End Function + + ' Days on the shared scale, rounded up to whole steps. + Private Function ScaleDays() As Integer + Dim longest As Integer = If(_routes.Count = 0, 0, _routes.Max(Function(item) item.Map.TotalDays)) + Dim stepDays As Integer = StepFor(longest) + Return Math.Max(stepDays, CInt(Math.Ceiling(longest / CDbl(stepDays))) * stepDays) + End Function + + Private Shared Function StepFor(days As Integer) As Integer + Return If(days > 1440, 360, If(days > 720, 180, If(days > 360, 120, 60))) + End Function + + Protected Overrides Sub OnPaint(e As PaintEventArgs) + + Dim g As Graphics = e.Graphics + g.Clear(BackColor) + Dim dpi As Integer = DeviceDpi + Dim unit As Integer = UiTheme.Px(1, dpi) + Dim flags As TextFormatFlags = TextFormatFlags.NoPrefix Or TextFormatFlags.SingleLine Or TextFormatFlags.NoPadding + + If _routes.Count = 0 Then + TextRenderer.DrawText(g, "No routes to draw yet.", Font, New Rectangle(0, HeaderHeight, Width, RowHeight), UiTheme.SecondaryText(), + TextFormatFlags.Left Or TextFormatFlags.VerticalCenter Or TextFormatFlags.NoPrefix) + Return + End If + + Dim layout = Columns() + Dim scale As Integer = ScaleDays() + Dim stepDays As Integer = StepFor(scale - 1) + Dim bodyBottom As Integer = HeaderHeight + _routes.Count * RowHeight + + Using bold As New Font(Font, FontStyle.Bold) + + TextRenderer.DrawText(g, "Manuscript", bold, New Point(UiTheme.Px(8, dpi), 0), UiTheme.SecondaryText(), flags) + TextRenderer.DrawText(g, "Days", bold, New Rectangle(Width - layout.TotalWidth - UiTheme.Px(8, dpi), 0, layout.TotalWidth, Line), UiTheme.SecondaryText(), flags Or TextFormatFlags.Right) + + ' The shared day scale. + For day As Integer = 0 To scale Step stepDays + Dim x As Integer = layout.Bar.Left + CInt(layout.Bar.Width * day / CDbl(scale)) + Dim text As String = day.ToString(CultureInfo.CurrentCulture) + Dim textWidth As Integer = TextRenderer.MeasureText(text, Font, Size.Empty, flags).Width + TextRenderer.DrawText(g, text, Font, New Point(Math.Max(layout.Bar.Left, x - textWidth \ 2), 0), UiTheme.SecondaryText(), flags) + Using grid As New Pen(UiTheme.SubtleBorder(), unit) + g.DrawLine(grid, x, HeaderHeight - UiTheme.Px(3, dpi), x, bodyBottom) + End Using + Next + + For index As Integer = 0 To _routes.Count - 1 + Dim entry As RouteMapEntry = _routes(index) + Dim top As Integer = HeaderHeight + index * RowHeight + Dim rowBackground As Color = BackColor + + If index = _selected AndAlso Focused Then + rowBackground = UiTheme.AccentMutedBackground() + ElseIf index = _hot Then + rowBackground = UiTheme.HeaderBackground() + End If + If rowBackground <> BackColor Then + Using highlight As New SolidBrush(rowBackground) + g.FillRectangle(highlight, 0, top, Width, RowHeight) + End Using + Using grid As New Pen(UiTheme.SubtleBorder(), unit) + For day As Integer = 0 To scale Step stepDays + Dim x As Integer = layout.Bar.Left + CInt(layout.Bar.Width * day / CDbl(scale)) + g.DrawLine(grid, x, top, x, top + RowHeight) + Next + End Using + End If + If index = _selected AndAlso Focused Then + Using accent As New SolidBrush(UiTheme.AccentColor()) + g.FillRectangle(accent, 0, top, 3 * unit, RowHeight) + End Using + End If + + Dim textTop As Integer = top + (RowHeight - Line * 2) \ 2 + TextRenderer.DrawText(g, ReminderService.SafeManuscriptTitle(entry.Manuscript), bold, New Rectangle(UiTheme.Px(8, dpi), textTop, layout.TitleWidth - UiTheme.Px(8, dpi), Line), + UiTheme.PrimaryText(), flags Or TextFormatFlags.EndEllipsis) + TextRenderer.DrawText(g, RouteMapService.Brief(entry.Map), Font, New Rectangle(UiTheme.Px(8, dpi), textTop + Line, layout.TitleWidth - UiTheme.Px(8, dpi), Line), + UiTheme.SecondaryText(), flags Or TextFormatFlags.EndEllipsis) + + Dim barHeight As Integer = UiTheme.Px(18, dpi) + Dim barTop As Integer = top + (RowHeight - barHeight) \ 2 + For Each segment As RouteSegment In entry.Map.Segments + Dim startDay As Double = (segment.Start.Date - entry.Map.Start.Date).TotalDays + Dim left As Single = CSng(layout.Bar.Left + layout.Bar.Width * startDay / scale) + Dim width As Single = CSng(layout.Bar.Width * segment.Days / CDbl(scale)) + RouteMapStyle.FillSegment(g, New RectangleF(left, barTop, Math.Max(1, width - 1), barHeight), segment.Kind, rowBackground) + If segment.Ongoing Then + Using pen As New Pen(RouteMapStyle.Fill(segment.Kind), 3 * unit) With {.DashStyle = DashStyle.Dot} + g.DrawLine(pen, left + width + 2 * unit, barTop + barHeight / 2.0F, left + width + 14 * unit, barTop + barHeight / 2.0F) + End Using + End If + Next + + TextRenderer.DrawText(g, entry.Map.TotalDays.ToString(CultureInfo.CurrentCulture) & If(entry.Map.Ongoing, "+", String.Empty), bold, + New Rectangle(Width - layout.TotalWidth - UiTheme.Px(8, dpi), top, layout.TotalWidth, RowHeight), UiTheme.PrimaryText(), + TextFormatFlags.Right Or TextFormatFlags.VerticalCenter Or flags) + + Using divider As New Pen(UiTheme.SubtleBorder(), unit) + g.DrawLine(divider, 0, top + RowHeight - 1, Width, top + RowHeight - 1) + End Using + Next + + End Using + + End Sub + + Private Function RowAt(y As Integer) As Integer + If y < HeaderHeight Then Return -1 + Dim index As Integer = (y - HeaderHeight) \ RowHeight + Return If(index < _routes.Count, index, -1) + End Function + + Protected Overrides Sub OnMouseMove(e As MouseEventArgs) + MyBase.OnMouseMove(e) + Dim index As Integer = RowAt(e.Y) + If index <> _hot Then + _hot = index + Cursor = If(index >= 0, Cursors.Hand, Cursors.Default) + Invalidate() + End If + End Sub + + Protected Overrides Sub OnMouseLeave(e As EventArgs) + MyBase.OnMouseLeave(e) + _hot = -1 + Invalidate() + End Sub + + Protected Overrides Sub OnMouseClick(e As MouseEventArgs) + MyBase.OnMouseClick(e) + Dim index As Integer = RowAt(e.Y) + If index < 0 Then Return + Focus() + SelectedIndex = index + RaiseEvent RouteOpened(Me, _routes(index)) + End Sub + + Protected Overrides Function IsInputKey(keyData As Keys) As Boolean + Return keyData = Keys.Up OrElse keyData = Keys.Down OrElse keyData = Keys.Enter OrElse MyBase.IsInputKey(keyData) + End Function + + Protected Overrides Sub OnKeyDown(e As KeyEventArgs) + MyBase.OnKeyDown(e) + If _routes.Count = 0 Then Return + Select Case e.KeyCode + Case Keys.Up : SelectedIndex = Math.Max(0, _selected - 1) + Case Keys.Down : SelectedIndex = Math.Min(_routes.Count - 1, _selected + 1) + Case Keys.Enter + If _selected >= 0 Then RaiseEvent RouteOpened(Me, _routes(_selected)) + Case Else : Return + End Select + e.Handled = True + End Sub + + Private Sub DescribeSelection() + If _selected < 0 OrElse _selected >= _routes.Count Then + AccessibleDescription = Nothing + Return + End If + Dim entry As RouteMapEntry = _routes(_selected) + AccessibleDescription = ReminderService.SafeManuscriptTitle(entry.Manuscript) & ". " & RouteMapService.Brief(entry.Map) & ". " & RouteMapStyle.Summary(entry.Map) + If Focused Then AccessibilityNotifyClients(AccessibleEvents.DescriptionChange, -1) + End Sub + + Protected Overrides Sub OnGotFocus(e As EventArgs) + MyBase.OnGotFocus(e) + Invalidate() + End Sub + + Protected Overrides Sub OnLostFocus(e As EventArgs) + MyBase.OnLostFocus(e) + Invalidate() + End Sub + + End Class + +End Namespace diff --git a/ManuscriptPipeline/Controls/TagChips.vb b/ManuscriptPipeline/Controls/TagChips.vb new file mode 100644 index 0000000..f9e3944 --- /dev/null +++ b/ManuscriptPipeline/Controls/TagChips.vb @@ -0,0 +1,361 @@ +Imports System +Imports System.Collections.Generic +Imports System.ComponentModel +Imports System.Drawing +Imports System.Drawing.Drawing2D +Imports System.Linq +Imports System.Windows.Forms +Imports ManuscriptPipeline.Models +Imports ManuscriptPipeline.Services + +Namespace Controls + + ' Draws one tag as a small rounded chip in its palette color (#64). + Friend NotInheritable Class TagChipPainter + + Private Sub New() + End Sub + + Public Shared Function Measure(text As String, font As Font, dpi As Integer) As Size + Dim size As Size = TextRenderer.MeasureText(text, font, Size.Empty, TextFormatFlags.NoPadding Or TextFormatFlags.NoPrefix) + Return New Size(size.Width + UiTheme.Px(14, dpi), size.Height + UiTheme.Px(4, dpi)) + End Function + + Public Shared Sub Draw(g As Graphics, bounds As Rectangle, text As String, palette As TagPalette, font As Font) + Dim dark As Boolean = UiTheme.IsDark() + g.SmoothingMode = SmoothingMode.AntiAlias + Using path As GraphicsPath = RoundedShapes.Create(New RectangleF(bounds.X, bounds.Y, bounds.Width - 1, bounds.Height - 1), bounds.Height / 2.0F), + fill As New SolidBrush(WorkTypeService.Background(palette, dark)) + g.FillPath(fill, path) + End Using + TextRenderer.DrawText(g, text, font, bounds, WorkTypeService.Foreground(palette, dark), + TextFormatFlags.HorizontalCenter Or TextFormatFlags.VerticalCenter Or TextFormatFlags.NoPadding Or TextFormatFlags.NoPrefix Or TextFormatFlags.SingleLine) + End Sub + + End Class + + + ' A card's tags on one line: as many as fit, then "+N" (#64). + Friend Class TagStrip + Inherits Control + + Private _tags As IReadOnlyList(Of String) = Array.Empty(Of String)() + Private _library As AuthorLibraryData = Nothing + + Public Sub New() + SetStyle(ControlStyles.UserPaint Or ControlStyles.AllPaintingInWmPaint Or ControlStyles.OptimizedDoubleBuffer Or ControlStyles.ResizeRedraw Or ControlStyles.SupportsTransparentBackColor, True) + SetStyle(ControlStyles.Selectable, False) + TabStop = False + AccessibleRole = AccessibleRole.StaticText + End Sub + + + Public Property Tags As IReadOnlyList(Of String) + Get + Return _tags + End Get + Set(value As IReadOnlyList(Of String)) + _tags = If(value, Array.Empty(Of String)()) + AccessibleName = If(_tags.Count = 0, String.Empty, "Tags: " & String.Join(", ", _tags)) + Invalidate() + End Set + End Property + + + Public Property Library As AuthorLibraryData + Get + Return _library + End Get + Set(value As AuthorLibraryData) + _library = value + Invalidate() + End Set + End Property + + ' The chips that fit in a width, with "+N" when some do not. + Private Function PlaceChips(width As Integer) As List(Of (Text As String, Bounds As Rectangle, Palette As TagPalette)) + + Dim result As New List(Of (Text As String, Bounds As Rectangle, Palette As TagPalette))() + Dim gap As Integer = UiTheme.Px(4, DeviceDpi) + Dim x As Integer = 0 + + For index As Integer = 0 To _tags.Count - 1 + Dim size As Size = TagChipPainter.Measure(_tags(index), Font, DeviceDpi) + Dim remaining As Integer = _tags.Count - index - 1 + Dim moreWidth As Integer = If(remaining > 0, TagChipPainter.Measure("+" & remaining.ToString(), Font, DeviceDpi).Width + gap, 0) + If x + size.Width + moreWidth > width Then + Dim more As String = "+" & (_tags.Count - index).ToString() + Dim moreSize As Size = TagChipPainter.Measure(more, Font, DeviceDpi) + If x + moreSize.Width <= width Then result.Add((more, New Rectangle(x, 0, moreSize.Width, moreSize.Height), TagPalette.Slate)) + Exit For + End If + result.Add((_tags(index), New Rectangle(x, 0, size.Width, size.Height), WorkTypeService.ColorOf(_tags(index), _library))) + x += size.Width + gap + Next + + Return result + + End Function + + ' The width the chips need, up to a limit. + Public Function PreferredWidth(maximum As Integer) As Integer + Dim chips = PlaceChips(maximum) + Return If(chips.Count = 0, 0, chips.Last().Bounds.Right) + End Function + + Public Overrides Function GetPreferredSize(proposedSize As Size) As Size + Return New Size(PreferredWidth(If(proposedSize.Width > 0, proposedSize.Width, Integer.MaxValue)), + TagChipPainter.Measure("Ag", Font, DeviceDpi).Height) + End Function + + Protected Overrides Sub OnPaint(e As PaintEventArgs) + For Each chip In PlaceChips(Width) + Dim bounds As Rectangle = chip.Bounds + bounds.Offset(0, (Height - bounds.Height) \ 2) + TagChipPainter.Draw(e.Graphics, bounds, chip.Text, chip.Palette, Font) + Next + End Sub + + End Class + + + ' Edits a manuscript's tags: chips with remove and color, and a box that + ' adds a tag on Enter or comma, suggesting tags already in the library. + Friend Class TagEditor + Inherits FlowLayoutPanel + + Private ReadOnly _input As New TextBox() + Private _tags As List(Of String) = New List(Of String)() + Private _library As AuthorLibraryData = Nothing + + ' Raised after a tag is added or removed, or its color changes. + Public Event TagsChanged As EventHandler + Public Event ColorChanged As EventHandler + + ' Not AutoSize: a wrapping panel measured before it knows its width + ' asks for one line per chip. Its height follows its actual width. + Public Sub New() + AutoSize = False + WrapContents = True + Margin = New Padding(0) + AccessibleName = "Tags" + + _input.PlaceholderText = "Add a tag" + _input.AccessibleName = "Add a tag" + _input.AccessibleDescription = "Type a tag and press Enter. Backspace in an empty box removes the last tag." + _input.AutoCompleteMode = AutoCompleteMode.SuggestAppend + _input.AutoCompleteSource = AutoCompleteSource.CustomSource + _input.Margin = New Padding(0, 3, 0, 3) + AddHandler _input.KeyDown, AddressOf InputKeyDown + AddHandler _input.KeyPress, + Sub(sender, e) + If e.KeyChar = ","c OrElse e.KeyChar = ";"c Then + e.Handled = True + Commit() + End If + End Sub + AddHandler _input.Leave, Sub(sender, e) Commit() + Controls.Add(_input) + End Sub + + Friend ReadOnly Property Input As TextBox + Get + Return _input + End Get + End Property + + ' Edits this list in place. + Public Sub Bind(tags As List(Of String), library As AuthorLibraryData, suggestions As IEnumerable(Of String)) + _tags = tags + _library = library + _input.AutoCompleteCustomSource.Clear() + _input.AutoCompleteCustomSource.AddRange(If(suggestions, Enumerable.Empty(Of String)()).ToArray()) + _input.Width = Math.Max(LogicalToDeviceUnits(140), TextRenderer.MeasureText(_input.PlaceholderText, _input.Font).Width + LogicalToDeviceUnits(24)) + Rebuild() + End Sub + + Protected Overrides Sub OnSizeChanged(e As EventArgs) + MyBase.OnSizeChanged(e) + FitHeight() + End Sub + + Private Sub FitHeight() + If Width <= 0 Then Return + Dim needed As Integer = MyBase.GetPreferredSize(New Size(Width, 0)).Height + If needed > 0 AndAlso needed <> Height Then Height = needed + End Sub + + Private Sub InputKeyDown(sender As Object, e As KeyEventArgs) + If e.KeyCode = Keys.Enter Then + e.SuppressKeyPress = True + e.Handled = True + Commit() + ElseIf e.KeyCode = Keys.Back AndAlso _input.TextLength = 0 AndAlso _tags.Count > 0 Then + e.SuppressKeyPress = True + RemoveTag(_tags.Last()) + End If + End Sub + + Friend Sub Commit() + Dim value As String = WorkTypeService.NormalizeTag(_input.Text) + _input.Clear() + If value.Length = 0 OrElse _tags.Contains(value, StringComparer.CurrentCultureIgnoreCase) Then Return + _tags.Add(value) + Rebuild() + RaiseEvent TagsChanged(Me, EventArgs.Empty) + _input.Focus() + End Sub + + Friend Sub RemoveTag(tag As String) + If _tags.RemoveAll(Function(item) String.Equals(item, tag, StringComparison.CurrentCultureIgnoreCase)) = 0 Then Return + Rebuild() + RaiseEvent TagsChanged(Me, EventArgs.Empty) + _input.Focus() + End Sub + + Private Sub Rebuild() + SuspendLayout() + For Each chip As Control In Controls.OfType(Of TagChipButton)().Cast(Of Control)().ToList() + Controls.Remove(chip) + chip.Dispose() + Next + Dim index As Integer = 0 + For Each tag As String In _tags + Dim chip As New TagChipButton(tag, WorkTypeService.ColorOf(tag, _library)) With {.Font = Font} + AddHandler chip.RemoveRequested, Sub(sender, e) RemoveTag(DirectCast(sender, TagChipButton).TagText) + AddHandler chip.ColorRequested, + Sub(sender, color) + If _library Is Nothing Then Return + WorkTypeService.SetColor(_library, DirectCast(sender, TagChipButton).TagText, color) + Rebuild() + RaiseEvent ColorChanged(Me, EventArgs.Empty) + End Sub + Controls.Add(chip) + Controls.SetChildIndex(chip, index) + index += 1 + Next + ResumeLayout(True) + FitHeight() + End Sub + + End Class + + + ' One tag in the editor: Delete or the × removes it; the menu sets its color. + Friend Class TagChipButton + Inherits Control + + Private ReadOnly _palette As TagPalette + Private _hot As Boolean + + Public ReadOnly Property TagText As String + + Public Event RemoveRequested As EventHandler + Public Event ColorRequested As EventHandler(Of TagPalette) + + Public Sub New(tag As String, palette As TagPalette) + TagText = tag + _palette = palette + SetStyle(ControlStyles.UserPaint Or ControlStyles.AllPaintingInWmPaint Or ControlStyles.OptimizedDoubleBuffer Or ControlStyles.Selectable Or ControlStyles.SupportsTransparentBackColor, True) + TabStop = True + Margin = New Padding(0, 3, 6, 3) + AccessibleRole = AccessibleRole.PushButton + AccessibleName = "Tag " & tag + AccessibleDescription = "Press Delete to remove. Open the context menu to choose a color." + + Dim menu As New ContextMenuStrip() + Dim colors As New ToolStripMenuItem("Color") + For Each value As TagPalette In [Enum].GetValues(GetType(TagPalette)) + Dim choice As TagPalette = value + Dim item As New ToolStripMenuItem(value.ToString()) With {.Checked = value = palette} + AddHandler item.Click, Sub(sender, e) RaiseEvent ColorRequested(Me, choice) + colors.DropDownItems.Add(item) + Next + menu.Items.Add(colors) + menu.Items.Add("Remove Tag", Nothing, Sub(sender, e) RaiseEvent RemoveRequested(Me, EventArgs.Empty)) + ContextMenuStrip = menu + AddHandler Disposed, Sub(sender, e) menu.Dispose() + End Sub + + Private ReadOnly Property RemoveWidth As Integer + Get + Return TextRenderer.MeasureText("×", Font).Width + UiTheme.Px(4, DeviceDpi) + End Get + End Property + + Public Overrides Function GetPreferredSize(proposedSize As Size) As Size + Dim chip As Size = TagChipPainter.Measure(TagText, Font, DeviceDpi) + Return New Size(chip.Width + RemoveWidth, chip.Height + UiTheme.Px(2, DeviceDpi)) + End Function + + Protected Overrides Sub OnFontChanged(e As EventArgs) + MyBase.OnFontChanged(e) + Size = GetPreferredSize(Size.Empty) + End Sub + + Protected Overrides Sub OnCreateControl() + MyBase.OnCreateControl() + Size = GetPreferredSize(Size.Empty) + End Sub + + Protected Overrides Sub OnPaint(e As PaintEventArgs) + Dim bounds As New Rectangle(0, 0, Width, Height) + TagChipPainter.Draw(e.Graphics, bounds, String.Empty, _palette, Font) + Dim ink As Color = WorkTypeService.Foreground(_palette, UiTheme.IsDark()) + Dim textBounds As New Rectangle(UiTheme.Px(7, DeviceDpi), 0, Width - RemoveWidth - UiTheme.Px(7, DeviceDpi), Height) + TextRenderer.DrawText(e.Graphics, TagText, Font, textBounds, ink, TextFormatFlags.VerticalCenter Or TextFormatFlags.Left Or TextFormatFlags.NoPadding Or TextFormatFlags.NoPrefix Or TextFormatFlags.SingleLine) + TextRenderer.DrawText(e.Graphics, "×", Font, New Rectangle(Width - RemoveWidth - UiTheme.Px(3, DeviceDpi), 0, RemoveWidth, Height), If(_hot, UiTheme.DangerColor(), ink), + TextFormatFlags.VerticalCenter Or TextFormatFlags.HorizontalCenter Or TextFormatFlags.NoPadding) + If Focused AndAlso ShowFocusCues Then + Using pen As New Pen(UiTheme.AccentColor(), UiTheme.Px(2, DeviceDpi)) + Using path As GraphicsPath = RoundedShapes.Create(New RectangleF(1, 1, Width - 3, Height - 3), (Height - 3) / 2.0F) + e.Graphics.DrawPath(pen, path) + End Using + End Using + End If + End Sub + + Protected Overrides Sub OnMouseMove(e As MouseEventArgs) + MyBase.OnMouseMove(e) + Dim hot As Boolean = e.X >= Width - RemoveWidth - UiTheme.Px(4, DeviceDpi) + If hot <> _hot Then + _hot = hot + Cursor = If(hot, Cursors.Hand, Cursors.Default) + Invalidate() + End If + End Sub + + Protected Overrides Sub OnMouseLeave(e As EventArgs) + MyBase.OnMouseLeave(e) + _hot = False + Invalidate() + End Sub + + Protected Overrides Sub OnMouseClick(e As MouseEventArgs) + MyBase.OnMouseClick(e) + If e.Button = MouseButtons.Left AndAlso e.X >= Width - RemoveWidth - UiTheme.Px(4, DeviceDpi) Then + RaiseEvent RemoveRequested(Me, EventArgs.Empty) + End If + End Sub + + Protected Overrides Sub OnKeyDown(e As KeyEventArgs) + MyBase.OnKeyDown(e) + If e.KeyCode = Keys.Delete OrElse e.KeyCode = Keys.Back Then + e.Handled = True + RaiseEvent RemoveRequested(Me, EventArgs.Empty) + End If + End Sub + + Protected Overrides Sub OnGotFocus(e As EventArgs) + MyBase.OnGotFocus(e) + Invalidate() + End Sub + + Protected Overrides Sub OnLostFocus(e As EventArgs) + MyBase.OnLostFocus(e) + Invalidate() + End Sub + + End Class + +End Namespace diff --git a/ManuscriptPipeline/Form1.Insights.vb b/ManuscriptPipeline/Form1.Insights.vb new file mode 100644 index 0000000..0f16b32 --- /dev/null +++ b/ManuscriptPipeline/Form1.Insights.vb @@ -0,0 +1,530 @@ +Imports System +Imports System.Collections.Generic +Imports System.Drawing +Imports System.Globalization +Imports System.Linq +Imports System.Windows.Forms +Imports ManuscriptPipeline.Controls +Imports ManuscriptPipeline.Models +Imports ManuscriptPipeline.Services + +' The Insights page (#30, #62): how your work has moved through journals, +' from your own records. Calculated on this computer each time the page is +' shown; nothing here changes a record. +Partial Public Class Form1 + + Private insightsContent As Panel = Nothing + Private insightsGrid As DataGridView = Nothing + Private insightsJournal As JournalHistory = Nothing + Private tabInsightsJournals As ShelfTabButton = Nothing + Private tabInsightsRoutes As ShelfTabButton = Nothing + Private tabInsightsMap As ShelfTabButton = Nothing + ' The Route Map shows published routes unless asked for all of them. + Private insightsMapAll As Boolean = False + ' Opens a route from the Route Map; tests replace the dialog. + Friend routeViewOpener As Action(Of Manuscript) = Nothing + Private insightsTiles As FlowLayoutPanel = Nothing + Private insightsScope As LinkLabel = Nothing + + + Private Function BuildInsightsPage() As Control + + insightsJournal = Nothing + + Dim btnReport As New ActionButton With { + .Text = "Pipeline Report...", + .Width = GetResponsiveButtonWidth("Pipeline Report...", 140), + .Height = GetResponsiveButtonHeight(34), + .AccessibleDescription = "Saves a read-only summary of the pipeline to share with a supervisor or coauthor." + } + AddHandler btnReport.Click, AddressOf SavePipelineReport + + Dim frame As TableLayoutPanel = CreatePageFrame( + "Insights", + "How your work has moved through journals, from your own PaperRoute records. Calculated on this computer; missing dates are left out, never estimated.", + btnReport) + + Dim dpi As Integer = DeviceDpi + Dim body As New TableLayoutPanel With { + .Dock = DockStyle.Fill, + .ColumnCount = 1, + .RowCount = 5, + .Margin = New Padding(0), + .BackColor = UiTheme.BoardBackground() + } + body.ColumnStyles.Add(New ColumnStyle(SizeType.Percent, 100.0F)) + body.RowStyles.Add(New RowStyle(SizeType.AutoSize)) + body.RowStyles.Add(New RowStyle(SizeType.AutoSize)) + body.RowStyles.Add(New RowStyle(SizeType.AutoSize)) + body.RowStyles.Add(New RowStyle(SizeType.Percent, 100.0F)) + body.RowStyles.Add(New RowStyle(SizeType.AutoSize)) + + insightsTiles = New FlowLayoutPanel With { + .AutoSize = True, + .AutoSizeMode = AutoSizeMode.GrowAndShrink, + .WrapContents = True, + .Dock = DockStyle.Top, + .Margin = New Padding(0, 0, 0, UiTheme.Px(10, dpi)), + .BackColor = UiTheme.BoardBackground(), + .AccessibleName = "At a glance" + } + body.Controls.Add(insightsTiles, 0, 0) + + Dim views As New FlowLayoutPanel With { + .Dock = DockStyle.Top, + .AutoSize = True, + .AutoSizeMode = AutoSizeMode.GrowAndShrink, + .WrapContents = False, + .Margin = New Padding(0, 0, 0, UiTheme.Px(6, dpi)), + .BackColor = UiTheme.BoardBackground() + } + AddHandler views.Paint, + Sub(sender, e) + Using line As New Pen(UiTheme.CardBorder()) + e.Graphics.DrawLine(line, 0, views.Height - 1, views.Width, views.Height - 1) + End Using + End Sub + tabInsightsJournals = New ShelfTabButton() With {.Text = "Your Journals"} + tabInsightsRoutes = New ShelfTabButton() With {.Text = "Your Routes"} + tabInsightsMap = New ShelfTabButton() With {.Text = "Route Map"} + views.Controls.Add(tabInsightsJournals) + views.Controls.Add(tabInsightsRoutes) + views.Controls.Add(tabInsightsMap) + body.Controls.Add(views, 0, 1) + + ' "Showing manuscripts sent to X · Show all" while a journal is chosen. + insightsScope = New LinkLabel With { + .AutoSize = True, + .UseMnemonic = False, + .Visible = False, + .LinkColor = UiTheme.AccentColor(), + .ActiveLinkColor = UiTheme.AccentColor(), + .VisitedLinkColor = UiTheme.AccentColor(), + .ForeColor = UiTheme.SecondaryText(), + .Margin = New Padding(0, 0, 0, UiTheme.Px(6, dpi)) + } + AddHandler insightsScope.LinkClicked, + Sub(sender, e) + insightsJournal = Nothing + FillInsights() + End Sub + body.Controls.Add(insightsScope, 0, 2) + + insightsContent = New Panel With {.Dock = DockStyle.Fill, .Margin = New Padding(0), .BackColor = UiTheme.BoardBackground()} + body.Controls.Add(insightsContent, 0, 3) + + body.Controls.Add(New Label With { + .Text = "Days are calendar days between recorded dates. A first decision is the earliest decision recorded for a submission; " & + "review time leaves out desk rejections. Journals group by their Journal Library record or exact name, never by a guess.", + .AutoSize = True, + .UseMnemonic = False, + .ForeColor = UiTheme.SecondaryText(), + .Margin = New Padding(0, UiTheme.Px(8, dpi), 0, 0) + }, 0, 4) + AddHandler body.SizeChanged, + Sub(sender, e) + For Each note As Label In body.Controls.OfType(Of Label)() + note.MaximumSize = New Size(Math.Max(UiTheme.Px(300, dpi), body.ClientSize.Width - UiTheme.Px(8, dpi)), 0) + Next + End Sub + + frame.Controls.Add(body, 0, 2) + + tabInsightsJournals.Checked = True + AddHandler tabInsightsJournals.CheckedChanged, Sub(sender, e) If tabInsightsJournals.Checked Then FillInsights() + AddHandler tabInsightsRoutes.CheckedChanged, Sub(sender, e) If tabInsightsRoutes.Checked Then FillInsights() + AddHandler tabInsightsMap.CheckedChanged, Sub(sender, e) If tabInsightsMap.Checked Then FillInsights() + + FillInsights() + Return frame + + End Function + + + Private Function CurrentJournalLibrary() As IEnumerable(Of JournalRecord) + Return If(authorLibrary?.Journals, New List(Of JournalRecord)()) + End Function + + + Private Sub FillInsights() + + If insightsContent Is Nothing OrElse insightsContent.IsDisposed Then Return + + Dim statistics As LibraryStatistics = RouteAnalyticsService.ForLibrary(manuscripts, DateTime.Today, CurrentJournalLibrary()) + + ' A chosen journal may no longer exist after an edit. + If insightsJournal IsNot Nothing Then + Dim name As String = insightsJournal.JournalName + insightsJournal = statistics.Journals.FirstOrDefault(Function(item) item.JournalName = name) + End If + + FillInsightTiles(statistics) + + tabInsightsJournals.Text = "Your Journals (" & statistics.Journals.Count.ToString(CultureInfo.CurrentCulture) & ")" + tabInsightsRoutes.Text = "Your Routes (" & statistics.Manuscripts.Where(Function(item) item.Submissions.Count > 0).Count().ToString(CultureInfo.CurrentCulture) & ")" + + For Each child As Control In insightsContent.Controls.Cast(Of Control)().ToList() + insightsContent.Controls.Remove(child) + child.Dispose() + Next + + insightsScope.Visible = insightsJournal IsNot Nothing AndAlso Not tabInsightsJournals.Checked + If insightsScope.Visible Then + insightsScope.Text = "Showing manuscripts sent to " & insightsJournal.JournalName & " · Show all" + insightsScope.LinkArea = New LinkArea(insightsScope.Text.Length - 8, 8) + End If + + If tabInsightsMap.Checked Then + insightsGrid = Nothing + insightsContent.Controls.Add(CreateRouteMapView()) + Return + End If + + insightsGrid = If(tabInsightsRoutes.Checked, CreateRoutesGrid(statistics), CreateJournalsGrid(statistics)) + insightsContent.Controls.Add(insightsGrid) + + End Sub + + + Private Sub FillInsightTiles(statistics As LibraryStatistics) + + insightsTiles.SuspendLayout() + For Each child As Control In insightsTiles.Controls.Cast(Of Control)().ToList() + insightsTiles.Controls.Remove(child) + child.Dispose() + Next + + Dim published As Integer = manuscripts.Where(Function(item) item.Location = ManuscriptLocation.Published).Count() + Dim submissions As Integer = statistics.Submissions.Count() + + insightsTiles.Controls.Add(CreateStatTile(manuscripts.Count.ToString(CultureInfo.CurrentCulture), + If(manuscripts.Count = 1, "manuscript", "manuscripts") & " · " & published.ToString(CultureInfo.CurrentCulture) & " published", UiTheme.PrimaryText())) + insightsTiles.Controls.Add(CreateStatTile(submissions.ToString(CultureInfo.CurrentCulture), + If(submissions = 1, "submission", "submissions") & " · " & statistics.CountOutcome(SubmissionOutcome.Accepted).ToString(CultureInfo.CurrentCulture) & " accepted", UiTheme.PrimaryText())) + insightsTiles.Controls.Add(CreateStatTile(DaysText(statistics.MedianDaysToFirstDecision), + "median to a first decision" & SampleText(statistics.MedianDaysToFirstDecision), UiTheme.AccentColor())) + insightsTiles.Controls.Add(CreateStatTile(DaysText(statistics.MedianDaysToAcceptance), + "median from first submission to acceptance" & SampleText(statistics.MedianDaysToAcceptance), UiTheme.AccentColor())) + + insightsTiles.ResumeLayout(True) + + End Sub + + + Private Shared Function DaysText(median As Median) As String + If Not median.HasValue Then Return "—" + Dim days As Double = median.Value.Value + Return days.ToString(If(days = Math.Floor(days), "0", "0.0"), CultureInfo.CurrentCulture) & If(days = 1, " day", " days") + End Function + + + Private Shared Function SampleText(median As Median) As String + Return If(median.SampleSize = 0, " (not recorded yet)", " (of " & median.SampleSize.ToString(CultureInfo.CurrentCulture) & ")") + End Function + + + ' A number over a caption, as on the Deadlines page. + Private Function CreateStatTile(value As String, caption As String, valueColor As Color) As Control + + Dim dpi As Integer = DeviceDpi + Dim panel As New RoundedPanel With { + .BackColor = UiTheme.CardBackground(), + .BorderColor = UiTheme.CardBorder(), + .BorderThickness = 1.0F, + .CornerRadius = UiTheme.Px(UiTheme.ControlRadius, dpi), + .Padding = New Padding(UiTheme.Px(12, dpi), UiTheme.Px(8, dpi), UiTheme.Px(12, dpi), UiTheme.Px(8, dpi)), + .Margin = New Padding(0, 0, UiTheme.Px(10, dpi), UiTheme.Px(6, dpi)), + .AccessibleName = value & " " & caption, + .AccessibleRole = AccessibleRole.StaticText + } + Dim number As New Label With { + .AutoSize = True, + .Text = value, + .UseMnemonic = False, + .Font = New Font(Me.Font.FontFamily, Me.Font.SizeInPoints * 1.45F, FontStyle.Bold), + .ForeColor = valueColor, + .BackColor = UiTheme.CardBackground(), + .Location = New Point(panel.Padding.Left, panel.Padding.Top) + } + Dim text As New Label With { + .AutoSize = True, + .Text = caption, + .UseMnemonic = False, + .ForeColor = UiTheme.SecondaryText(), + .BackColor = UiTheme.CardBackground() + } + panel.Controls.Add(number) + panel.Controls.Add(text) + text.Location = New Point(panel.Padding.Left, number.Bottom) + panel.Size = New Size( + Math.Max(UiTheme.Px(150, dpi), Math.Max(number.PreferredWidth, TextRenderer.MeasureText(caption, Me.Font).Width) + panel.Padding.Horizontal), + text.Bottom + panel.Padding.Bottom) + Return panel + + End Function + + + Private Function CreateJournalsGrid(statistics As LibraryStatistics) As DataGridView + + Dim grid As DataGridView = CreatePageGrid("Your journals. Press Enter to see the manuscripts sent to the selected journal.") + Dim dpi As Integer = DeviceDpi + + grid.Columns.Add(New DataGridViewTextBoxColumn With {.Name = "Journal", .HeaderText = "Journal", .AutoSizeMode = DataGridViewAutoSizeColumnMode.Fill, .FillWeight = 200, .MinimumWidth = UiTheme.Px(200, dpi)}) + For Each column In {("Submissions", "Submissions"), ("Accepted", "Accepted"), ("Revisions", "Asked to revise"), + ("Rejected", "Rejected after review"), ("Desk", "Desk rejected"), ("FirstDecision", "Median days to first decision"), + ("Review", "Median days in review")} + grid.Columns.Add(New DataGridViewTextBoxColumn With {.Name = column.Item1, .HeaderText = column.Item2, .AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells, .ValueType = GetType(Double)}) + grid.Columns(column.Item1).DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleRight + Next + grid.Columns.Add(New DataGridViewTextBoxColumn With {.Name = "Last", .HeaderText = "Last submitted", .AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells, .ValueType = GetType(DateTime)}) + grid.Columns("Last").DefaultCellStyle.Format = "d" + For Each column As DataGridViewColumn In grid.Columns + column.SortMode = DataGridViewColumnSortMode.Automatic + Next + + For Each history As JournalHistory In statistics.Journals + Dim rejected As Integer = history.CountOutcome(SubmissionOutcome.RejectedAfterReview) + history.CountOutcome(SubmissionOutcome.Rejected) + Dim index As Integer = grid.Rows.Add( + history.JournalName, + CDbl(history.Count), + CDbl(history.CountOutcome(SubmissionOutcome.Accepted)), + CDbl(history.WithRevisions), + CDbl(rejected), + CDbl(history.CountOutcome(SubmissionOutcome.DeskRejected)), + MedianCell(history.MedianDaysToFirstDecision), + MedianCell(history.MedianReviewDays), + history.LastSubmitted) + grid.Rows(index).Tag = history + Next + + Dim openJournal As Action(Of DataGridViewRow) = + Sub(row) + insightsJournal = TryCast(row?.Tag, JournalHistory) + If insightsJournal IsNot Nothing Then tabInsightsRoutes.Checked = True + End Sub + AddHandler grid.CellDoubleClick, Sub(sender, e) If e.RowIndex >= 0 Then openJournal(grid.Rows(e.RowIndex)) + AddHandler grid.KeyDown, + Sub(sender, e) + If e.KeyCode = Keys.Enter AndAlso grid.CurrentRow IsNot Nothing Then + e.Handled = True + openJournal(grid.CurrentRow) + End If + End Sub + + EmptyHint.Attach(grid, Function() "No submissions recorded yet. Record one on a manuscript's Submissions tab, and your history with each journal appears here.") + Return grid + + End Function + + + Private Function CreateRoutesGrid(statistics As LibraryStatistics) As DataGridView + + Dim grid As DataGridView = CreatePageGrid("Your routes. Press Enter to open the selected manuscript.") + Dim dpi As Integer = DeviceDpi + + grid.Columns.Add(New DataGridViewTextBoxColumn With {.Name = "Title", .HeaderText = "Manuscript", .AutoSizeMode = DataGridViewAutoSizeColumnMode.Fill, .FillWeight = 220, .MinimumWidth = UiTheme.Px(220, dpi)}) + grid.Columns.Add(New DataGridViewTextBoxColumn With {.Name = "Stage", .HeaderText = "Stage", .AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells}) + grid.Columns.Add(New DataGridViewTextBoxColumn With {.Name = "Route", .HeaderText = "Route", .AutoSizeMode = DataGridViewAutoSizeColumnMode.Fill, .FillWeight = 80}) + For Each column In {("Journals", "Journals"), ("Rounds", "Revision rounds"), ("Acceptance", "Days to acceptance"), ("Publication", "Days to publication")} + grid.Columns.Add(New DataGridViewTextBoxColumn With {.Name = column.Item1, .HeaderText = column.Item2, .AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells, .ValueType = GetType(Double)}) + grid.Columns(column.Item1).DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleRight + Next + grid.Columns.Add(New DataGridViewTextBoxColumn With {.Name = "First", .HeaderText = "First submitted", .AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells, .ValueType = GetType(DateTime)}) + grid.Columns("First").DefaultCellStyle.Format = "d" + For Each column As DataGridViewColumn In grid.Columns + column.SortMode = DataGridViewColumnSortMode.Automatic + Next + + Dim included As HashSet(Of Manuscript) = Nothing + If insightsJournal IsNot Nothing Then included = New HashSet(Of Manuscript)(insightsJournal.Submissions.Select(Function(item) item.Manuscript)) + + For Each route As ManuscriptStatistics In statistics.Manuscripts + If route.Submissions.Count = 0 Then Continue For + If included IsNot Nothing AndAlso Not included.Contains(route.Manuscript) Then Continue For + Dim index As Integer = grid.Rows.Add( + route.Manuscript.Title, + FormatStage(route.Manuscript.CurrentStage), + RouteSummaryService.Describe(route.Manuscript).Text, + CDbl(route.JournalCount), + CDbl(route.RevisionRounds), + If(route.DaysToAcceptance.HasValue, CObj(CDbl(route.DaysToAcceptance.Value)), Nothing), + If(route.DaysToPublication.HasValue, CObj(CDbl(route.DaysToPublication.Value)), Nothing), + route.FirstSubmitted.Value) + grid.Rows(index).Tag = route.Manuscript + Next + + AddHandler grid.CellDoubleClick, Sub(sender, e) If e.RowIndex >= 0 Then OpenInsightRoute(grid.Rows(e.RowIndex)) + AddHandler grid.KeyDown, + Sub(sender, e) + If e.KeyCode = Keys.Enter AndAlso grid.CurrentRow IsNot Nothing Then + e.Handled = True + OpenInsightRoute(grid.CurrentRow) + End If + End Sub + + EmptyHint.Attach(grid, Function() "No routes yet. A manuscript's route begins with its first recorded submission.") + Return grid + + End Function + + + ' Every route lined up at day 0 on one scale (#82): how long each took, + ' and how much of that was waiting on journals versus the author's own + ' turns. Published routes by default, so the lengths compare like with + ' like. + Private Function CreateRouteMapView() As Control + + Dim dpi As Integer = DeviceDpi + Dim scoped As IEnumerable(Of Manuscript) = manuscripts + If insightsJournal IsNot Nothing Then scoped = insightsJournal.Submissions.Select(Function(item) item.Manuscript).Distinct() + Dim library As RouteMapLibrary = RouteMapService.Library(scoped, DateTime.Today, insightsMapAll) + + Dim host As New Panel With {.Dock = DockStyle.Fill, .AutoScroll = True, .BackColor = UiTheme.BoardBackground()} + Dim section As New SectionCard With { + .Location = New Point(0, 0), + .AutoSize = True, + .AutoSizeMode = AutoSizeMode.GrowAndShrink, + .Padding = New Padding(UiTheme.Px(16, dpi), UiTheme.Px(12, dpi), UiTheme.Px(16, dpi), UiTheme.Px(14, dpi)), + .Margin = New Padding(0), + .BackColor = UiTheme.CardBackground(), + .ForeColor = UiTheme.PrimaryText(), + .AccessibleName = "Route Map" + } + Dim card As New TableLayoutPanel With { + .Dock = DockStyle.Top, + .AutoSize = True, + .AutoSizeMode = AutoSizeMode.GrowAndShrink, + .ColumnCount = 1, + .RowCount = 4, + .Padding = New Padding(0), + .Margin = New Padding(0), + .BackColor = UiTheme.CardBackground() + } + card.ColumnStyles.Add(New ColumnStyle(SizeType.Percent, 100.0F)) + For index As Integer = 0 To 3 + card.RowStyles.Add(New RowStyle(SizeType.AutoSize)) + Next + section.Controls.Add(card) + + Dim count As Integer = library.Routes.Count + Dim median As Median = library.MedianDaysToPublication + Dim summary As String + If insightsMapAll Then + Dim unfinished As Integer = library.Routes.Where(Function(item) Not item.IsPublished).Count() + summary = count.ToString(CultureInfo.CurrentCulture) & If(count = 1, " route", " routes") & " lined up at day 0; " & + unfinished.ToString(CultureInfo.CurrentCulture) & " not yet published, drawn to today or to the last decision." & + If(median.HasValue, " Published: median " & DaysText(median) & " from first submission to publication.", String.Empty) + ElseIf count = 0 Then + summary = "No published routes yet. A route is drawn from a manuscript's first recorded submission to its publication date." + Else + summary = count.ToString(CultureInfo.CurrentCulture) & If(count = 1, " published route", " published routes") & " lined up at day 0." & + If(median.HasValue, " Median " & DaysText(median) & " from first submission to publication.", String.Empty) + End If + + Dim header As New FlowLayoutPanel With { + .AutoSize = True, + .AutoSizeMode = AutoSizeMode.GrowAndShrink, + .WrapContents = True, + .Anchor = AnchorStyles.Left Or AnchorStyles.Top, + .Margin = New Padding(0), + .BackColor = UiTheme.CardBackground() + } + Dim lblSummary As New Label With { + .AutoSize = True, + .UseMnemonic = False, + .Text = summary, + .Font = New Font(Me.Font, FontStyle.Bold), + .ForeColor = UiTheme.PrimaryText(), + .BackColor = UiTheme.CardBackground(), + .Margin = New Padding(0, 0, UiTheme.Px(12, dpi), 0) + } + Dim toggle As New LinkLabel With { + .AutoSize = True, + .UseMnemonic = False, + .Text = If(insightsMapAll, "Show published routes only", "Include work not yet published"), + .LinkColor = UiTheme.AccentColor(), + .ActiveLinkColor = UiTheme.AccentColor(), + .VisitedLinkColor = UiTheme.AccentColor(), + .BackColor = UiTheme.CardBackground(), + .Margin = New Padding(0) + } + AddHandler toggle.LinkClicked, + Sub(sender, e) + insightsMapAll = Not insightsMapAll + FillInsights() + End Sub + header.Controls.Add(lblSummary) + header.Controls.Add(toggle) + card.Controls.Add(header, 0, 0) + + Dim shares As New List(Of (Kind As RouteSegmentKind, Text As String))() + For Each item In {(RouteSegmentKind.Journal, "With a journal"), (RouteSegmentKind.Author, "With you, revising or rerouting"), + (RouteSegmentKind.Production, "In production"), (RouteSegmentKind.NotRecorded, "Not recorded")} + Dim share As Double = library.Share(item.Item1) + If share > 0 Then shares.Add((item.Item1, item.Item2 & " · " & share.ToString("0%", CultureInfo.CurrentCulture))) + Next + card.Controls.Add(New RouteMapLegend With { + .Anchor = AnchorStyles.Left Or AnchorStyles.Right Or AnchorStyles.Top, + .Margin = New Padding(0, UiTheme.Px(10, dpi), 0, 0), + .BackColor = UiTheme.CardBackground(), + .Items = shares + }, 0, 1) + + Dim chart As New RouteMapChart With { + .Anchor = AnchorStyles.Left Or AnchorStyles.Right Or AnchorStyles.Top, + .Margin = New Padding(0, UiTheme.Px(12, dpi), 0, 0), + .BackColor = UiTheme.CardBackground(), + .Routes = library.Routes + } + AddHandler chart.RouteOpened, + Sub(sender, entry) + If routeViewOpener IsNot Nothing Then + routeViewOpener(entry.Manuscript) + Else + OpenRouteView(entry.Manuscript) + End If + End Sub + card.Controls.Add(chart, 0, 2) + + card.Controls.Add(New Label With { + .AutoSize = True, + .UseMnemonic = False, + .Text = "Percentages are shares of all " & library.TotalDays.ToString("N0", CultureInfo.CurrentCulture) & " days drawn. " & + "Click a route, or select it and press Enter, to open its route map." & + If(insightsMapAll, " A dotted end and + mark a route still under way today.", String.Empty), + .ForeColor = UiTheme.SecondaryText(), + .BackColor = UiTheme.CardBackground(), + .Margin = New Padding(0, UiTheme.Px(10, dpi), 0, 0) + }, 0, 3) + + host.Controls.Add(section) + Dim fit As Action = + Sub() + Dim width As Integer = Math.Max(UiTheme.Px(420, dpi), host.ClientSize.Width - If(host.VerticalScroll.Visible, 0, SystemInformation.VerticalScrollBarWidth) - UiTheme.Px(2, dpi)) + section.MinimumSize = New Size(width, 0) + section.MaximumSize = New Size(width, 0) + Dim inner As Integer = width - section.Padding.Horizontal + For Each label As Label In card.Controls.OfType(Of Label)() + label.MaximumSize = New Size(inner, 0) + Next + header.MaximumSize = New Size(inner, 0) + lblSummary.MaximumSize = New Size(inner, 0) + End Sub + AddHandler host.ClientSizeChanged, Sub(sender, e) fit() + fit() + Return host + + End Function + + + Private Shared Function MedianCell(median As Median) As Object + Return If(median.HasValue, CObj(median.Value.Value), Nothing) + End Function + + + Private Sub OpenInsightRoute(row As DataGridViewRow) + Dim manuscript As Manuscript = TryCast(row?.Tag, Manuscript) + If manuscript IsNot Nothing Then OpenManuscript(manuscript) + End Sub + +End Class diff --git a/ManuscriptPipeline/Form1.ManuscriptPage.vb b/ManuscriptPipeline/Form1.ManuscriptPage.vb index bf86fd7..f9bd4e5 100644 --- a/ManuscriptPipeline/Form1.ManuscriptPage.vb +++ b/ManuscriptPipeline/Form1.ManuscriptPage.vb @@ -90,6 +90,7 @@ Partial Public Class Form1 Case WorkspacePage.Library : Return "Library" Case WorkspacePage.Journals : Return "Journals" Case WorkspacePage.Deadlines : Return "Deadlines" + Case WorkspacePage.Insights : Return "Insights" Case WorkspacePage.ImportExport : Return "Import & Export" Case Else : Return "Board" End Select @@ -260,6 +261,7 @@ Partial Public Class Form1 End Sub Dim pageMenu As New ContextMenuStrip() + pageMenu.Items.Add("Route Report...", Nothing, Sub(sender, e) SaveRouteReport(FindManuscript(currentManuscriptId))) pageMenu.Items.Add("Check for Publication...", Nothing, Sub(sender, e) CheckOpenManuscriptForPublication()) pageMenu.Items.Add(New ToolStripSeparator()) Dim deleteItem As ToolStripItem = diff --git a/ManuscriptPipeline/Form1.Reports.vb b/ManuscriptPipeline/Form1.Reports.vb new file mode 100644 index 0000000..8e6a6a6 --- /dev/null +++ b/ManuscriptPipeline/Form1.Reports.vb @@ -0,0 +1,60 @@ +Imports System +Imports System.Collections.Generic +Imports System.Globalization +Imports System.IO +Imports System.Linq +Imports System.Windows.Forms +Imports ManuscriptPipeline.Forms +Imports ManuscriptPipeline.Models +Imports ManuscriptPipeline.Services + +' Shareable reports (#30, #63): saved as self-contained web pages that +' print to PDF. Building one never changes a record. +Partial Public Class Form1 + + Private Function PreparedByName() As String + Dim self As AuthorRecord = If(authorLibrary?.Authors, New List(Of AuthorRecord)()). + FirstOrDefault(Function(author) author IsNot Nothing AndAlso author.IsMe) + Return If(self?.DisplayName, String.Empty) + End Function + + + Private Sub SavePipelineReport(sender As Object, e As EventArgs) + + If manuscripts.Count = 0 Then + MessageBox.Show(Me, "Add a manuscript before making a pipeline report.", "Pipeline Report", MessageBoxButtons.OK, MessageBoxIcon.Information) + Return + End If + + Dim choices As List(Of Manuscript) = manuscripts. + OrderBy(Function(item) item.Location). + ThenBy(Function(item) item.Title, StringComparer.CurrentCultureIgnoreCase).ToList() + Dim preparedBy As String = PreparedByName() + Dim today As DateTime = DateTime.Today + + Using dialog As New ReportForm("Pipeline Report", "PaperRoute-Pipeline-" & today.ToString("yyyy-MM-dd", CultureInfo.InvariantCulture) & ".html", choices, + Function(chosen, deadlines) ReportService.PipelineReport(chosen, today, preparedBy, deadlines)) + If dialog.ShowDialog(Me) = DialogResult.OK Then + lblStatus.Text = "Saved the pipeline report to " & Path.GetFileName(dialog.SavedPath) & "." + End If + End Using + + End Sub + + + Private Sub SaveRouteReport(manuscript As Manuscript) + + If manuscript Is Nothing Then Return + Dim today As DateTime = DateTime.Today + Dim fileTitle As String = String.Concat(ReminderService.SafeManuscriptTitle(manuscript).Take(60).Where(Function(ch) Not Path.GetInvalidFileNameChars().Contains(ch))).Trim() + + Using dialog As New ReportForm("Route Report", fileTitle & " - Route.html", Nothing, + Function(chosen, deadlines) ReportService.RouteReport(manuscript, today)) + If dialog.ShowDialog(Me) = DialogResult.OK Then + lblStatus.Text = "Saved the route report to " & Path.GetFileName(dialog.SavedPath) & "." + End If + End Using + + End Sub + +End Class diff --git a/ManuscriptPipeline/Form1.Shell.vb b/ManuscriptPipeline/Form1.Shell.vb index 8d20763..3e4ca95 100644 --- a/ManuscriptPipeline/Form1.Shell.vb +++ b/ManuscriptPipeline/Form1.Shell.vb @@ -20,6 +20,7 @@ Partial Public Class Form1 Library Journals Deadlines + Insights ImportExport ' Not in the rail: a manuscript opened from another page. Manuscript @@ -193,6 +194,7 @@ Partial Public Class Form1 (WorkspacePage.Library, RailGlyph.Library, "Library"), (WorkspacePage.Journals, RailGlyph.Journals, "Journals"), (WorkspacePage.Deadlines, RailGlyph.Deadlines, "Deadlines"), + (WorkspacePage.Insights, RailGlyph.Insights, "Insights"), (WorkspacePage.ImportExport, RailGlyph.ImportExport, "Import & Export") } Dim page As WorkspacePage = entry.Item1 @@ -535,6 +537,8 @@ Partial Public Class Form1 libraryFilter = Nothing deadlinesList = Nothing deadlinesFilter = Nothing + insightsContent = Nothing + insightsGrid = Nothing ' Hosted editors save as they go. Refresh the board's copies, as the ' board did after their dialogs closed. @@ -570,6 +574,8 @@ Partial Public Class Form1 New JournalLibraryForm(manuscripts)) Case WorkspacePage.Deadlines view = BuildDeadlinesPage() + Case WorkspacePage.Insights + view = BuildInsightsPage() Case Else view = BuildImportExportPage() End Select @@ -734,7 +740,7 @@ Partial Public Class Form1 Private Function BuildLibraryPage() As Control libraryFilter = New TextBox With { - .PlaceholderText = "Filter by title, journal, stage, or route", + .PlaceholderText = "Filter by title, journal, stage, route, type, or tag", .BorderStyle = BorderStyle.None, .BackColor = UiTheme.CardBackground(), .ForeColor = UiTheme.PrimaryText(), @@ -861,9 +867,9 @@ Partial Public Class Form1 End Function - Private Sub ShowLibraryManuscripts() - - ClearLibraryContent() + ' A read-only, sortable table in the page style, shared by the Library + ' and Insights pages. + Private Function CreatePageGrid(accessibleName As String) As DataGridView Dim grid As New DataGridView With { .Dock = DockStyle.Fill, @@ -881,7 +887,7 @@ Partial Public Class Form1 .StandardTab = True, .BackgroundColor = UiTheme.CardBackground(), .GridColor = UiTheme.SubtleBorder(), - .AccessibleName = "All manuscripts. Press Enter to open the selected manuscript.", + .AccessibleName = accessibleName, .ColumnHeadersHeightSizeMode = DataGridViewColumnHeadersHeightSizeMode.AutoSize } @@ -897,11 +903,24 @@ Partial Public Class Form1 grid.ColumnHeadersDefaultCellStyle.Padding = New Padding(UiTheme.Px(6, DeviceDpi), UiTheme.Px(6, DeviceDpi), UiTheme.Px(6, DeviceDpi), UiTheme.Px(6, DeviceDpi)) grid.RowTemplate.Height = TextRenderer.MeasureText("Ag", Me.Font).Height + UiTheme.Px(14, DeviceDpi) + Return grid + + End Function + + + Private Sub ShowLibraryManuscripts() + + ClearLibraryContent() + + Dim grid As DataGridView = CreatePageGrid("All manuscripts. Press Enter to open the selected manuscript.") + grid.Columns.Add(New DataGridViewTextBoxColumn With {.Name = "Title", .HeaderText = "Title", .AutoSizeMode = DataGridViewAutoSizeColumnMode.Fill, .FillWeight = 220, .MinimumWidth = UiTheme.Px(220, DeviceDpi)}) grid.Columns.Add(New DataGridViewTextBoxColumn With {.Name = "Stage", .HeaderText = "Stage", .AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells}) grid.Columns.Add(New DataGridViewTextBoxColumn With {.Name = "Shelf", .HeaderText = "Shelf", .AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells}) grid.Columns.Add(New DataGridViewTextBoxColumn With {.Name = "Journal", .HeaderText = "Target journal", .AutoSizeMode = DataGridViewAutoSizeColumnMode.Fill, .FillWeight = 55}) grid.Columns.Add(New DataGridViewTextBoxColumn With {.Name = "Route", .HeaderText = "Route", .AutoSizeMode = DataGridViewAutoSizeColumnMode.Fill, .FillWeight = 70}) + grid.Columns.Add(New DataGridViewTextBoxColumn With {.Name = "Type", .HeaderText = "Type", .AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells}) + grid.Columns.Add(New DataGridViewTextBoxColumn With {.Name = "Tags", .HeaderText = "Tags", .AutoSizeMode = DataGridViewAutoSizeColumnMode.Fill, .FillWeight = 45}) grid.Columns.Add(New DataGridViewTextBoxColumn With {.Name = "Days", .HeaderText = "Days in stage", .AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells, .ValueType = GetType(Integer)}) grid.Columns("Days").DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleRight @@ -951,9 +970,11 @@ Partial Public Class Form1 For Each manuscript As Manuscript In manuscripts Dim route As String = RouteSummaryService.Describe(manuscript).Text + Dim type As String = If(manuscript.WorkType = WorkType.Unspecified, String.Empty, WorkTypeService.DisplayName(manuscript.WorkType)) + Dim tags As String = String.Join(", ", If(manuscript.Tags, New List(Of String)())) If filter.Length > 0 AndAlso - Not {manuscript.Title, manuscript.TargetJournal, FormatStage(manuscript.CurrentStage), FormatShelf(manuscript.Location), route}. + Not {manuscript.Title, manuscript.TargetJournal, FormatStage(manuscript.CurrentStage), FormatShelf(manuscript.Location), route, type, tags}. Any(Function(value) If(value, String.Empty).IndexOf(filter, StringComparison.CurrentCultureIgnoreCase) >= 0) Then Continue For End If @@ -970,6 +991,8 @@ Partial Public Class Form1 FormatShelf(manuscript.Location), manuscript.TargetJournal, route, + type, + tags, days) libraryGrid.Rows(index).Tag = manuscript @@ -1023,6 +1046,8 @@ Partial Public Class Form1 FillLibraryGrid() Case WorkspacePage.Deadlines FillDeadlines() + Case WorkspacePage.Insights + FillInsights() End Select End Sub diff --git a/ManuscriptPipeline/Form1.vb b/ManuscriptPipeline/Form1.vb index 5b3ddac..95fbbd6 100644 --- a/ManuscriptPipeline/Form1.vb +++ b/ManuscriptPipeline/Form1.vb @@ -1748,7 +1748,9 @@ Public Class Form1 manuscript ), query - ) + ) OrElse + If(manuscript.Tags, New List(Of String)()).Any(Function(tag) ContainsSearchText(tag, query.TrimStart("#"c))) OrElse + (manuscript.WorkType <> WorkType.Unspecified AndAlso ContainsSearchText(WorkTypeService.DisplayName(manuscript.WorkType), query)) If Not matchesSearch Then Return False @@ -2179,7 +2181,7 @@ Public Class Form1 End If Return True - ' Ctrl+1 to Ctrl+5 open the rail's pages in order. + ' Ctrl+1 to Ctrl+6 open the rail's pages in order. Case Keys.Control Or Keys.D1, Keys.Control Or Keys.NumPad1 NavigateTo(WorkspacePage.Board) Return True @@ -2193,6 +2195,9 @@ Public Class Form1 NavigateTo(WorkspacePage.Deadlines) Return True Case Keys.Control Or Keys.D5, Keys.Control Or Keys.NumPad5 + NavigateTo(WorkspacePage.Insights) + Return True + Case Keys.Control Or Keys.D6, Keys.Control Or Keys.NumPad6 NavigateTo(WorkspacePage.ImportExport) Return True @@ -2641,6 +2646,26 @@ Public Class Form1 } If hasJournal Then cardToolTip.SetToolTip(lblJournal, manuscript.TargetJournal) + ' Tags share the journal line, right-aligned, so every card keeps the + ' same height. Clicking one searches the board for it. + Dim tagStrip As TagStrip = Nothing + If manuscript.Tags IsNot Nothing AndAlso manuscript.Tags.Count > 0 Then + tagStrip = New TagStrip With { + .Tags = manuscript.Tags.ToList(), + .Library = authorLibrary, + .Font = cardMetaFont, + .Top = journalTop, + .Height = metaLine + 2, + .BackColor = UiTheme.CardBackground(), + .Cursor = Cursors.Hand + } + cardToolTip.SetToolTip(tagStrip, String.Join(", ", manuscript.Tags) & " (click to search the board)") + AddHandler tagStrip.MouseClick, + Sub(sender, e) + If e.Button = MouseButtons.Left Then txtBoardSearch.Text = manuscript.Tags(0) + End Sub + End If + ' ================================================= ' Route footer ' ================================================= @@ -2735,6 +2760,7 @@ Public Class Form1 card.Controls.Add(stageBadge) If lblStatusLine IsNot Nothing Then card.Controls.Add(lblStatusLine) card.Controls.Add(lblJournal) + If tagStrip IsNot Nothing Then card.Controls.Add(tagStrip) card.Controls.Add(divider) card.Controls.Add(dots) card.Controls.Add(lblRouteSummary) @@ -2752,7 +2778,7 @@ Public Class Form1 child.ContextMenuStrip = cardMenu AddHandler child.MouseEnter, refreshHover AddHandler child.MouseLeave, refreshHover - If Not TypeOf child Is LinkLabel AndAlso Not TypeOf child Is ButtonBase Then + If Not TypeOf child Is LinkLabel AndAlso Not TypeOf child Is ButtonBase AndAlso Not TypeOf child Is TagStrip Then AddHandler child.MouseClick, openOnLeftClick End If Next @@ -2774,6 +2800,12 @@ Public Class Form1 lblTitle.Width = contentWidth lblJournal.Width = contentWidth + If tagStrip IsNot Nothing Then + ' Tags take at most half the line; the journal keeps the rest. + tagStrip.Width = tagStrip.PreferredWidth(contentWidth \ 2) + tagStrip.Left = right - tagStrip.Width + lblJournal.Width = Math.Max(1, contentWidth - tagStrip.Width - If(tagStrip.Width > 0, UiTheme.Px(8, dpi), 0)) + End If divider.Width = contentWidth lblRoute.Left = Math.Max(pad, right - routeLinkWidth) diff --git a/ManuscriptPipeline/Forms/EditManuscriptForm.vb b/ManuscriptPipeline/Forms/EditManuscriptForm.vb index 8bb99a9..e8d7f76 100644 --- a/ManuscriptPipeline/Forms/EditManuscriptForm.vb +++ b/ManuscriptPipeline/Forms/EditManuscriptForm.vb @@ -48,6 +48,12 @@ Namespace Forms Private _authorLibraryDirty As Boolean = False Private ReadOnly fileDrawerGroup As New SectionCard() + + ' The kind of work and its tags (#64), edited in the working copy. + Private ReadOnly classificationGroup As New SectionCard() + Private ReadOnly cmbWorkType As New ComboBox() + Private ReadOnly tagEditor As New TagEditor() + Private ReadOnly lblFileDrawerDateValue As New Label() Private ReadOnly txtFileDrawerReason As New TextBox() @@ -627,13 +633,16 @@ Namespace Forms .AutoSize = True, .AutoSizeMode = AutoSizeMode.GrowAndShrink, .ColumnCount = 1, - .RowCount = 3, + .RowCount = 4, .Padding = New Padding(0) } root.RowStyles.Add(New RowStyle(SizeType.Absolute, 330)) root.RowStyles.Add(New RowStyle(SizeType.AutoSize)) root.RowStyles.Add(New RowStyle(SizeType.AutoSize)) + root.RowStyles.Add(New RowStyle(SizeType.AutoSize)) + + BuildClassificationGroup() ' The linked Journal Library record's notes and checklist, so its ' requirements are in view while editing. @@ -1189,8 +1198,9 @@ Namespace Forms footer.Controls.Add(rightButtons, 1, 0) root.Controls.Add(detailsGroup, 0, 0) - root.Controls.Add(fileDrawerGroup, 0, 1) - root.Controls.Add(journalNotesGroup, 0, 2) + root.Controls.Add(classificationGroup, 0, 1) + root.Controls.Add(fileDrawerGroup, 0, 2) + root.Controls.Add(journalNotesGroup, 0, 3) scrollHost.Controls.Add(root) @@ -1290,6 +1300,58 @@ Namespace Forms End Sub + Private Sub BuildClassificationGroup() + + classificationGroup.Text = "Type and tags" + classificationGroup.Dock = DockStyle.Top + classificationGroup.AutoSize = True + classificationGroup.AutoSizeMode = AutoSizeMode.GrowAndShrink + classificationGroup.Padding = New Padding(14, 8, 14, 12) + classificationGroup.Margin = New Padding(3, 8, 3, 8) + + Dim layout As New TableLayoutPanel With { + .Dock = DockStyle.Top, + .AutoSize = True, + .AutoSizeMode = AutoSizeMode.GrowAndShrink, + .ColumnCount = 2, + .RowCount = 2, + .Margin = New Padding(0) + } + layout.ColumnStyles.Add(New ColumnStyle(SizeType.AutoSize)) + layout.ColumnStyles.Add(New ColumnStyle(SizeType.Percent, 100)) + layout.RowStyles.Add(New RowStyle(SizeType.AutoSize)) + layout.RowStyles.Add(New RowStyle(SizeType.AutoSize)) + + cmbWorkType.DropDownStyle = ComboBoxStyle.DropDownList + cmbWorkType.AccessibleName = "Type of work" + cmbWorkType.Width = 240 + cmbWorkType.Anchor = AnchorStyles.Left + cmbWorkType.Margin = New Padding(3, 4, 3, 6) + For Each type As WorkType In [Enum].GetValues(GetType(WorkType)) + cmbWorkType.Items.Add(WorkTypeService.DisplayName(type)) + Next + AddHandler cmbWorkType.SelectedIndexChanged, + Sub(sender, e) + If cmbWorkType.SelectedIndex >= 0 Then _workingManuscript.WorkType = CType(cmbWorkType.SelectedIndex, WorkType) + End Sub + + tagEditor.Anchor = AnchorStyles.Left Or AnchorStyles.Right + tagEditor.Margin = New Padding(3, 2, 3, 2) + AddHandler tagEditor.ColorChanged, Sub(sender, e) _authorLibraryDirty = True + + Dim typeLabel As Label = CreateFieldLabel("Type") + Dim tagsLabel As Label = CreateFieldLabel("Tags") + typeLabel.Margin = New Padding(3, 4, 16, 6) + layout.Controls.Add(typeLabel, 0, 0) + layout.Controls.Add(cmbWorkType, 1, 0) + layout.Controls.Add(tagsLabel, 0, 1) + layout.Controls.Add(tagEditor, 1, 1) + + classificationGroup.Controls.Add(layout) + + End Sub + + Private Function CreateFieldLabel(text As String) As Label Return New Label With { @@ -1346,6 +1408,11 @@ Namespace Forms String.Empty ) + If _workingManuscript.Tags Is Nothing Then _workingManuscript.Tags = New List(Of String)() + cmbWorkType.SelectedIndex = CInt(_workingManuscript.WorkType) + ' Tags already used in the library are suggested while typing. + tagEditor.Bind(_workingManuscript.Tags, _authorLibrary, WorkTypeService.AllTags(_allManuscripts)) + RefreshAuthorsList() RefreshSubmissionList() @@ -3374,6 +3441,12 @@ Namespace Forms _originalManuscript.Metadata = committed.Metadata + _originalManuscript.WorkType = + committed.WorkType + + _originalManuscript.Tags = + committed.Tags + _originalManuscript.RelatedLinks = committed.RelatedLinks diff --git a/ManuscriptPipeline/Forms/JournalLibraryForm.vb b/ManuscriptPipeline/Forms/JournalLibraryForm.vb index be2fd02..f32fec4 100644 --- a/ManuscriptPipeline/Forms/JournalLibraryForm.vb +++ b/ManuscriptPipeline/Forms/JournalLibraryForm.vb @@ -363,34 +363,33 @@ Namespace Forms ). Count() - Dim submissionCount As Integer = - _manuscripts.Sum( - Function(item) - - If item.Submissions Is Nothing Then - Return 0 - End If - - Return item.Submissions. - Where( - Function(submission) - Return submission IsNot Nothing AndAlso - submission.JournalId.HasValue AndAlso - submission.JournalId.Value = selected.Id - End Function - ). - Count() + ' Your own history with the journal (#62), from recorded + ' submissions only: linked ones, and exact name matches. + Dim history As JournalHistory = + RouteAnalyticsService.ForLibrary(_manuscripts, DateTime.Today, _library.Journals).Journals. + FirstOrDefault(Function(item) item.JournalId.HasValue AndAlso item.JournalId.Value = selected.Id) + + Dim parts As New List(Of String) From { + selected.Name & " — target on " & targetCount.ToString() & If(targetCount = 1, " manuscript", " manuscripts") + } - End Function - ) + If history Is Nothing Then + parts.Add("no submissions recorded yet.") + Else + parts.Add(history.Count.ToString() & If(history.Count = 1, " submission", " submissions")) + For Each outcome In {(history.CountOutcome(SubmissionOutcome.Accepted), "accepted"), + (history.WithRevisions, "asked to revise"), + (history.CountOutcome(SubmissionOutcome.RejectedAfterReview) + history.CountOutcome(SubmissionOutcome.Rejected), "rejected"), + (history.CountOutcome(SubmissionOutcome.DeskRejected), "desk rejected")} + If outcome.Item1 > 0 Then parts.Add(outcome.Item1.ToString() & " " & outcome.Item2) + Next + If history.MedianDaysToFirstDecision.HasValue Then + parts.Add("median " & history.MedianDaysToFirstDecision.Value.Value.ToString("0.#", Globalization.CultureInfo.CurrentCulture) & " days to a first decision") + End If + parts.Add("last submitted " & history.LastSubmitted.ToString("MMM d, yyyy", Globalization.CultureInfo.CurrentCulture) & ".") + End If - lblInfo.Text = - selected.Name & - " — target on " & - targetCount.ToString() & - " manuscript(s); used by " & - submissionCount.ToString() & - " submission(s)." + lblInfo.Text = String.Join(" · ", parts) End Sub diff --git a/ManuscriptPipeline/Forms/ManuscriptRouteViewForm.vb b/ManuscriptPipeline/Forms/ManuscriptRouteViewForm.vb index 8383bda..83e3027 100644 --- a/ManuscriptPipeline/Forms/ManuscriptRouteViewForm.vb +++ b/ManuscriptPipeline/Forms/ManuscriptRouteViewForm.vb @@ -300,7 +300,7 @@ Namespace Forms .ColumnCount = 3, .RowCount = Math.Max( 1, - _route.Waypoints.Count + _route.Waypoints.Count + 1 ), .Margin = New Padding(0), .BackColor = UiTheme.BoardBackground() @@ -393,8 +393,36 @@ Namespace Forms End If + ' The route drawn to scale (#82), above the waypoints. + timeline.RowStyles.Add( + New RowStyle( + SizeType.AutoSize + ) + ) + + Dim mapCard As Control = + BuildRouteMapCard() + + If mapCard IsNot Nothing Then + + timeline.Controls.Add( + mapCard, + 0, + 0 + ) + + timeline.SetColumnSpan( + mapCard, + 3 + ) + + End If + For index As Integer = 0 To _route.Waypoints.Count - 1 + Dim row As Integer = + index + 1 + timeline.RowStyles.Add( New RowStyle( SizeType.AutoSize @@ -426,19 +454,19 @@ Namespace Forms timeline.Controls.Add( dateLabel, 0, - index + row ) timeline.Controls.Add( marker, 1, - index + row ) timeline.Controls.Add( card, 2, - index + row ) Next @@ -454,6 +482,123 @@ Namespace Forms End Function + ' The whole route to scale: who held it and for how long, with each + ' event numbered and explained. Nothing when no submission is + ' recorded yet. + Private Function BuildRouteMapCard() As Control + + Dim map As RouteMap = + RouteMapService.Build( + _manuscript, + DateTime.Today + ) + + If map.IsEmpty Then + Return Nothing + End If + + Dim section As New SectionCard With { + .Dock = DockStyle.Fill, + .AutoSize = True, + .AutoSizeMode = AutoSizeMode.GrowAndShrink, + .Padding = New Padding(18, 14, 18, 16), + .Margin = New Padding(0, 0, 0, 16), + .BackColor = UiTheme.CardBackground(), + .AccessibleName = "Route map" + } + + Dim card As New TableLayoutPanel With { + .Dock = DockStyle.Top, + .AutoSize = True, + .AutoSizeMode = AutoSizeMode.GrowAndShrink, + .ColumnCount = 1, + .RowCount = 3, + .Padding = New Padding(0), + .Margin = New Padding(0), + .BackColor = UiTheme.CardBackground() + } + + card.ColumnStyles.Add( + New ColumnStyle( + SizeType.Percent, + 100 + ) + ) + + For index As Integer = 0 To 2 + card.RowStyles.Add( + New RowStyle( + SizeType.AutoSize + ) + ) + Next + + Dim lblTitle As New Label With { + .UseMnemonic = False, + .AutoSize = True, + .Text = + map.TotalDays.ToString(Globalization.CultureInfo.CurrentCulture) & + " days from first submission to " & + If( + map.Ongoing, + "today, and counting", + If( + map.Markers.Any(Function(item) item.Kind = RouteMarkerKind.Published), + "publication", + "the last decision" + ) + ), + .Margin = New Padding(0), + .Font = New Font( + Me.Font.FontFamily, + 11.5F, + FontStyle.Bold + ), + .ForeColor = UiTheme.PrimaryText(), + .BackColor = UiTheme.CardBackground() + } + + Dim legend As New RouteMapLegend With { + .Anchor = AnchorStyles.Left Or AnchorStyles.Right Or AnchorStyles.Top, + .Margin = New Padding(0, 8, 0, 0), + .BackColor = UiTheme.CardBackground(), + .Items = RouteMapStyle.DayTotals(map) + } + + Dim bar As New RouteMapBar With { + .Anchor = AnchorStyles.Left Or AnchorStyles.Right Or AnchorStyles.Top, + .Margin = New Padding(0, 14, 0, 0), + .BackColor = UiTheme.CardBackground(), + .Map = map + } + + card.Controls.Add( + lblTitle, + 0, + 0 + ) + + card.Controls.Add( + legend, + 0, + 1 + ) + + card.Controls.Add( + bar, + 0, + 2 + ) + + section.Controls.Add( + card + ) + + Return section + + End Function + + Private Sub MakeWaypointCardInteractive( rootControl As Control, waypoint As ManuscriptRouteWaypoint diff --git a/ManuscriptPipeline/Forms/PublicationExportForm.vb b/ManuscriptPipeline/Forms/PublicationExportForm.vb index fb3254c..e7bd925 100644 --- a/ManuscriptPipeline/Forms/PublicationExportForm.vb +++ b/ManuscriptPipeline/Forms/PublicationExportForm.vb @@ -18,6 +18,7 @@ Namespace Forms Private ReadOnly cmbScope As New ComboBox() Private ReadOnly cmbStyle As New ComboBox() Private ReadOnly cmbFormat As New ComboBox() + Private ReadOnly chkGroupByType As New CheckBox() Private ReadOnly lstItems As New CheckedListBox() Private ReadOnly txtPreview As New TextBox() @@ -211,6 +212,13 @@ Namespace Forms cmbFormat ) + ' Sections such as Journal articles and Conference papers (#64). + chkGroupByType.Text = "Group by type" + chkGroupByType.AutoSize = True + chkGroupByType.Margin = New Padding(12, 6, 3, 3) + AddHandler chkGroupByType.CheckedChanged, Sub(sender, e) RefreshPreview() + options.Controls.Add(chkGroupByType) + Dim btnAll As New Button With { .Text = "Select All", .AutoSize = True @@ -525,7 +533,8 @@ Namespace Forms OptionItem ).Value, PublicationExportStyle - ) + ), + chkGroupByType.Checked ) End Function diff --git a/ManuscriptPipeline/Forms/ReportForm.vb b/ManuscriptPipeline/Forms/ReportForm.vb new file mode 100644 index 0000000..e75a86b --- /dev/null +++ b/ManuscriptPipeline/Forms/ReportForm.vb @@ -0,0 +1,230 @@ +Imports System +Imports System.Collections.Generic +Imports System.Diagnostics +Imports System.Drawing +Imports System.IO +Imports System.Linq +Imports System.Text +Imports System.Windows.Forms +Imports ManuscriptPipeline.Controls +Imports ManuscriptPipeline.Models +Imports ManuscriptPipeline.Services + +Namespace Forms + + ' Previews a report exactly as it will be saved (#30, #63). For the + ' pipeline report, the user chooses which manuscripts it covers. + Friend Class ReportForm + Inherits Form + + Private ReadOnly _build As Func(Of List(Of Manuscript), Boolean, String) + Private ReadOnly _choices As List(Of Manuscript) + Private ReadOnly _fileName As String + + Private ReadOnly lstManuscripts As New CheckedListBox() + Private ReadOnly chkDeadlines As New CheckBox() + Private ReadOnly chkOpen As New CheckBox() + Private ReadOnly preview As New WebBrowser() + Private ReadOnly btnSave As New ActionButton() + Private ReadOnly previewTimer As New Timer With {.Interval = 250} + + ' Tests choose the file instead of a Save dialog. + Friend SavePathPrompt As Func(Of String) = Nothing + + + Friend Property SavedPath As String = String.Empty + + ' A report of the chosen manuscripts, with a list to choose them. + Public Sub New(title As String, fileName As String, choices As List(Of Manuscript), build As Func(Of List(Of Manuscript), Boolean, String)) + _build = build + _choices = choices + _fileName = fileName + BuildInterface(title) + End Sub + + Private Sub BuildInterface(title As String) + + Text = title + StartPosition = FormStartPosition.CenterParent + ShowInTaskbar = False + MinimizeBox = False + AutoScaleMode = AutoScaleMode.Dpi + Font = New Font("Segoe UI", 9.0F) + ClientSize = New Size(1120, 700) + MinimumSize = New Size(720, 480) + + Dim root As New TableLayoutPanel With {.Dock = DockStyle.Fill, .ColumnCount = If(_choices Is Nothing, 1, 2), .RowCount = 2, .Padding = New Padding(16, 14, 16, 12)} + If _choices IsNot Nothing Then root.ColumnStyles.Add(New ColumnStyle(SizeType.Absolute, 280)) + root.ColumnStyles.Add(New ColumnStyle(SizeType.Percent, 100)) + root.RowStyles.Add(New RowStyle(SizeType.Percent, 100)) + root.RowStyles.Add(New RowStyle(SizeType.AutoSize)) + + If _choices IsNot Nothing Then + Dim side As New TableLayoutPanel With {.Dock = DockStyle.Fill, .ColumnCount = 1, .RowCount = 4, .Margin = New Padding(0, 0, 12, 0)} + side.RowStyles.Add(New RowStyle(SizeType.AutoSize)) + side.RowStyles.Add(New RowStyle(SizeType.Percent, 100)) + side.RowStyles.Add(New RowStyle(SizeType.AutoSize)) + side.RowStyles.Add(New RowStyle(SizeType.AutoSize)) + side.Controls.Add(New Label With {.Text = "Include", .AutoSize = True, .Font = New Font(Font, FontStyle.Bold), .Margin = New Padding(0, 0, 0, 4)}, 0, 0) + + lstManuscripts.Dock = DockStyle.Fill + lstManuscripts.CheckOnClick = True + lstManuscripts.IntegralHeight = False + lstManuscripts.HorizontalScrollbar = True + lstManuscripts.AccessibleName = "Manuscripts in the report" + For Each manuscript As Manuscript In _choices + Dim index As Integer = lstManuscripts.Items.Add(ReminderService.SafeManuscriptTitle(manuscript)) + lstManuscripts.SetItemChecked(index, manuscript.Location = ManuscriptLocation.Pipeline) + Next + AddHandler lstManuscripts.ItemCheck, Sub(sender, e) SchedulePreview() + side.Controls.Add(lstManuscripts, 0, 1) + + chkDeadlines.Text = "Include the next deadline" + chkDeadlines.AutoSize = True + chkDeadlines.Checked = True + chkDeadlines.Margin = New Padding(0, 8, 0, 0) + AddHandler chkDeadlines.CheckedChanged, Sub(sender, e) SchedulePreview() + side.Controls.Add(chkDeadlines, 0, 2) + + side.Controls.Add(New Label With { + .Text = "The report never includes notes, correspondence, reviewer comments, files, or contact details. Reminders appear only as ""Reminder"".", + .AutoSize = True, + .MaximumSize = New Size(260, 0), + .ForeColor = SystemColors.GrayText, + .UseMnemonic = False, + .Margin = New Padding(0, 10, 0, 0) + }, 0, 3) + root.Controls.Add(side, 0, 0) + End If + + preview.Dock = DockStyle.Fill + preview.ScriptErrorsSuppressed = True + preview.IsWebBrowserContextMenuEnabled = False + preview.WebBrowserShortcutsEnabled = False + preview.AllowWebBrowserDrop = False + preview.AccessibleName = "Report preview" + ' The preview shows the report; it never leaves it. + AddHandler preview.Navigating, + Sub(sender, e) + If e.Url IsNot Nothing AndAlso e.Url.ToString() <> "about:blank" Then e.Cancel = True + End Sub + Dim frame As New Panel With {.Dock = DockStyle.Fill, .Padding = New Padding(1), .Margin = New Padding(0), .BackColor = UiTheme.CardBorder()} + frame.Controls.Add(preview) + root.Controls.Add(frame, If(_choices Is Nothing, 0, 1), 0) + + Dim buttons As New FlowLayoutPanel With {.AutoSize = True, .AutoSizeMode = AutoSizeMode.GrowAndShrink, .FlowDirection = FlowDirection.RightToLeft, .WrapContents = False, .Dock = DockStyle.Fill, .Margin = New Padding(0, 12, 0, 0)} + btnSave.Text = "Save Report..." + btnSave.Role = ActionButtonRole.Primary + btnSave.Height = 34 + btnSave.Width = 130 + AddHandler btnSave.Click, AddressOf SaveReport + Dim btnCancel As New ActionButton With {.Text = "Cancel", .Height = 34, .Width = 90, .DialogResult = DialogResult.Cancel, .Margin = New Padding(0, 0, 8, 0)} + chkOpen.Text = "Open in my browser after saving, to print or save as PDF" + chkOpen.AutoSize = True + chkOpen.Checked = True + chkOpen.Margin = New Padding(0, 8, 16, 0) + buttons.Controls.Add(btnSave) + buttons.Controls.Add(btnCancel) + buttons.Controls.Add(chkOpen) + root.Controls.Add(buttons, 0, 1) + root.SetColumnSpan(buttons, root.ColumnCount) + + Controls.Add(root) + AcceptButton = btnSave + CancelButton = btnCancel + + AddHandler previewTimer.Tick, + Sub(sender, e) + previewTimer.Stop() + RefreshPreview() + End Sub + + UiPolish.ApplyDialog(Me) + + End Sub + + + Protected Overrides Sub OnShown(e As EventArgs) + MyBase.OnShown(e) + RefreshPreview() + End Sub + + + Private Sub SchedulePreview() + previewTimer.Stop() + previewTimer.Start() + End Sub + + + Friend ReadOnly Property Chosen As List(Of Manuscript) + Get + If _choices Is Nothing Then Return Nothing + Return lstManuscripts.CheckedIndices.Cast(Of Integer)().Select(Function(index) _choices(index)).ToList() + End Get + End Property + + + Friend Function CurrentHtml() As String + Return _build(Chosen, chkDeadlines.Checked) + End Function + + + Private Sub RefreshPreview() + If IsDisposed Then Return + btnSave.Enabled = _choices Is Nothing OrElse lstManuscripts.CheckedIndices.Count > 0 + preview.DocumentText = CurrentHtml() + End Sub + + + Friend Sub SaveReport(sender As Object, e As EventArgs) + + Dim path As String + If SavePathPrompt IsNot Nothing Then + path = SavePathPrompt() + Else + Using picker As New SaveFileDialog With { + .Title = Text, + .Filter = "Web page (*.html)|*.html", + .DefaultExt = "html", + .AddExtension = True, + .OverwritePrompt = True, + .FileName = _fileName + } + If picker.ShowDialog(Me) <> DialogResult.OK Then Return + path = picker.FileName + End Using + End If + If String.IsNullOrWhiteSpace(path) Then Return + + Try + File.WriteAllText(path, CurrentHtml(), New UTF8Encoding(False)) + Catch ex As Exception When TypeOf ex Is IOException OrElse TypeOf ex Is UnauthorizedAccessException + MessageBox.Show(Me, "PaperRoute could not save the report." & Environment.NewLine & Environment.NewLine & ex.Message, + Text, MessageBoxButtons.OK, MessageBoxIcon.Error) + Return + End Try + + SavedPath = path + + If chkOpen.Checked AndAlso SavePathPrompt Is Nothing Then + Try + Process.Start(New ProcessStartInfo(path) With {.UseShellExecute = True}) + Catch ex As Exception + ' Saving succeeded; opening is a convenience. + End Try + End If + + DialogResult = DialogResult.OK + Close() + + End Sub + + + Protected Overrides Sub Dispose(disposing As Boolean) + If disposing Then previewTimer.Dispose() + MyBase.Dispose(disposing) + End Sub + + End Class + +End Namespace diff --git a/ManuscriptPipeline/ManuscriptPipeline.vbproj b/ManuscriptPipeline/ManuscriptPipeline.vbproj index f50ad2a..4571ff5 100644 --- a/ManuscriptPipeline/ManuscriptPipeline.vbproj +++ b/ManuscriptPipeline/ManuscriptPipeline.vbproj @@ -1,9 +1,9 @@ - 0.7.0 - 0.7.0.0 - 0.7.0.0 + 0.8.0-rc.1 + 0.8.0.0 + 0.8.0.0 PaperRouteTracker ManuscriptPipeline PaperRoute Tracker diff --git a/ManuscriptPipeline/Models/AuthorLibraryData.vb b/ManuscriptPipeline/Models/AuthorLibraryData.vb index abbc34b..38067ae 100644 --- a/ManuscriptPipeline/Models/AuthorLibraryData.vb +++ b/ManuscriptPipeline/Models/AuthorLibraryData.vb @@ -16,6 +16,11 @@ Namespace Models Public Property Journals As List(Of JournalRecord) = New List(Of JournalRecord)() + ' Colors chosen for tags (#64). A tag without one gets its color from + ' its name. + Public Property TagColors As List(Of TagColor) = + New List(Of TagColor)() + End Class End Namespace diff --git a/ManuscriptPipeline/Models/Manuscript.vb b/ManuscriptPipeline/Models/Manuscript.vb index 99909ba..552ba65 100644 --- a/ManuscriptPipeline/Models/Manuscript.vb +++ b/ManuscriptPipeline/Models/Manuscript.vb @@ -64,6 +64,12 @@ Namespace Models Public Property Submissions As List(Of JournalSubmission) = New List(Of JournalSubmission)() + ' The kind of work and the user's own tags (Schema 8). + Public Property WorkType As WorkType = WorkType.Unspecified + + Public Property Tags As List(Of String) = + New List(Of String)() + ' Possible publications found by a publication check (Schema 7). Public Property PublicationMatches As List(Of PublicationMatch) = New List(Of PublicationMatch)() diff --git a/ManuscriptPipeline/Models/TagColor.vb b/ManuscriptPipeline/Models/TagColor.vb new file mode 100644 index 0000000..3a2d385 --- /dev/null +++ b/ManuscriptPipeline/Models/TagColor.vb @@ -0,0 +1,25 @@ +Namespace Models + + ' A color the user chose for a tag. Tags without one get a color from + ' their name, so the same tag always looks the same. + Public Class TagColor + + Public Property Tag As String = String.Empty + + Public Property Color As TagPalette = TagPalette.Teal + + End Class + + + Public Enum TagPalette + Teal + Blue + Violet + Rose + Amber + Green + Slate + Orange + End Enum + +End Namespace diff --git a/ManuscriptPipeline/Models/WorkType.vb b/ManuscriptPipeline/Models/WorkType.vb new file mode 100644 index 0000000..095c4cf --- /dev/null +++ b/ManuscriptPipeline/Models/WorkType.vb @@ -0,0 +1,17 @@ +Namespace Models + + ' What kind of work a manuscript is (#64). Unspecified until the user or + ' an import says; nothing is inferred. + Public Enum WorkType + Unspecified + JournalArticle + Preprint + ConferencePaper + ConferenceAbstract + Poster + BookChapter + Thesis + Other + End Enum + +End Namespace diff --git a/ManuscriptPipeline/Program.vb b/ManuscriptPipeline/Program.vb index 68707f1..ff29712 100644 --- a/ManuscriptPipeline/Program.vb +++ b/ManuscriptPipeline/Program.vb @@ -15,6 +15,25 @@ Friend Module Program ' existing VB application framework continues as usual. VelopackApp.Build().Run() + ' One window per library (#77): a second launch brings the running + ' window forward and exits before touching storage. + Dim instanceKey As String = SingleInstanceService.KeyFor(StorageMigrationService.CurrentDataRoot()) + Dim instance As SingleInstanceService = SingleInstanceService.TryStart(instanceKey) + + If instance Is Nothing Then + SingleInstanceService.SignalExisting(instanceKey) + Return + End If + + Using instance + Run(args, instance) + End Using + + End Sub + + + Private Sub Run(args As String(), instance As SingleInstanceService) + Try ' Validate and migrate PaperRoute storage before settings, @@ -47,6 +66,19 @@ Friend Module Program Dim application As New My.MyApplication() + instance.Listen( + Sub() + Dim window As Form = Application.OpenForms.OfType(Of Form1)().FirstOrDefault() + If window Is Nothing OrElse window.IsDisposed OrElse Not window.IsHandleCreated Then Return + window.BeginInvoke( + New Action( + Sub() + If window.WindowState = FormWindowState.Minimized Then window.WindowState = FormWindowState.Normal + window.Activate() + window.BringToFront() + End Sub)) + End Sub) + application.Run( args ) diff --git a/ManuscriptPipeline/Services/AuthorLibraryRepository.vb b/ManuscriptPipeline/Services/AuthorLibraryRepository.vb index e6be404..1f76fd6 100644 --- a/ManuscriptPipeline/Services/AuthorLibraryRepository.vb +++ b/ManuscriptPipeline/Services/AuthorLibraryRepository.vb @@ -554,6 +554,8 @@ Namespace Services End If + WorkTypeService.NormalizeTagColors(library) + Dim authorIds As New HashSet(Of Guid)() For Each author As AuthorRecord In library.Authors diff --git a/ManuscriptPipeline/Services/BibTeXService.vb b/ManuscriptPipeline/Services/BibTeXService.vb index bfc52e8..b74d647 100644 --- a/ManuscriptPipeline/Services/BibTeXService.vb +++ b/ManuscriptPipeline/Services/BibTeXService.vb @@ -84,13 +84,16 @@ Namespace Services End If Dim entryType As String = - If( - manuscript.Metadata IsNot Nothing AndAlso - Not String.IsNullOrWhiteSpace( - manuscript.Metadata.PublicationJournal - ), - "article", - "misc" + WorkTypeService.ToBibTeX( + manuscript.WorkType, + If( + manuscript.Metadata IsNot Nothing AndAlso + Not String.IsNullOrWhiteSpace( + manuscript.Metadata.PublicationJournal + ), + "article", + "misc" + ) ) Dim key As String = diff --git a/ManuscriptPipeline/Services/BibliographyExchangeService.vb b/ManuscriptPipeline/Services/BibliographyExchangeService.vb index fc8214e..1c011fb 100644 --- a/ManuscriptPipeline/Services/BibliographyExchangeService.vb +++ b/ManuscriptPipeline/Services/BibliographyExchangeService.vb @@ -252,6 +252,12 @@ Namespace Services record.LooksPublished Dim manuscript As New Manuscript With { + .WorkType = + If( + record.SourceFormat = BibliographyFormat.BibTeX, + WorkTypeService.FromBibTeX(record.SourceType), + WorkTypeService.FromRis(record.SourceType) + ), .Title = If( String.IsNullOrWhiteSpace(record.Title), diff --git a/ManuscriptPipeline/Services/CrossrefApplyService.vb b/ManuscriptPipeline/Services/CrossrefApplyService.vb index 94a8e44..6bef9f9 100644 --- a/ManuscriptPipeline/Services/CrossrefApplyService.vb +++ b/ManuscriptPipeline/Services/CrossrefApplyService.vb @@ -174,6 +174,11 @@ Namespace Services End If + ' Crossref names the kind of work; it fills only an unset type. + If manuscript.WorkType = WorkType.Unspecified Then + manuscript.WorkType = WorkTypeService.FromRegistry(suggestion.WorkType) + End If + RecordProvenance( manuscript.Metadata, suggestion diff --git a/ManuscriptPipeline/Services/LibraryExcelExporter.vb b/ManuscriptPipeline/Services/LibraryExcelExporter.vb index b0b39ff..3251ba1 100644 --- a/ManuscriptPipeline/Services/LibraryExcelExporter.vb +++ b/ManuscriptPipeline/Services/LibraryExcelExporter.vb @@ -86,6 +86,14 @@ Namespace Services manuscriptsSheet.Cell(manuscriptRow, 8).Value = manuscript.FileDrawerReason + If manuscript.WorkType <> WorkType.Unspecified Then + manuscriptsSheet.Cell(manuscriptRow, 9).Value = + WorkTypeService.DisplayName(manuscript.WorkType) + End If + + manuscriptsSheet.Cell(manuscriptRow, 10).Value = + String.Join("; ", If(manuscript.Tags, New List(Of String)())) + manuscriptRow += 1 ' ========================================= diff --git a/ManuscriptPipeline/Services/ManuscriptCloneService.vb b/ManuscriptPipeline/Services/ManuscriptCloneService.vb index 7fe780a..7fcb678 100644 --- a/ManuscriptPipeline/Services/ManuscriptCloneService.vb +++ b/ManuscriptPipeline/Services/ManuscriptCloneService.vb @@ -32,7 +32,9 @@ Namespace Services .StageEnteredDate = source.StageEnteredDate, .RevisionDeadline = source.RevisionDeadline, .FileDrawerDate = source.FileDrawerDate, - .FileDrawerReason = source.FileDrawerReason + .FileDrawerReason = source.FileDrawerReason, + .WorkType = source.WorkType, + .Tags = If(source.Tags, New List(Of String)()).ToList() } If source.Authors IsNot Nothing Then diff --git a/ManuscriptPipeline/Services/ManuscriptRepository.vb b/ManuscriptPipeline/Services/ManuscriptRepository.vb index 28499d2..0ed1db4 100644 --- a/ManuscriptPipeline/Services/ManuscriptRepository.vb +++ b/ManuscriptPipeline/Services/ManuscriptRepository.vb @@ -651,6 +651,7 @@ Namespace Services ReviewerResponseService.NormalizeAndValidateManuscript(manuscript) PublicationMatchService.NormalizeAndValidateManuscript(manuscript) + WorkTypeService.NormalizeAndValidateManuscript(manuscript) Next @@ -1226,6 +1227,7 @@ Namespace Services ReviewerResponseService.NormalizeAndValidateManuscript(manuscript) PublicationMatchService.NormalizeAndValidateManuscript(manuscript) + WorkTypeService.NormalizeAndValidateManuscript(manuscript) Next diff --git a/ManuscriptPipeline/Services/OrcidApplyService.vb b/ManuscriptPipeline/Services/OrcidApplyService.vb index c62e2af..a63f4c5 100644 --- a/ManuscriptPipeline/Services/OrcidApplyService.vb +++ b/ManuscriptPipeline/Services/OrcidApplyService.vb @@ -402,6 +402,7 @@ Namespace Services work.PublishedDate.HasValue Dim manuscript As New Manuscript With { + .WorkType = WorkTypeService.FromRegistry(work.WorkType), .Title = work.Title.Trim(), .Metadata = metadata, .CurrentStage = diff --git a/ManuscriptPipeline/Services/PortableRestoreService.vb b/ManuscriptPipeline/Services/PortableRestoreService.vb index 39ed098..fdda55e 100644 --- a/ManuscriptPipeline/Services/PortableRestoreService.vb +++ b/ManuscriptPipeline/Services/PortableRestoreService.vb @@ -1138,6 +1138,7 @@ Namespace Services ReviewerResponseService.NormalizeAndValidateManuscript(manuscript) PublicationMatchService.NormalizeAndValidateManuscript(manuscript) + WorkTypeService.NormalizeAndValidateManuscript(manuscript) Next diff --git a/ManuscriptPipeline/Services/PublicationExportService.vb b/ManuscriptPipeline/Services/PublicationExportService.vb index 7dc9c57..1e1bf55 100644 --- a/ManuscriptPipeline/Services/PublicationExportService.vb +++ b/ManuscriptPipeline/Services/PublicationExportService.vb @@ -79,7 +79,8 @@ Namespace Services manuscripts As IEnumerable(Of Manuscript), authorLibrary As AuthorLibraryData, format As PublicationExportFormat, - style As PublicationExportStyle + style As PublicationExportStyle, + Optional groupByType As Boolean = False ) As String If manuscripts Is Nothing Then @@ -110,6 +111,10 @@ Namespace Services ). ToList() + If groupByType Then + Return ExportGrouped(items, authorLibrary, format, style) + End If + Select Case format Case PublicationExportFormat.PlainText @@ -147,6 +152,76 @@ Namespace Services End Function + ' One section per kind of work (#64), in a fixed order; work without + ' a type, or of another type, comes last as "Other work". + Public Shared Function GroupHeading(type As WorkType) As String + Select Case type + Case WorkType.JournalArticle : Return "Journal articles" + Case WorkType.Preprint : Return "Preprints" + Case WorkType.ConferencePaper : Return "Conference papers" + Case WorkType.ConferenceAbstract : Return "Conference abstracts" + Case WorkType.Poster : Return "Posters" + Case WorkType.BookChapter : Return "Book chapters" + Case WorkType.Thesis : Return "Theses and dissertations" + Case Else : Return "Other work" + End Select + End Function + + + Private Shared Function ExportGrouped( + items As List(Of Manuscript), + authorLibrary As AuthorLibraryData, + format As PublicationExportFormat, + style As PublicationExportStyle + ) As String + + Dim sections = items. + GroupBy(Function(item) If(item.WorkType = WorkType.Unspecified, WorkType.Other, item.WorkType)). + OrderBy(Function(group) CInt(group.Key)).ToList() + + Dim builder As New StringBuilder() + + Select Case format + + Case PublicationExportFormat.PlainText + If style = PublicationExportStyle.CvSection Then builder.AppendLine("PUBLICATIONS").AppendLine() + For Each section In sections + builder.AppendLine(GroupHeading(section.Key).ToUpperInvariant()).AppendLine() + builder.AppendLine(ExportPlainText(section.ToList(), authorLibrary, PublicationExportStyle.PublicationList)).AppendLine() + Next + Return builder.ToString().TrimEnd() + + Case PublicationExportFormat.Markdown + If style = PublicationExportStyle.CvSection Then builder.AppendLine("## Publications").AppendLine() + For Each section In sections + builder.AppendLine("### " & GroupHeading(section.Key)).AppendLine() + builder.AppendLine(ExportMarkdown(section.ToList(), authorLibrary, PublicationExportStyle.PublicationList)).AppendLine() + Next + Return builder.ToString().TrimEnd() + + Case PublicationExportFormat.Html + builder.AppendLine("") + builder.AppendLine("PaperRoute Publications") + If style = PublicationExportStyle.CvSection Then builder.AppendLine("

Publications

") + For Each section In sections + builder.AppendLine("

" & WebUtility.HtmlEncode(GroupHeading(section.Key)) & "

") + builder.AppendLine("
    ") + For Each manuscript As Manuscript In section + builder.Append("
  • ").Append(WebUtility.HtmlEncode(FormatCitation(manuscript, authorLibrary))).AppendLine("
    • ") + Next + builder.AppendLine("
") + Next + builder.AppendLine("") + Return builder.ToString() + + Case Else + Throw New ArgumentOutOfRangeException(NameOf(format)) + + End Select + + End Function + + Public Shared Function FormatCitation( manuscript As Manuscript, authorLibrary As AuthorLibraryData diff --git a/ManuscriptPipeline/Services/ReportService.vb b/ManuscriptPipeline/Services/ReportService.vb new file mode 100644 index 0000000..2e8e90d --- /dev/null +++ b/ManuscriptPipeline/Services/ReportService.vb @@ -0,0 +1,232 @@ +Imports System +Imports System.Collections.Generic +Imports System.Globalization +Imports System.Linq +Imports System.Net +Imports System.Text +Imports ManuscriptPipeline.Models + +Namespace Services + + ' Self-contained HTML reports (#30, #63) that open in any browser and + ' print to PDF. They are built only from titles, stages, journals, dates, + ' and decisions: notes, correspondence, reviewer comments and responses, + ' file paths, and contact details are never read, so they cannot leak. + Public NotInheritable Class ReportService + + Private Sub New() + End Sub + + + Public Shared Function StageName(stage As PaperStage) As String + Select Case stage + Case PaperStage.UnderReview : Return "Under review" + Case PaperStage.InPress : Return "In press" + Case Else : Return stage.ToString() + End Select + End Function + + + Public Shared Function ShelfName(location As ManuscriptLocation) As String + Select Case location + Case ManuscriptLocation.FileDrawer : Return "File Drawer" + Case ManuscriptLocation.Published : Return "Published" + Case Else : Return "Pipeline" + End Select + End Function + + + ' A pipeline status report for a supervisor, mentor, or coauthor. + Public Shared Function PipelineReport( + manuscripts As IEnumerable(Of Manuscript), + today As DateTime, + Optional preparedBy As String = "", + Optional includeDeadlines As Boolean = True + ) As String + + Dim chosen As List(Of Manuscript) = manuscripts.Where(Function(item) item IsNot Nothing).ToList() + Dim deadlines As List(Of DeadlineItem) = + If(includeDeadlines, DeadlineService.Build(chosen, today).Where(Function(item) item.DueDate.HasValue AndAlso item.Group <> DeadlineGroup.Done).ToList(), New List(Of DeadlineItem)()) + + Dim html As New StringBuilder() + OpenDocument(html, "Manuscript pipeline") + html.Append("

Manuscript pipeline

") + html.Append(Encode(today.ToString("MMMM d, yyyy", CultureInfo.CurrentCulture))) + If Not String.IsNullOrWhiteSpace(preparedBy) Then html.Append(" · Prepared by ").Append(Encode(preparedBy.Trim())) + html.Append(" · ").Append(chosen.Count.ToString(CultureInfo.CurrentCulture)).Append(If(chosen.Count = 1, " manuscript", " manuscripts")) + html.Append("

") + + For Each location In {ManuscriptLocation.Pipeline, ManuscriptLocation.Published, ManuscriptLocation.FileDrawer} + Dim shelf As List(Of Manuscript) = chosen.Where(Function(item) item.Location = location). + OrderBy(Function(item) item.CurrentStage).ThenBy(Function(item) item.Title, StringComparer.CurrentCultureIgnoreCase).ToList() + If shelf.Count = 0 Then Continue For + + html.Append("

").Append(Encode(ShelfName(location))).Append("

") + html.Append("") + If location = ManuscriptLocation.Pipeline Then html.Append("") + If includeDeadlines AndAlso location = ManuscriptLocation.Pipeline Then html.Append("") + html.Append("") + + For Each manuscript As Manuscript In shelf + html.Append("") + html.Append("") + html.Append("") + html.Append("") + If location = ManuscriptLocation.Pipeline Then + Dim entered As DateTime = manuscript.StageEnteredDate.Date + html.Append("") + End If + If includeDeadlines AndAlso location = ManuscriptLocation.Pipeline Then + Dim nextDue As DeadlineItem = deadlines.Where(Function(item) item.ManuscriptId = manuscript.Id).OrderBy(Function(item) item.DueDate.Value).FirstOrDefault() + html.Append("") + End If + html.Append("") + Next + + html.Append("
ManuscriptStageJournalRouteIn stageNext deadline
").Append(Encode(ReminderService.SafeManuscriptTitle(manuscript))).Append("").Append(Encode(StageName(manuscript.CurrentStage))).Append("").Append(Encode(If(manuscript.TargetJournal, String.Empty).Trim())).Append("").Append(Encode(RouteSummaryService.Describe(manuscript).Text)).Append("") + If entered > DateTime.MinValue.Date AndAlso entered <= today.Date Then html.Append(DayCount((today.Date - entered).Days)) + html.Append("") + If nextDue IsNot Nothing Then + html.Append(Encode(nextDue.DueDate.Value.ToString("MMM d", CultureInfo.CurrentCulture))).Append(" · ").Append(Encode(DeadlineLabel(nextDue))) + End If + html.Append("
") + Next + + html.Append("
From PaperRoute records on ").Append(Encode(today.ToString("MMMM d, yyyy", CultureInfo.CurrentCulture))) + html.Append(". Notes, correspondence, reviewer comments, and files are not included.
") + CloseDocument(html) + Return html.ToString() + + End Function + + + ' Custom reminder titles are the user's own words, so a shared report + ' names only the kind of deadline. + Private Shared Function DeadlineLabel(item As DeadlineItem) As String + Select Case item.Kind + Case DeadlineKind.Revision : Return "Revision due" + Case DeadlineKind.FollowUp : Return "Journal follow-up" + Case Else : Return "Reminder" + End Select + End Function + + + ' One manuscript's route: every submission, its decisions, and the + ' durations between recorded dates, with the definitions used. + Public Shared Function RouteReport(manuscript As Manuscript, today As DateTime) As String + + If manuscript Is Nothing Then Throw New ArgumentNullException(NameOf(manuscript)) + + Dim statistics As ManuscriptStatistics = RouteAnalyticsService.DescribeManuscript(manuscript, today) + Dim html As New StringBuilder() + Dim title As String = ReminderService.SafeManuscriptTitle(manuscript) + + OpenDocument(html, title & " route") + html.Append("

").Append(Encode(title)).Append("

") + html.Append(Encode(StageName(manuscript.CurrentStage))).Append(" · ").Append(Encode(ShelfName(manuscript.Location))) + html.Append(" · Route as of ").Append(Encode(today.ToString("MMMM d, yyyy", CultureInfo.CurrentCulture))).Append("

") + + html.Append("
") + Summary(html, "Journals", statistics.JournalCount.ToString(CultureInfo.CurrentCulture)) + Summary(html, "Revision rounds", statistics.RevisionRounds.ToString(CultureInfo.CurrentCulture)) + Summary(html, "First submitted", DateText(statistics.FirstSubmitted)) + Summary(html, "First submission to acceptance", If(statistics.DaysToAcceptance.HasValue, DayCount(statistics.DaysToAcceptance.Value), "Not recorded")) + Summary(html, "First submission to publication", If(statistics.DaysToPublication.HasValue, DayCount(statistics.DaysToPublication.Value), "Not recorded")) + html.Append("
") + + If statistics.Submissions.Count = 0 Then + html.Append("

No submissions are recorded yet.

") + Else + html.Append("

Submissions

") + Dim number As Integer = 0 + For Each submission As SubmissionStatistics In statistics.Submissions + number += 1 + Dim decisions As String = String.Join("; ", + If(submission.Submission.Decisions, New List(Of EditorialDecisionEvent)()). + Where(Function(item) item IsNot Nothing AndAlso item.Decision <> EditorialDecision.None). + OrderBy(Function(item) item.DecisionDate). + Select(Function(item) EditorialDecisionDisplayService.Format(item.Decision) & ", " & item.DecisionDate.ToString("MMM d, yyyy", CultureInfo.CurrentCulture))) + html.Append("") + html.Append("") + html.Append("") + html.Append("") + html.Append("") + html.Append("") + html.Append("") + Next + html.Append("
#JournalSubmittedDecisionsFirst decisionOutcomeAt the journal
").Append(number.ToString(CultureInfo.CurrentCulture)).Append("").Append(Encode(If(submission.JournalName.Length > 0, submission.JournalName, "(No journal recorded)"))).Append("").Append(Encode(submission.SubmittedDate.ToString("MMM d, yyyy", CultureInfo.CurrentCulture))).Append("").Append(Encode(If(decisions.Length > 0, decisions, "None recorded"))).Append("").Append(If(submission.DaysToFirstDecision.HasValue, DayCount(submission.DaysToFirstDecision.Value), "—")).Append("").Append(Encode(OutcomeName(submission.Outcome))).Append("").Append(If(submission.DaysAtJournal.HasValue, DayCount(submission.DaysAtJournal.Value) & If(submission.Outcome = SubmissionOutcome.Open, " so far", ""), "—")).Append("
") + End If + + html.Append("

How this is calculated. Days are calendar days between dates recorded in PaperRoute. ") + html.Append("A first decision is the earliest decision recorded for a submission. An open submission counts to the report date. ") + html.Append("Missing or inconsistent dates are shown as not recorded, never estimated. Dates are when events happened as entered, not when they were typed in.

") + html.Append("

Notes, correspondence, reviewer comments, and files are not included.

") + CloseDocument(html) + Return html.ToString() + + End Function + + + Public Shared Function OutcomeName(outcome As SubmissionOutcome) As String + Select Case outcome + Case SubmissionOutcome.DeskRejected : Return "Desk rejected" + Case SubmissionOutcome.RejectedAfterReview : Return "Rejected after review" + Case SubmissionOutcome.Rejected : Return "Rejected" + Case SubmissionOutcome.Accepted : Return "Accepted" + Case SubmissionOutcome.Withdrawn : Return "Withdrawn" + Case Else : Return "Open" + End Select + End Function + + + Private Shared Sub Summary(html As StringBuilder, term As String, value As String) + html.Append("
").Append(Encode(term)).Append("
").Append(Encode(value)).Append("
") + End Sub + + + Private Shared Function DateText(value As DateTime?) As String + Return If(value.HasValue, value.Value.ToString("MMM d, yyyy", CultureInfo.CurrentCulture), "Not recorded") + End Function + + + Private Shared Function DayCount(days As Integer) As String + Return days.ToString(CultureInfo.CurrentCulture) & If(days = 1, " day", " days") + End Function + + + Private Shared Function Encode(value As String) As String + Return WebUtility.HtmlEncode(If(value, String.Empty)) + End Function + + + ' Print-friendly, and readable on screen in light or dark. + Private Shared Sub OpenDocument(html As StringBuilder, title As String) + html.Append("") + html.Append("") + html.Append("") + html.Append("") + html.Append("").Append(Encode(title)).Append("") + End Sub + + + Private Shared Sub CloseDocument(html As StringBuilder) + html.Append("") + End Sub + + End Class + +End Namespace diff --git a/ManuscriptPipeline/Services/RisService.vb b/ManuscriptPipeline/Services/RisService.vb index a7f5241..81b4e5d 100644 --- a/ManuscriptPipeline/Services/RisService.vb +++ b/ManuscriptPipeline/Services/RisService.vb @@ -171,13 +171,16 @@ Namespace Services End If Dim recordType As String = - If( - manuscript.Metadata IsNot Nothing AndAlso - Not String.IsNullOrWhiteSpace( - manuscript.Metadata.PublicationJournal - ), - "JOUR", - "GEN" + WorkTypeService.ToRis( + manuscript.WorkType, + If( + manuscript.Metadata IsNot Nothing AndAlso + Not String.IsNullOrWhiteSpace( + manuscript.Metadata.PublicationJournal + ), + "JOUR", + "GEN" + ) ) AddLine(builder, "TY", recordType) diff --git a/ManuscriptPipeline/Services/RouteAnalyticsService.vb b/ManuscriptPipeline/Services/RouteAnalyticsService.vb new file mode 100644 index 0000000..7d2fa03 --- /dev/null +++ b/ManuscriptPipeline/Services/RouteAnalyticsService.vb @@ -0,0 +1,408 @@ +Imports System +Imports System.Collections.Generic +Imports System.Linq +Imports System.Text.RegularExpressions +Imports ManuscriptPipeline.Models + +Namespace Services + + ' How a journal submission ended, from its latest recorded decision. + Public Enum SubmissionOutcome + ' No closing decision yet, including a revision in progress. + Open + DeskRejected + RejectedAfterReview + ' Rejected without saying whether the paper was reviewed. + Rejected + Accepted + Withdrawn + End Enum + + + Public NotInheritable Class SubmissionStatistics + + Public Property Submission As JournalSubmission + + Public Property JournalName As String = String.Empty + + Public Property SubmittedDate As DateTime + + ' The first recorded decision, and how long it took. + Public Property FirstDecision As EditorialDecision? = Nothing + + Public Property DaysToFirstDecision As Integer? = Nothing + + ' Revision requests (major, minor, or revise and resubmit). + Public Property RevisionRounds As Integer + + Public Property Outcome As SubmissionOutcome + + Public Property ClosedDate As DateTime? = Nothing + + ' Submitted to closed, or to today while open. + Public Property DaysAtJournal As Integer? = Nothing + + ' True when the first decision was a review outcome; Nothing when the + ' record does not say (no decision, withdrawn, or "rejected"). + Public Property WentToReview As Boolean? = Nothing + + End Class + + + Public NotInheritable Class ManuscriptStatistics + + Public Property Manuscript As Manuscript + + ' Oldest first. + Public Property Submissions As New List(Of SubmissionStatistics)() + + Public Property JournalCount As Integer + + Public Property FirstSubmitted As DateTime? = Nothing + + Public Property AcceptedDate As DateTime? = Nothing + + Public Property PublishedDate As DateTime? = Nothing + + Public Property DaysToAcceptance As Integer? = Nothing + + Public Property DaysToPublication As Integer? = Nothing + + Public ReadOnly Property RevisionRounds As Integer + Get + Return Submissions.Sum(Function(item) item.RevisionRounds) + End Get + End Property + + End Class + + + ' Your own history with one journal (#62): personal records, not + ' official journal statistics. + Public NotInheritable Class JournalHistory + + Public Property JournalName As String = String.Empty + + Public Property JournalId As Guid? = Nothing + + Public Property Submissions As New List(Of (Manuscript As Manuscript, Statistics As SubmissionStatistics))() + + Public ReadOnly Property Count As Integer + Get + Return Submissions.Count + End Get + End Property + + Public Function CountOutcome(outcome As SubmissionOutcome) As Integer + Return Submissions.Where(Function(item) item.Statistics.Outcome = outcome).Count() + End Function + + ' Submissions that were asked for at least one revision. + Public ReadOnly Property WithRevisions As Integer + Get + Return Submissions.Where(Function(item) item.Statistics.RevisionRounds > 0).Count() + End Get + End Property + + Public Property MedianDaysToFirstDecision As Median + + Public Property MedianReviewDays As Median + + Public ReadOnly Property LastSubmitted As DateTime + Get + Return Submissions.Max(Function(item) item.Statistics.SubmittedDate) + End Get + End Property + + End Class + + + ' A median and how many records it is based on. + Public Structure Median + + Public ReadOnly Value As Double? + Public ReadOnly SampleSize As Integer + + Public Sub New(value As Double?, sampleSize As Integer) + Me.Value = value + Me.SampleSize = sampleSize + End Sub + + Public ReadOnly Property HasValue As Boolean + Get + Return Value.HasValue + End Get + End Property + + End Structure + + + Public NotInheritable Class LibraryStatistics + + Public Property Manuscripts As New List(Of ManuscriptStatistics)() + + Public Property Journals As New List(Of JournalHistory)() + + Public ReadOnly Property Submissions As IEnumerable(Of SubmissionStatistics) + Get + Return Manuscripts.SelectMany(Function(item) item.Submissions) + End Get + End Property + + Public Function CountOutcome(outcome As SubmissionOutcome) As Integer + Return Submissions.Where(Function(item) item.Outcome = outcome).Count() + End Function + + Public Property MedianDaysToFirstDecision As Median + + Public Property MedianDaysToDeskRejection As Median + + Public Property MedianReviewDays As Median + + Public Property MedianDaysToAcceptance As Median + + Public Property MedianDaysToPublication As Median + + End Class + + + ' Route statistics (#30) from stored history only. A missing or + ' inconsistent date leaves a value out; nothing is estimated, and + ' nothing here changes a record. + Public NotInheritable Class RouteAnalyticsService + + Private Sub New() + End Sub + + + Public Shared Function DescribeSubmission(submission As JournalSubmission, today As DateTime) As SubmissionStatistics + + If submission Is Nothing Then Throw New ArgumentNullException(NameOf(submission)) + + Dim decisions As List(Of EditorialDecisionEvent) = + If(submission.Decisions, New List(Of EditorialDecisionEvent)()). + Where(Function(item) item IsNot Nothing AndAlso item.Decision <> EditorialDecision.None). + OrderBy(Function(item) item.DecisionDate).ToList() + + Dim submitted As DateTime = submission.SubmittedDate.Date + Dim statistics As New SubmissionStatistics With { + .Submission = submission, + .JournalName = If(submission.JournalName, String.Empty).Trim(), + .SubmittedDate = submitted, + .RevisionRounds = decisions.Where(Function(item) IsRevision(item.Decision)).Count() + } + + If decisions.Count > 0 Then + Dim first As EditorialDecisionEvent = decisions(0) + statistics.FirstDecision = first.Decision + statistics.DaysToFirstDecision = DaysBetween(submitted, first.DecisionDate) + Select Case first.Decision + Case EditorialDecision.DeskRejected + statistics.WentToReview = False + Case EditorialDecision.RejectedAfterReview, EditorialDecision.MajorRevision, EditorialDecision.MinorRevision, + EditorialDecision.ReviseAndResubmit, EditorialDecision.Accepted + statistics.WentToReview = True + End Select + End If + + Dim latest As EditorialDecisionEvent = decisions.LastOrDefault() + statistics.Outcome = OutcomeOf(If(latest Is Nothing, EditorialDecision.None, latest.Decision)) + + If statistics.Outcome <> SubmissionOutcome.Open Then + statistics.ClosedDate = latest.DecisionDate.Date + statistics.DaysAtJournal = DaysBetween(submitted, latest.DecisionDate) + Else + statistics.DaysAtJournal = DaysBetween(submitted, today) + End If + + Return statistics + + End Function + + + Public Shared Function DescribeManuscript(manuscript As Manuscript, today As DateTime) As ManuscriptStatistics + + If manuscript Is Nothing Then Throw New ArgumentNullException(NameOf(manuscript)) + + Dim statistics As New ManuscriptStatistics With {.Manuscript = manuscript} + + statistics.Submissions = If(manuscript.Submissions, New List(Of JournalSubmission)()). + Where(Function(item) item IsNot Nothing). + OrderBy(Function(item) item.SubmittedDate). + Select(Function(item) DescribeSubmission(item, today)).ToList() + + statistics.JournalCount = statistics.Submissions. + Select(Function(item) NameKey(item.JournalName)).Distinct().Count() + + If statistics.Submissions.Count > 0 Then + statistics.FirstSubmitted = statistics.Submissions(0).SubmittedDate + End If + + Dim accepted As SubmissionStatistics = statistics.Submissions.FirstOrDefault(Function(item) item.Outcome = SubmissionOutcome.Accepted) + If accepted IsNot Nothing Then statistics.AcceptedDate = accepted.ClosedDate + + statistics.PublishedDate = PublishedDateOf(manuscript) + + If statistics.FirstSubmitted.HasValue Then + If statistics.AcceptedDate.HasValue Then + statistics.DaysToAcceptance = DaysBetween(statistics.FirstSubmitted.Value, statistics.AcceptedDate.Value) + End If + If statistics.PublishedDate.HasValue Then + statistics.DaysToPublication = DaysBetween(statistics.FirstSubmitted.Value, statistics.PublishedDate.Value) + End If + End If + + Return statistics + + End Function + + + ' The publication date field, or else the date the manuscript was + ' recorded as published. Nothing when neither exists. + Public Shared Function PublishedDateOf(manuscript As Manuscript) As DateTime? + + If manuscript.Metadata IsNot Nothing AndAlso manuscript.Metadata.PublishedDate.HasValue Then + Return manuscript.Metadata.PublishedDate.Value.Date + End If + + Dim published As HistoryEvent = + If(manuscript.History, New List(Of HistoryEvent)()). + Where(Function(item) item IsNot Nothing AndAlso item.Stage = PaperStage.Published). + OrderBy(Function(item) item.EventDate).FirstOrDefault() + + Return If(published Is Nothing, CType(Nothing, DateTime?), published.EventDate.Date) + + End Function + + + Public Shared Function ForLibrary( + manuscripts As IEnumerable(Of Manuscript), + today As DateTime, + Optional journalLibrary As IEnumerable(Of JournalRecord) = Nothing + ) As LibraryStatistics + + If manuscripts Is Nothing Then Throw New ArgumentNullException(NameOf(manuscripts)) + + Dim library As New LibraryStatistics With { + .Manuscripts = manuscripts.Where(Function(item) item IsNot Nothing). + Select(Function(item) DescribeManuscript(item, today)).ToList() + } + + Dim submissions As List(Of SubmissionStatistics) = library.Submissions.ToList() + + library.MedianDaysToFirstDecision = MedianOf(submissions.Select(Function(item) item.DaysToFirstDecision)) + library.MedianDaysToDeskRejection = MedianOf(submissions.Where(Function(item) item.FirstDecision.HasValue AndAlso item.FirstDecision.Value = EditorialDecision.DeskRejected).Select(Function(item) item.DaysToFirstDecision)) + library.MedianReviewDays = MedianOf(submissions.Where(Function(item) item.WentToReview.GetValueOrDefault()).Select(Function(item) item.DaysToFirstDecision)) + library.MedianDaysToAcceptance = MedianOf(library.Manuscripts.Select(Function(item) item.DaysToAcceptance)) + library.MedianDaysToPublication = MedianOf(library.Manuscripts.Select(Function(item) item.DaysToPublication)) + + library.Journals = GroupByJournal(library.Manuscripts, journalLibrary) + + Return library + + End Function + + + ' Submissions linked to a Journal Library record count under that + ' record; free-text names count under the same record only when the + ' name matches it exactly (ignoring case and spacing). Anything else + ' keeps its own name: nothing is merged by guess. + Private Shared Function GroupByJournal(manuscripts As List(Of ManuscriptStatistics), journalLibrary As IEnumerable(Of JournalRecord)) As List(Of JournalHistory) + + Dim records As List(Of JournalRecord) = If(journalLibrary, Enumerable.Empty(Of JournalRecord)()).Where(Function(item) item IsNot Nothing).ToList() + Dim groups As New Dictionary(Of String, JournalHistory)(StringComparer.Ordinal) + + For Each manuscript As ManuscriptStatistics In manuscripts + For Each submission As SubmissionStatistics In manuscript.Submissions + + Dim record As JournalRecord = Nothing + If submission.Submission.JournalId.HasValue Then + record = records.FirstOrDefault(Function(item) item.Id = submission.Submission.JournalId.Value) + End If + If record Is Nothing AndAlso submission.JournalName.Length > 0 Then + Dim key As String = NameKey(submission.JournalName) + record = records.FirstOrDefault(Function(item) NameKey(item.Name) = key) + End If + + Dim groupKey As String + Dim display As String + If record IsNot Nothing Then + groupKey = "id:" & record.Id.ToString() + display = record.Name.Trim() + ElseIf submission.JournalName.Length > 0 Then + groupKey = "name:" & NameKey(submission.JournalName) + display = submission.JournalName + Else + groupKey = "none" + display = "(No journal recorded)" + End If + + Dim history As JournalHistory = Nothing + If Not groups.TryGetValue(groupKey, history) Then + history = New JournalHistory With {.JournalName = display, .JournalId = If(record Is Nothing, CType(Nothing, Guid?), record.Id)} + groups(groupKey) = history + End If + history.Submissions.Add((manuscript.Manuscript, submission)) + + Next + Next + + For Each history As JournalHistory In groups.Values + Dim items As List(Of SubmissionStatistics) = history.Submissions.Select(Function(item) item.Statistics).ToList() + history.MedianDaysToFirstDecision = MedianOf(items.Select(Function(item) item.DaysToFirstDecision)) + history.MedianReviewDays = MedianOf(items.Where(Function(item) item.WentToReview.GetValueOrDefault()).Select(Function(item) item.DaysToFirstDecision)) + Next + + Return groups.Values. + OrderByDescending(Function(item) item.Count). + ThenBy(Function(item) item.JournalName, StringComparer.CurrentCultureIgnoreCase).ToList() + + End Function + + + Public Shared Function MedianOf(values As IEnumerable(Of Integer?)) As Median + + Dim known As List(Of Integer) = values.Where(Function(item) item.HasValue).Select(Function(item) item.Value).OrderBy(Function(item) item).ToList() + If known.Count = 0 Then Return New Median(Nothing, 0) + + Dim middle As Integer = known.Count \ 2 + Dim value As Double = If(known.Count Mod 2 = 1, known(middle), (known(middle - 1) + known(middle)) / 2.0) + Return New Median(value, known.Count) + + End Function + + + Public Shared Function OutcomeOf(decision As EditorialDecision) As SubmissionOutcome + Select Case decision + Case EditorialDecision.DeskRejected : Return SubmissionOutcome.DeskRejected + Case EditorialDecision.RejectedAfterReview : Return SubmissionOutcome.RejectedAfterReview + Case EditorialDecision.Rejected : Return SubmissionOutcome.Rejected + Case EditorialDecision.Accepted : Return SubmissionOutcome.Accepted + Case EditorialDecision.Withdrawn : Return SubmissionOutcome.Withdrawn + Case Else : Return SubmissionOutcome.Open + End Select + End Function + + + Private Shared Function IsRevision(decision As EditorialDecision) As Boolean + Return decision = EditorialDecision.MajorRevision OrElse + decision = EditorialDecision.MinorRevision OrElse + decision = EditorialDecision.ReviseAndResubmit + End Function + + + ' A later date before an earlier one is a data-entry slip, not a + ' negative duration; it is left out. + Private Shared Function DaysBetween(start As DateTime, finish As DateTime) As Integer? + Dim days As Integer = (finish.Date - start.Date).Days + Return If(days >= 0, days, CType(Nothing, Integer?)) + End Function + + + Friend Shared Function NameKey(name As String) As String + Return Regex.Replace(If(name, String.Empty).Trim(), "\s+", " ").ToUpperInvariant() + End Function + + End Class + +End Namespace diff --git a/ManuscriptPipeline/Services/RouteMapService.vb b/ManuscriptPipeline/Services/RouteMapService.vb new file mode 100644 index 0000000..f36c420 --- /dev/null +++ b/ManuscriptPipeline/Services/RouteMapService.vb @@ -0,0 +1,387 @@ +Imports System +Imports System.Collections.Generic +Imports System.Linq +Imports ManuscriptPipeline.Models + +Namespace Services + + ' Who holds the ball during a stretch of a route (#82). + Public Enum RouteSegmentKind + ' Submitted and waiting on the journal. + Journal + ' Revising, or preparing the next submission after a rejection. + Author + ' Accepted and waiting on the publisher. + Production + ' The route continued, but its dates do not say whose turn it was, + ' such as a revision whose resubmission date was never entered. + NotRecorded + End Enum + + + Public Enum RouteMarkerKind + Submitted + Decision + Resubmitted + Published + End Enum + + + Public NotInheritable Class RouteSegment + Public Property Kind As RouteSegmentKind + Public Property Start As DateTime + Public Property Finish As DateTime + ' Still running today. + Public Property Ongoing As Boolean + Public Property JournalName As String = String.Empty + + Public ReadOnly Property Days As Integer + Get + Return (Finish.Date - Start.Date).Days + End Get + End Property + End Class + + + Public NotInheritable Class RouteMarker + Public Property Kind As RouteMarkerKind + Public Property MarkerDate As DateTime + Public Property Decision As EditorialDecision = EditorialDecision.None + Public Property JournalName As String = String.Empty + End Class + + + Public NotInheritable Class RouteMap + + Public Property Segments As New List(Of RouteSegment)() + + Public Property Markers As New List(Of RouteMarker)() + + Public ReadOnly Property IsEmpty As Boolean + Get + Return Segments.Count = 0 + End Get + End Property + + Public ReadOnly Property Start As DateTime + Get + Return If(IsEmpty, DateTime.MinValue, Segments.Min(Function(item) item.Start)) + End Get + End Property + + Public ReadOnly Property Finish As DateTime + Get + Return If(IsEmpty, DateTime.MinValue, Segments.Max(Function(item) item.Finish)) + End Get + End Property + + Public ReadOnly Property TotalDays As Integer + Get + Return If(IsEmpty, 0, (Finish.Date - Start.Date).Days) + End Get + End Property + + Public Function DaysOf(kind As RouteSegmentKind) As Integer + Return Segments.Where(Function(item) item.Kind = kind).Sum(Function(item) item.Days) + End Function + + Public ReadOnly Property Ongoing As Boolean + Get + Return Segments.Any(Function(item) item.Ongoing) + End Get + End Property + + ' The journals in route order. + Public ReadOnly Property Journals As List(Of String) + Get + Return Segments.Where(Function(item) item.JournalName.Length > 0).Select(Function(item) item.JournalName).Distinct().ToList() + End Get + End Property + + End Class + + + Public NotInheritable Class RouteStep + Public Property Number As Integer + Public Property Marker As RouteMarker + Public Property Title As String = String.Empty + Public Property Note As String = String.Empty + End Class + + + Public NotInheritable Class RouteMapEntry + Public Property Manuscript As Manuscript + Public Property Map As RouteMap + ' Reached a recorded publication date. + Public Property IsPublished As Boolean + End Class + + + Public NotInheritable Class RouteMapLibrary + + Public Property Routes As New List(Of RouteMapEntry)() + + ' Days from first submission to publication, published routes only. + Public ReadOnly Property MedianDaysToPublication As Median + Get + Return RouteAnalyticsService.MedianOf(Routes.Where(Function(item) item.IsPublished).Select(Function(item) CType(item.Map.TotalDays, Integer?))) + End Get + End Property + + Public ReadOnly Property TotalDays As Integer + Get + Return Routes.Sum(Function(item) item.Map.Segments.Sum(Function(segment) segment.Days)) + End Get + End Property + + ' Share of all drawn days, 0 to 1. + Public Function Share(kind As RouteSegmentKind) As Double + Dim total As Integer = TotalDays + If total = 0 Then Return 0 + Return Routes.Sum(Function(item) item.Map.DaysOf(kind)) / CDbl(total) + End Function + + End Class + + + ' Draws a manuscript's route to scale from recorded dates only (#82). + ' Waiting on a journal runs from a submission (or resubmission) to its + ' decision; the author's turn runs from a revision request to the + ' recorded return to review, or from a rejection to the next + ' submission; production runs from acceptance to publication. A stretch + ' whose split is not recorded is shown as such, never estimated. + Public NotInheritable Class RouteMapService + + Private Sub New() + End Sub + + + Public Shared Function Build(manuscript As Manuscript, today As DateTime) As RouteMap + + If manuscript Is Nothing Then Throw New ArgumentNullException(NameOf(manuscript)) + + Dim map As New RouteMap() + Dim now As DateTime = today.Date + Dim submissions As List(Of JournalSubmission) = + If(manuscript.Submissions, New List(Of JournalSubmission)()). + Where(Function(item) item IsNot Nothing AndAlso item.SubmittedDate.Date <= now). + OrderBy(Function(item) item.SubmittedDate).ToList() + + If submissions.Count = 0 Then Return map + + Dim returns As List(Of DateTime) = + If(manuscript.History, New List(Of HistoryEvent)()). + Where(Function(item) item IsNot Nothing AndAlso (item.Stage = PaperStage.Submitted OrElse item.Stage = PaperStage.UnderReview)). + Select(Function(item) item.EventDate.Date).OrderBy(Function(item) item).ToList() + + Dim published As DateTime? = If(manuscript.Location = ManuscriptLocation.Published OrElse manuscript.CurrentStage = PaperStage.Published, + RouteAnalyticsService.PublishedDateOf(manuscript), CType(Nothing, DateTime?)) + Dim active As Boolean = manuscript.Location = ManuscriptLocation.Pipeline AndAlso manuscript.CurrentStage <> PaperStage.Published + + For index As Integer = 0 To submissions.Count - 1 + + Dim submission As JournalSubmission = submissions(index) + Dim journal As String = If(submission.JournalName, String.Empty).Trim() + Dim nextStart As DateTime? = If(index < submissions.Count - 1, submissions(index + 1).SubmittedDate.Date, CType(Nothing, DateTime?)) + Dim isLast As Boolean = Not nextStart.HasValue + Dim cursor As DateTime = submission.SubmittedDate.Date + Dim phase As RouteSegmentKind = RouteSegmentKind.Journal + Dim closed As EditorialDecision = EditorialDecision.None + + map.Markers.Add(New RouteMarker With {.Kind = RouteMarkerKind.Submitted, .MarkerDate = cursor, .JournalName = journal}) + + Dim decisions As List(Of EditorialDecisionEvent) = + If(submission.Decisions, New List(Of EditorialDecisionEvent)()). + Where(Function(item) item IsNot Nothing AndAlso item.Decision <> EditorialDecision.None AndAlso item.DecisionDate.Date <= now). + OrderBy(Function(item) item.DecisionDate).ToList() + + For decisionIndex As Integer = 0 To decisions.Count - 1 + + Dim decision As EditorialDecisionEvent = decisions(decisionIndex) + Dim decided As DateTime = decision.DecisionDate.Date + If decided < cursor Then Continue For + + AddSegment(map, phase, cursor, decided, False, journal) + map.Markers.Add(New RouteMarker With {.Kind = RouteMarkerKind.Decision, .MarkerDate = decided, .Decision = decision.Decision, .JournalName = journal}) + cursor = decided + + If IsRevision(decision.Decision) Then + ' The author's turn ends at the recorded return to + ' review, if one falls before the next decision. + Dim nextDecision As DateTime? = If(decisionIndex < decisions.Count - 1, decisions(decisionIndex + 1).DecisionDate.Date, CType(Nothing, DateTime?)) + Dim limit As DateTime = If(nextDecision, If(nextStart, now)) + Dim resubmitted As DateTime? = returns.Where(Function(item) item > decided AndAlso item <= limit).Select(Function(item) CType(item, DateTime?)).FirstOrDefault() + + If resubmitted.HasValue Then + AddSegment(map, RouteSegmentKind.Author, cursor, resubmitted.Value, False, journal) + map.Markers.Add(New RouteMarker With {.Kind = RouteMarkerKind.Resubmitted, .MarkerDate = resubmitted.Value, .JournalName = journal}) + cursor = resubmitted.Value + phase = RouteSegmentKind.Journal + ElseIf nextDecision.HasValue Then + phase = RouteSegmentKind.NotRecorded + Else + ' Still revising, when that is the current stage. + phase = If(isLast AndAlso active AndAlso manuscript.CurrentStage = PaperStage.Revision, RouteSegmentKind.Author, RouteSegmentKind.NotRecorded) + End If + ElseIf decision.Decision = EditorialDecision.Accepted OrElse RouteAnalyticsService.OutcomeOf(decision.Decision) <> SubmissionOutcome.Open Then + closed = decision.Decision + Exit For + Else + phase = RouteSegmentKind.Journal + End If + + Next + + ' What follows the last recorded decision. + If closed = EditorialDecision.Accepted Then + If published.HasValue AndAlso published.Value.Date >= cursor Then + AddSegment(map, RouteSegmentKind.Production, cursor, published.Value.Date, False, String.Empty) + map.Markers.Add(New RouteMarker With {.Kind = RouteMarkerKind.Published, .MarkerDate = published.Value.Date}) + ElseIf active Then + AddSegment(map, RouteSegmentKind.Production, cursor, now, True, String.Empty) + End If + ElseIf closed <> EditorialDecision.None Then + ' Rejected or withdrawn: preparing the next submission. + If nextStart.HasValue Then + AddSegment(map, RouteSegmentKind.Author, cursor, nextStart.Value, False, String.Empty) + ElseIf active Then + AddSegment(map, RouteSegmentKind.Author, cursor, now, True, String.Empty) + End If + Else + If isLast AndAlso Not active Then + ' Filed, or published without a recorded decision: + ' what happened after the last decision is unknown. + If published.HasValue Then AddSegment(map, RouteSegmentKind.NotRecorded, cursor, published.Value.Date, False, journal) + Else + AddSegment(map, phase, cursor, If(nextStart, now), isLast, journal) + End If + End If + + Next + + Return map + + End Function + + + Private Shared Sub AddSegment(map As RouteMap, kind As RouteSegmentKind, start As DateTime, finish As DateTime, ongoing As Boolean, journal As String) + If finish <= start Then Return + Dim previous As RouteSegment = map.Segments.LastOrDefault() + ' Overlapping submissions: never draw a stretch twice. + If previous IsNot Nothing AndAlso start < previous.Finish Then start = previous.Finish + If finish <= start Then Return + map.Segments.Add(New RouteSegment With { + .Kind = kind, .Start = start, .Finish = finish, .Ongoing = ongoing, + .JournalName = If(kind = RouteSegmentKind.Journal OrElse kind = RouteSegmentKind.NotRecorded, journal, String.Empty) + }) + End Sub + + + Private Shared Function IsRevision(decision As EditorialDecision) As Boolean + Return decision = EditorialDecision.MajorRevision OrElse + decision = EditorialDecision.MinorRevision OrElse + decision = EditorialDecision.ReviseAndResubmit + End Function + + + ' The numbered events under a route map, each with what it took: + ' "Desk rejected" / "7 days after submission". The first submission + ' is where the map starts, so it is not numbered. + Public Shared Function Steps(map As RouteMap) As List(Of RouteStep) + + Dim result As New List(Of RouteStep)() + If map Is Nothing Then Return result + + For index As Integer = 1 To map.Markers.Count - 1 + Dim marker As RouteMarker = map.Markers(index) + Dim previous As RouteMarker = map.Markers(index - 1) + Dim days As String = DaysText((marker.MarkerDate.Date - previous.MarkerDate.Date).Days) + Dim title As String + Dim note As String + + Select Case marker.Kind + Case RouteMarkerKind.Submitted + title = If(marker.JournalName.Length > 0, "Submitted to " & marker.JournalName, "Submitted") + note = If(previous.Kind = RouteMarkerKind.Decision AndAlso RouteAnalyticsService.OutcomeOf(previous.Decision) <> SubmissionOutcome.Open, + "after " & days & " of rerouting", days & " after the previous submission") + Case RouteMarkerKind.Resubmitted + title = "Resubmitted" + note = "after " & days & " of revising" + Case RouteMarkerKind.Published + title = "Published" + note = days & If(previous.Kind = RouteMarkerKind.Decision AndAlso previous.Decision = EditorialDecision.Accepted, " after acceptance", " later") + Case Else + title = EditorialDecisionDisplayService.Format(marker.Decision) + Select Case previous.Kind + Case RouteMarkerKind.Submitted : note = days & " after submission" + Case RouteMarkerKind.Resubmitted : note = days & " after resubmission" + Case Else : note = days & " after the previous decision" + End Select + End Select + + result.Add(New RouteStep With {.Number = index, .Marker = marker, .Title = title, .Note = note}) + Next + + Return result + + End Function + + + ' "2 journals · 2 revisions · 1 rejection" for a row of the + ' side-by-side map. + Public Shared Function Brief(map As RouteMap) As String + Dim decisions As List(Of RouteMarker) = map.Markers.Where(Function(item) item.Kind = RouteMarkerKind.Decision).ToList() + Dim revisions As Integer = decisions.Where(Function(item) IsRevision(item.Decision)).Count() + Dim rejections As Integer = decisions.Where(Function(item) RouteAnalyticsService.OutcomeOf(item.Decision) = SubmissionOutcome.DeskRejected OrElse + RouteAnalyticsService.OutcomeOf(item.Decision) = SubmissionOutcome.RejectedAfterReview OrElse + RouteAnalyticsService.OutcomeOf(item.Decision) = SubmissionOutcome.Rejected).Count() + Dim parts As New List(Of String) From {Plural(map.Journals.Count, "journal")} + If revisions > 0 Then parts.Add(Plural(revisions, "revision")) + If rejections > 0 Then parts.Add(Plural(rejections, "rejection")) + If map.Ongoing Then parts.Add("in progress") + Return String.Join(" · ", parts) + End Function + + + ' Routes lined up at day 0, shortest first (#82). Published routes + ' by default; with unfinished ones, open stretches run to today. + Public Shared Function Library(manuscripts As IEnumerable(Of Manuscript), today As DateTime, includeUnfinished As Boolean) As RouteMapLibrary + + Dim result As New RouteMapLibrary() + For Each manuscript As Manuscript In If(manuscripts, Enumerable.Empty(Of Manuscript)()) + If manuscript Is Nothing Then Continue For + Dim isPublished As Boolean = manuscript.Location = ManuscriptLocation.Published OrElse manuscript.CurrentStage = PaperStage.Published + If Not isPublished AndAlso Not includeUnfinished Then Continue For + Dim map As RouteMap = Build(manuscript, today) + If map.IsEmpty Then Continue For + result.Routes.Add(New RouteMapEntry With {.Manuscript = manuscript, .Map = map, .IsPublished = isPublished AndAlso map.Markers.Any(Function(item) item.Kind = RouteMarkerKind.Published)}) + Next + result.Routes.Sort(Function(left, right) If(left.Map.TotalDays <> right.Map.TotalDays, left.Map.TotalDays.CompareTo(right.Map.TotalDays), + String.Compare(left.Manuscript.Title, right.Manuscript.Title, StringComparison.CurrentCultureIgnoreCase))) + Return result + + End Function + + + Private Shared Function DaysText(days As Integer) As String + Return Plural(days, "day") + End Function + + + Private Shared Function Plural(count As Integer, noun As String) As String + Return count.ToString(Globalization.CultureInfo.CurrentCulture) & " " & noun & If(count = 1, String.Empty, "s") + End Function + + + Public Shared Function KindName(kind As RouteSegmentKind) As String + Select Case kind + Case RouteSegmentKind.Journal : Return "with the journal" + Case RouteSegmentKind.Author : Return "with you" + Case RouteSegmentKind.Production : Return "in production" + Case Else : Return "not recorded" + End Select + End Function + + End Class + +End Namespace diff --git a/ManuscriptPipeline/Services/Schema7MigrationService.vb b/ManuscriptPipeline/Services/Schema7MigrationService.vb index b3828d3..a9d933b 100644 --- a/ManuscriptPipeline/Services/Schema7MigrationService.vb +++ b/ManuscriptPipeline/Services/Schema7MigrationService.vb @@ -7,16 +7,18 @@ Imports ManuscriptPipeline.Models Namespace Services - Friend NotInheritable Class Schema7MigrationService + ' Schemas 7 and 8 add fields that default to empty: remembered + ' publication matches (#61), then work types, tags, and tag colors + ' (#64). Upgrading validates the whole library with the current rules + ' and then advances only the marker, keeping the old one as + ' schema.vN.bak. The older JSON, managed files, and backups stay + ' byte-for-byte, and the new marker keeps an older build from opening + ' the library and silently dropping the new fields. + Friend NotInheritable Class MarkerOnlyMigration Private Sub New() End Sub - Friend Shared Sub Migrate(currentRoot As String, schemaPath As String) - ' Schema 7 adds remembered publication matches (#61), which default - ' to empty. As in Schema 6, the older JSON, managed files, and - ' backups stay byte-for-byte; only the marker advances, after all - ' existing data validates. The marker keeps an older build from - ' opening the library and silently dropping ignored matches. + Friend Shared Sub Migrate(currentRoot As String, schemaPath As String, fromVersion As Integer) Dim options As New JsonSerializerOptions With {.PropertyNameCaseInsensitive = True} options.Converters.Add(New JsonStringEnumConverter()) Try @@ -29,6 +31,7 @@ Namespace Services SubmissionReadinessValidationService.NormalizeAndValidateManuscript(manuscript) ReviewerResponseService.NormalizeAndValidateManuscript(manuscript) PublicationMatchService.NormalizeAndValidateManuscript(manuscript) + WorkTypeService.NormalizeAndValidateManuscript(manuscript) Next End If Dim authorsPath = Path.Combine(currentRoot, "data", "authors.json") @@ -37,18 +40,19 @@ Namespace Services If library Is Nothing Then Throw New InvalidDataException("The reusable metadata library cannot be null.") End If Catch ex As Exception When TypeOf ex Is JsonException OrElse TypeOf ex Is InvalidDataException - Throw New InvalidDataException("PaperRoute cannot migrate storage schema 6 because existing data is invalid. The existing schema and data were left unchanged. " & ex.Message, ex) + Throw New InvalidDataException("PaperRoute cannot migrate storage schema " & fromVersion.ToString() & + " because existing data is invalid. The existing schema and data were left unchanged. " & ex.Message, ex) End Try Dim payload As New Dictionary(Of String, Object) From { - {"SchemaVersion", 7}, {"UpdatedAtUtc", DateTime.UtcNow.ToString("O")} + {"SchemaVersion", fromVersion + 1}, {"UpdatedAtUtc", DateTime.UtcNow.ToString("O")} } Dim temporaryPath = schemaPath & ".tmp-" & Guid.NewGuid().ToString("N") Try File.WriteAllText(temporaryPath, JsonSerializer.Serialize(payload, New JsonSerializerOptions With {.WriteIndented = True})) ' Replacing atomically also preserves any existing backup if ' the marker is locked. Never remove that backup beforehand. - File.Replace(temporaryPath, schemaPath, Path.Combine(Path.GetDirectoryName(schemaPath), "schema.v6.bak"), True) + File.Replace(temporaryPath, schemaPath, Path.Combine(Path.GetDirectoryName(schemaPath), "schema.v" & fromVersion.ToString() & ".bak"), True) Finally If File.Exists(temporaryPath) Then Try diff --git a/ManuscriptPipeline/Services/SingleInstanceService.vb b/ManuscriptPipeline/Services/SingleInstanceService.vb new file mode 100644 index 0000000..c151bff --- /dev/null +++ b/ManuscriptPipeline/Services/SingleInstanceService.vb @@ -0,0 +1,112 @@ +Imports System +Imports System.Runtime.InteropServices +Imports System.Security.Cryptography +Imports System.Text +Imports System.Threading + +Namespace Services + + ' One PaperRoute window per library (#77). Two windows on the same + ' library each keep their own copy in memory, so a save in one could + ' overwrite the other. A second launch instead asks the running window to + ' come forward and exits before touching storage. The key is the + ' library's folder, so the development profile and isolated test + ' sessions never collide with an installed PaperRoute. + Friend NotInheritable Class SingleInstanceService + Implements IDisposable + + Private Const AnyProcess As Integer = -1 + + + Private Shared Function AllowSetForegroundWindow(processId As Integer) As Boolean + End Function + + Private ReadOnly _mutex As Mutex + Private ReadOnly _activate As EventWaitHandle + Private ReadOnly _stop As New ManualResetEvent(False) + Private _listener As Thread + + Private Sub New(mutex As Mutex, activate As EventWaitHandle) + _mutex = mutex + _activate = activate + End Sub + + + Public Shared Function KeyFor(dataRoot As String) As String + Dim normalized As String = If(dataRoot, String.Empty).Trim().TrimEnd("\"c, "/"c).ToUpperInvariant() + Dim hash As Byte() = SHA256.HashData(Encoding.UTF8.GetBytes(normalized)) + Return "PaperRoute-" & Convert.ToHexString(hash, 0, 12) + End Function + + + ' The running instance for this library, or Nothing when another + ' process already has it open. + Public Shared Function TryStart(key As String) As SingleInstanceService + + Dim created As Boolean + Dim mutex As New Mutex(True, "Local\" & key & "-instance", created) + + If Not created Then + mutex.Dispose() + Return Nothing + End If + + Return New SingleInstanceService(mutex, New EventWaitHandle(False, EventResetMode.AutoReset, "Local\" & key & "-activate")) + + End Function + + + ' Asks the running instance to come forward. Returns whether one was found. + Public Shared Function SignalExisting(key As String) As Boolean + + Dim activate As EventWaitHandle = Nothing + If Not EventWaitHandle.TryOpenExisting("Local\" & key & "-activate", activate) Then Return False + + Using activate + ' Windows lets the running window take the foreground only + ' when the launching process allows it. + AllowSetForegroundWindow(AnyProcess) + activate.Set() + End Using + Return True + + End Function + + + ' Runs onActivate on a background thread each time another launch + ' signals; the caller marshals to its window. + Public Sub Listen(onActivate As Action) + + _listener = New Thread( + Sub() + Dim signals As WaitHandle() = {_activate, _stop} + While WaitHandle.WaitAny(signals) = 0 + Try + onActivate() + Catch ex As Exception When TypeOf ex Is InvalidOperationException OrElse TypeOf ex Is ObjectDisposedException + ' The window is closing; there is nothing to bring forward. + End Try + End While + End Sub) With {.IsBackground = True, .Name = "PaperRoute single instance"} + _listener.Start() + + End Sub + + + ' Must run on the thread that started the instance, which owns the mutex. + Public Sub Dispose() Implements IDisposable.Dispose + _stop.Set() + _listener?.Join(TimeSpan.FromSeconds(2)) + Try + _mutex.ReleaseMutex() + Catch ex As ApplicationException + ' Not owned by this thread; closing the handle still releases it. + End Try + _mutex.Dispose() + _activate.Dispose() + _stop.Dispose() + End Sub + + End Class + +End Namespace diff --git a/ManuscriptPipeline/Services/StandardExcelImporter.vb b/ManuscriptPipeline/Services/StandardExcelImporter.vb index 4b05c06..c88d19f 100644 --- a/ManuscriptPipeline/Services/StandardExcelImporter.vb +++ b/ManuscriptPipeline/Services/StandardExcelImporter.vb @@ -241,8 +241,18 @@ Namespace Services "FILEDRAWERREASON" ) + ' Type and tags (#64): a type is kept only when it is one + ' PaperRoute knows; otherwise the row imports without one. + Dim typeText As String = ReadOptionalText(worksheet, rowNumber, headers, "WORKTYPE") + Dim workType As WorkType = WorkTypeService.Parse(typeText) + If workType = WorkType.Unspecified AndAlso Not String.IsNullOrWhiteSpace(typeText) Then + result.Warnings.Add("Manuscripts row " & rowNumber.ToString() & ": unrecognized WorkType '" & typeText & "'. Imported without a type.") + End If + Dim tagText As String = ReadOptionalText(worksheet, rowNumber, headers, "TAGS") + Dim manuscript As New Manuscript With { .Id = Guid.NewGuid(), + .WorkType = workType, .Title = title, .TargetJournal = targetJournal, .CurrentStage = stage, @@ -252,6 +262,10 @@ Namespace Services .FileDrawerReason = fileDrawerReason } + For Each tag As String In If(tagText, String.Empty).Split({";"c, ","c}, StringSplitOptions.RemoveEmptyEntries) + WorkTypeService.AddTag(manuscript, tag) + Next + manuscript.History.Add( New HistoryEvent With { .Id = Guid.NewGuid(), diff --git a/ManuscriptPipeline/Services/StandardTemplateGenerator.vb b/ManuscriptPipeline/Services/StandardTemplateGenerator.vb index 20d9499..4f57ae8 100644 --- a/ManuscriptPipeline/Services/StandardTemplateGenerator.vb +++ b/ManuscriptPipeline/Services/StandardTemplateGenerator.vb @@ -193,7 +193,9 @@ Namespace Services "TargetJournal", "StageEnteredDate", "FileDrawerDate", - "FileDrawerReason" + "FileDrawerReason", + "WorkType", + "Tags" } WriteHeaders( @@ -211,6 +213,8 @@ Namespace Services worksheet.Column("F").Width = 18 worksheet.Column("G").Width = 18 worksheet.Column("H").Width = 42 + worksheet.Column("I").Width = 22 + worksheet.Column("J").Width = 30 worksheet.Range("F2:G500").Style.NumberFormat.Format = "yyyy-mm-dd" diff --git a/ManuscriptPipeline/Services/StorageMigrationService.vb b/ManuscriptPipeline/Services/StorageMigrationService.vb index 9f57497..217d1f4 100644 --- a/ManuscriptPipeline/Services/StorageMigrationService.vb +++ b/ManuscriptPipeline/Services/StorageMigrationService.vb @@ -10,7 +10,7 @@ Namespace Services Public NotInheritable Class StorageMigrationService - Public Const CurrentSchemaVersion As Integer = 7 + Public Const CurrentSchemaVersion As Integer = 8 Private Const MinimumMigratableSchemaVersion As Integer = 1 @@ -372,7 +372,11 @@ Namespace Services Case 6 - Schema7MigrationService.Migrate(currentRoot, schemaPath) + MarkerOnlyMigration.Migrate(currentRoot, schemaPath, 6) + + Case 7 + + MarkerOnlyMigration.Migrate(currentRoot, schemaPath, 7) Case Else diff --git a/ManuscriptPipeline/Services/WorkTypeService.vb b/ManuscriptPipeline/Services/WorkTypeService.vb new file mode 100644 index 0000000..135289d --- /dev/null +++ b/ManuscriptPipeline/Services/WorkTypeService.vb @@ -0,0 +1,258 @@ +Imports System +Imports System.Collections.Generic +Imports System.Drawing +Imports System.IO +Imports System.Linq +Imports System.Text.RegularExpressions +Imports ManuscriptPipeline.Models + +Namespace Services + + ' Work types and tags (#64): names, the tag palette, normalization, and + ' how imported records map to a type. A type is set only when the user or + ' the source says so; nothing is inferred. + Public NotInheritable Class WorkTypeService + + Public Const MaximumTagLength As Integer = 40 + + Private Sub New() + End Sub + + + Public Shared Function DisplayName(type As WorkType) As String + Select Case type + Case WorkType.JournalArticle : Return "Journal article" + Case WorkType.Preprint : Return "Preprint" + Case WorkType.ConferencePaper : Return "Conference paper" + Case WorkType.ConferenceAbstract : Return "Conference abstract" + Case WorkType.Poster : Return "Poster" + Case WorkType.BookChapter : Return "Book chapter" + Case WorkType.Thesis : Return "Thesis or dissertation" + Case WorkType.Other : Return "Other" + Case Else : Return "Not specified" + End Select + End Function + + + ' A type from its display name or enum name, ignoring case and spaces. + ' Unspecified when the text names no type. + Public Shared Function Parse(text As String) As WorkType + Dim key As String = Regex.Replace(If(text, String.Empty), "[\s_-]", String.Empty) + If key.Length = 0 Then Return WorkType.Unspecified + For Each type As WorkType In [Enum].GetValues(GetType(WorkType)) + If String.Equals(key, type.ToString(), StringComparison.OrdinalIgnoreCase) OrElse + String.Equals(key, Regex.Replace(DisplayName(type), "\s", String.Empty), StringComparison.OrdinalIgnoreCase) Then + Return type + End If + Next + Select Case key.ToLowerInvariant() + Case "article", "journal" : Return WorkType.JournalArticle + Case "thesis", "dissertation" : Return WorkType.Thesis + Case "chapter" : Return WorkType.BookChapter + Case "abstract" : Return WorkType.ConferenceAbstract + End Select + Return WorkType.Unspecified + End Function + + + ' Trimmed, single-spaced, and at most MaximumTagLength characters. + ' Empty when nothing usable remains. + Public Shared Function NormalizeTag(tag As String) As String + Dim value As String = Regex.Replace(If(tag, String.Empty).Trim().TrimStart("#"c).Trim(), "\s+", " ") + If value.Length > MaximumTagLength Then value = value.Substring(0, MaximumTagLength).TrimEnd() + Return value + End Function + + + ' Adds a tag unless the manuscript already has it in any capitalization. + ' Returns whether it was added. + Public Shared Function AddTag(manuscript As Manuscript, tag As String) As Boolean + Dim value As String = NormalizeTag(tag) + If value.Length = 0 Then Return False + If manuscript.Tags Is Nothing Then manuscript.Tags = New List(Of String)() + If manuscript.Tags.Contains(value, StringComparer.CurrentCultureIgnoreCase) Then Return False + manuscript.Tags.Add(value) + Return True + End Function + + + Public Shared Function HasTag(manuscript As Manuscript, tag As String) As Boolean + Return manuscript?.Tags IsNot Nothing AndAlso manuscript.Tags.Contains(NormalizeTag(tag), StringComparer.CurrentCultureIgnoreCase) + End Function + + + ' Every tag in the library, most used first, for suggestions and filters. + Public Shared Function AllTags(manuscripts As IEnumerable(Of Manuscript)) As List(Of String) + Return manuscripts.Where(Function(item) item?.Tags IsNot Nothing). + SelectMany(Function(item) item.Tags). + GroupBy(Function(tag) tag, StringComparer.CurrentCultureIgnoreCase). + OrderByDescending(Function(group) group.Count()). + ThenBy(Function(group) group.Key, StringComparer.CurrentCultureIgnoreCase). + Select(Function(group) group.First()).ToList() + End Function + + + Public Shared Sub NormalizeAndValidateManuscript(manuscript As Manuscript) + + If manuscript Is Nothing Then Throw New ArgumentNullException(NameOf(manuscript)) + If Not [Enum].IsDefined(manuscript.WorkType) Then + Throw New InvalidDataException("The manuscript library contains an unsupported work type.") + End If + + Dim tags As New List(Of String)() + For Each tag As String In If(manuscript.Tags, New List(Of String)()) + Dim value As String = NormalizeTag(tag) + If value.Length > 0 AndAlso Not tags.Contains(value, StringComparer.CurrentCultureIgnoreCase) Then tags.Add(value) + Next + manuscript.Tags = tags + + End Sub + + + Public Shared Sub NormalizeTagColors(library As AuthorLibraryData) + + Dim colors As New List(Of TagColor)() + For Each entry As TagColor In If(library.TagColors, New List(Of TagColor)()) + If entry Is Nothing OrElse Not [Enum].IsDefined(entry.Color) Then Continue For + Dim tag As String = NormalizeTag(entry.Tag) + If tag.Length = 0 Then Continue For + colors.RemoveAll(Function(existing) String.Equals(existing.Tag, tag, StringComparison.CurrentCultureIgnoreCase)) + colors.Add(New TagColor With {.Tag = tag, .Color = entry.Color}) + Next + library.TagColors = colors + + End Sub + + + ' The chosen color, or one from the tag's name that never changes + ' between runs or computers. + Public Shared Function ColorOf(tag As String, library As AuthorLibraryData) As TagPalette + + Dim value As String = NormalizeTag(tag) + Dim chosen As TagColor = If(library?.TagColors, New List(Of TagColor)()). + FirstOrDefault(Function(entry) entry IsNot Nothing AndAlso String.Equals(entry.Tag, value, StringComparison.CurrentCultureIgnoreCase)) + If chosen IsNot Nothing Then Return chosen.Color + + Dim hash As UInteger = 2166136261UI + For Each character As Char In value.ToUpperInvariant() + hash = CUInt((CULng(hash Xor AscW(character)) * 16777619UL) And &HFFFFFFFFUL) + Next + Return CType(CInt(hash Mod CUInt([Enum].GetValues(GetType(TagPalette)).Length)), TagPalette) + + End Function + + + Public Shared Sub SetColor(library As AuthorLibraryData, tag As String, color As TagPalette) + Dim value As String = NormalizeTag(tag) + If value.Length = 0 Then Return + If library.TagColors Is Nothing Then library.TagColors = New List(Of TagColor)() + library.TagColors.RemoveAll(Function(entry) entry Is Nothing OrElse String.Equals(entry.Tag, value, StringComparison.CurrentCultureIgnoreCase)) + library.TagColors.Add(New TagColor With {.Tag = value, .Color = color}) + End Sub + + + ' Background and text colors with at least 4.5:1 contrast in both themes. + Public Shared Function Background(color As TagPalette, dark As Boolean) As Color + Select Case color + Case TagPalette.Blue : Return If(dark, Drawing.Color.FromArgb(30, 58, 138), Drawing.Color.FromArgb(219, 234, 254)) + Case TagPalette.Violet : Return If(dark, Drawing.Color.FromArgb(76, 29, 149), Drawing.Color.FromArgb(237, 233, 254)) + Case TagPalette.Rose : Return If(dark, Drawing.Color.FromArgb(136, 19, 55), Drawing.Color.FromArgb(255, 228, 230)) + Case TagPalette.Amber : Return If(dark, Drawing.Color.FromArgb(120, 53, 15), Drawing.Color.FromArgb(254, 243, 199)) + Case TagPalette.Green : Return If(dark, Drawing.Color.FromArgb(20, 83, 45), Drawing.Color.FromArgb(220, 252, 231)) + Case TagPalette.Slate : Return If(dark, Drawing.Color.FromArgb(51, 65, 85), Drawing.Color.FromArgb(226, 232, 240)) + Case TagPalette.Orange : Return If(dark, Drawing.Color.FromArgb(124, 45, 18), Drawing.Color.FromArgb(255, 237, 213)) + Case Else : Return If(dark, Drawing.Color.FromArgb(19, 78, 74), Drawing.Color.FromArgb(204, 251, 241)) + End Select + End Function + + + Public Shared Function Foreground(color As TagPalette, dark As Boolean) As Color + Select Case color + Case TagPalette.Blue : Return If(dark, Drawing.Color.FromArgb(191, 219, 254), Drawing.Color.FromArgb(30, 64, 175)) + Case TagPalette.Violet : Return If(dark, Drawing.Color.FromArgb(221, 214, 254), Drawing.Color.FromArgb(91, 33, 182)) + Case TagPalette.Rose : Return If(dark, Drawing.Color.FromArgb(254, 205, 211), Drawing.Color.FromArgb(159, 18, 57)) + Case TagPalette.Amber : Return If(dark, Drawing.Color.FromArgb(253, 230, 138), Drawing.Color.FromArgb(146, 64, 14)) + Case TagPalette.Green : Return If(dark, Drawing.Color.FromArgb(187, 247, 208), Drawing.Color.FromArgb(22, 101, 52)) + Case TagPalette.Slate : Return If(dark, Drawing.Color.FromArgb(226, 232, 240), Drawing.Color.FromArgb(51, 65, 85)) + Case TagPalette.Orange : Return If(dark, Drawing.Color.FromArgb(254, 215, 170), Drawing.Color.FromArgb(154, 52, 18)) + Case Else : Return If(dark, Drawing.Color.FromArgb(153, 246, 228), Drawing.Color.FromArgb(17, 94, 89)) + End Select + End Function + + + ' --------------------------------------------------------------- + ' Imports say what a record is; these map their words to a type. + ' --------------------------------------------------------------- + + Public Shared Function FromBibTeX(entryType As String) As WorkType + Select Case If(entryType, String.Empty).Trim().ToLowerInvariant() + Case "article" : Return WorkType.JournalArticle + Case "inproceedings", "conference", "proceedings" : Return WorkType.ConferencePaper + Case "incollection", "inbook" : Return WorkType.BookChapter + Case "phdthesis", "mastersthesis", "thesis" : Return WorkType.Thesis + Case "unpublished", "misc", "" : Return WorkType.Unspecified + Case Else : Return WorkType.Other + End Select + End Function + + + Public Shared Function FromRis(ty As String) As WorkType + Select Case If(ty, String.Empty).Trim().ToUpperInvariant() + Case "JOUR", "JFULL", "EJOUR", "MGZN" : Return WorkType.JournalArticle + Case "CPAPER", "CONF" : Return WorkType.ConferencePaper + Case "ABST" : Return WorkType.ConferenceAbstract + Case "CHAP", "ECHAP" : Return WorkType.BookChapter + Case "THES" : Return WorkType.Thesis + Case "UNPB", "GEN", "" : Return WorkType.Unspecified + Case Else : Return WorkType.Other + End Select + End Function + + + ' Export: a known type names its entry; otherwise the caller's + ' fallback, as before types existed. + Public Shared Function ToBibTeX(type As WorkType, fallback As String) As String + Select Case type + Case WorkType.JournalArticle : Return "article" + Case WorkType.ConferencePaper, WorkType.ConferenceAbstract : Return "inproceedings" + Case WorkType.BookChapter : Return "incollection" + Case WorkType.Thesis : Return "phdthesis" + Case WorkType.Preprint, WorkType.Poster, WorkType.Other : Return "misc" + Case Else : Return fallback + End Select + End Function + + + Public Shared Function ToRis(type As WorkType, fallback As String) As String + Select Case type + Case WorkType.JournalArticle : Return "JOUR" + Case WorkType.Preprint : Return "UNPB" + Case WorkType.ConferencePaper : Return "CPAPER" + Case WorkType.ConferenceAbstract : Return "ABST" + Case WorkType.Poster : Return "CONF" + Case WorkType.BookChapter : Return "CHAP" + Case WorkType.Thesis : Return "THES" + Case WorkType.Other : Return "GEN" + Case Else : Return fallback + End Select + End Function + + + ' ORCID and Crossref both use lower-case hyphenated names. + Public Shared Function FromRegistry(type As String) As WorkType + Select Case If(type, String.Empty).Trim().ToLowerInvariant().Replace("_", "-") + Case "journal-article" : Return WorkType.JournalArticle + Case "preprint", "posted-content" : Return WorkType.Preprint + Case "conference-paper", "proceedings-article" : Return WorkType.ConferencePaper + Case "conference-abstract" : Return WorkType.ConferenceAbstract + Case "conference-poster", "poster" : Return WorkType.Poster + Case "book-chapter" : Return WorkType.BookChapter + Case "dissertation-thesis", "dissertation", "thesis" : Return WorkType.Thesis + Case "" : Return WorkType.Unspecified + Case Else : Return WorkType.Other + End Select + End Function + + End Class + +End Namespace diff --git a/PaperRoute.Tests/DashboardShelfLayoutTests.vb b/PaperRoute.Tests/DashboardShelfLayoutTests.vb index 3c851ff..e7ebbe6 100644 --- a/PaperRoute.Tests/DashboardShelfLayoutTests.vb +++ b/PaperRoute.Tests/DashboardShelfLayoutTests.vb @@ -341,7 +341,7 @@ Public Class DashboardShelfLayoutTests Application.DoEvents() CollectionAssert.AreEqual( - {"Board", "Library", "Journals", "Deadlines", "Import & Export"}, + {"Board", "Library", "Journals", "Deadlines", "Insights", "Import & Export"}, board.RailPages.Select(Function(page) page.Text).ToList()) Assert.AreEqual("Board", board.ActivePageName) Assert.IsFalse(Descendants(board).OfType(Of Button)().Any(Function(button) button.Text.StartsWith("Data")), @@ -355,7 +355,7 @@ Public Class DashboardShelfLayoutTests Dim grid As DataGridView = Descendants(board).OfType(Of DataGridView)().Single() Assert.AreEqual(90, grid.Rows.Count, "The Library lists every manuscript on every shelf.") - board.PressCommandKey(Keys.Control Or Keys.D5) + board.PressCommandKey(Keys.Control Or Keys.D6) Application.DoEvents() Assert.AreEqual("ImportExport", board.ActivePageName) @@ -384,7 +384,7 @@ Public Class DashboardShelfLayoutTests board.Show() Application.DoEvents() - board.PressCommandKey(Keys.Control Or Keys.D5) + board.PressCommandKey(Keys.Control Or Keys.D6) Application.DoEvents() Dim commands As List(Of String) = Descendants(board).OfType(Of Button)().Select(Function(button) button.Text).ToList() For Each command As String In { diff --git a/PaperRoute.Tests/ManuscriptPageTests.vb b/PaperRoute.Tests/ManuscriptPageTests.vb index 53b8176..d8169e0 100644 --- a/PaperRoute.Tests/ManuscriptPageTests.vb +++ b/PaperRoute.Tests/ManuscriptPageTests.vb @@ -109,7 +109,7 @@ Public Class ManuscriptPageTests board.Open(manuscript) board.Field("Title").Text = "Kept title" board.SetPrompt(Function(title) DialogResult.Yes) - board.PressCommandKey(Keys.Control Or Keys.D5) + board.PressCommandKey(Keys.Control Or Keys.D6) Assert.AreEqual("ImportExport", board.PageName) Assert.AreEqual("Kept title", manuscript.Title, "Yes saves before leaving.") Assert.AreEqual(1, board.SaveCount) @@ -652,6 +652,186 @@ Public Class ManuscriptPageTests End Function End Class + ' Insights (#30, #62): your journals and routes, from recorded dates. + + Public Sub InsightsSummarizeJournalsAndRoutesFromTheLibrary() + RunOnStaThread( + Sub() + Using board As New PageBoard() + Dim routed As Manuscript = WithRoute() + board.Prepare(routed, Sample("Unsubmitted idea")) + + board.PressCommandKey(Keys.Control Or Keys.D5) + Assert.AreEqual("Insights", board.PageName) + Dim tiles As List(Of String) = Descendants(board).OfType(Of RoundedPanel)().Select(Function(tile) tile.AccessibleName).Where(Function(name) name IsNot Nothing).ToList() + Assert.IsTrue(tiles.Contains("2 submissions · 0 accepted"), String.Join(" | ", tiles)) + Assert.IsTrue(tiles.Contains("19.5 days median to a first decision (of 2)"), "The median of 7 and 32 days.") + Assert.IsTrue(tiles.Contains("— median from first submission to acceptance (not recorded yet)"), "Nothing is estimated.") + + Dim journals As DataGridView = Descendants(board).OfType(Of DataGridView)().Single() + CollectionAssert.AreEquivalent({"First Journal", "Second Journal"}, journals.Rows.Cast(Of DataGridViewRow)().Select(Function(row) CStr(row.Cells("Journal").Value)).ToList()) + Dim second As DataGridViewRow = journals.Rows.Cast(Of DataGridViewRow)().Single(Function(row) CStr(row.Cells("Journal").Value) = "Second Journal") + Assert.AreEqual(1.0, CDbl(second.Cells("Revisions").Value)) + Assert.AreEqual(32.0, CDbl(second.Cells("FirstDecision").Value)) + + journals.CurrentCell = second.Cells(0) + GetType(Control).GetMethod("OnKeyDown", BindingFlags.Instance Or BindingFlags.NonPublic).Invoke(journals, New Object() {New KeyEventArgs(Keys.Enter)}) + Application.DoEvents() + Dim routes As DataGridView = Descendants(board).OfType(Of DataGridView)().Single() + Assert.AreEqual(1, routes.Rows.Count, "Enter on a journal shows the routes that went through it.") + Assert.AreEqual("Routed manuscript", CStr(routes.Rows(0).Cells("Title").Value)) + Assert.IsTrue(Descendants(board).OfType(Of LinkLabel)().Any(Function(link) link.Visible AndAlso link.Text.StartsWith("Showing manuscripts sent to Second Journal"))) + + routes.CurrentCell = routes.Rows(0).Cells(0) + GetType(Control).GetMethod("OnKeyDown", BindingFlags.Instance Or BindingFlags.NonPublic).Invoke(routes, New Object() {New KeyEventArgs(Keys.Enter)}) + Application.DoEvents() + Assert.AreEqual("Manuscript", board.PageName, "Enter on a route opens the manuscript.") + Assert.AreEqual(0, board.SaveCount, "Insights never save.") + + board.Close() + End Using + End Sub) + End Sub + + ' The route map (#82): every route side by side on Insights, each one + ' opening its own route view. + + Public Sub TheRouteMapLinesUpRoutesAndOpensTheChosenOne() + RunOnStaThread( + Sub() + Using board As New PageBoard() + Dim published As Manuscript = RouteMapServiceTests.Anchoring() + Dim routed As Manuscript = WithRoute() + board.Prepare(published, routed, Sample("Unsubmitted idea")) + Dim opened As New List(Of Manuscript)() + board.routeViewOpener = Sub(item) opened.Add(item) + + board.PressCommandKey(Keys.Control Or Keys.D5) + Descendants(board).OfType(Of ShelfTabButton)().Single(Function(item) item.Text = "Route Map").Checked = True + Application.DoEvents() + Dim chart As RouteMapChart = Descendants(board).OfType(Of RouteMapChart)().Single() + CollectionAssert.AreEqual({published}, chart.Routes.Select(Function(item) item.Manuscript).ToList(), "Published routes by default.") + Assert.IsTrue(Descendants(board).OfType(Of Label)().Any(Function(label) label.Text = "1 published route lined up at day 0. Median 264 days from first submission to publication.")) + Assert.IsTrue(Descendants(board).OfType(Of RouteMapLegend)().Single().AccessibleName.StartsWith("With a journal · 40%"), "105 of 264 days.") + + Dim toggle As LinkLabel = Descendants(board).OfType(Of LinkLabel)().Single(Function(link) link.Text = "Include work not yet published") + GetType(LinkLabel).GetMethod("OnLinkClicked", BindingFlags.Instance Or BindingFlags.NonPublic). + Invoke(toggle, New Object() {New LinkLabelLinkClickedEventArgs(toggle.Links(0))}) + Application.DoEvents() + chart = Descendants(board).OfType(Of RouteMapChart)().Single() + CollectionAssert.AreEquivalent({published, routed}, chart.Routes.Select(Function(item) item.Manuscript).ToList(), "Work in progress runs to today; an idea has no route.") + Assert.IsTrue(chart.Routes.Single(Function(item) item.Manuscript Is routed).Map.Ongoing) + + chart.SelectedIndex = chart.Routes.FindIndex(Function(item) item.Manuscript Is routed) + GetType(Control).GetMethod("OnKeyDown", BindingFlags.Instance Or BindingFlags.NonPublic).Invoke(chart, New Object() {New KeyEventArgs(Keys.Enter)}) + CollectionAssert.AreEqual({routed}, opened, "Enter opens the selected route.") + Assert.AreEqual(0, board.SaveCount, "The route map never saves.") + + board.Close() + End Using + End Sub) + End Sub + + + Public Sub TheRouteViewOpensOnItsRouteDrawnToScale() + RunOnStaThread( + Sub() + Using view As New ManuscriptRouteViewForm(RouteMapServiceTests.Anchoring()) + ShowOffscreen(view) + Dim bar As RouteMapBar = Descendants(view).OfType(Of RouteMapBar)().Single() + Assert.AreEqual("Route drawn to scale. 264 days from first submission to publication: 105 days with the journals, 131 days with you, 28 days in production.", bar.AccessibleName) + Assert.AreEqual(8, bar.Steps.Count) + StringAssert.StartsWith(bar.AccessibleDescription, "1: Desk rejected, Jan 12, 7 days after submission") + Assert.IsTrue(bar.Height > 0 AndAlso bar.Width > 0) + Dim onScreen As Rectangle = view.RectangleToClient(bar.RectangleToScreen(bar.ClientRectangle)) + Assert.IsTrue(onScreen.Right <= view.ClientSize.Width, "The map fits the window's width.") + view.Close() + End Using + + Using view As New ManuscriptRouteViewForm(Sample("Unsubmitted idea")) + ShowOffscreen(view) + Assert.IsFalse(Descendants(view).OfType(Of RouteMapBar)().Any(), "No route map before a first submission.") + view.Close() + End Using + End Sub) + End Sub + + + Public Sub ReportsPreviewAndSaveWhatIsChosen() + RunOnStaThread( + Sub() + Dim path As String = IO.Path.Combine(IO.Path.GetTempPath(), "PaperRoute-Report-" & Guid.NewGuid().ToString("N") & ".html") + Try + Dim pipeline As Manuscript = Sample("In the pipeline") + Dim drawer As Manuscript = Sample("In the drawer") + drawer.Location = ManuscriptLocation.FileDrawer + Using dialog As New ReportForm("Pipeline Report", "report.html", New List(Of Manuscript) From {pipeline, drawer}, + Function(chosen, deadlines) ReportService.PipelineReport(chosen, DateTime.Today)) + dialog.SavePathPrompt = Function() path + ShowOffscreen(dialog) + CollectionAssert.AreEqual({pipeline}, dialog.Chosen, "Pipeline work is included by default; the File Drawer is not.") + dialog.SaveReport(Nothing, EventArgs.Empty) + Assert.AreEqual(path, dialog.SavedPath) + End Using + Dim saved As String = IO.File.ReadAllText(path) + StringAssert.Contains(saved, "In the pipeline") + Assert.IsFalse(saved.Contains("In the drawer")) + Finally + If IO.File.Exists(path) Then IO.File.Delete(path) + End Try + End Sub) + End Sub + + ' Work types and tags (#64): edited on the page, saved with it, shown on + ' the card, and found by board search. + + Public Sub TypesAndTagsAreEditedOnThePageAndShownOnTheBoard() + RunOnStaThread( + Sub() + Using board As New PageBoard() + Dim manuscript As Manuscript = Sample("Tagged manuscript") + Dim other As Manuscript = Sample("Other manuscript") + other.Tags.Add("grant") + board.Prepare(manuscript, other) + board.Open(manuscript) + + Dim type As ComboBox = Descendants(board.Editor).OfType(Of ComboBox)().Single(Function(box) box.AccessibleName = "Type of work") + Assert.AreEqual("Not specified", type.Text, "No type is inferred.") + type.SelectedIndex = CInt(WorkType.Poster) + Dim tags As TagEditor = Descendants(board.Editor).OfType(Of TagEditor)().Single() + CollectionAssert.Contains(tags.Input.AutoCompleteCustomSource.Cast(Of String)().ToList(), "grant", "Tags already in the library are suggested.") + tags.Input.Text = "teaching" + tags.Commit() + tags.Input.Text = " Teaching " + tags.Commit() + Assert.AreEqual(1, Descendants(tags).OfType(Of TagChipButton)().Count(), "A tag is added once.") + Assert.IsTrue(board.Editor.HasUnsavedChanges()) + Assert.AreEqual(WorkType.Unspecified, manuscript.WorkType, "Edits stay in the working copy until saved.") + + board.PressCommandKey(Keys.Control Or Keys.S) + Assert.AreEqual(WorkType.Poster, manuscript.WorkType) + CollectionAssert.AreEqual({"teaching"}, manuscript.Tags) + Assert.AreEqual(1, board.SaveCount) + + board.PressCommandKey(Keys.Alt Or Keys.Left) + Assert.AreEqual("Board", board.PageName) + Dim strip As TagStrip = Descendants(board).OfType(Of TagStrip)().Single(Function(item) item.AccessibleName = "Tags: teaching") + Assert.IsTrue(strip.Width > 0, "The card shows the tag on its journal line.") + + Dim search As TextBox = DirectCast(GetType(Form1).GetField("txtBoardSearch", BindingFlags.Instance Or BindingFlags.NonPublic).GetValue(board), TextBox) + Dim matches = GetType(Form1).GetMethod("ManuscriptMatchesBoardFilters", BindingFlags.Instance Or BindingFlags.NonPublic) + search.Text = "#teaching" + Assert.IsTrue(CBool(matches.Invoke(board, New Object() {manuscript}))) + Assert.IsFalse(CBool(matches.Invoke(board, New Object() {other}))) + search.Text = "poster" + Assert.IsTrue(CBool(matches.Invoke(board, New Object() {manuscript})), "The type is searchable too.") + search.Text = String.Empty + + board.Close() + End Using + End Sub) + End Sub + Private Shared Function DeadlineRows(board As PageBoard) As List(Of DeadlineRow) Return Descendants(board).OfType(Of DeadlineRow)().ToList() End Function diff --git a/PaperRoute.Tests/ReportServiceTests.vb b/PaperRoute.Tests/ReportServiceTests.vb new file mode 100644 index 0000000..96bc637 --- /dev/null +++ b/PaperRoute.Tests/ReportServiceTests.vb @@ -0,0 +1,83 @@ +Imports System +Imports System.Collections.Generic +Imports System.Linq +Imports System.Text.Json +Imports Microsoft.VisualStudio.TestTools.UnitTesting +Imports ManuscriptPipeline.Models +Imports ManuscriptPipeline.Services + +' Shareable reports (#30, #63): only what a supervisor or coauthor should +' see, escaped, and built without changing a record. + +Public Class ReportServiceTests + + Private Shared ReadOnly Today As New DateTime(2026, 9, 28) + + + Public Sub PipelineReportLeavesOutPrivateMaterial() + Dim manuscript As Manuscript = Sensitive() + Dim before As String = JsonSerializer.Serialize(manuscript) + + Dim html As String = ReportService.PipelineReport({manuscript}, Today, "Dr. Example") + + StringAssert.Contains(html, "Grit & resilience <script>", "Titles are escaped.") + Assert.IsFalse(html.Contains("