;;; fleuron.paren --- extra fancy HTML documents with OrgMode

;; (C) Copyright 2022 by David T. O'Toole
;; Author: David T. O'Toole <deeteeoh1138@gmail.com>
;; License: MIT
;; Version: 0.9
;; URL: https://davidotoole.info/fleuron.html
;; Time-stamp: <2022-12-24 03:29:38 dto>

;; Permission is hereby granted, free of charge, to any person
;; obtaining a copy of this software and associated documentation
;; files (the "Software"), to deal in the Software without
;; restriction, including without limitation the rights to use, copy,
;; modify, merge, publish, distribute, sublicense, and/or sell copies
;; of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:

;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.

;; The Software is provided "as is", without warranty of any kind,
;; express or implied, including but not limited to the warranties of
;; merchantability, fitness for a particular purpose and
;; noninfringement. In no event shall the authors or copyright holders
;; be liable for any claim, damages or other liability, whether in an
;; action of contract, tort or otherwise, arising from, out of or in
;; connection with the Software or the use or other dealings in the
;; Software.

;;; Commentary: 

;; Org-fleuron adds fancy things to org-info-js.  See
;; https://davidotoole.info/fleuron.html for details and
;; documentation.

;; This file is written in Parenscript, a subset of Common Lisp that
;; compiles to JavaScript. To compile in Common Lisp see the included
;; file "compile-js.lisp". The results are in "fleuron.js".

;;; Code: 

;;; Configuration variables

(defvar FleuronLicensePageNumber 1 "Page number of the license.")
(defvar FleuronHelpPageNumber 2 "Page number of the help documentation.")

(defvar FleuronDocuments nil
  "A list of lists, each of which is of the form (URL TITLE SUBTITLE
AUTHOR) used to fill the Documents tab.")

(defvar FleuronFullTextSearchIsEnabled t
  "When non-nil, emit a link to search.html.")

;;; Utilities

(defun FleuronHideElement (element)
  "Hide the ELEMENT."
  (setf (@ element style display) "none"))

(defun FleuronShowElement (element)
  "Show the ELEMENT in block display style."
  (setf (@ element style display) "block"))

(defun FleuronShowElementInline (element)
  "Show the ELEMENT in inline display style."
  (setf (@ element style display) "inline"))

(defun FleuronElement (id)
  "Return the DOM element identified by ID."
  ((@ document getElementById) id))

(defun FleuronStoreItem (key value)
  "Save the KEY,VALUE pair to local storage."
  ((@ localStorage setItem) key value))

(defun FleuronRetrieveItem (key)
  "Retrieve the value for KEY in local storage."
  ((@ localStorage getItem) key))

(defun FleuronRemoveItem (key)
  "Remove the key KEY and its value from local storage."
  ((@ localStorage removeItem) key))

(defun FleuronLocalStorageKeys ()
  "Return a list of all storage keys."
  ((@ Object keys) localStorage))

;;; Fancy public domain capital letters by William Morris

