diff options
62 files changed, 1291 insertions, 207 deletions
diff --git a/doc/frontend.org b/doc/frontend.org index 0b5725aa..63d6fe1f 100644 --- a/doc/frontend.org +++ b/doc/frontend.org @@ -1,29 +1,5 @@ ** Javascript "components" -*** input-list -file:../static/input_list.js - -All elements having 'input-list' ∈ =class= - -Direct children must all have 'unit' ∈ =class= -One direct child must have 'final' ∈ =class= - -binds =get_value= on instances, by default returning the value -of all =<input/>= tags joined by =,=. This can be overwritten with -- =data-joinby= :: Alternative character to join by -- =data-bindby= :: replacement for get_value - -TODO: instead, override value? - -=addEventList('input',= is overwritten, registering the listener for all input -elements. - *** Popup Handles popup. Currently rather specific -*** Dragable -file:../static/dragable.js - -Manually apply =bind_popup_control= to the statusbar of a floating "window". -Nothing is required from the component, but the "window" must have -'popup-container' ∈ =class= diff --git a/doc/ref/Makefile b/doc/ref/Makefile new file mode 100644 index 00000000..2232a70e --- /dev/null +++ b/doc/ref/Makefile @@ -0,0 +1,7 @@ +TEXI_FILES := $(shell find . -type f -name \*.texi) +INFOFLAGS := + +all: calp.info + +calp.info: $(TEXI_FILES) + makeinfo $(INFOFLAGS) calp.texi diff --git a/doc/ref/calp.texi b/doc/ref/calp.texi new file mode 100644 index 00000000..e5c4baab --- /dev/null +++ b/doc/ref/calp.texi @@ -0,0 +1,71 @@ +\input texinfo +@settitle Calp + +@copying +Copyright @copyright{} 2020 Hugo Hörnquist +@end copying + +@c Borrowed from guile.texi +@c @nicode{S} is plain S in info, or @code{S} elsewhere. This can be used +@c when the quotes that @code{} gives in info aren't wanted, but the +@c fontification in tex or html is wanted. @alias is used rather +@c than @macro because backslashes don't work properly in an @macro. +@ifinfo +@alias nicode=asis +@end ifinfo +@ifnotinfo +@alias nicode=code +@end ifnotinfo + +@c @ifinfo +@c @macro i{text} +@c [3m\text\[0m +@c @end macro +@c @end ifinfo + +@c for use with deftp for extended classes +@macro extends{class} +@w{@i{extends} \class\} +@end macro + +@c For things that should be fixed in the (actual) code. +@c An ``invitation'' to the reader +@macro TODO{text} +text @footnote{Improvements welcome} +@end macro + +@macro githash{hash,path,line} +@url{https://git.hornquist.se/calp/tree/\path\?id=\hash\#n\line\,\hash\} +@end macro + +@titlepage +@title Calp +@author Hugo Hörnquist + +@page +@vskip 0pt plus 1filll +@insertcopying +@end titlepage + +@contents + +@ifnottex +@node Top +@top Calp +@end ifnottex + +@c @menu +@c * Index:: +@c @end menu + +@include guile.texi +@include javascript.texi + +@node Index +@unnumbered Index +@printindex cp +@printindex fn +@printindex tp +@printindex vr + +@bye diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi new file mode 100644 index 00000000..8468021e --- /dev/null +++ b/doc/ref/guile.texi @@ -0,0 +1,17 @@ +@node Guile +@chapter Guile + +@c TODO +This chapter will probably in the future be replaced by a proper +system overview in the future. + +@c module (vcomponent control) + +@defmac with-replaced-properties (component (key value) ...) body ... +Through the extent of @var{body} each @var{key}'s value in +@var{component} is replaced by its repspective @var{value}. + +Note that @var{body} is guarded through a dynamic-wind, meaning that +even non-local exits will restore @var{component} to its initial +state. +@end defmac diff --git a/doc/ref/javascript.texi b/doc/ref/javascript.texi new file mode 100644 index 00000000..6fbd7cdc --- /dev/null +++ b/doc/ref/javascript.texi @@ -0,0 +1,35 @@ +@node Javascript +@chapter Javascript + +@node Concepts +@section Concepts + +@subsection ``Componenents'' + +@deftp {} date_time +@cindex date-time + +@ref{date_time} +@end deftp + +@deftp {} draggable +@end deftp + +@deftp {} input_list +@end deftp + +@node Reference +@section Reference +@include javascript/arbitary_kv.texi +@include javascript/binders.texi +@include javascript/clock.texi +@include javascript/date_time.texi +@include javascript/draggable.texi +@include javascript/input_list.texi +@include javascript/jcal.texi +@include javascript/lib.texi +@include javascript/popup.texi +@include javascript/rrule.texi +@include javascript/script.texi +@include javascript/server_connect.texi +@include javascript/types.texi diff --git a/doc/ref/javascript/arbitary_kv.texi b/doc/ref/javascript/arbitary_kv.texi new file mode 100644 index 00000000..b28c8b92 --- /dev/null +++ b/doc/ref/javascript/arbitary_kv.texi @@ -0,0 +1,3 @@ +@node arbitary_kv +@subsection arbitary_kv.js + diff --git a/doc/ref/javascript/binders.texi b/doc/ref/javascript/binders.texi new file mode 100644 index 00000000..2b64b230 --- /dev/null +++ b/doc/ref/javascript/binders.texi @@ -0,0 +1,47 @@ + +@node binders +@subsection binders.js + +The bind system allows HTML-elements to specify that they want to be +updated whenever its corresponding (vcalendar) object changes. +The bind system is currently set up in +@code{bind_properties} (@pxref{bind_properties}) +(which at the time of writing is (badly) located in @ref{script}). + +All (HTML) components with the class @code{bind} are bound. By default +the (HTML) attribute @code{data-property} is checked for a property +name, and @code{object.innerHTML} is set whenever that property field +changes. +Alternatively an (HTML) component may specify a specific binder +through the HTML attribute @code{data-bindby}, which should be the +name of a JavaScript function taking two arguments, an @TODO{event +component} +@footnote{Root ``root'' HTML component of a given calendar event +(something which @code{get_property} can be called on}, +and the component in question. + +@c Also sets up event listeners, which most doesn't do. + +Binder functions are generally placed in @file{binders.js}, and +shouldn't be called manually. + +@defun bind_recur el e +Handles recurrence rules. +Uses a sub-binder system on components with class containing +``bind-rr''. +@end defun + +@defun bind_edit el e +Cases for @code{input} and @code{textarea} elements @TODO{(should also +handle @code{select}s?)} +@end defun + +@defun bind_view el e +The same as the default binder???? +@end defun + +@defun bind_wholeday el e +Binder for the wholeday toggle button. +While CSS would suffice, this sets the disabled flags on the time +inputs, giving a better user experience. +@end defun diff --git a/doc/ref/javascript/clock.texi b/doc/ref/javascript/clock.texi new file mode 100644 index 00000000..5c2bd954 --- /dev/null +++ b/doc/ref/javascript/clock.texi @@ -0,0 +1,84 @@ +@node clock +@subsection clock.js + +@deftp {(abstract) class} Clock +Interface for ``things'' which wants to get updated on a human timescale. + +@defmethod Clock update now +Called every now and then, with @var{now} being the current time. +@end defmethod + +All instances are expected to implement @code{update}, but are free to +implement any other methods they see fit. +@end deftp + +Below, only the methods (including @code{constructor} and +@code{update} which do something of note (excluding the expected)) +are noted. + +@deftp {class} Timebar @extends{Clock} +The (blue) vertical line which show the current time in the current day. + +@c @defmethod Timebar constructor ∅ +@c @end defmethod +@c +@c @defmethod Timebar update now +@c @end defmethod +@end deftp + +@deftp {class} SmallcalCellHighlight @extends{Clock} +Highlights the current date in the small calendar to the side. +Currently directly sets a border +@TODO{but should preferably set a class instead}. + +@defmethod SmallcalCellHighlight constructor small_cal +@var{small_cal} is the DOM-node of the calendar. +(it should support querySelector). +@end defmethod + +@c @defmethod SmallcalCellHighlight update now +@c @end defmethod +@end deftp + +@deftp {class} ButtonUpdater @extends{Clock} +Updates the ``Today'' link in the side panel to point directly to the +correct web-address. The link works without JavaScript, but then +requires a redirect from the server. + +All actual updating logic is already abstracted away. It would be +desirable if something more was done with this. + +@defmethod ButtonUpdater el proc +Takes the element @var{el} to be updated, and the procedure @var{proc} +which will be called with the element, and the current time. +@end defmethod +@end deftp + + +As of commit +@githash{c9719ce7937f0f0f2aa371ced1d585f67af22457,static/script.js,231} +all objects required manual setup. See static/script.js: + +@verbatim + 231 let start_time = document.querySelector("meta[name='start-time']").content; + 232 let end_time = document.querySelector("meta[name='end-time']").content; + 233 + 234 const button_updater = new ButtonUpdater( + 235 document.getElementById("today-button"), + 236 (e, d) => e.href = d.format('~Y-~m-~d') + ".html" + 237 ); + 238 + 239 const sch = new SmallcalCellHighlight( + 240 document.querySelector('.small-calendar')) + 241 + 242 const timebar = new Timebar(start_time, end_time); + 243 + 244 timebar.update(new Date); + 245 window.setInterval(() => { + 246 let d = new Date; + 247 timebar.update(d); + 248 button_updater.update(d); + 249 sch.update(d); + 250 }, 1000 * 60); + 251 +@end verbatim diff --git a/doc/ref/javascript/date_time.texi b/doc/ref/javascript/date_time.texi new file mode 100644 index 00000000..fb2563f1 --- /dev/null +++ b/doc/ref/javascript/date_time.texi @@ -0,0 +1,39 @@ +@node date_time +@subsection date_time.js + +@defun init_date_time +@c possibly have special index for these +@cindex dummy component +Procedure which initializes the dummy component for date-time input. +When called, finds all elements with class ``date-time'', and makes +them date-time inputs. + +@c <input type='date-time'/> + +The expected HTML form is +@example +<div class="date-time" name="@var{name}"> + <input type="date"/> + <input type="time"/> +</div> +@end example + +Each date-time gets the following fields: + +@defivar date_time value +The current date-time value as a string, +on the form @code{YYYY-mm-ddTHH:MM[:SS]} +(@code{SS} if the underlying time input has it). + +A new date-time can also be set to the field, the same format as above +is expected. +@end defivar + +@defivar date_time name +The ``name'' field of the date-time input. Since @code{name} note that +this is an addition, since name is actually invalid on non-input +components. We nevertheless use it here since we are emulating an +input element. +@end defivar + +@end defun diff --git a/doc/ref/javascript/draggable.texi b/doc/ref/javascript/draggable.texi new file mode 100644 index 00000000..d1851ec4 --- /dev/null +++ b/doc/ref/javascript/draggable.texi @@ -0,0 +1,24 @@ +@node dragable +@subsection dragable.js + +@c TODO This text is just yanked from the old org file, along with the +@c source codes header. It should probably be rewritten. + +Manually apply =bind_popup_control= to the statusbar of a floating +"window". Nothing is required from the component, but the "window" +must have 'popup-container' ∈ =class= + +@defun bind_popup_control nav +Apply to a given component to make it draggable. +Drag area (usually a title bar) should be be the only argument. +It is REQUIRED that the object which should be moved have the class +@code{popup-container}. + +@example +<div class='popup-container'> + ... + <nav /> + ... +</div> +@end example +@end defun diff --git a/doc/ref/javascript/input_list.texi b/doc/ref/javascript/input_list.texi new file mode 100644 index 00000000..65db81a4 --- /dev/null +++ b/doc/ref/javascript/input_list.texi @@ -0,0 +1,51 @@ +@node input_list +@subsection input_list.js +@cindex dummy component + +All elements with the class @code{input-list} are treated as a +collection of input fields. Uses including setting tags on calendar +entries. + +All direct children of the ``input-list'' @emph{must} have the class +@code{unit}, and one direct child @code{unit} have the class @code{final}. + +@c All elements having 'input-list' ∈ =class= + +@c Direct children must all have 'unit' ∈ =class= +@c One direct child must have 'final' ∈ =class= + +@defmethod input_list get_value + +@example +querySelectorAll('input') + .map(x => x.value) + .join(@var{joinby}) +@end example +@end defmethod + +@defivar input_list [data-]joinby + Alternative character to join by +@end defivar + +@defivar input_list [data-]bindby + replacement for get_value +@end defivar + +binds =get_value= on instances, by default returning the value +of all =<input/>= tags joined by =,=. This can be overwritten with + +TODO: instead, override value? + +=addEventList('input',= is overwritten, registering the listener for all input +elements. + + + ∀ children('.input-list') => 'unit' ∈ classList(child) + + <div class="input-list"> + <div class="unit"><input/></div> + <div class="unit final"><input/></div> + </div> + +@defun init_input_list +@end defun diff --git a/doc/ref/javascript/jcal.texi b/doc/ref/javascript/jcal.texi new file mode 100644 index 00000000..4be8d33b --- /dev/null +++ b/doc/ref/javascript/jcal.texi @@ -0,0 +1,4 @@ + +@node jcal +@subsection jcal.js + diff --git a/doc/ref/javascript/lib.texi b/doc/ref/javascript/lib.texi new file mode 100644 index 00000000..ec5d4450 --- /dev/null +++ b/doc/ref/javascript/lib.texi @@ -0,0 +1,147 @@ + +@node lib +@subsection lib.js + +General procedures which in theory could be used anywhere. + +@defvar xcal +The xml namespace name for xcalendar, which is +``urn:ietf:params:xml:ns:icalendar-2.0''. +@end defvar + + +@node Default prototype extensions +@subsubsection Default prototype extensions + +HTMLElement extensions + +@defmethod HTMLElement addEventListener name proc +Replace the default @code{addEventListener} with a version that stores +all listeners in the dictionary @var{listeners}. +@end defmethod + +@defivar HTMLElement listeners +Dictionary of all registered listeners to this element. +Keys are taken from @code{addEventListener}. +@end defivar + +@defmethod DOMTokenList find regexp +Finds the first element of the DOMTokenList whichs value matches +the supplied regexp. Returns a pair of the index and the value. +@end defmethod + +@defmethod Object format args ... +Returns a string representation of the given object. +Allows extending for custom types, +@ref{date-format} +@end defmethod + +@node General +@subsubsection General + +@defun zip args ... +Takes a list of lists, and returns a single list of tuples. +@example +» zip([1,2,3,4,5], "Hello") +← [[1,'H'],[2,'e'],[3,'l'],[4,'l'],[5,'o']] +@end example +@end defun + +@defun makeElement name [attr=@{@}] +Creates a new DOM element of type @var{name}, with all keys in +@var{attr} transfered to it. For example, the equivalent of +@example +<input type='number'/> +@end example +would be +@verbatim +values.push(makeElement('input', { + type: 'number', +})); +@end verbatim +. +@end defun + +@defun round_time time fraction +TODO +@end defun + +@defun date_to_percent date +Retuns how far along the date specified by @var{date} is, between 0 +and 100, where 00:00 maps to 0, and 23:59 to ~100. +@end defun + +@defun gensym [pxrefix='gensym'] +Generates a new string which is (hopefully) globally unique. +Compare with @code{gensym} from Lisp. +@end defun + +@defun setVar str val +Set the CSS var @var{str} to @var{val} on the root element. +@end defun + +@defun asList thing +Ensures that @var{thing} is a list. Returning it outright if it +already is one, otherwise wrapping it in a list. +@end defun + +@node Date +@subsubsection Date + +Some extensions to the builtin class ``Date'' is made. + +@defivar Date utc +Boolean indicating if the given timestamp is in UTC or local time. +true means UTC. +@end defivar + +@defivar Date dateonly +Boolean indicating if the time component of the Date object should be disregarded. +@end defivar + +@defun parseDate str +Takes a string @var{str}, which should be in ISO-8601 date-format, and +returns a javascript Date object. +@end defun + +@defun copyDate date +Creates a new instance of the given Date @var{date}, also transfers my +custom fields. +@end defun + +@defun to_local date +@anchor{to_local} +Returns a Date object (which may be new) which is guaranteed in local +time. +This means that the @var{utc} field is @code{false}, and that +@code{to_local(current_time())} should show what your wall-clock shows. +@end defun + +@defmethod Date format str args ... +@anchor{date-format} +Formats a Date object according to the format specification @var{str}. +Keeping with Guile each format specifier starts with a ~. + +@c table formatting borrowed from Gulie Reference (SRFI-19 Date to string) +@multitable {MMMM} {MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM} +@item @nicode{~~} @tab literal ~ +@c Almost all fields are left padded. How do I signify this +@c with a single footnote? +@item @nicode{~Y} @tab year, left-padding with zeroes. +@item @nicode{~m} @tab month number, left padded with zeroes. +@item @nicode{~d} @tab day of month. +@item @nicode{~H} @tab hour +@item @nicode{~M} @tab minute +@item @nicode{~S} @tab second +@item @nicode{~Z} @tab 'Z' if Date is UTC, otherwise nothing + +@item @nicode{~L} @tab Converts the date to local time +(@pxref{to_local}) (doesn't modify source object). Outputs nothing +@end multitable +@end defmethod + +@defun format_date date str +Equivalent to @code{(@var{date}).format(@var{str})}. +@c TODO link +@end defun + diff --git a/doc/ref/javascript/popup.texi b/doc/ref/javascript/popup.texi new file mode 100644 index 00000000..2dd8f48f --- /dev/null +++ b/doc/ref/javascript/popup.texi @@ -0,0 +1,5 @@ + + +@node popup +@subsection popup.js + diff --git a/doc/ref/javascript/rrule.texi b/doc/ref/javascript/rrule.texi new file mode 100644 index 00000000..5d7a7576 --- /dev/null +++ b/doc/ref/javascript/rrule.texi @@ -0,0 +1,4 @@ + +@node rrule +@subsection rrule.js + diff --git a/doc/ref/javascript/script.texi b/doc/ref/javascript/script.texi new file mode 100644 index 00000000..a60343e4 --- /dev/null +++ b/doc/ref/javascript/script.texi @@ -0,0 +1,60 @@ + +@node script +@subsection script.js + +@dfn{Main} for my javascript, and also currently dumping ground for stuff. + +@deftp {class} EventCreator + +@defmethod EventCreator create_empty_event +@end defmethod + +@defmethod EventCreator create_event_down intended_target +@end defmethod + +@defmethod EventCreator create_event_move pos_in [round=1] [wide_element=false] +@end defmethod + +@defmethod EventCreator create_event_finisher callback +@end defmethod + +@end deftp + +@defun place_in_edit_mode event +@end defun + +@c window.onload is here in source file + +@defun get_property event field default_value +Returns the @emph{value} slot of given field in @var{event}, creating it if needed. + +@itemize +@item +@var{el}: the event to work on + +@item +@var{field}: name of the field + +@item +@var{default_value}: default value when creating + +@item +@var{bind_to_ical} should this property be added to the icalendar subtree? +@end itemize +@end defun + +@defun bind_properties el [wide_event=false] +@anchor{bind_properties} +@ref{binders} + Properties are icalendar properties. + + p['name'] to get and set value (also updates any connected slots) + + p['_value_name'] for raw value + p['_slot_name'] for connected slots, Vector of pairs, where the + car should be a reference to the slot, and the + cdr a procedure which takes a slot and a value + and binds the value to the slot. +@end defun + + diff --git a/doc/ref/javascript/server_connect.texi b/doc/ref/javascript/server_connect.texi new file mode 100644 index 00000000..2f50f02d --- /dev/null +++ b/doc/ref/javascript/server_connect.texi @@ -0,0 +1,2 @@ +@node server_connect +@subsection server_connect.js diff --git a/doc/ref/javascript/types.texi b/doc/ref/javascript/types.texi new file mode 100644 index 00000000..73a58550 --- /dev/null +++ b/doc/ref/javascript/types.texi @@ -0,0 +1,39 @@ +@node types +@subsection types.js + +Collection of type information for calendar data. + +@defvar all_types +Name of all valid icalendar types. + + text, uri, binary, float, integer, date-time, date, duration, + period, utc-offset, cal-address, recur, boolean, +@end defvar + +@defvar property_names +All known names properties (top level keys) can have. +Such as ``calscale'', ``dtstart'', ... +@end defvar + +@defvar valid_fields +Which property fields each component can hold. + +@verbatim +{ 'VCALENDAR': ['PRODID', 'VERSION', 'CALSCALE', 'METHOD'], + ... +} +@end verbatim +@end defvar + +@defvar valid_input_types +Which types are valid to store under each property. +If multiple values are an option for that property, then +the list of possibilities will contain a sub-list (see example). + +@verbatim +{ 'DTSTART': ['date', 'date-time'], + 'CATEGORIES': [['text']], + ... +} +@end verbatim +@end defvar diff --git a/module/calp/entry-points/server.scm b/module/calp/entry-points/server.scm index 55f84c1a..a456c292 100644 --- a/module/calp/entry-points/server.scm +++ b/module/calp/entry-points/server.scm @@ -78,7 +78,7 @@ (catch 'system-error (lambda () - (start-server `(family: ,family port: ,port host: ,addr))) + (start-server (list family: family port: port host: addr))) ;; probably address already in use (lambda (err proc fmt args errno) diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm index 5d10c996..cd8c207e 100644 --- a/module/calp/html/vcomponent.scm +++ b/module/calp/html/vcomponent.scm @@ -7,7 +7,7 @@ :use-module ((text util) :select (add-enumeration-punctuation)) :use-module ((web uri-query) :select (encode-query-parameters)) :use-module (calp html util) - :use-module ((calp html config) :select (edit-mode)) + :use-module ((calp html config) :select (edit-mode debug)) :use-module ((calp html components) :select (btn tabset form with-label)) :use-module ((calp util color) :select (calculate-fg-color)) :use-module ((vcomponent recurrence internal) :prefix #{rrule:}#) @@ -371,6 +371,10 @@ (define (editable-repeat-info event) `(div (@ (class "eventtext")) (h2 "Upprepningar") + ,@(when (debug) + '((button (@ (style "position:absolute;right:1ex;top:1ex") + (onclick "console.log(event_from_popup(this.closest('.popup-container')).properties.rrule.asJcal());")) + "js"))) (table (@ (class "recur-components bind") (name "rrule") (data-bindby "bind_recur")) @@ -531,10 +535,10 @@ (list (btn "🖊️" title: "Redigera" - onclick: "place_in_edit_mode(document.getElementById(this.closest('.popup-container').id.substr(5)))") + onclick: "place_in_edit_mode(event_from_popup(this.closest('.popup-container')))") (btn "🗑" title: "Ta bort" - onclick: "remove_event(document.getElementById(this.closest('.popup-container').id.substr(5)))")))) + onclick: "remove_event(event_from_popup(this.closest('.popup-container')))")))) ,(tabset `(("📅" title: "Översikt" @@ -546,10 +550,16 @@ ("⤓" title: "Nedladdning" (div (@ (class "eventtext") (style "font-family:sans")) (h2 "Ladda ner") - (ul (li (a (@ (href "/calendar/" ,(prop ev 'UID) ".ics")) - "som iCal")) - (li (a (@ (href "/calendar/" ,(prop ev 'UID) ".xcs")) - "som xCal"))))) + (div (@ (class "side-by-side")) + (ul (li (a (@ (href "/calendar/" ,(prop ev 'UID) ".ics")) + "som iCal")) + (li (a (@ (href "/calendar/" ,(prop ev 'UID) ".xcs")) + "som xCal"))) + ,@(when (debug) + `((ul + (li (button (@ (onclick "console.log(event_to_jcal(event_from_popup(this.closest('.popup-container'))));")) "js")) + (li (button (@ (onclick "console.log(jcal_to_xcal(event_to_jcal(event_from_popup(this.closest('.popup-container')))));")) "xml")))))) + )) ,@(when (prop ev 'RRULE) `(("↺" title: "Upprepningar" class: "repeating" diff --git a/module/calp/html/view/calendar.scm b/module/calp/html/view/calendar.scm index d41197b0..3f607bb7 100644 --- a/module/calp/html/view/calendar.scm +++ b/module/calp/html/view/calendar.scm @@ -39,7 +39,7 @@ ;;; All this filtering is probably slow, and should be looked into. ;; TODO place this somewhere proper -(define repo-url (make-parameter "https://git.hornquist.se")) +(define repo-url (make-parameter "https://git.hornquist.se/calp")) ;; TODO document what @var{render-calendar} is supposed to take and return. @@ -106,6 +106,7 @@ (script (@ (defer) (src "/static/types.js"))) (script (@ (defer) (src "/static/lib.js"))) + (script (@ (defer) (src "/static/jcal.js"))) (script (@ (defer) (src "/static/dragable.js"))) (script (@ (defer) (src "/static/clock.js"))) (script (@ (defer) (src "/static/popup.js"))) @@ -141,7 +142,7 @@ (footer (@ (style "grid-area: footer")) (span "Page generated " ,(date->string (current-date))) - (span (a (@ (href ,(repo-url) "/calparse")) + (span (a (@ (href ,(repo-url))) "Source Code"))) ;; Small calendar and navigation diff --git a/module/calp/server/routes.scm b/module/calp/server/routes.scm index 276513f5..368c7cb0 100644 --- a/module/calp/server/routes.scm +++ b/module/calp/server/routes.scm @@ -85,9 +85,13 @@ (make-routes ;; Manual redirect to not reserve root. + ;; Also reason for really ugly frontend redirect. (GET "/" () (return '((content-type text/html)) - (sxml->html-string '(a (@ (href "/today")) "Gå till idag")))) + (sxml->html-string + '(body (a (@ (href "/today")) "Gå till idag") + (script "window.onload = function() { + document.getElementsByTagName('a')[0].click();}"))))) (GET "/favicon.ico" () (return @@ -185,6 +189,8 @@ ;; (vcalendar ;; (vevent ...)))) ;; @end example + + ;; TODO ;; However, *PI* will probably be omited, and currently events ;; are sent without the vcalendar part. Earlier versions ;; Also omitted the icalendar part. And I'm not sure if the @@ -197,7 +203,8 @@ (move-to-namespace ;; TODO Multiple event components (car ((sxpath '(// IC:vevent)) - (xml->sxml data namespaces: '((IC . "urn:ietf:params:xml:ns:icalendar-2.0"))))) + (xml->sxml data namespaces: + '((IC . "urn:ietf:params:xml:ns:icalendar-2.0"))))) #f)) (lambda (err port . args) (return (build-response code: 400) diff --git a/module/datetime.scm b/module/datetime.scm index cb732ad3..9abd1307 100644 --- a/module/datetime.scm +++ b/module/datetime.scm @@ -37,13 +37,13 @@ (dec december ) 12) (define-many define-public - (sun) 0 - (mon) 1 - (tue) 2 - (wed) 3 - (thu) 4 - (fri) 5 - (sat) 6) + (sun sunday) 0 + (mon monday) 1 + (tue tuesday) 2 + (wed wednesday) 3 + (thu thursday) 4 + (fri friday) 5 + (sat saturday) 6) ;;; Configuration @@ -717,6 +717,16 @@ (define*-public (string->date str optional: (fmt "~Y-~m-~d")) (get-date (string->datetime str fmt))) +;; Parse @var{string} as either a date, time, or date-time. +;; String MUST be on iso-8601 format. +(define-public (string->date/-time string) + (define (contains symb) + (lambda (string) (string-contains string symb))) + + (cond [string (contains "T") => string->datetime] + [string (contains ":") => string->time] + [string (contains "-") => string->date])) + (define-public (parse-ics-date str) (string->date str "~Y~m~d")) @@ -757,15 +767,14 @@ time: ,(if verbose (time->sexp (get-time% dt)) (get-time% dt)) tz: ,(tz dt))) + (define (date-reader chr port) + (define (dt->sexp dt) (datetime->sexp dt #t) ) (unread-char chr port) - (let ((line (symbol->string (read port)))) - (cond [(string-contains line "T") - (-> line string->datetime (datetime->sexp #t))] - [(string-contains line ":") - (-> line string->time time->sexp)] - [(string-contains line "-") - (-> line string->date date->sexp)]))) + (let ((data (string->date/-time (symbol->string (read port))))) + (cond [data datetime? => dt->sexp] + [data time? => time->sexp] + [data date? => date->sexp]))) (read-hash-extend #\0 date-reader) (read-hash-extend #\1 date-reader) diff --git a/module/vcomponent/control.scm b/module/vcomponent/control.scm index add48c28..5fe5b8b0 100644 --- a/module/vcomponent/control.scm +++ b/module/vcomponent/control.scm @@ -22,6 +22,7 @@ (set! (prop component key) val)))) keys))) +;; TODO what is this even used for? (define-syntax with-replaced-properties (syntax-rules () [(_ (component (key val) ...) diff --git a/module/vcomponent/datetime.scm b/module/vcomponent/datetime.scm index 887ae48b..ca4f90e9 100644 --- a/module/vcomponent/datetime.scm +++ b/module/vcomponent/datetime.scm @@ -68,6 +68,13 @@ Event must have the DTSTART and DTEND protperty set." date-difference datetime-difference) (prop e 'DTEND) (prop e 'DTSTART)))) +;; +;; |-----| extent of event +;; |-----| time we are interested in, +;; defined through @var{start-date} and @var{end-date} +;; |X| part of event within that time (X) +;; +;; Returns the length of the interval (X). (define-public (event-length/clamped start-date end-date e) (let ((end (or (prop e 'DTEND) (if (date? (prop e 'DTSTART)) diff --git a/module/vcomponent/recurrence/internal.scm b/module/vcomponent/recurrence/internal.scm index 8e84a8b6..1b9dd405 100644 --- a/module/vcomponent/recurrence/internal.scm +++ b/module/vcomponent/recurrence/internal.scm @@ -51,6 +51,10 @@ freq until count interval bysecond byminute byhour byday bymonthday byyearday byweekno bymonth bysetpos wkst) + ;; TODO possibly validate fields here + ;; to prevent creation of invalid rules. + ;; This was made apparent when wkst was (incorrectly) set to MO, + ;; which later crashed generate-recurrence-set. (make-recur-rule% freq until count interval bysecond byminute byhour byday bymonthday byyearday byweekno bymonth bysetpos wkst)) diff --git a/module/vcomponent/recurrence/parse.scm b/module/vcomponent/recurrence/parse.scm index b48e88e5..ba2a5583 100644 --- a/module/vcomponent/recurrence/parse.scm +++ b/module/vcomponent/recurrence/parse.scm @@ -13,7 +13,7 @@ ;; transform into weekday objects from -(define (rfc->datetime-weekday symbol) +(define-public (rfc->datetime-weekday symbol) (case symbol [(SU) sun] [(MO) mon] diff --git a/module/vcomponent/xcal/parse.scm b/module/vcomponent/xcal/parse.scm index 6b877b9f..6ae8c2f9 100644 --- a/module/vcomponent/xcal/parse.scm +++ b/module/vcomponent/xcal/parse.scm @@ -50,8 +50,15 @@ [(recur) (apply (@ (vcomponent recurrence internal) make-recur-rule) - (for (k v) in value - (list (symbol->keyword k) v)))] + (concatenate + (for (k v) in value + (list (symbol->keyword k) + (case k + ((wkst) + ((@ (vcomponent recurrence parse) + rfc->datetime-weekday) + (string->symbol v))) + (else v))))))] [(time) (parse-iso-time (car value))] diff --git a/static/clock.js b/static/clock.js index 40382faa..b7777a08 100644 --- a/static/clock.js +++ b/static/clock.js @@ -16,14 +16,14 @@ class Timebar extends Clock { update(now) { - if (! (this.start_time <= now.getTime() && now.getTime() < this.end_time)) - return; + // if (! (this.start_time <= now.getTime() && now.getTime() < this.end_time)) + // return; var event_area = document.getElementById(now.format("~Y-~m-~d")) if (event_area) { if (this.bar_object) { - this.bar_object.parentNode.removeChild(bar_object) + this.bar_object.parentNode.removeChild(this.bar_object) } else { this.bar_object = makeElement ('div', { id: 'bar', diff --git a/static/input_list.js b/static/input_list.js index 9397e6ee..a7a446f3 100644 --- a/static/input_list.js +++ b/static/input_list.js @@ -9,6 +9,7 @@ */ +/* private */ function transferListeners(old_unit, new_unit) { for (let [o, n] of zip([old_unit, ...old_unit.querySelectorAll("*")], [new_unit, ...new_unit.querySelectorAll("*")])) { @@ -22,6 +23,7 @@ function transferListeners(old_unit, new_unit) { } +/* private */ function advance_final(input_list) { let old_unit = input_list.unit; let new_unit = old_unit.cloneNode(true); @@ -31,7 +33,7 @@ function advance_final(input_list) { } - +/* private */ function update_inline_list () { /* can target self */ @@ -75,7 +77,7 @@ function init_input_list() { if (lst.dataset.bindby) { lst.get_value = lst.dataset.bindby; } else if (lst.dataset.joinby) { - lst.get_value = get_value(lst.dataset.joinby); + lst.get_value = get_get_value(lst.dataset.joinby); } else { lst.get_value = get_get_value(); } @@ -101,8 +103,8 @@ function init_input_list() { const get_get_value = (join=',') => function () { return [...this.querySelectorAll('input')] .map(x => x.value) - .filter(x => x != '') - .join(join); + .filter(x => x != ''); + // .join(join); } /* -------------------------------------------------- */ diff --git a/static/jcal-tests.js b/static/jcal-tests.js new file mode 100644 index 00000000..c84d9bd1 --- /dev/null +++ b/static/jcal-tests.js @@ -0,0 +1,32 @@ +/* "Test cases" for jcal.js. + ideally we would actually have runnable tests, but + `document' is only available in the browser. +*/ + +let doc = document.implementation.createDocument(xcal, 'icalendar'); + +jcal = ['key', {}, 'text', 'value']; + +jcal_property_to_xcal_property(doc, jcal); + + + +jcal_to_xcal(['vcalendar', [], [['vevent', [['key', {}, 'text', 'value']], []]]]).childNodes[0].outerHTML + +/* returns (except not pretty printee) +<icalendar xmlns="urn:ietf:params:xml:ns:icalendar-2.0"> + <vcalendar> + <properties/> + <components> + <vevent> + <properties> + <key> + <text>value</text> + </key> + </properties> + <components/> + </vevent> + </components> + </vcalendar> +</icalendar> +*/ diff --git a/static/jcal.js b/static/jcal.js new file mode 100644 index 00000000..da17a19e --- /dev/null +++ b/static/jcal.js @@ -0,0 +1,174 @@ +function jcal_type_to_xcal(doc, type, value) { + let el = doc.createElementNS(xcal, type); + switch (type) { + case 'boolean': + el.innerHTML = value ? "true" : "false"; + break; + + case 'float': + case 'integer': + el.innerHTML = '' + value; + break; + + case 'period': + let [start, end] = value; + let startEl = doc.createElementNS(xcal, 'start'); + startEl.innerHTML = start; + let endEL; + if (end.find('P')) { + endEl = doc.createElementNS(xcal, 'duration'); + } else { + endEl = doc.createElementNS(xcal, 'end'); + } + endEl.innerHTML = end; + el.appendChild(startEl); + el.appendChild(endEl); + break; + + case 'recur': + for (var key in value) { + if (! value.hasOwnProperty(key)) continue; + let e = doc.createElementNS(xcal, key); + e.innerHTML = value[key]; + el.appendChild(e); + } + break; + + case 'date': + case 'time': + case 'date-time': + + case 'duration': + + case 'binary': + case 'text': + case 'uri': + case 'cal-address': + case 'utc-offset': + el.innerHTML = value; + break; + + default: + /* TODO error */ + } + return el; +} + +function jcal_property_to_xcal_property(doc, jcal) { + let [propertyName, params, type, ...values] = jcal; + + let tag = doc.createElementNS(xcal, propertyName); + + /* setup parameters */ + let paramEl = doc.createElementNS(xcal, 'params'); + for (var key in params) { + /* Check if the key actually belongs to us. + At least (my) format also appears when iterating + over the parameters. Probably a case of builtins + vs user defined. + + This is also the reason we can't check if params + is empty beforehand, and instead check the + number of children of paramEl below. + */ + if (! params.hasOwnProperty(key)) continue; + + let el = doc.createElementNS(xcal, key); + + for (let v of asList(params[key])) { + let text = doc.createElementNS(xcal, 'text'); + text.innerHTML = '' + v; + el.appendChild(text); + } + + paramEl.appendChild(el); + } + + if (paramEl.childCount > 0) { + tag.appendChild(paramEl); + } + + /* setup value (and type) */ + // let typeEl = doc.createElementNS(xcal, type); + + switch (propertyName) { + case 'geo': + if (type == 'float') { + // assert values[0] == [x, y] + let [x, y] = values[0]; + let lat = doc.createElementNS(xcal, 'latitude') + let lon = doc.createElementNS(xcal, 'longitude') + lat.innerHTML = x; + lon.innerHTML = y; + tag.appendChild(lat); + tag.appendChild(lon); + } else { + /* TODO, error */ + } + break; + case 'request-status': + if (type == 'text') { + // assert values[0] instanceof Array + let [code, desc, ...data] = values[0]; + let codeEl = doc.createElementNS(xcal, 'code') + code.innerHTML = code; + tag.appendChild(codeEl); + + + let descEl = doc.createElementNS(xcal, 'description') + desc.innerHTML = desc; + tag.appendChild(descEl); + + if (data !== []) { + data = data[0]; + let dataEl = doc.createElementNS(xcal, 'data') + data.innerHTML = data; + tag.appendChild(dataEl); + } + } else { + /* TODO, error */ + } + break; + default: + for (let value of values) { + tag.appendChild(jcal_type_to_xcal(doc, type, value)) + } + } + + return tag; +} + + +function jcal_to_xcal(...jcals) { + let doc = document.implementation.createDocument(xcal, 'icalendar'); + for (let jcal of jcals) { + doc.documentElement.appendChild(jcal_to_xcal_inner(doc, jcal)); + } + return doc; +} + +function jcal_to_xcal_inner(doc, jcal) { + let [tagname, properties, components] = jcal; + + let xcal_tag = doc.createElementNS(xcal, tagname); + + /* I'm not sure if the properties and components tag should be left out + when empty. It should however NOT be an error to leave them in. + */ + + let xcal_properties = doc.createElementNS(xcal, 'properties'); + for (let property of properties) { + xcal_properties.appendChild(jcal_property_to_xcal_property(doc, property)); + } + + let xcal_children = doc.createElementNS(xcal, 'components'); + for (let child of components) { + xcal_children.appendChild(jcal_to_xcal_inner(doc, child)); + } + + xcal_tag.appendChild(xcal_properties); + xcal_tag.appendChild(xcal_children); + + return xcal_tag; + +} diff --git a/static/lib.js b/static/lib.js index ab279353..1d42100c 100644 --- a/static/lib.js +++ b/static/lib.js @@ -32,6 +32,9 @@ function zip(...args) { NOTE that only the raw `get' (and NOT the `getUTC') methods should be used on these objects, and that the reported timezone is quite often wrong. + + TODO The years between 0 and 100 (inclusive) gives dates in the twentieth + century, due to how javascript works (...). */ function parseDate(str) { @@ -117,7 +120,16 @@ function setVar(str, val) { } +function asList(thing) { + if (thing instanceof Array) { + return thing; + } else { + return [thing]; + } +} + +/* internal */ function datepad(thing, width=2) { return (thing + "").padStart(width, "0"); } @@ -147,7 +159,7 @@ function format_date(date, str) { } return outstr; } -Object.prototype.format = function () { return this; } /* any number of arguments */ +Object.prototype.format = function () { return "" + this; } /* any number of arguments */ Date.prototype.format = function (str) { return format_date (this, str); } /* diff --git a/static/recur.js b/static/recur.js deleted file mode 100644 index e69de29b..00000000 --- a/static/recur.js +++ /dev/null diff --git a/static/rrule.js b/static/rrule.js index abc648af..67a4453f 100644 --- a/static/rrule.js +++ b/static/rrule.js @@ -8,6 +8,14 @@ function recur_xml_to_rrule(dom_element) { return rr; } +function recur_jcal_to_rrule(jcal) { + let rr = new RRule; + for (var key in jcal) { + rr[key] = jcal[key]; + } + return rr; +} + class RRule { /* direct access to fields is fine */ @@ -17,7 +25,9 @@ class RRule { fields = ['freq', 'until', 'count', 'interval', 'bysecond', 'byminute', 'byhour', 'bymonthday', 'byyearday', 'byweekno', - 'bymonth', 'bysetpos', 'wkst'] + 'bymonth', 'bysetpos', 'wkst', + 'byday' + ] constructor() { @@ -49,16 +59,33 @@ class RRule { this.listeners[field].push(proc); } - asXcal() { + /* NOTE this function is probably never used. + Deperate it and refer to RRule.asJcal + together with jcal_to_xcal */ + asXcal(doc) { /* TODO empty case */ - let str = "<recur>"; + // let str = "<recur>"; + let root = doc.createElementNS(xcal, 'recur'); for (let f of this.fields) { let v = this.fields[f]; if (! v) continue; - str += `<${f}>${v}</${f}>`; + let tag = doc.createElementNS(xcal, f); + /* TODO type formatting */ + tag.innerHTML = `${v}`; + root.appendChild(tag); + } + return root; + } + + asJcal() { + let obj = {}; + for (let f of this.fields) { + let v = this[f]; + if (! v) continue; + /* TODO special formatting for some types */ + obj[f] = v; } - str += "</recur>"; - return str; + return obj; } /* diff --git a/static/script.js b/static/script.js index 3a3148b5..6b7ddcd9 100644 --- a/static/script.js +++ b/static/script.js @@ -228,8 +228,8 @@ function place_in_edit_mode (event) { } window.onload = function () { - let start_time = document.querySelector("meta[name='start-time']").content; - let end_time = document.querySelector("meta[name='end-time']").content; + // let start_time = document.querySelector("meta[name='start-time']").content; + // let end_time = document.querySelector("meta[name='end-time']").content; const button_updater = new ButtonUpdater( document.getElementById("today-button"), @@ -239,9 +239,10 @@ window.onload = function () { const sch = new SmallcalCellHighlight( document.querySelector('.small-calendar')) - const timebar = new Timebar(start_time, end_time); + const timebar = new Timebar(/*start_time, end_time*/); timebar.update(new Date); + sch.update(new Date); window.setInterval(() => { let d = new Date; timebar.update(d); @@ -382,7 +383,9 @@ window.onload = function () { */ function get_property(el, field, default_value) { if (! el.properties) { + /* TODO only have construction once */ el.properties = {}; + el.properties.ical_properties = new Set() } if (! el.properties["_slot_" + field]) { @@ -423,6 +426,7 @@ function get_property(el, field, default_value) { function bind_properties (el, wide_event=false) { el.properties = {} + el.properties.ical_properties = new Set() let popup = popup_from_event(el); // let children = el.getElementsByTagName("properties")[0].children; @@ -523,6 +527,9 @@ function bind_properties (el, wide_event=false) { }]); } + for (let property of property_names) { + el.properties.ical_properties.add(property) + } /* icalendar properties */ for (let child of el.querySelector("vevent > properties").children) { @@ -531,29 +538,15 @@ function bind_properties (el, wide_event=false) { let field = child.tagName; let lst = get_property(el, field); + el.properties.ical_properties.add(field) /* Bind vcomponent fields for this event */ for (let s of el.querySelectorAll(`${field} > :not(parameters)`)) { - lst.push([s, (s, v) => { - if (v instanceof Date) { - if (v.isWholeDay) { - let str = v.format('~Y-~m-~d'); - child.innerHTML = `<date>${str}</date>`; - } else { - let str = v.format('~Y-~m-~dT~H:~M:00~Z'); - child.innerHTML = `<date-time>${str}</date-time>`; - } - } else if (v instanceof RRule) { - child.innerHTML = v.asXcal(); - } else { - /* assume that type already is correct */ - s.innerHTML = v; - } - }]); - /* Binds value from XML-tree to javascript object [parsedate] + + TODO capture xcal type here, to enable us to output it to jcal later. */ switch (field) { case 'rrule': @@ -565,29 +558,6 @@ function bind_properties (el, wide_event=false) { } } - /* Dynamicly add or remove the <location/> and <description/> elements - from the <vevent><properties/> list. - - TODO generalize this to all fields, /especially/ those which are - dynamicly added. - */ - for (let field of ['location', 'description', 'categories']) { - get_property(el, field).push( - [el.querySelector('vevent > properties'), - (s, v) => { - let slot = s.querySelector(field); - if (v === '' && slot) { - slot.remove(); - } else { - if (! slot) { - /* finns det verkligen inget bättre sätt... */ - s.innerHTML += `<${field}><text/></${field}>`; - } - s.querySelector(`${field} > text`).innerHTML = v; - } - }]); - } - /* set up graphical display changes */ let container = el.closest(".event-container"); if (container === null) { @@ -617,28 +587,6 @@ function bind_properties (el, wide_event=false) { } - /* Update XML on rrule field change */ - if (el.properties.rrule) { - for (let f of el.properties.rrule.fields) { - el.properties.rrule.addListener( - f, v => { - console.log(v); - let recur = el.querySelector('rrule recur'); - let field = recur.querySelector(f); - if (field) { - if (! v) { - field.remove(); - } else { - field.innerHTML = v; - } - } else { - if (v) recur.innerHTML += `<${f}>${v}</${f}>`; - } - }); - } - } - - /* ---------- Calendar ------------------------------ */ if (! el.dataset.calendar) { diff --git a/static/server_connect.js b/static/server_connect.js index e789d72c..a50128ae 100644 --- a/static/server_connect.js +++ b/static/server_connect.js @@ -21,16 +21,90 @@ async function remove_event (element) { } } +function event_to_jcal (event) { + let properties = []; + + for (let prop of event.properties.ical_properties) { + let v = event.properties[prop]; + if (v !== undefined) { + + let type = 'text'; + let value; + + if (v instanceof Array) { + } else if (v instanceof Date) { + if (v.isWholeDay) { + type = 'date'; + value = v.format("~Y-~m-~d"); + } else { + type = 'date-time'; + /* TODO TZ */ + value = v.format("~Y-~m-~dT~H:~M:~S"); + } + } else if (v === true || v === false) { + type = 'boolean'; + value = v; + } else if (typeof(v) == 'number') { + /* TODO float or integer */ + type = 'integer'; + value = v; + } else if (v instanceof RRule) { + type = 'recur'; + value = v.asJcal(); + } + /* TODO period */ + else { + /* text types */ + value = v; + } + + properties.push([prop, {}, type, value]); + } + } + + return ['vevent', properties, [/* alarms go here */]] +} + async function create_event (event) { - let xml = event.getElementsByTagName("icalendar")[0].outerHTML + // let xml = event.getElementsByTagName("icalendar")[0].outerHTML let calendar = event.properties.calendar; - console.log(calendar, xml); + console.log(calendar/*, xml*/); let data = new URLSearchParams(); data.append("cal", calendar); - data.append("data", xml); + // data.append("data", xml); + + console.log(event); + + + + let jcal = + ['vcalendar', + [ + /* + 'prodid' and 'version' are technically both required (RFC 5545, + 3.6 Calendar Components). + */ + ], + [ + /* vtimezone goes here */ + event_to_jcal(event), + ] + ]; + + console.log(jcal); + + let doc = jcal_to_xcal(jcal); + console.log(doc); + let str = doc.documentElement.outerHTML; + console.log(str); + data.append("data", str); + + // console.log(event.properties); + + // return; let response = await fetch ( '/insert', { method: 'POST', @@ -54,12 +128,12 @@ async function create_event (event) { */ let parser = new DOMParser(); - let properties = parser + let return_properties = parser .parseFromString(body, 'text/xml') .children[0]; let child; - while ((child = properties.firstChild)) { + while ((child = return_properties.firstChild)) { let target = event.querySelector( "vevent properties " + child.tagName); if (target) { diff --git a/static/style.scss b/static/style.scss index b81e8c01..202e3a34 100644 --- a/static/style.scss +++ b/static/style.scss @@ -173,6 +173,10 @@ html, body { } } +li > button { + width: 100%; +} + /* Eventlist ---------------------------------------- The sidebar with all the events @@ -950,6 +954,10 @@ along with their colors. background-color: var(--color); } +.side-by-side { + display: flex; +} + /* Icalendar ---------------------------------------- */ diff --git a/static/types.js b/static/types.js index cfed8584..9a4aa01c 100644 --- a/static/types.js +++ b/static/types.js @@ -15,6 +15,17 @@ let all_types = [ 'boolean', ] +let property_names = [ + 'calscale', 'method', 'prodid', 'version', 'attach', 'categories', + 'class', 'comment', 'description', 'geo', 'location', 'percent-complete', + 'priority', 'resources', 'status', 'summary', 'completed', 'dtend', 'due', + 'dtstart', 'duration', 'freebusy', 'transp', 'tzid', 'tzname', 'tzoffsetfrom', + 'tzoffsetto', 'tzurl', 'attendee', 'contact', 'organizer', 'recurrence-id', + 'related-to', 'url', 'uid', 'exdate', 'exrule', 'rdate', 'rrule', 'action', + 'repeat', 'trigger', 'created', 'dtstamp', 'last-modified', 'sequence', 'request-status' +]; + + let valid_fields = { 'VCALENDAR': ['PRODID', 'VERSION', 'CALSCALE', 'METHOD'], 'VEVENT': ['DTSTAMP', 'UID', 'DTSTART', 'CLASS', 'CREATED', diff --git a/tests/base64.scm b/tests/base64.scm index b0bb992a..59a8784c 100644 --- a/tests/base64.scm +++ b/tests/base64.scm @@ -1,6 +1,10 @@ +;;; Commentary: +;; Test that Base64 encoding and decoding works +;; Examples from RFC4648 +;;; Code: + (((base64) base64encode base64decode)) -;; Examples from RFC4648 (test-equal "" (base64encode "")) (test-equal "Zg==" (base64encode "f")) diff --git a/tests/cpp.scm b/tests/cpp.scm index d83ba554..84bd4b92 100644 --- a/tests/cpp.scm +++ b/tests/cpp.scm @@ -1,3 +1,7 @@ +;;; Commentary: +;; Tests my parser for a subset of the C programming language. +;;; Code: + (((c lex) lex) ((c parse) parse-lexeme-tree)) diff --git a/tests/datetime-compare.scm b/tests/datetime-compare.scm index 649dc59f..f2585f46 100644 --- a/tests/datetime-compare.scm +++ b/tests/datetime-compare.scm @@ -1,3 +1,8 @@ +;;; Commentary: +;; Tests that all ordering predicates for dates, +;; times, and datetimes hold. +;;; Code: + (((datetime) date datetime time diff --git a/tests/datetime-util.scm b/tests/datetime-util.scm index 123229c7..28317676 100644 --- a/tests/datetime-util.scm +++ b/tests/datetime-util.scm @@ -1,3 +1,9 @@ +;;; Commentary: +;; Tests timespan overlaps and month-streams. +;; Separate from tests/datetime.scm since +;; (datetime util) originally was its own module. +;;; Code: + (((datetime) date time datetime month-stream in-date-range? timespan-overlaps?) ((srfi srfi-41) stream->list stream-take diff --git a/tests/datetime.scm b/tests/datetime.scm index 83750472..5bf2df6d 100644 --- a/tests/datetime.scm +++ b/tests/datetime.scm @@ -1,3 +1,8 @@ +;;; Commentary: +;; Tests date, time, and datetime creation, +;; (output) formatting, and arithmetic. +;;; Code: + (((datetime) date+ date- time+ time- year month day diff --git a/tests/display b/tests/display new file mode 100755 index 00000000..e58288a2 --- /dev/null +++ b/tests/display @@ -0,0 +1,2 @@ +#!/bin/bash +guild display-commentary *.scm | sed -e 's/^ / /' -e 's/^\S/\n&/g' diff --git a/tests/let.scm b/tests/let.scm index 82919b49..81a34131 100644 --- a/tests/let.scm +++ b/tests/let.scm @@ -1,3 +1,7 @@ +;;; Commentary: +;; Tests my custom let*. +;;; Code: + (((calp util) let*) ((guile) set!)) diff --git a/tests/param.scm b/tests/param.scm index 0c4190dd..23704948 100644 --- a/tests/param.scm +++ b/tests/param.scm @@ -1,3 +1,8 @@ +;;; Commentary: +;; Checks that parameters (1) are correctly parsed and stored. +;; (1): 'A', and 'B' in the line "KEY;A=1;B=2:Some text" +;;; Code: + (((vcomponent base) param prop* parameters) ((vcomponent parse) parse-calendar) ((calp util) sort*)) diff --git a/tests/recurrence.scm b/tests/recurrence-advanced.scm index 6ced6af0..c2242c19 100644 --- a/tests/recurrence.scm +++ b/tests/recurrence-advanced.scm @@ -1,9 +1,20 @@ ;;; Commentary: +;; Tests of recurrence rule generation with focus on correct instances +;; being generated. For tests of basic recurrence functionallity, see +;; recurrence-simple.scm. +;; +;; This file also tests format-recurrence-rule, which checks that human +;; readable representations of the RRULES work. +;; +;; Also contains the tests for EXDATE. +;; +;; Most examples copied from RFC5545, some home written. +;;; Code: + ;; The human readable tests are expected to fail with any change to the ;; text creator. Proof-read them manually, and update the test cases ;; to match. `x-summary' used for target string. Target strings should ;; be in swedish. -;;; Code: (((vcomponent recurrence parse) parse-recurrence-rule) ((vcomponent recurrence generate) generate-recurrence-set) @@ -16,8 +27,6 @@ ((srfi srfi-41) stream->list) ((srfi srfi-88) keyword->string)) -;; Examples copied from RFC5545 - (define (run-test comp) (test-equal (string-append "RSET: " (prop comp 'SUMMARY)) diff --git a/tests/recurrence-id.scm b/tests/recurrence-id.scm deleted file mode 100644 index 601b0f71..00000000 --- a/tests/recurrence-id.scm +++ /dev/null @@ -1,30 +0,0 @@ -(((srfi srfi-41) stream->list) - ((vcomponent) parse-calendar) - ((vcomponent recurrence) generate-recurrence-set) - ((guile) format) - ) - -(define uid (symbol->string (gensym "areallyuniqueid"))) - -(define ev - (call-with-input-string - (format #f "BEGIN:VCALENDAR -BEGIN:VEVENT -SUMMARY:Changing type on Recurrence-id. -UID:~a -DTSTART;VALUE=DATE:20090127 -END:VEVENT -BEGIN:VEVENT -UID:~a -SUMMARY:Changing type on Recurrence-id. -DTSTART;TZID=Europe/Stockholm:20100127T120000 -RECURRENCE-ID;VALUE=DATE:20100127 -SUMMARY:This instance only has a time component -END:VEVENT -END:VCALENDAR" - uid uid) - parse-calendar)) - - -(test-assert "Changing type on Recurrence id." - (stream->list 10 (generate-recurrence-set ev))) diff --git a/tests/recurring.scm b/tests/recurrence-simple.scm index a3f98027..9c78977b 100644 --- a/tests/recurring.scm +++ b/tests/recurrence-simple.scm @@ -1,9 +1,43 @@ +;;; Commentary: +;; Simples tests of recurrence system, ensuring that all parsers and +;; basic generators work. Some more fully-featured tests are here, but +;; most are instead in recurrence-advanced.scm. +;;; Code: + (((srfi srfi-41) stream-take stream-map stream->list stream-car) - ((datetime) day-stream) + ((datetime) day-stream mon) ((vcomponent base) extract prop) + ((calp util exceptions) warnings-are-errors warning-handler) + ((guile) format) + ((vcomponent) parse-calendar) - ((vcomponent recurrence) generate-recurrence-set)) + ((vcomponent recurrence) + parse-recurrence-rule + make-recur-rule + generate-recurrence-set)) + +;;; Test that basic parsing or recurrence rules work. + +(test-equal (make-recur-rule freq: 'HOURLY wkst: mon interval: 1) + (parse-recurrence-rule "FREQ=HOURLY")) + +(test-equal (make-recur-rule freq: 'HOURLY count: 3 interval: 1 wkst: mon) + (parse-recurrence-rule "FREQ=HOURLY;COUNT=3")) + +;;; Test that recurrence rule parsing fails where appropriate + +(parameterize ((warnings-are-errors #t) + (warning-handler identity)) ; silence warnings + (test-error "Invalid FREQ" 'warning + (parse-recurrence-rule "FREQ=ERR;COUNT=3")) + + (test-error "Negative COUNT" 'warning + (parse-recurrence-rule "FREQ=HOURLY;COUNT=-1")) + + (test-error "Invalid COUNT" + 'wrong-type-argument + (parse-recurrence-rule "FREQ=HOURLY;COUNT=err")) ) ;;; Test that basic recurrence works ;;; also see the neighbour test file recurrence.scm for more tests. @@ -158,3 +192,49 @@ END:VEVENT" (test-assert "Full test" (stream-car (generate-recurrence-set ev))) + +;;; Tests that exceptions (in the recurrence-id meaning) +;;; in recurrence sets are handled correctly. +;;; TODO Is however far from done. + +(define uid (symbol->string (gensym "areallyuniqueid"))) + +;; TODO standardize vcomponents for tests as xcal, for example: +`(vcalendar + (children + (vevent + (properties + (summary (text "Changing type on Recurrence-id.")) + (uid (text ,uid)) + (dtstart (date "20090127")))) + (vevent + (properties + (summary (text "Changing type on Recurrence-id.")) + (uid (text ,uid)) + (dtstart (params (TZID "Europe/Stockholm")) + (date-time "20100127T120000")) + (recurrence-id (date "20100127")) + (summary "This instance only has a time component"))))) + +(define ev + (call-with-input-string + (format #f "BEGIN:VCALENDAR +BEGIN:VEVENT +SUMMARY:Changing type on Recurrence-id. +UID:~a +DTSTART;VALUE=DATE:20090127 +END:VEVENT +BEGIN:VEVENT +UID:~a +SUMMARY:Changing type on Recurrence-id. +DTSTART;TZID=Europe/Stockholm:20100127T120000 +RECURRENCE-ID;VALUE=DATE:20100127 +SUMMARY:This instance only has a time component +END:VEVENT +END:VCALENDAR" + uid uid) + parse-calendar)) + + +(test-assert "Changing type on Recurrence id." + (stream->list 10 (generate-recurrence-set ev))) diff --git a/tests/rrule-parse.scm b/tests/rrule-parse.scm deleted file mode 100644 index b7a851a0..00000000 --- a/tests/rrule-parse.scm +++ /dev/null @@ -1,24 +0,0 @@ -(((vcomponent recurrence parse) - parse-recurrence-rule) - ((vcomponent recurrence) make-recur-rule) - ((datetime) mon) - ((calp util exceptions) warnings-are-errors warning-handler) - ) - -(test-equal (make-recur-rule freq: 'HOURLY wkst: mon interval: 1) - (parse-recurrence-rule "FREQ=HOURLY")) - -(test-equal (make-recur-rule freq: 'HOURLY count: 3 interval: 1 wkst: mon) - (parse-recurrence-rule "FREQ=HOURLY;COUNT=3")) - -(parameterize ((warnings-are-errors #t) - (warning-handler identity)) ; silence warnings - (test-error "Invalid FREQ" 'warning - (parse-recurrence-rule "FREQ=ERR;COUNT=3")) - - (test-error "Negative COUNT" 'warning - (parse-recurrence-rule "FREQ=HOURLY;COUNT=-1")) - - (test-error "Invalid COUNT" - 'wrong-type-argument - (parse-recurrence-rule "FREQ=HOURLY;COUNT=err")) ) diff --git a/tests/run-tests.scm b/tests/run-tests.scm index 670a1784..4060a170 100755 --- a/tests/run-tests.scm +++ b/tests/run-tests.scm @@ -2,6 +2,13 @@ -s !# +;;; Commentary: +;; Not a test, but a script that runs tests. +;; Assumes that all other .scm files in this directory are test files, +;; and should thereby follow the test-file syntax. +;; TODO document the testfile syntax. +;;; Code: + (eval-when (compile load) (define here (dirname (current-filename)))) diff --git a/tests/server.scm b/tests/server.scm index a9cb870e..d21c11da 100644 --- a/tests/server.scm +++ b/tests/server.scm @@ -1,6 +1,21 @@ -(((web http make-routes) parse-endpoint-string)) +;;; Commentary: +;; Tests parse-endpoint-string, used for defining server routes. +;;; Code: -(test-assert (parse-endpoint-string "/static/:dir/:file")) -;; => "/static/([^/]+)/([^/]+)" -;; => (dir file) +(((web http make-routes) parse-endpoint-string) + ((calp util) let*)) +(test-assert "Check that parsing doesn't crash" + (parse-endpoint-string "/static/:dir/:file")) + +;; Checks that parsing produces correct results +(let* ((path args (parse-endpoint-string "/static/:dir/:file"))) + (test-equal "/static/([^/.]+)/([^/.]+)" path) + (test-equal '(dir file) args)) + + +;; Checks that parsing with custom regex works +;; along with literal periods. +(let* ((path args (parse-endpoint-string "/static/:filename{.*}.:ext"))) + (test-equal "/static/(.*)\\.([^/.]+)" path) + (test-equal '(filename ext) args)) diff --git a/tests/srfi-41-util.scm b/tests/srfi-41-util.scm index 61bce71e..3c2c3f0f 100644 --- a/tests/srfi-41-util.scm +++ b/tests/srfi-41-util.scm @@ -1,3 +1,8 @@ +;;; Commentary: +;; Tests (srfi srfi-41 util). +;; Currently only tests stream-paginate. +;;; Code: + (((srfi srfi-41 util) stream-paginate) ((srfi srfi-41) stream->list stream-ref stream-from stream-filter stream-car stream) diff --git a/tests/termios.scm b/tests/termios.scm index 214a12a0..c0cb4323 100755..100644 --- a/tests/termios.scm +++ b/tests/termios.scm @@ -1,10 +1,8 @@ ;;; Commentary: - ;; Tests that my termios function works, at least somewhat. -;; Note that this actually modifies the terminal it's run on, and might fail if -;; the terminal doesn't support the wanted modes. See termios(3). +;; Note that this actually modifies the terminal it's run on, and might fail +;; if the terminal doesn't support the wanted modes. See termios(3). ;; It might also leave the terminal in a broken state if exited prematurely. - ;;; Code: (((calp util) set!) diff --git a/tests/tz.scm b/tests/tz.scm index 8ccd636d..147f0807 100644 --- a/tests/tz.scm +++ b/tests/tz.scm @@ -1,3 +1,11 @@ +;;; Commentary: +;; Tests that datetime->unix-time correctly converts between Olssen +;; timezone definitions (e.g. Europe/Stockholm), into correct times +;; and offsets (in unix time). +;; Also indirectly tests the Zone Info Compiler (datetime zic), since +;; the zoneinfo comes from there. +;;; Code: + (((datetime) parse-ics-datetime datetime date time diff --git a/tests/util.scm b/tests/util.scm index f917b5ce..ed5abfd1 100644 --- a/tests/util.scm +++ b/tests/util.scm @@ -1,3 +1,7 @@ +;;; Commentary: +;; Checks some prodecuders from (calp util) +;;; Code: + (((calp util) filter-sorted set/r!)) (test-equal "Filter sorted" diff --git a/tests/vcomponent-control.scm b/tests/vcomponent-control.scm index 8cc87a0a..2ee4c243 100644 --- a/tests/vcomponent-control.scm +++ b/tests/vcomponent-control.scm @@ -1,3 +1,7 @@ +;;; Commentary: +;; Tests that with-replaced-properties work. +;;; Code: + (((vcomponent control) with-replaced-properties) ((vcomponent) parse-calendar) ((vcomponent base) prop)) diff --git a/tests/vcomponent-datetime.scm b/tests/vcomponent-datetime.scm index f7bb00f4..0bc584f6 100644 --- a/tests/vcomponent-datetime.scm +++ b/tests/vcomponent-datetime.scm @@ -1,3 +1,8 @@ +;;; Commentary: +;; Tests that event-clamping (checking how long part of an event +;; overlaps another time span) works. +;;; Code: + (((datetime) date time datetime) @@ -13,10 +18,15 @@ DTEND:20200401T100000 END:VEVENT" parse-calendar)) +;; |-----------------| test interval +;; |----------| event interval (test-equal "Correct clamping" - (datetime time: (time hour: 7)) - (event-length/clamped #2020-03-23 #2020-03-29 ev)) + (datetime time: (time hour: 7)) ; 2020-03-29T17:00 - 2020-03-30T00:00 + (event-length/clamped + #2020-03-23 ; a time way before the start of the event + #2020-03-29 ; a time slightly after the end of the event + ev)) (define utc-ev (call-with-input-string "BEGIN:VEVENT diff --git a/tests/vcomponent.scm b/tests/vcomponent.scm index 0d81ab0e..15c83845 100644 --- a/tests/vcomponent.scm +++ b/tests/vcomponent.scm @@ -1,3 +1,7 @@ +;;; Commentary: +;; Test that vcomponent parsing works at all. +;;; Code: + (((vcomponent base) prop) ((vcomponent) parse-calendar)) diff --git a/tests/web-server.scm b/tests/web-server.scm index 6b315319..bce05d0e 100644 --- a/tests/web-server.scm +++ b/tests/web-server.scm @@ -1,3 +1,8 @@ +;;; Commentary: +;; Checks that HTTP server can start correctly, and that at least some +;; endpoints return correct information. +;;; Code: + (((calp server routes) make-make-routes) ((web server) run-server) ((ice-9 threads) call-with-new-thread cancel-thread) diff --git a/tests/xcal.scm b/tests/xcal.scm index 1748cba3..babb2218 100644 --- a/tests/xcal.scm +++ b/tests/xcal.scm @@ -1,3 +1,8 @@ +;;; Commentary: +;; Basic tests of xcal convertion. +;; Currently only checks that events survive a round trip. +;;; Code: + (((vcomponent xcal parse) sxcal->vcomponent) ((vcomponent xcal output) vcomponent->sxcal) ((vcomponent ical parse) parse-calendar) |