Coverage report: /home/samppa/personal/opiskelu/ohtuprojekti/pulsu/trunk/ui.lisp

Kind	Covered	All	%
expression	102	180	56.7
branch	10	34	29.4

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

2

(in-package :puls.ui)

3

4

;; these should probably be somewhere else

5

(setf hunchentoot:*show-lisp-errors-p* t)

6

(setf hunchentoot:*show-lisp-backtraces-p* t)

7

(setf hunchentoot:*hunchentoot-default-external-format*

8

(flex:make-external-format :utf-8))

9

10

11

(defun paged-list-of-widgets (list widget current-page page-param

12

&optional (n-per-page 1))

13

(with-html-output (*http-stream*)

14

(htm

15

(when (> (length list) n-per-page)

16

(make-pager current-page

17

page-param

18

(/ (length list) n-per-page)))

19

(mapcar widget (subseq list

20

(* current-page n-per-page)

21

(min (length list)

22

(* (+ current-page 1) n-per-page)))))))

23

24

25

26

(defhtml make-pager (current-page

27

page-param

28

number-of-pages)

29

(str

30

(make-generic-pager-widget

31

number-of-pages current-page

32

(lambda (x &optional (label (+ 1 x)))

33

(with-output-to-string (*http-stream*)

34

(funcall

35

(html ()

36

(link-here* (format nil " ~A " label)

37

page-param x)))))

38

(lambda ()

39

(format nil "~A" (+ 1 current-page)))

40

#'identity

41

:pages-shown-near-current-page 2

42

:next/previous-labels (list ">>" "<<"))))

43

44

45

(defhtml render-case (row)

46

(let ((id (unique-id "hide")))

47

(htm

48

(:div :class "case"

49

(:em (str (getf row :doc_date)))

50

" " (str (getf row :disease_name)) " " (str (getf row :country))

51

(show-id id)

52

(:div :id id (str "MOI"))))))

53

54

55

(defun unique-id (&optional (prefix "id"))

56

(multiple-value-bind (counter present) (aux-request-value :counter)

57

(if (null present)

58

(setf (aux-request-value :counter) 1)

59

(incf (aux-request-value :counter)))

60

(format nil "~A~A" prefix (aux-request-value :counter))))

61

62

(defun pulsu-make-highlight-pair (name start-index end-index)

63

(make-highlight-pair (format nil "" name) ""

64

start-index

65

end-index))

66

67

68

