mishell/mishell.factor at master · jarnaldich/mishell · GitHub

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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
! Copyright (C) 2015 Joan Arnaldich
! See http://factorcode.org/license.txt for BSD license.
USING: accessors io io.backend io.directories io.files
io.launcher io.pathnames kernel lexer math namespaces see sequences sorting
vocabs io.encodings.binary io.encodings.utf8 strings assocs parser serialize
io.files.private ui.tools.listener prettyprint ;
IN: mishell

SYMBOL: mishell-current-cfg
TUPLE: mishell-cfg default-enc default-env session-dir ;


: get-default-encoding ( -- enc )
    mishell-current-cfg get default-enc>> ;

! ------------------------------------------------------------------------------
!                               Raw String Syntax
! ------------------------------------------------------------------------------
: take-until ( end lexer -- string )
    dup [ drop 1 + ] change-lexer-column
    [ [ index-from ] 2keep [ swapd subseq ] [ 2drop 1 + ] 3bi ]
    change-lexer-column ;

: parsing-raw ( accum end -- accum )
    lexer get take-until suffix! ;

SYNTAX: r| 124 parsing-raw ;

! ------------------------------------------------------------------------------
!                                Session Saving
! ------------------------------------------------------------------------------
: dump-words ( vocab path -- )
    utf8 [
        vocab-words [ name>> ] sort-by
        [ "IN: scratchpad" print [ "DEFER: " write name>> print ] each nl ]
        [ [ see nl ] each ] bi
    ] with-file-writer ;

<PRIVATE

: save-var? ( k v -- ? )
    drop
      [ string? ]
      [ V{
            current-directory
            mishell-current-cfg
         } member? ]
    bi or ; inline

PRIVATE>

: words ( -- seq )
    "scratchpad" vocab-words ;

: vars ( -- assoc )
    namespace [ save-var? ] assoc-filter  ;

: dump-vars ( fname -- )
    ! filter out the keys that are not strings
    ! to remove system variables that may not be serializable
    [ vars ] dip
    binary [ serialize ] with-file-writer ;

: load-vars ( fname -- )
   binary [ deserialize ] with-file-reader
   [ set ] assoc-each ;

: save-session ( -- )
    mishell-current-cfg get session-dir>>
    [ "scratchpad.factor" append-path "scratchpad" swap dump-words ]
    [ "vars.bin" append-path dump-vars ] bi ;

: load-session ( -- )
    mishell-current-cfg get session-dir>>
    [ "scratchpad.factor" append-path run-file ]
    [ "vars.bin" append-path dump-vars ] bi ;

! Reload a new file with, eg:
! "~/dump.factor" parse-file

! ------------------------------------------------------------------------------
! Commands
! ------------------------------------------------------------------------------
<PRIVATE
: with-process-reader/noerr ( desc q -- n )
    [ mishell-current-cfg get default-enc>> <process-reader> ] dip
    swap
    [ with-input-stream ] dip
    wait-for-process ; inline
PRIVATE>


: <mishell-cfg> ( -- x )
    mishell-cfg new ;

: set-cfg ( session-path enc env --  )
    mishell-cfg boa mishell-current-cfg set ;

: set-default-cfg ( -- )
    utf8
    H{ }
    home ".mishell/" append-path dup make-directories
    set-cfg ;

! The old version is like qualified-directory-files
: default-process-reader ( cmd -- stream )
    <process>
        swap >>command
        +stdout+ >>stderr
        t >>hidden
        mishell-current-cfg get default-env>> >>environment
        mishell-current-cfg get default-enc>> <process-reader> ;

: proc-lines ( cmd -- arr )
    default-process-reader stream-lines ;

! : each-proc-line ( proc quot -- status )
!     '[ readln dup _ when* ] ;
!
! : >sh ( cmd -- ret-code )
! default-process-reader
! [ [ readln dup [ print ] when* ] loop ] with-process-reader/noerr ;

: cls ( -- )
    get-listener clear-output ;

STARTUP-HOOK: set-default-cfg

! ------------------------------------------------------------------------------
!                              "Shell" commands
! ------------------------------------------------------------------------------
: ls ( -- )
    current-directory get directory-files . ;
!    [ directory-files ] [ [ prepend-path normalize-path ] curry ] bi map ;

: cd ( dir -- )
    set-current-directory ;

: cwd ( -- dir )
    current-directory get ;

: cat ( fname -- )
    mishell-current-cfg get default-enc>> file-contents . ;

: barf* ( seq fname -- )
    get-default-encoding set-file-lines ;