Move note formatting back to src/pages/notepad.rkt, and add support for page/media tags.
This commit is contained in:
Feufochmar
parent
c62053d28b
commit
34fb27d07d
|
|
@ -3,8 +3,6 @@
|
|||
(require
|
||||
"stored-objects.rkt"
|
||||
"user.rkt"
|
||||
; Formatting
|
||||
(prefix-in scrib: scribble/reader)
|
||||
)
|
||||
|
||||
(provide
|
||||
|
|
@ -13,7 +11,6 @@
|
|||
; Operations
|
||||
new-note update-note remove-note
|
||||
get-note-by-name get-all-notes get-public-notes
|
||||
format-note format-note-content
|
||||
; Init repo
|
||||
note-init-repository
|
||||
)
|
||||
|
|
@ -116,84 +113,3 @@
|
|||
; Get all public notes
|
||||
(define (get-public-notes)
|
||||
(find-instances notepadnote '((public . #t))))
|
||||
|
||||
; Format a note
|
||||
(define (format-note nt)
|
||||
(format-note-content (notepadnote-content nt)))
|
||||
; Format a note content
|
||||
(define (format-note-content cnt)
|
||||
; Recursive parsing function
|
||||
(define (collect parsed)
|
||||
; Recursively apply the parsing:
|
||||
; - filter out #f values
|
||||
; - Two successive "\n" (i.e a blank line) are replaced by a '(br)
|
||||
(define (recur lst)
|
||||
(filter
|
||||
values
|
||||
(map
|
||||
(lambda (x) (collect x))
|
||||
(reverse
|
||||
(foldl
|
||||
(lambda (val res)
|
||||
(if (and (not (null? res))
|
||||
(equal? "\n" val)
|
||||
(equal? "\n" (car res)))
|
||||
(cons '(br) res)
|
||||
(cons val res)))
|
||||
'()
|
||||
lst)))))
|
||||
; Parse and transform the content
|
||||
(cond
|
||||
; Not a list => output as is
|
||||
((not (list? parsed)) parsed)
|
||||
(#t
|
||||
(case (car parsed)
|
||||
; @link[path]{Text} : content: link to another page
|
||||
((link)
|
||||
`(a ((href ,(symbol->string (cadr parsed))))
|
||||
,@(recur (cddr parsed))))
|
||||
; @image[path]{Alt text} : content: image
|
||||
((image)
|
||||
(define alt (apply string-append (cddr parsed)))
|
||||
`(img ((src ,(symbol->string (cadr parsed)))
|
||||
(alt ,alt)
|
||||
(title ,alt))))
|
||||
; @strong{Text} : content : strong
|
||||
; @str{Text} : content : strong
|
||||
((strong str)
|
||||
`(strong ,@(recur (cdr parsed))))
|
||||
; @emphase{Text} : content : emphase
|
||||
; @emp{Text} : content : emphase
|
||||
((emphase emp)
|
||||
`(em ,@(recur (cdr parsed))))
|
||||
; @section{Text} : content : title and start of section
|
||||
((section)
|
||||
`(h2 ,@(recur (cdr parsed))))
|
||||
; @subsection{Text} : content : title and start of subsection
|
||||
((subsection)
|
||||
`(h3 ,@(recur (cdr parsed))))
|
||||
; @subsubsection{Text} : content : title and start of subsubsection
|
||||
((subsubsection)
|
||||
`(h4 ,@(recur (cdr parsed))))
|
||||
; @paragraph[justify]{Text} : content : paragraph with an optional justification
|
||||
; @para[justify]{Text} : content : paragraph with an optional justification
|
||||
((paragraph para)
|
||||
(if (not (null? (cdr parsed)))
|
||||
(case (cadr parsed)
|
||||
((left) `(p ((style "text-align: left;")) ,@(recur (cddr parsed))))
|
||||
((right) `(p ((style "text-align: right;")) ,@(recur (cddr parsed))))
|
||||
((center centered) `(p ((style "text-align: center;")) ,@(recur (cddr parsed))))
|
||||
(else `(p ,@(recur (cdr parsed)))))
|
||||
#f))
|
||||
; Other kind of lists: recurse on them
|
||||
(else
|
||||
(recur parsed))
|
||||
))))
|
||||
;
|
||||
(collect
|
||||
(with-handlers
|
||||
(( exn:fail?
|
||||
(lambda (e) (list (exn-message e))) ))
|
||||
(scrib:read-inside
|
||||
(open-input-string
|
||||
cnt)))))
|
||||
|
|
|
|||
|
|
@ -14,6 +14,8 @@
|
|||
web-server/http/request-structs
|
||||
net/cookies/server
|
||||
net/uri-codec
|
||||
; Formatting pages
|
||||
(prefix-in scrib: scribble/reader)
|
||||
)
|
||||
|
||||
(provide
|
||||
|
|
@ -139,7 +141,7 @@
|
|||
#:date (note-date note)
|
||||
#:content
|
||||
`(article
|
||||
,@(format-note note)
|
||||
,@(format-note-content (note-content note))
|
||||
,@(if connected-usr
|
||||
`((hr)
|
||||
(a ((href ,(note-link 'edit page))) "Éditer") " — "
|
||||
|
|
@ -221,6 +223,8 @@
|
|||
"{" ,(caddr x) "}") " " ,@(cadddr x)))
|
||||
'(("link" "to" "desc" ("Un lien vers l'addresse " (code "to") " intitulé " (code "desc") "."))
|
||||
("image" "path" "alt" ("Une image située à l'addresse " (code "path") " avec le texte alternatif " (code "alt") "."))
|
||||
("page" "to" "desc" ("Un lien vers la page du bloc-note nommée " (code "to") " intitulé " (code "desc") "."))
|
||||
("media" "path" "alt" ("Un lien vers le media du bloc-note nommé " (code "path") " avec le texte alternatif " (code "alt") "."))
|
||||
("strong" #f "text" ("Affiche le texte " (code "text") " en gras."))
|
||||
("str" #f "text" ("Synonyme de " (code "strong") "."))
|
||||
("emphase" #f "text" ("Affiche le texte " (code "text") " en italique."))
|
||||
|
|
@ -325,6 +329,108 @@
|
|||
,@(format-note-content content))
|
||||
""))))
|
||||
|
||||
; Format a note content
|
||||
(define (format-note-content cnt)
|
||||
; Recursive parsing function
|
||||
(define (collect parsed)
|
||||
; Recursively apply the parsing:
|
||||
; - filter out #f values
|
||||
; - Two successive "\n" (i.e a blank line) are replaced by a '(br)
|
||||
(define (recur lst)
|
||||
(filter
|
||||
values
|
||||
(map
|
||||
(lambda (x) (collect x))
|
||||
(reverse
|
||||
(foldl
|
||||
(lambda (val res)
|
||||
(if (and (not (null? res))
|
||||
(equal? "\n" val)
|
||||
(equal? "\n" (car res)))
|
||||
(cons '(br) res)
|
||||
(cons val res)))
|
||||
'()
|
||||
lst)))))
|
||||
; Parse and transform the content
|
||||
(cond
|
||||
; Not a list => output as is
|
||||
((not (list? parsed)) parsed)
|
||||
(#t
|
||||
(case (car parsed)
|
||||
; @link[path]{Text} : link to another (external) page
|
||||
( (link)
|
||||
`(a ((href ,(symbol->string (cadr parsed))))
|
||||
,@(recur (cddr parsed))))
|
||||
; @image[path]{Alt text} : (external) image
|
||||
( (image)
|
||||
(define alt (apply string-append (cddr parsed)))
|
||||
`(img ((src ,(symbol->string (cadr parsed)))
|
||||
(alt ,alt)
|
||||
(title ,alt))))
|
||||
; @page[name]{Text} : link to another (internal) page : name is the name of the page (not the title)
|
||||
( (page)
|
||||
(define pagename (symbol->string (cadr parsed)))
|
||||
`(a ((href ,(string-append "/notes/show/" pagename)))
|
||||
,@(recur (cddr parsed))))
|
||||
; @media[name]{Text} : (internal) media - displayed accordingly to its type
|
||||
( (media)
|
||||
(define name (symbol->string (cadr parsed)))
|
||||
(define media (get-media-by-name name))
|
||||
(define file (and media (media-file media)))
|
||||
(define alt (apply string-append (cddr parsed)))
|
||||
(cond
|
||||
( (and media (equal? "image" (media-type media)))
|
||||
; Image
|
||||
`(img ((src ,(string-append "/media/get/" file))
|
||||
(alt ,alt)
|
||||
(title ,alt))))
|
||||
( (and media (equal? "other" (media-type media)))
|
||||
; Other : displayed as link
|
||||
`(a ((href ,(string-append "/media/get/" file)))
|
||||
,@(recur (cddr parsed))))
|
||||
(#t
|
||||
; Ignored
|
||||
"")))
|
||||
; @strong{Text} : strong
|
||||
; @str{Text} : strong
|
||||
((strong str)
|
||||
`(strong ,@(recur (cdr parsed))))
|
||||
; @emphase{Text} : emphase
|
||||
; @emp{Text} : emphase
|
||||
((emphase emp)
|
||||
`(em ,@(recur (cdr parsed))))
|
||||
; @section{Text} : title and start of section
|
||||
((section)
|
||||
`(h2 ,@(recur (cdr parsed))))
|
||||
; @subsection{Text} : title and start of subsection
|
||||
((subsection)
|
||||
`(h3 ,@(recur (cdr parsed))))
|
||||
; @subsubsection{Text} : title and start of subsubsection
|
||||
((subsubsection)
|
||||
`(h4 ,@(recur (cdr parsed))))
|
||||
; @paragraph[justify]{Text} : paragraph with an optional justification
|
||||
; @para[justify]{Text} : paragraph with an optional justification
|
||||
((paragraph para)
|
||||
(if (not (null? (cdr parsed)))
|
||||
(case (cadr parsed)
|
||||
((left) `(p ((style "text-align: left;")) ,@(recur (cddr parsed))))
|
||||
((right) `(p ((style "text-align: right;")) ,@(recur (cddr parsed))))
|
||||
((center centered) `(p ((style "text-align: center;")) ,@(recur (cddr parsed))))
|
||||
(else `(p ,@(recur (cdr parsed)))))
|
||||
#f))
|
||||
; Other kind of lists: recurse on them
|
||||
(else
|
||||
(recur parsed))
|
||||
))))
|
||||
;
|
||||
(collect
|
||||
(with-handlers
|
||||
(( exn:fail?
|
||||
(lambda (e) (list (exn-message e))) ))
|
||||
(scrib:read-inside
|
||||
(open-input-string
|
||||
cnt)))))
|
||||
|
||||
|
||||
; Media
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue