Ticket #1764: 0001-qwiki-search-Exclude-old-pages-by-default.patch

File 0001-qwiki-search-Exclude-old-pages-by-default.patch, 2.3 KB (added by Vasilij Schneidermann, 5 years ago)

  • qwiki/2.2/qwiki-search.scm 

    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  
    107107                               (label "identifier"
    108108                                      (input (@ (type "text") (name "ident"))))
    109109                               (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")))))))
    111116                   . ,contents))))
    112117     . ,(lambda contents contents))
    113118    ,@alist-conv-rules*))
    … …  
    128133                 (title ,(sprintf "View page ~A of ~A" (add1 p) page-count)))
    129134              ,text))))))
    130135
     136;; NOTE: this must be updated after each major release
     137(define old-page-rx "^(eggref|man)/[34]")
     138
    131139(define (search request)
    132140  (ensure-qwiki-node-exists!)
    133141  (let* ((query (uri-query (request-uri request)))
    … …  
    140148         (ident (if ident-m
    141149                    (irregex-match-substring ident-m 2)
    142150                    (string-trim-both (alist-ref 'ident query eq? ""))))
     151         (exclude-old? (not (equal? (alist-ref 'includeold query eq? "") "on")))
    143152         (attr-phrases (if (not (string-null? ident))
    144153                           (list (conc type " STRINC " ident))
    145154                           (list)))
     155         (attr-phrases (if exclude-old?
     156                           (cons (conc "@uri !STRRX " old-page-rx) attr-phrases)
     157                           attr-phrases))
    146158         (text (alist-ref 'text query eq? ""))
    147159         (phrase (if (string-null? (string-trim-both text))
    148160                     ;; Search for the identifier in main text so it shows