[7cfd61]: news-page.lisp Maximize Restore History

Download this file

news-page.lisp    100 lines (84 with data), 3.4 kB

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
(in-package :sbcl-page)
(define-page :news "News" "news" news-page)
(define-page :all-news "All News" "all-news" all-news-page :index-order :none)
(defvar *recent-news* nil)
(defmacro define-news (version-number &rest major-items)
`(progn
(setf *recent-news* (remove ,version-number *recent-news* :key #'car :test #'equalp))
(push-end (cons ,version-number ',major-items) *recent-news*)))
(defun whitespace-onlyp (s)
(scan "^\\s+$" s))
(defun news-linkify (item)
(let ((initial 0)
result)
(do-scans (mstart mend rstarts rends "lp#([1-9][0-9]+)" item
(push (subseq item initial) result))
(push (subseq item initial mstart) result)
(push (<a href= ,(format nil "https://bugs.launchpad.net/sbcl/+bug/~A" (subseq item (+ mstart 3) mend))>
(subseq item (+ mstart 2) mend))
result)
(setf initial mend))
(nreverse result)))
(defun format-as-ul (list)
(<ul class= "news-items">
(remove
nil
(mapcar
(lambda (item)
(if (not
(or (and (listp item) (eql (length item) 1)
(whitespace-onlyp (car item)))
(and (not (listp item)) (whitespace-onlyp item))))
(if (listp item)
(<li class= "news-item">
(news-linkify (car item))
(if (cdr item)
(list (format-as-ul (cdr item)))))
(<li class= "news-item"> (news-linkify item))))) list))))
(defun news-page ()
(list
(<a name= "top"> "")
(<p> "New SBCL versions are usually released at the end of each
month: check the "
(<a href= "http://sourceforge.net/project/showfiles.php?group_id=1373">
"Sourceforge File List")
" to see the current version. The new features of the two most recent SBCL releases are listed below.")
(<p> "Please see the "
(<a href=,(page-link :all-news)>
"complete news page")
" for details on all historical SBCL releases.")
(mapcar
(lambda (news)
(<div>
(<a name=,(car news)> "")
(<h2> (format nil "New in version ~A" (car news)))
(<span class= "back-to-top-link">
(<a href="#top"> "Back to top"))
(format-as-ul (cdr news))))
(loop for i from 1 to 2
for j in *recent-news*
collect j))
(<a href=,(page-link :all-news)>
"Older SBCL releases")))
(defun all-news-page ()
(list
(<a name= "top"> "")
(<p> "New SBCL versions are usually released at the end of each
month: check the "
(<a href= "http://sourceforge.net/project/showfiles.php?group_id=1373">
"Sourceforge File List")
" to see the current version. The new features of all SBCL releases are listed below.")
(<ul class= "news-links">
(mapcar (lambda (news)
(<li> (<a href=,(concatenate 'string "#" (car news))>
(car news)) " "))
*recent-news*))
(mapcar
(lambda (news)
(<div>
(<a name=,(car news)> "")
(<h2> (format nil "New in version ~A" (car news)))
(<span class= "back-to-top-link">
(<a href="#top"> "Back to top"))
(format-as-ul (cdr news))))
*recent-news*)))