(defun FleuronFancyCapitalImageFile (letter)
  "Return the local URL of the image for the LETTER."
  (concatenate 'string "caps/" letter ".png"))

(defun FleuronFancyCapital (letter)
  "Build the HTML image for the LETTER."
  (concatenate 'string
               "<img class=\"fleuron-fancy-capital\" src=\""
               (FleuronFancyCapitalImageFile letter)
               "\">"))

(defun FleuronFancyBookCoverImageFile ()
  "Return a fancy book cover image."
  "book-cover.png")

;;; Bookmark basics

(defun FleuronFileFromURL (url)
  "Extract the file name from the URL."
  (let ((part1 ((@ ((@ url split) "/") pop))))
    (let ((part2 ((@ part1 split) "#")))
      (@ part2 0))))

(defun FleuronCleanString (s)
  "Remove any double-quotes from the string S."
  ((@ s replaceAll)
   ((@ String fromCharCode) 34)
   ""))

(defun FleuronBookmarkKey ()
  "Build a storage key string for the current document node."
  (concatenate 'string
               "OrgInfoBookmark$"
               (@ window location href)
               "$"
               (FleuronCleanString (@ document title))
               "$"
               (FleuronCleanString 
                (@ (@ org_html_manager NODE)
                   HEADING textContent))))

(defun FleuronBookmarkData (key)
  "Return the bookmark data for KEY."
  (append ((@ key split) "$")
          (list (FleuronRetrieveItem key))))

(defun FleuronSaveBookmark (pageNumber)
  "Save a bookmark for the current document node at PAGENUMBER."
  (FleuronStoreItem (FleuronBookmarkKey) pageNumber)
  ((@ org_html_manager warn)
   (concatenate 'string
                "Bookmark saved at page "
                (1+ pageNumber)
                ".")
   t)
  (FleuronUpdateBookmarksTab))

(defun FleuronDeleteBookmark (key)
  "Delete the bookmark identified by KEY."
  (FleuronRemoveItem key)
  (FleuronUpdateBookmarksTab))

(defun FleuronCompareBookmarks (a b)
  "Comparison predicate used for sorting bookmarks."
  (if (and a b)
      (destructuring-bind (url title heading pageNumber) a
        (destructuring-bind (url* title* heading* pageNumber*) b
          (if (equal title title*)
              (> (parseInt pageNumber)
                 (parseInt pageNumber*))
              (> title title*))))
      false))

(defun FleuronSortBookmarks (bookmarks)
  "Sort BOOKMARKS by page, grouped by document."
  (if bookmarks
      (let ((result ((@ bookmarks slice))))
        ((@ result sort) #'FleuronCompareBookmarks)
        result)
      nil))

;;; Enumerating bookmarks

(defun FleuronFindBookmarks (predicate)
  "Return a list of all bookmarks in the current document."
  (let* ((keys (FleuronLocalStorageKeys))
         (data (mapcar #'FleuronBookmarkData keys))
         (results []))
    (dolist (item data)
      (destructuring-bind (slug url title heading pageNumber) item
        (when (funcall #'predicate slug url)
          ((@ results push) (list url title heading pageNumber)))))
    results))

(defun FleuronAllBookmarks ()
  "Return a list of all bookmarks on the current site."
  (FleuronFindBookmarks
   #'(lambda (slug url)
       (equal slug "OrgInfoBookmark"))))

(defun FleuronLocalBookmarks ()
  "Return a list of all bookmarks in the current document."
  (FleuronFindBookmarks
   #'(lambda (slug url)
       (and (equal slug "OrgInfoBookmark")
            (equal (FleuronFileFromURL url)
                   (FleuronFileFromURL (@ window location href)))))))
 

(defun FleuronRemoteBookmarks ()
  "Return a list of all bookmarks in other documents."
  (FleuronFindBookmarks
   #'(lambda (slug url)
       (and (equal slug "OrgInfoBookmark")
            (not (equal (FleuronFileFromURL url)
                        (FleuronFileFromURL (@ window location href))))))))

;;; Determining the proper target of a bookmark link

(defun FleuronBookmarkLink (bookmark)
  "Return an appropriate link for the BOOKMARK."
  (destructuring-bind (url title heading pageNumber) bookmark
    (if (equal (FleuronFileFromURL url)
               (FleuronFileFromURL (@ window location href)))
        ;; local link
        (concatenate 'string "javascript:org_html_manager.navigateTo(" pageNumber ")")
        ;; another page
        url)))

;;; Formatting bookmarks into HTML

(defun FleuronBookmarkToHtml (bookmark show-title)
  "Format a BOOKMARK as HTML. When SHOW-TITLE is non-nil, show the title."
  (destructuring-bind (url title heading pageNumber) bookmark
    (let ((link (FleuronBookmarkLink bookmark))
          (pn (+ 1 (parseInt pageNumber))))
      (concatenate 'string
                   "<a href=\"" link "\">"
                   (if show-title title "")
                   (if show-title " -- " "")
                   heading
                   ;; display page number
                   " (page " pn ")</a>"
                   ;; deletion button
                   " <span class=\"fleuron-mini-button\"><a href=\"#\" onClick=\"javascript:FleuronDeleteBookmark('"
                   "OrgInfoBookmark$"
                   url
                   "$"
                   (FleuronCleanString title)
                   "$"
                   (FleuronCleanString heading)
                   "')\">"
                   "delete"
                   "</span></a>"))))

(defun FleuronBookmarksToHtml (bookmarks show-title)
  "Format BOOKMARKS to HTML. When SHOW-TITLE is non-nil, show the title."
  (let ((strings (new Array)))
    (if bookmarks
        (progn
          (dolist (item (mapcar #'(lambda (bookmark)
                                    (if bookmark (concatenate 'string "<li>"
                                                              (FleuronBookmarkToHtml bookmark show-title))
                                        ""))
                                bookmarks))
            ((@ strings push) item))
          (concatenate 'string
                       "<ul>"
                       ((@ strings join) " ")
                       "</ul>"))
        "<ul><li>No bookmarks to display.</ul>")))

(defun FleuronGroupBookmarksByDocument (bookmarks)
  "Return a list of lists of bookmarks, with each outer list containing
all the bookmarks from one document."
  (when bookmarks
    (let ((last-title (@ (@ bookmarks 0) 1))
          (groups [])
          (group []))
      (dolist (bookmark bookmarks)
        (when bookmark
          (if (equal last-title (@ bookmark 1))
              ((@ group push) bookmark)
              (progn
                (setf last-title (@ bookmark 1))
                ((@ groups push) group)
                (setf group [])
                ((@ group push) bookmark)))))
      ((@ groups push) group)
      ((@ groups sort) #'(lambda (a b)
                           (> (@ (@ a 0) 1)
                              (@ (@ b 0) 1)))))))

(defun FleuronAllBookmarksToHtml ()
  "Format all bookmarks to HTML, grouping by locality, document, and sorted by page."
  (let ((groups (FleuronGroupBookmarksByDocument (FleuronSortBookmarks (FleuronRemoteBookmarks)))))
    (let ((strings [])
          (html nil))
      (when groups
        (dolist (group groups)
          ((@ strings push) (concatenate 'string "<p>" (@ (@ group 0) 1) "<br>"))
          ((@ strings push) (FleuronBookmarksToHtml group nil)))
        (setf html ((@ strings join) " ")))
      (concatenate 'string
                   "<hr>"
                   "<p><i>In this document:</i><br>"
                   (FleuronBookmarksToHtml (FleuronSortBookmarks (FleuronLocalBookmarks)) nil)
                   "<hr>"
                   "<p><i>On this site:</i><br>"
                   (if (< 0 (length strings))
                       html
                       "<ul><li>No bookmarks to display.</ul>")))))

;;; Inserting the navigation buttons and help balloons for each page

(defun FleuronInsertButtons (pageNumber)
  "Insert HTML buttons and balloons for PAGENUMBER."
  (let ((extra "")
        (bookmarks (FleuronLocalBookmarks)))
    (when (and (equal null FleuronHelloFlag)
               (or (= pageNumber 0) (equal pageNumber "0")))
      (setf FleuronHelloFlag t)
      ;; show the help/greeting balloon
      (setf extra "<span id=\"myfade\"
 style=\"position:fixed;display:block;right:8pt;bottom:40pt;z-index:4;\"><a href=\"#\"
 onClick=\"javascript:FleuronHideBalloons()\">
<img class=\"hello\" src=\"hello.png\"></a>
</span>")
      (when (not (equal bookmarks null))
        ;; show the bookmark balloon if there's a local bookmark
        (setf extra (concatenate 'string extra "<span id=\"mybookmark\"
 style=\"position:fixed;display:block;right:273pt;bottom:40pt;z-index:5;\"><a href\"#\"
 onClick=\"javascript:FleuronHideBalloons()\"><img class=\"bookmark\"
 src=\"bookmark.png\"></a></span>"))))
    (concatenate 'string
                 extra
                 ;; next
                 "<span class=\"mytooltip\"
                  style=\"position:fixed;display:block;right:0;bottom:0;z-index:4;\">"
                 "<a href=\"javascript:org_html_manager.navigateTo(" (1+ pageNumber) ")\">"
                 "<img class=\"myflip\" src=\"next-button.png\"></a>
                 <span class=\"tooltiptext\">Next page</span></span>"
                 ;; previous
                 "<span class=\"mytooltip\"
                 style=\"position:fixed;display:block;right:105pt;bottom:0;z-index:4;\">"
                 "<a href=\"javascript:org_html_manager.navigateTo(" (1- pageNumber) ")\">"
                 "<img class=\"myflap\" src=\"previous-button.png\"></a><span
                 class=\"tooltiptext\">Previous page</span></span>"
                 ;; toc
                 "<span class=\"mytooltip\"
                 style=\"position:fixed;display:block;right:175pt;bottom:0;z-index:4;\">"
                 "<a href=\"javascript:org_html_manager.navigateTo(0)\">"
                 "<img class=\"mytoc\" src=\"toc-button.png\"></a>
                 <span class=\"tooltiptext\">Show table of contents</span></span>"
                 ;; home
                 "<span class=\"mytooltip\"
                 style=\"position:fixed;display:block;left:3pt;bottom:0;z-index:4;\">"
                 "<a href=\"./index.html\"><img class=\"myfleuron\" src=\"fleuron-button.png\"></a><span
                 class=\"tooltiptext\">Site home</span></span>"
                 ;; back
                 "<span class=\"mytooltip\"
                  style=\"position:fixed;display:block;right:70pt;bottom:0;z-index:4;\">"
                 "<a href=\"javascript:org_html_manager.popHistory(false)\">"
                 "<img class=\"myback\" src=\"back-button.png\"></a>
                 <span class=\"tooltiptext\">Go back</span></span>"
                 ;; help
                 "<span class=\"mytooltip\"
                  style=\"position:fixed;display:block;right:140pt;bottom:0;z-index:4;\">"
                 "<a href=\"javascript:org_html_manager.navigateTo(FleuronHelpPageNumber)\">"
                 "<img class=\"myhelp\" src=\"help-button.png\"></a>
                 <span class=\"tooltiptext\">Show help</span></span>"
                 ;; license
                 "<span class=\"mytooltip\"
                  style=\"position:fixed;display:block;right:210pt;bottom:0;z-index:4;\">"
                 "<a href=\"javascript:org_html_manager.navigateTo(FleuronLicensePageNumber)\">"
                 "<img class=\"mylicense\" src=\"license-button.png\"></a><span
                  class=\"tooltiptext\">Show license</span></span>"
                 ;; save bookmark
                 "<span class=\"mytooltip\"
                  style=\"position:fixed;display:block;right:245pt;bottom:0;z-index:4;\">"
                 "<a href=\"#\" onClick=\"javascript:FleuronSaveBookmark(" pageNumber ")\">"
                 "<img class=\"mysavebookmark\" src=\"add-bookmark-button.png\"></a><span
                  class=\"tooltiptext\">Save bookmark</span></span>"
                 ;; show bookmarks tab
                 "<span class=\"mytooltip\"
                   style=\"position:fixed;display:block;right:280pt;bottom:0;z-index:4;\">"
                 "<a href=\"#\" onClick=\"javascript:FleuronJumpToBookmarksTab()\">"
                 "<img class=\"myrestorebookmark\" src=\"jump-to-bookmark-button.png\"></a><span
                  class=\"tooltiptext\">Show bookmarks</span></span>"
                 ;; toggle sidebar
                 "<span class=\"mytooltip\"
                  style=\"position:fixed;display:block;right:315pt;bottom:0;z-index:4;\">"
                 "<a href=\"#\" onClick=\"javascript:FleuronToggleSidebar()\">"
                 "<img class=\"mytogglesidebar\" src=\"sidebar-button.png\"></a><span
                   class=\"tooltiptext\">Toggle sidebar</span></span>"
                 ;; bar background color
                 "<span style=\"position:fixed;display:block;right:0;
                   bottom:0;width:100%;height:41pt;z-index:3;background-color:#eee8d5;
                  \"></span>")))

;;; Showing the balloons only once

(defvar FleuronHelloFlag nil "When non-nil, don't show balloons again.")

;;; Hiding the help balloons when navigating

(defun FleuronAfterNavigate (pageNumber)
  "Hide balloons after navigating."
  (FleuronHideBalloons))

(defun FleuronHideBalloons ()
  "Hide all balloons."
  (let ((hello (FleuronElement "myfade"))
        (bookmark (FleuronElement "mybookmark")))
    (when hello
      (setf (@ hello style display) "none")
      (setf (@ hello style visibility) "hidden"))
    (when bookmark
      (setf (@ bookmark style display) "none")
      (setf (@ bookmark style visibility) "hidden"))))

;;; Sidebar

(defun FleuronSidebar ()
  "Returns the sidebar DOM object."
  (FleuronElement "FleuronSidebar"))

(defvar FleuronSidebarIsShown nil
  "When non-nil, the sidebar is shown.")

(defvar FleuronSavedMarginValue nil
  "This variable holds the computed style value of the left margin.")

(defun FleuronHideSidebar ()
  "Hide the sidebar."
  (let ((sidebar (FleuronSidebar)))
    (when sidebar
      ;; hide div
      (setf (@ sidebar style display) "none")
      ;; adjust document margins
      (let ((style (@ document body style)))
        (setf (aref style "margin-left")
              (or FleuronSavedMarginValue "15%")))
      ;; do bookkeeping
      (FleuronSidebarSetPersistent 0)
      (setf FleuronSidebarIsShown nil))))

(defun FleuronShowSidebar ()
  "Show the sidebar."
  (FleuronHideBalloons)
  (FleuronFillSidebarContents)
  (FleuronFillSidebarDocuments)
  (let ((sidebar (FleuronSidebar)))
    (when sidebar
      ;; hide div
      (setf (@ sidebar style display) "block")
      ;; adjust document margins
      (let ((style (@ document body style))
            (current-style (getComputedStyle (@ document body))))
        (when (null FleuronSavedMarginValue)
          (setf FleuronSavedMarginValue (aref current-style "margin-left")))
        (setf (aref style "margin-left") "192pt"))
      ;; do bookkeeping
      (FleuronSidebarSetPersistent 1)
      (setf FleuronSidebarIsShown t))))

(defun FleuronToggleSidebar ()
  "Toggle the visibility of the sidebar."
  (let ((sidebar (FleuronSidebar)))
    (when sidebar
      (if FleuronSidebarIsShown
          (FleuronHideSidebar)
          (FleuronShowSidebar)))))

;;; Sidebar tabs

(defun FleuronDocumentsTab ()
  "Return the documents tab."
  (FleuronElement "fleuron-documents"))

(defun FleuronContentsTab ()
  "Return the contents tab."
  (FleuronElement "fleuron-toc"))

(defun FleuronBookmarksTab ()
  "Return the bookmarks tab."
  (FleuronElement "fleuron-bookmarks"))

(defun FleuronAllTabs ()
  "Return a list of all tabs."
  ((@ document getElementsByClassName) "fleuron-tab"))

(defun FleuronShowContentsButton ()
  "Return the Contents tab button."
  (FleuronElement "fleuron-show-contents-button"))

(defun FleuronShowDocumentsButton ()
  "Return the Documents tab button."
  (FleuronElement "fleuron-show-documents-button"))

(defun FleuronShowBookmarksButton ()
  "Return the Bookmarks tab button."
  (FleuronElement "fleuron-show-bookmarks-button"))

(defun FleuronAllTabButtons ()
  "Return a list of all the tab buttons."
  (list (FleuronShowContentsButton)
        (FleuronShowDocumentsButton)
        (FleuronShowBookmarksButton)))

(defun FleuronSetBackgroundColor (element color)
  "Set the background color of the ELEMENT to COLOR."
  (setf (@ element style "background-color") color))

(defun FleuronDimButtons ()
  "Remove any highlight from the tab buttons."
  (mapcar #'(lambda (button)
              (FleuronSetBackgroundColor button "#eee8d5"))
          (FleuronAllTabButtons)))

(defun FleuronHighlightButton (button)
  "Highlight the tab BUTTON."
  (FleuronSetBackgroundColor button "#fdf6e3"))

(defun FleuronJumpToBookmarksTab ()
  "Open the sidebar and show the bookmarks tab."
  (FleuronShowSidebar)
  (FleuronShowBookmarksTab))

(defun FleuronTOC ()
  "Return the OrgInfo TOC object."
  (FleuronElement "text-table-of-contents"))

(defun FleuronFillSidebarContents ()
  "Create the sidebar and copy the Table of Contents from OrgInfo."
  (let ((sidebar (FleuronSidebar)))
    (let ((TOC (FleuronTOC))
          (ContentsTab (FleuronContentsTab)))
      (when (and sidebar TOC)
        (setf (@ ContentsTab innerHTML)
              (concatenate 'string
                           (@ TOC innerHTML)
                           ;; add link to footnotes section if present
                           (if (equal null (FleuronElement "footnotes"))
                               ""
                               (concatenate 'string
                                            "<ul><li>"
                                            (FleuronFootnotesLink)
                                            "</ul>"))
                           "<p>&nbsp;</p><p>&nbsp;</p><p>&nbsp;</p>"))))))

(defun FleuronSearchInput ()
  "Return the DOM element of the search text input box."
  (FleuronElement "FleuronSearchInput"))

(defun FleuronDoSearch ()
  "Trigger Org Info forward search."
  (let ((text (@ (FleuronSearchInput) value)))
    (unless (equal "" text)
      (OrgInfoDoSearch org_html_manager text))))

(defun FleuronDoSearchBackward ()
  "Trigger Org Info backward search."
  (let ((text (@ (FleuronSearchInput) value)))
    (unless (equal "" text)
      (OrgInfoDoSearchBackward org_html_manager text))))

(defun FleuronDoClearSearch ()
  "Clear the search input text box and any search highlights."
  (let ((input (FleuronSearchInput)))
    (setf (@ input value) "")
    (OrgInfoDoRemoveSearchHighlight org_html_manager)))

(defun FleuronFillSidebarDivs ()
  "Insert the child DIVs of the sidebar."
  (let ((sidebar (FleuronSidebar)))
    (when sidebar
      (setf (@ sidebar innerHTML)
            (concatenate 'string
            "<div class=\"fleuron-tab-bar\">
    <button id=\"fleuron-show-contents-button\"
    class=\"fleuron-tab-button\"
    onClick=\"javascript:FleuronShowContentsTab()\">Contents</button>
    <button id=\"fleuron-show-bookmarks-button\"
    class=\"fleuron-tab-button\"
    onClick=\"javascript:FleuronShowBookmarksTab()\">Bookmarks</button>
    <button id=\"fleuron-show-documents-button\"
    class=\"fleuron-tab-button\"
    onClick=\"javascript:FleuronShowDocumentsTab()\">Documents</button>
    </div> <p>&nbsp <div class=\"fleuron-search-bar\"> <input
    type=\"text\" id=\"FleuronSearchInput\"
    class=\"fleuron-search-input\" name=\"FleuronSearchInput\"
    onFocus=\"javascript:FleuronDisableKeybindings()\"
    onBlur=\"javascript:FleuronEnableKeybindings()\"> <div><button
    id=\"FleuronDoSearchButton\" class=\"fleuron-normal-button\"
    onClick=\"javascript:FleuronDoSearch()\">Search forward</button>
    <button id=\"FleuronDoSearchBackwardButton\"
    class=\"fleuron-normal-button\"
    onClick=\"javascript:FleuronDoSearchBackward()\">Search
    backward</button> <button id=\"FleuronClearSearchButton\"
    class=\"fleuron-normal-button\"
    onClick=\"javascript:FleuronDoClearSearch()\">Clear</button>"
            (if FleuronFullTextSearchIsEnabled "<a href=\"search.html\">Full-text site search</a>" "")
            "</div> </div>
  <div id=\"fleuron-toc\" class=\"fleuron-tab\"></div>
  <div id=\"fleuron-bookmarks\" class=\"fleuron-tab\" style=\"display:none\"></div>
  <div id=\"fleuron-documents\" class=\"fleuron-tab\" style=\"display:none\"></div>")))))

(defun FleuronBuildDocumentsTab ()
  "Create the HTML for the Documents tab based on the contents of
the variable `FleuronDocuments'."
  (let ((results []))
    (if (null FleuronDocuments)
        ""
        (progn 
          (dolist (document FleuronDocuments)
            (destructuring-bind (link title subtitle author) document
              ((@ results push)
                    (concatenate 'string
                                 "<p><div class=\"fleuron-document\">"
                                 (FleuronFancyCapital ((@ String fromCharCode)
                                                       ((@ ((@ title toLowerCase))
                                                           charCodeAt)
                                                        0)))
                                 "<br><a href=\""
                                 link
                                 "\">"
                                 title
                                 (if subtitle " - " "")
                                 subtitle
                                 "</a><br>by "
                                 author
                                 "</div>"
                                 ))))
          ((@ results join) " ")))))

(defun FleuronFillSidebarDocuments ()
  "Fill the Documents tab with contents."
  (let ((sidebar (FleuronSidebar))
        (DocumentsTab (FleuronDocumentsTab)))
    (when (and sidebar DocumentsTab)
      (setf (@ DocumentsTab innerHTML)
            (FleuronBuildDocumentsTab)))))

(defun FleuronAllBookmarkButtons ()
  "Return a list of all the bookmark buttons."
  ((@ document getElementsByClassName) "fleuron-mini-button"))

(defun FleuronShowBookmarkButtons ()
  "Show all the bookmark management buttons."
  (dolist (button (FleuronAllBookmarkButtons))
    (FleuronShowElementInline button)))

(defun FleuronHideBookmarkButtons ()
  "Hide all the bookmark management buttons."
  (dolist (button (FleuronAllBookmarkButtons))
    (FleuronHideElement button)))

(defvar FleuronManageBookmarksChecked nil
  "When non-nil, the Manage Bookmarks checkbox is checked.")

(defun FleuronManageBookmarksCheckboxClicked (checkbox)
  "Handler function for when the Manage Bookmarks checkbox is clicked."
  (if (not FleuronManageBookmarksChecked)
      (FleuronShowBookmarkButtons)
      (FleuronHideBookmarkButtons))
  (if FleuronManageBookmarksChecked
      (setf FleuronManageBookmarksChecked nil)
      (setf FleuronManageBookmarksChecked t)))
  
(defun FleuronManageBookmarksCheckbox ()
  "Return a string with the Manage Bookmarks checkbox in HTML."
  (concatenate 'string
               "<input type=\"checkbox\" id=\"ManageBookmarksCheckbox\" name=\"ManageBookmarksCheckbox\" value=\"Yes\" onClick=\"javascript:FleuronManageBookmarksCheckboxClicked(this)\">"
               "<label for=\"ManageBookmarksCheckbox\">Manage bookmarks</label>"))

(defun FleuronUpdateBookmarksTab ()
  "Refresh the contents of the bookmarks tab."
  (setf (@ (FleuronBookmarksTab) innerHTML)
        (concatenate 'string
                     (FleuronManageBookmarksCheckbox)
                     "<p>"
                     (FleuronAllBookmarksToHtml)))
  ;; preserve the state of the checkbox and buttons
  (when FleuronManageBookmarksChecked
    (let ((checkbox (FleuronElement "ManageBookmarksCheckbox")))
      (setf (@ checkbox "checked") t)
      (FleuronShowBookmarkButtons))))

;;; Injecting the sidebar div

(defun FleuronInjectSidebarDiv ()
  "Add the sidebar container DIV to the document."
  (let* ((div ((@ document createElement) "div"))
         (content (FleuronElement "content")))
    (setf (@ div className) "fleuron-sidebar")
    (setf (@ div id) "FleuronSidebar")
    ((@ content after) div)))

;;; Startup

(defun FleuronComeFromSearchMaybe ()
  "Adjust the UI when coming from the full-text search page."
  (let ((targetPage (FleuronGetTargetPage)))
    (when targetPage
      ((@ org_html_manager navigateTo) targetPage)
      (let ((targetString (FleuronGetTargetString)))
        (when targetString
          (setf (@ (FleuronSearchInput) value)
                targetString)
          (FleuronDoSearch))))))

(defun FleuronAfterReadyFunction ()
  "When the document is ready, fill the sidebar and show any tabs if
needed."
  (FleuronInjectSidebarDiv)
  (FleuronFillSidebarDivs)
  (FleuronHighlightButton (FleuronShowContentsButton))
  (when (FleuronSidebarIsPersistent)
    (FleuronShowSidebar)
    (FleuronRestoreCurrentTab))
  (FleuronInstallEnterKey)
  (FleuronComeFromSearchMaybe))

;;; Hiding and showing tabs

(defun FleuronHideAllTabs ()
  "Hide all tabs."
  (dolist (tab (FleuronAllTabs))
    (FleuronHideElement tab)))

(defun FleuronSaveCurrentTab (string)
  (FleuronStoreItem "FleuronCurrentTab" string))

(defun FleuronRestoreCurrentTab ()
  (let ((value (FleuronRetrieveItem "FleuronCurrentTab")))
    (case value
      ("Contents" (FleuronShowContentsTab))
      ("Documents" (FleuronShowDocumentsTab))
      ("Bookmarks" (FleuronShowBookmarksTab)))))

(defun FleuronShowContentsTab ()
  "Show the contents tab."
  (FleuronHideAllTabs)
  (FleuronDimButtons)
  (FleuronHighlightButton (FleuronShowContentsButton))
  (FleuronSaveCurrentTab "Contents")
  (FleuronShowElement (FleuronContentsTab)))

(defun FleuronShowBookmarksTab ()
  "Show the bookmarks tab."
  (FleuronHideAllTabs)
  (FleuronUpdateBookmarksTab)
  (FleuronDimButtons)
  (FleuronHighlightButton (FleuronShowBookmarksButton))
  (FleuronSaveCurrentTab "Bookmarks")
  (FleuronShowElement (FleuronBookmarksTab)))

(defun FleuronShowDocumentsTab ()
  "Show the contents tab."
  (FleuronHideAllTabs)
  (FleuronDimButtons)
  (FleuronHighlightButton (FleuronShowDocumentsButton))
  (FleuronSaveCurrentTab "Documents")
  (FleuronShowElement (FleuronDocumentsTab)))

;;; Sidebar persistent state

(defun FleuronSidebarIsPersistent ()
  "Returns non-nil when the sidebar should persist from the previous page."
  (string= "1" (FleuronRetrieveItem "FleuronSidebarIsPersistent")))

(defun FleuronSidebarSetPersistent (value)
  "Ensure (or prevent) that the sidebar stays persistent upon switching
documents. If VALUE is 0, the sidebar will not be persistent. If VALUE
is 1, the sidebar will be persistent."
  (FleuronStoreItem "FleuronSidebarIsPersistent" value))

;;; Install hooks into OrgInfo

(setf OrgInfoPageInsertFunction #'FleuronInsertButtons)
(setf OrgInfoAfterNavigateFunction #'FleuronAfterNavigate)
(setf OrgInfoAfterPlainViewFunction #'FleuronAfterPlainView)
(setf OrgInfoAfterInfoViewFunction #'FleuronAfterInfoView)
(setf OrgInfoAfterReadyFunction #'FleuronAfterReadyFunction)

;;; Additional keybindings

(defun FleuronKeyZ ()
  "Toggle the sidebar when Z is pressed."
  (FleuronToggleSidebar))

(setf OrgInfoUserKeyZ #'FleuronKeyZ)

(defun FleuronKeyK ()
  "Jump to the Bookmarks tab when K is pressed."
  (FleuronJumpToBookmarksTab))

(setf OrgInfoUserKeyK #'FleuronKeyK)

;;; Controlling the keyboard handler

(defun FleuronNull (e)
  "Do nothing and return null."
  null)

(defun FleuronDisableKeybindings ()
  "Disable OrgInfo keyboard event processing."
  (when (not (FleuronIsFullTextSearch))
    (setf (@ document onKeyPress) #'FleuronNull))
 (setf OrgInfoDisableKeybindings t))

(defun FleuronEnableKeybindings ()
  "Enable OrgInfo keyboard event processing."
  (when (not (FleuronIsFullTextSearch))
    (setf (@ document onKeyPress) #'OrgHtmlManagerKeyEvent))
  (setf OrgInfoDisableKeybindings nil))

;;; Adding the Enter key to the search bar

(defun FleuronInstallEnterKey ()
  "Add a JavaScript event so that Search occurs when Enter is pressed on
the search box."
  (let ((input (FleuronSearchInput)))
    ((@ input addEventListener)
     "keypress"
     #'(lambda (event)
         (when (equal "Enter" (@ event key))
           ((@ event preventDefault))
           (FleuronDoSearch))))))

;;; Other hooks 

(defun FleuronShowAll ()
  (dotimes (n 3)
    ((@ org_html_manager toggleGlobaly))
    ((@ org_html_manager NODE DIV scrollIntoView) t)))

(defun FleuronAfterPlainView ()
  "Function to run after Plain View is activated."
  (FleuronShowAll))

(defun FleuronAfterInfoView ()
  "Function to run after Info View is activated."
  t)

;;; Jumping to the Footnotes section

(defun FleuronFootnotesPageNumber ()
  "Return the page number of the Footnotes section."
  (1- (@ org_html_manager SECS length)))

(defun FleuronFootnotesLink ()
  "Create a JavaScript link to the Footnotes section."
  (concatenate 'string
               "<a href=\"#\" onClick=\"javascript:org_html_manager.navigateTo("
               (FleuronFootnotesPageNumber)
               ")\">Footnotes</a>"))

;;; Full text search

;; The index is generated in fleuron.el from the exported org HTML
;; files, and goes into search.js. This is not very scalable because
;; the entire site content is transmitted when you visit
;; search.html. But it is nice to have a built-in solution for smaller
;; sites, and server-side GZip can help speed things up.

(defvar FleuronSearchData null
  "List of Org html entries to search. This is set by the generated file
`search.js'. Each entry is a list of the form:
   (URL SEARCH-TITLE TITLE CONTENT PAGE)")

(defun FleuronFullTextSearchContainer ()
  "Return the container DIV for the whole search UI."
  (FleuronElement "FleuronFullTextSearch"))

(defun FleuronFullTextSearchInput ()
  "Return the text input element for the search UI."
  (FleuronElement "FleuronFullTextSearchInput"))

(defun FleuronFullTextSearchResultsContainer ()
  "Return the results container DIV for the search UI."
  (FleuronElement "FleuronFullTextSearchResults"))

(defun FleuronIsFullTextSearch ()
  "Returns non-nil if the search page is present."
  (not (equal null (FleuronFullTextSearchContainer))))

(defun FleuronFullTextSearchDivContents ()
  "Return the HTML for the search UI."
  "<div class=\"fleuron-full-text-search-bar\">
 <input type=\"text\" id=\"FleuronFullTextSearchInput\"
       class=\"fleuron-search-input\"
        name=\"FleuronFullTextSearchInput\"
     onFocus=\"javascript:FleuronDisableKeybindings()\"
      onBlur=\"javascript:FleuronEnableKeybindings()\">
  <div><button id=\"FleuronDoFullTextSearchButton\" class=\"fleuron-normal-button\"
          onClick=\"javascript:FleuronDoFullTextSearch()\">Search site</button>
<button id=\"FleuronClearFullTextSearchButton\" class=\"fleuron-normal-button\"
   onClick=\"javascript:FleuronDoClearFullTextSearch()\">Clear</button>
 </div>
</div>
<div id=\"FleuronFullTextSearchResults\">
</div>")

(defun FleuronFullTextSearchFocus ()
  ((@ (FleuronFullTextSearchInput) focus)))

(defun FleuronFullTextSearchOnLoad ()
  "Install the search UI."
  (setf (@ (FleuronFullTextSearchContainer) innerHTML)
        (FleuronFullTextSearchDivContents))
  (FleuronFullTextSearchInstallEnterKey)
  (FleuronFullTextSearchFocus)
  ;; repeat last search if needed
  (let ((string (FleuronPeekTargetString)))
    (when string
      (setf (@ (FleuronFullTextSearchInput) value)
            string)
      (FleuronDoFullTextSearch))))

(defun FleuronFullTextSearchInstallEnterKey ()
  "Add a JavaScript event so that Search occurs when Enter is pressed on
the search box."
  (let ((input (FleuronFullTextSearchInput)))
    ((@ input addEventListener)
     "keypress"
     #'(lambda (event)
         (when (equal "Enter" (@ event key))
           ((@ event preventDefault))
           (FleuronDoFullTextSearch))))))

(defun FleuronSearchString (string)
  "Search the database for the string STRING and return any matches."
  (let ((entries FleuronSearchData)
        (matches (new Array))
        (rx (new (RegExp string "i"))))
    (dolist (entry entries)
      (when (and entry (> (length entry) 0))
        (destructuring-bind (file search-title title content page) entry
          (when (or (!= -1 ((@ content search) rx))
                    (!= -1 ((@ search-title search) rx)))
            ((@ matches push) (list file title page content string (!= -1 ((@ search-title search) rx))))))))
    matches))

(defun FleuronDoFullTextSearch ()
  "Search the site with the currently entered search string."
  (let ((string (@ (FleuronFullTextSearchInput) value)))
    (when (< 0 (length string))
      (let ((matches (FleuronSearchString string)))
        (FleuronFillSearchResults matches)
        (FleuronSaveTargetString string)
        (FleuronHighlightSearchResults)))))

(defun FleuronDoClearFullTextSearch ()
  "Clear the search string and delete any results."
  (FleuronRemoveItem "FleuronTargetString")
  (setf (@ (FleuronFullTextSearchInput) value) "")
  (setf (@ (FleuronFullTextSearchResultsContainer) innerHTML) ""))

(defun FleuronFindMatchingLine (content string)
  "Return the first line in CONTENT matching STRING."
  (let ((lines ((@ content split) "
"))
        (rx (new (RegExp string "i"))))
    (let (match)
      (block matching
        (dolist (line lines)
          (when (!= -1 ((@ line search) rx))
            (setf match line)
            (return-from matching line))))
      match)))

(defun FleuronFillSearchResults (matches)
  "Write HTML to the page with clickable search results."
  (let ((div (FleuronFullTextSearchResultsContainer)))
    (let ((strings (new Array)))
      (dolist (match matches)
        (destructuring-bind (file title page content string heading-only) match
          ((@ strings push) (concatenate 'string
                                         "<a class=\"fleuron-fancy-link\"
                                     href=\"javascript:FleuronFollowSearchResult('"
                                         file "', " page ", "
                                         (if (not heading-only) "true" "false")
                                         ")\">"
                                         file ": " title "</a>"
                                         "<br>"
                                         "<span class=\"fleuron-fancy-result\">"
                                         (or (FleuronFindMatchingLine content string)
                                             "")
                                         "</span>"
                                         ))))
      (setf (@ div innerHTML) ((@ strings join) "<br>")))))

(defun FleuronSaveTargetPage (page)
  "Save the target page to be visited upon click-through."
  (FleuronStoreItem "FleuronTargetPage" page))

(defun FleuronGetTargetPage ()
  "Get the click-through target page, and delete the value."
  (let ((item (FleuronRetrieveItem "FleuronTargetPage")))
    (when item
      (prog1 item
        (FleuronRemoveItem "FleuronTargetPage")))))

(defun FleuronSaveTargetString (string)
  "Save the target search query for click-through."
  (FleuronStoreItem "FleuronPeekTargetString" string)
  (FleuronStoreItem "FleuronTargetString" string))

(defun FleuronGetTargetString ()
  "Get the click-through search query, and delete the value."
  (let ((item (FleuronRetrieveItem "FleuronTargetString")))
    (when item
      (prog1 item
        (FleuronRemoveItem "FleuronTargetString")))))

(defun FleuronPeekTargetString ()
  "Get the click-through search query, without deleting the value."
  (FleuronRetrieveItem "FleuronPeekTargetString"))

(defun FleuronFollowSearchResult (file page search-on-landing)
  "Click through on a search result."
  (FleuronSaveTargetPage page)
  (if search-on-landing
      (FleuronSaveTargetString (@ (FleuronFullTextSearchInput) value))
      (FleuronRemoveItem "FleuronTargetString"))
  (setf (@ window location href) file))

(defun FleuronHighlightSearchResults ()
  "Highlight the matched string in the search results."
  (let ((string (@ (FleuronFullTextSearchInput) value)))
    (when (< 0 (length string))
      (dolist (span ((@ document getElementsByClassName) "fleuron-fancy-result"))
        (let ((temp (@ span innerHTML)))
          (setf (@ span innerHTML)
                ((@ temp replaceAll)
                 (new (RegExp string "ig"))
                 (concatenate 'string
                              "<span class=\"org-info-js_search-highlight\">"
                              "$&"
                              "</span>"))))))))

;;; Agenda enhancements

(defun FleuronAgendaOnLoad ()
  (let ((agenda (FleuronElement "FleuronAgendaTable")))
    (when agenda
      (let ((last-row ()))
        (dolist (row (@ agenda rows))
          (let ((string (@ row children 1 textContent)))
            (when (and string last-row)
              (when (< 3 (length string))
                ;; draw a line to separate days
                (setf (@ last-row style "border-bottom") "1px solid black"))))
          (setf last-row row))))))

;;; fleuron.paren ends here