(defun make-trigger-link (row)

69

(let ((offsets (puls.controller:get-trigger-offsets row))

70

(a (with-output-to-string (*http-stream*)

71

(link/keep-state* ""

72

"/dv"

73

'n (getf row :docno)

74

'c (getf row :event_id)))))

75

(when offsets

76

;;FIXME: this removes indent, but will break if link indent is changed

77

;; yep, be careful with the sequence limits

78

(make-highlight-pair (subseq a 1 (- (length a) 5))

79

"</a>"

80

(first offsets)

81

(second offsets)))))

82

83

84

(defun make-strong(row)

85

(let ((offsets (puls.controller:get-trigger-offsets row)))

86

(when offsets

87

(make-highlight-pair ""

88

""

89

(first offsets)

90

(second offsets)))))

91

92

93

(defun highlight-document (text row rows)

94

95

;; Remove the "current" row

96

(let ((rows (remove (getf row :event_id) rows

97

:test #'equal

98

:key (lambda (x)

99

(getf x :event_id))))

100

101

(list (loop :for a :in (puls.controller::get-attrs)

102

:nconcing

103

(if (and

104

(listp (attr-offsets a))

105

(puls.controller:start-index a row)

106

(puls.controller:end-index a row)

107

(> (puls.controller:start-index a row) -1)

108

(> (puls.controller:end-index a row) -1))

109

(list

110

(pulsu-make-highlight-pair

111

(puls.controller:attr-id a)

112

(puls.controller:start-index a row)

113

(puls.controller:end-index a row)))

114

nil))))

115

116

117

;; Current case is "strong"

118

(let ((strong (make-strong row)))

119

(when strong

120

(push strong list)))

121

122

;; Other cases are links

123

(dolist (r rows)

124

(let ((link (make-trigger-link r)))

125

(when link

126

(push link list))))

127

128

129

(highlight-text list text)))

130

131

;;;;

132

133

134

(defhtml render-attrs (row)

135

(dolist (attr (puls.controller:get-attrs))

136

(render-attr attr row)))

137

138

(defhtml render-attr (attr row)

139

(:tr :id (format nil "~A_tr" (attr-id attr))

140

(if (not (equalp (attr-type attr) :plain))

141

(switch-input (attr-id attr))

142

(htm (:td)))

143

(:td :id (format nil "~A_id_text" (string-downcase(attr-id attr))) (str (attr-desc attr)))

144

(:td

145

(case (puls.controller:attr-type attr)

146

(:plain (str (attr-value attr row)))

147

(:select

148

(htm

149

(:select :name (attr-id attr)

150

:id (format nil "~A_id" (attr-id attr))

151

:onChange "checkAttributes()"

152

(dolist (i (attr-options attr row))

153

(htm

154

(:option :value i

155

:selected

156

(if (string= i (attr-value attr row))

157

"selected"

158

nil)

159

(str i)))))))

160

(:text

161

(htm

162

(:input :type "text"

163

:name (attr-id attr)

164

:id (format nil "~A_id" (attr-id attr))

165

:size "20"

166

:value (attr-value attr row))))))))

167

168

;;;;

169

170

(deftest test-paged ()

171

(check (equal (with-html-output-to-string (*http-stream*)

172

(paged-list-of-widgets (list 1 2 3 4 5 6 7 8 9)

173

(html (x) (:p (str x)))

174

2

175

'moicca

176

2))

177

"

178

179

<a href=\"/foo?moicca=1&c=3&b=2&a=1\"> <<

180

</a>

181

182

<a href=\"/foo?moicca=0&c=3&b=2&a=1\"> 1

183

</a>

184

185

<a href=\"/foo?moicca=1&c=3&b=2&a=1\"> 2

186

</a>

187

3

188

189

<a href=\"/foo?moicca=3&c=3&b=2&a=1\"> 4

190

</a>

191

192

<a href=\"/foo?moicca=4&c=3&b=2&a=1\"> 5

193

</a>

194

195

<a href=\"/foo?moicca=3&c=3&b=2&a=1\"> >>

196

</a>

197

5

198

199

6

200

")))

201

202

(deftest test-pager ()

203

(check (equal (with-html-output-to-string (*http-stream*)

204

(make-pager 2 'moicca 50))

205

"

206

207

<a href=\"/foo?moicca=1&c=3&b=2&a=1\"> <<

208

</a>

209

210

<a href=\"/foo?moicca=0&c=3&b=2&a=1\"> 1

211

</a>

212

213

<a href=\"/foo?moicca=1&c=3&b=2&a=1\"> 2

214

</a>

215

3

216

217

<a href=\"/foo?moicca=3&c=3&b=2&a=1\"> 4

218

</a>

219

220

<a href=\"/foo?moicca=4&c=3&b=2&a=1\"> 5

221

</a>

222

...

223

224

<a href=\"/foo?moicca=47&c=3&b=2&a=1\"> 48

225

</a>

226

227

<a href=\"/foo?moicca=48&c=3&b=2&a=1\"> 49

228

</a>

229

230

<a href=\"/foo?moicca=49&c=3&b=2&a=1\"> 50

231

</a>

232

233

<a href=\"/foo?moicca=3&c=3&b=2&a=1\"> >>

234

</a>")))

235

236

(deftest test-pulsu-make-highlight-pair ()

237

238

(let* ((row (puls.controller:get-event "20050101_bbc_b118e8867977ba4feae312bb5ea17ef4" 1)))

239

(check (equal (write-to-string(pulsu-make-highlight-pair "testi" 0 10))

240

                   "(#I(PULS.WEB::HIGHLIGHT PULS.WEB::NAME \"<span class='testi'>\" PULS.WEB::INDEX

241

NIL PULS.WEB::BEGIN-OR-END :BEGIN PULS.WEB::OTHER-HALF

242

#I(PULS.WEB::HIGHLIGHT PULS.WEB::NAME \"\" PULS.WEB::INDEX NIL

243

PULS.WEB::BEGIN-OR-END :END PULS.WEB::MAGIC-NUMBER NIL))

244

#I(PULS.WEB::HIGHLIGHT PULS.WEB::NAME \"\" PULS.WEB::INDEX NIL

245

PULS.WEB::BEGIN-OR-END :END PULS.WEB::MAGIC-NUMBER NIL))"))))

246

247

(deftest test-make-trigger-link ()

248

249

(let* ((row (puls.controller:get-event "20050101_bbc_b118e8867977ba4feae312bb5ea17ef4" 1)))

250

(check (equal (write-to-string (make-trigger-link row))

251

"(#I(PULS.WEB::HIGHLIGHT PULS.WEB::NAME

252

\"<a href=\\\"/dv?n=20050101_bbc_b118e8867977ba4feae312bb5ea17ef4&c=1\\\">\"

253

PULS.WEB::INDEX 1039 PULS.WEB::BEGIN-OR-END :BEGIN PULS.WEB::OTHER-HALF

254

#I(PULS.WEB::HIGHLIGHT PULS.WEB::NAME \"</a>\" PULS.WEB::INDEX 1063

255

PULS.WEB::BEGIN-OR-END :END PULS.WEB::MAGIC-NUMBER NIL))

256

#I(PULS.WEB::HIGHLIGHT PULS.WEB::NAME \"</a>\" PULS.WEB::INDEX 1063

257

PULS.WEB::BEGIN-OR-END :END PULS.WEB::MAGIC-NUMBER NIL))"))))

258

259

(deftest test-make-strong ()

260

261

(let* ((row (puls.controller:get-event "20050101_bbc_b118e8867977ba4feae312bb5ea17ef4" 1)))

262

263

(check (equal (write-to-string (make-strong row))

264

"(#I(PULS.WEB::HIGHLIGHT PULS.WEB::NAME \"\" PULS.WEB::INDEX 1039

265

PULS.WEB::BEGIN-OR-END :BEGIN PULS.WEB::OTHER-HALF

266

#I(PULS.WEB::HIGHLIGHT PULS.WEB::NAME \"\" PULS.WEB::INDEX 1063

267

PULS.WEB::BEGIN-OR-END :END PULS.WEB::MAGIC-NUMBER NIL))

268

#I(PULS.WEB::HIGHLIGHT PULS.WEB::NAME \"\" PULS.WEB::INDEX 1063

269

PULS.WEB::BEGIN-OR-END :END PULS.WEB::MAGIC-NUMBER NIL))"))))

270

271

(deftest test-ui ()

272

(combine-results

273

(test-pager)

274

(test-paged)

275

(test-pulsu-make-highlight-pair)

276

(test-make-trigger-link)

277

(test-make-strong)))