From 84ec2fcfa71dc63e76c83cfb6d15f0d06f0e731c Mon Sep 17 00:00:00 2001
From: Vasilij Schneidermann <mail@vasilij.de>
Date: Tue, 8 Jun 2021 11:59:07 +0200
Subject: [PATCH] qwiki-search: Exclude old pages by default
---
qwiki/2.2/qwiki-search.scm | 14 +++++++++++++-
1 file changed, 13 insertions(+), 1 deletion(-)
diff --git a/qwiki/2.2/qwiki-search.scm b/qwiki/2.2/qwiki-search.scm
index 2cbbe46..0bb2a46 100644
a
|
b
|
|
107 | 107 | (label "identifier" |
108 | 108 | (input (@ (type "text") (name "ident")))) |
109 | 109 | (input (@ (type "submit") (value "search"))) |
110 | | (a (@ (href "/search-help")) "search help")))) |
| 110 | (a (@ (href "/search-help")) "search help")) |
| 111 | (div |
| 112 | (label "include old search results" |
| 113 | (input (@ (type "checkbox") |
| 114 | (id "includeold") |
| 115 | (name "includeold"))))))) |
111 | 116 | . ,contents)))) |
112 | 117 | . ,(lambda contents contents)) |
113 | 118 | ,@alist-conv-rules*)) |
… |
… |
|
128 | 133 | (title ,(sprintf "View page ~A of ~A" (add1 p) page-count))) |
129 | 134 | ,text)))))) |
130 | 135 | |
| 136 | ;; NOTE: this must be updated after each major release |
| 137 | (define old-page-rx "^(eggref|man)/[34]") |
| 138 | |
131 | 139 | (define (search request) |
132 | 140 | (ensure-qwiki-node-exists!) |
133 | 141 | (let* ((query (uri-query (request-uri request))) |
… |
… |
|
140 | 148 | (ident (if ident-m |
141 | 149 | (irregex-match-substring ident-m 2) |
142 | 150 | (string-trim-both (alist-ref 'ident query eq? "")))) |
| 151 | (exclude-old? (not (equal? (alist-ref 'includeold query eq? "") "on"))) |
143 | 152 | (attr-phrases (if (not (string-null? ident)) |
144 | 153 | (list (conc type " STRINC " ident)) |
145 | 154 | (list))) |
| 155 | (attr-phrases (if exclude-old? |
| 156 | (cons (conc "@uri !STRRX " old-page-rx) attr-phrases) |
| 157 | attr-phrases)) |
146 | 158 | (text (alist-ref 'text query eq? "")) |
147 | 159 | (phrase (if (string-null? (string-trim-both text)) |
148 | 160 | ;; Search for the identifier in main text so it shows |