basis/help/home/home.factor

   1 ! Copyright (C) 2009, 2010 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: arrays compiler.units fry hashtables help.topics io
   4 kernel math namespaces sequences sets help.vocabs
   5 help.apropos vocabs help.markup ;
   6 IN: help.home
   7
   8 SYMBOLS: recent-words recent-articles recent-vocabs recent-searches ;
   9
  10 CONSTANT: recent-count 10
  11
  12 { recent-words recent-articles recent-vocabs recent-searches }
  13 [ [ V{ } clone ] initialize ] each
  14
  15 GENERIC: add-recent-where ( obj -- obj symbol )
  16
  17 M: link add-recent-where recent-articles ;
  18 M: word-link add-recent-where recent-words ;
  19 M: vocab-spec add-recent-where recent-vocabs ;
  20 M: apropos-search add-recent-where recent-searches ;
  21 M: object add-recent-where f ;
  22
  23 : $recent ( element -- )
  24     first get [ valid-article? ] filter <reversed>
  25     [ nl ] [ 1array $pretty-link ] interleave ;
  26
  27 : $recent-searches ( element -- )
  28     drop recent-searches get [ <$link> ] map $list ;
  29
  30 : redisplay-recent-page ( -- )
  31     HS{ } clone "help.home" >link over adjoin
  32     notify-definition-observers ;
  33
  34 : expire ( seq -- )
  35     [ length recent-count - [ 0 > ] keep ] keep
  36     '[ 0 _ _ delete-slice ] when ;
  37
  38 : add-recent ( obj -- )
  39     add-recent-where dup
  40     [ get [ adjoin ] [ expire ] bi ] [ 2drop ] if
  41     redisplay-recent-page ;