<commit_before>(library (errata helper)
  (export errata-logo
          powered-by-lunula
          preload-script
          menu
          links
          public-revisions
          report-window
          revision-window
          shelf-window
          exlibris-window)
  (import (except (rnrs) div)
          (only (core) format)
          (match)
          (only (srfi :13) string-tokenize)
          (only (srfi :19) date->string string->date date-year)
          (only (lcs) lcs-fold)
          (only (lunula gettext) __)
          (only (lunula mod_lisp) entry-paths build-entry-path)
          (only (lunula mysql) lookup lookup-all)
          (prefix (lunula html) html:)
          (only (lunula persistent-record) id-of created-at-of)
          (only (lunula session) account account-nick account-name)
          (only (errata calendar) ad->japanese-era)
          (only (errata isbn) isbn10->amazon)
          (errata model)
          (errata helper pagination))

  (define (errata-logo uuid . _)
    (html:h1 ((id "logo") (title "えらった べーた"))
             (html:a ((href (build-entry-path 'index uuid)))
                     (cons "Errata" (html:span ((style "color:red;")) "β")))))

  (define powered-by-lunula
    (html:div ((id "bottom")) "powered by "
              (html:a ((href "http://fixedpoint.jp/lunula/")) 'Lunula)))

  (define preload-script 
    '("$(document).ready(function() {"
      "$('.links').corner();"
      "$('#private').corner();"
      "$('#public').corner();"
      "$('.dog').corner('dog tr 15px');"
      "});"))

  (define (menu uuid . _)
    (html:p
     ((id "menu"))
     (cond ((string? uuid)
            (html:span (html:a ((href (build-entry-path 'logout uuid))) "ログアウト")))
           (else
            (list
             (html:span (html:a ((href (build-entry-path 'login))) "ログイン"))
             "&nbsp;"
             (html:span (html:a ((href (build-entry-path 'sign-up))) "サインアップ")))))))

  (define *public-links* '((board . "書誌一覧")))

  (define *private-links*
    '((shelf . "書棚の閲覧")
      (put-on . "蔵書の登録")
      (modify-account . "アカウントの編集")
      (cancel . "アカウントの解除")
      ))

  (define (links uuid . _)
    (define (p-link pair)
      (html:p (html:a ((href (build-entry-path (car pair) uuid))) (cdr pair))))
    (append
     (html:div
      ((class "links"))
      (html:div (map p-link *public-links*)))
     (if (string? uuid)
         (html:div
          ((class "links"))
          (html:div (map p-link *private-links*)))
         '())))

  (define (hidden-field name value)
    (html:input ((type "hidden") (name name) (value value))))

  (define (datetime->date str)
    (guard (e (else #f))
      (string->date str "~Y-~m-~d ~H:~M:~S")))

  (define (date->ymd date)
    (let ((year (date-year date)))
      (guard (e
              (else (date->string date "~Y-~m-~d")))
        (append (html:span ((title (ad->japanese-era year))) year)
                (date->string date "-~m-~d")))))

  (define (datetime->ymd str)
    (cond ((datetime->date str) => date->ymd)
          (else #f)))

  (define (signature a)
    (html:span ((title (html:escape-string (account-name a))))
               (html:escape-string (account-name a))))

  (define-syntax with-uuid
    (syntax-rules ()
      ((_ uuid thunk)
       (if (string? uuid)
           thunk
           '()))))

  (define-syntax revision-skeleton
    (syntax-rules ()
      ((_ b r x y z)
       (append
        (html:h3 (html:escape-string (bib-title b)))
        (html:table
         (html:tr
          (html:th
           ((rowspan 4))
           (html:a ((href (isbn10->amazon (bib-isbn10 b))) (target "_blank"))
                   (html:image ((src (bib-image b)) (alt (html:escape-string (bib-title b)))))))
          (html:th ((rowspan 2) (style "text-align:left;")) (__ ISBN))
          (html:td ((style "color:#555555;")) (bib-isbn13 b)))
         (html:tr
          (html:td ((style "color:#555555;")) (bib-isbn10 b)))
         (html:tr
          (html:th ((style "text-align:left;")) (__ Revision))
          (html:td ((style "color:#555555;"))
                   (cons* (html:escape-string (revision-name r))
                          "(" (datetime->ymd (revision-revised-at r)) ")" x)))
         (html:tr
          (html:td y)
          (html:td z)))))))

  (define (go-to-board uuid)
    (html:form ((action (build-entry-path 'board uuid)))
               (html:input  ((type "submit") (value (__ to-board))))))

  (define (go-to-table uuid r)
    (html:form ((action (build-entry-path 'table uuid)))
               (hidden-field "id" (id-of r))
               (html:input ((type "submit") (value (__ to-table))))))

  (define (go-to-shelf uuid)
    (html:form ((action (build-entry-path 'shelf uuid)))
               (html:input ((type "submit") (value (__ to-shelf))))))

  (define (public-revisions uuid page)
    (with-pagination
     (board uuid page)
     (lookup-all revision "EXISTS (SELECT * FROM publicity p, exlibris ex, account a WHERE ex.id = p.exlibris_id AND revision.id = ex.revision_id AND a.id = ex.account_id)")
     (lambda (r)
       (cond ((lookup bib (revision-bib-id r))
              => (lambda (b)<commit_msg>only created by the account<commit_after>(library (errata helper)
  (export errata-logo
          powered-by-lunula
          preload-script
          menu
          links
          public-revisions
          report-window
          revision-window
          shelf-window
          exlibris-window)
  (import (except (rnrs) div)
          (only (core) format)
          (match)
          (only (srfi :13) string-tokenize)
          (only (srfi :19) date->string string->date date-year)
          (only (lcs) lcs-fold)
          (only (lunula gettext) __)
          (only (lunula mod_lisp) entry-paths build-entry-path)
          (only (lunula mysql) lookup lookup-all)
          (prefix (lunula html) html:)
          (only (lunula persistent-record) id-of created-at-of)
          (only (lunula session) account account-nick account-name)
          (only (errata calendar) ad->japanese-era)
          (only (errata isbn) isbn10->amazon)
          (errata model)
          (errata helper pagination))

  (define (errata-logo uuid . _)
    (html:h1 ((id "logo") (title "えらった べーた"))
             (html:a ((href (build-entry-path 'index uuid)))
                     (cons "Errata" (html:span ((style "color:red;")) "β")))))

  (define powered-by-lunula
    (html:div ((id "bottom")) "powered by "
              (html:a ((href "http://fixedpoint.jp/lunula/")) 'Lunula)))

  (define preload-script 
    '("$(document).ready(function() {"
      "$('.links').corner();"
      "$('#private').corner();"
      "$('#public').corner();"
      "$('.dog').corner('dog tr 15px');"
      "});"))

  (define (menu uuid . _)
    (html:p
     ((id "menu"))
     (cond ((string? uuid)
            (html:span (html:a ((href (build-entry-path 'logout uuid))) "ログアウト")))
           (else
            (list
             (html:span (html:a ((href (build-entry-path 'login))) "ログイン"))
             "&nbsp;"
             (html:span (html:a ((href (build-entry-path 'sign-up))) "サインアップ")))))))

  (define *public-links* '((board . "書誌一覧")))

  (define *private-links*
    '((shelf . "書棚の閲覧")
      (put-on . "蔵書の登録")
      (modify-account . "アカウントの編集")
      (cancel . "アカウントの解除")
      ))

  (define (links uuid . _)
    (define (p-link pair)
      (html:p (html:a ((href (build-entry-path (car pair) uuid))) (cdr pair))))
    (append
     (html:div
      ((class "links"))
      (html:div (map p-link *public-links*)))
     (if (string? uuid)
         (html:div
          ((class "links"))
          (html:div (map p-link *private-links*)))
         '())))

  (define (hidden-field name value)
    (html:input ((type "hidden") (name name) (value value))))

  (define (datetime->date str)
    (guard (e (else #f))
      (string->date str "~Y-~m-~d ~H:~M:~S")))

  (define (date->ymd date)
    (let ((year (date-year date)))
      (guard (e
              (else (date->string date "~Y-~m-~d")))
        (append (html:span ((title (ad->japanese-era year))) year)
                (date->string date "-~m-~d")))))

  (define (datetime->ymd str)
    (cond ((datetime->date str) => date->ymd)
          (else #f)))

  (define (signature a)
    (html:span ((title (html:escape-string (account-name a))))
               (html:escape-string (account-name a))))

  (define-syntax with-uuid
    (syntax-rules ()
      ((_ uuid thunk)
       (if (string? uuid)
           thunk
           '()))))

  (define-syntax revision-skeleton
    (syntax-rules ()
      ((_ b r x y z)
       (append
        (html:h3 (html:escape-string (bib-title b)))
        (html:table
         (html:tr
          (html:th
           ((rowspan 4))
           (html:a ((href (isbn10->amazon (bib-isbn10 b))) (target "_blank"))
                   (html:image ((src (bib-image b)) (alt (html:escape-string (bib-title b)))))))
          (html:th ((rowspan 2) (style "text-align:left;")) (__ ISBN))
          (html:td ((style "color:#555555;")) (bib-isbn13 b)))
         (html:tr
          (html:td ((style "color:#555555;")) (bib-isbn10 b)))
         (html:tr
          (html:th ((style "text-align:left;")) (__ Revision))
          (html:td ((style "color:#555555;"))
                   (cons* (html:escape-string (revision-name r))
                          "(" (datetime->ymd (revision-revised-at r)) ")" x)))
         (html:tr
          (html:td y)
          (html:td z)))))))

  (define (go-to-board uuid)
    (html:form ((action (build-entry-path 'board uuid)))
               (html:input  ((type "submit") (value (__ to-board))))))

  (define (go-to-table uuid r)
    (html:form ((action (build-entry-path 'table uuid)))
               (hidden-field "id" (id-of r))
               (html:input ((type "submit") (value (__ to-table))))))

  (define (go-to-shelf uuid)
    (html:form ((action (build-entry-path 'shelf uuid)))
               (html:input ((type "submit") (value (__ to-shelf))))))

  (define (public-revisions uuid page)
    (with-pagination
     (board uuid page)
     (lookup-all revision "EXISTS (SELECT * FROM publicity p, exlibris ex, account a WHERE ex.id = p.exlibris_id AND revision.id = ex.revision_id AND a.id = ex.account_id AND a.created_at <= ex.created_at)")
     (lambda (r)
       (cond ((lookup bib (revision-bib-id r))
              => (lambda (b)
{'fraction_non_alphanumeric': 0.18386599922988064, 'fraction_numerical': 0.007316134000770119, 'mean_word_length': 2.124511278195489, 'pattern_counts': {'":': 0, '<': 4, '<?xml version=': 0, '>': 37, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1847328', 'n_tokens_mistral': 3643, 'n_tokens_neox': 3531, 'n_words': 844}