picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

eled.l (22858B)


      1 # 29nov12tj
      2 # Authors Thorsten Jolitz, Alexander Burger
      3 # (c) Software Lab. Alexander Burger
      4 
      5 # Line editor
      6 # emacs-mode
      7 
      8 (mapc undef
      9    '(*Led fkey revise) )
     10 
     11 (setq
     12    "Line"      NIL      # Holds current input line
     13    "LPos"      1        # Position in line (1 .. length)
     14    "HPos"      1        # Position in history
     15    "UndoLine"  NIL      # Undo
     16    "UndoPos"   0
     17    "Line1"     NIL      # Initial line
     18    "Insert"    T        # Insert mode flag
     19    "FKey"      NIL      # Function key bindings
     20    "Clip"      NIL      # Cut/Copy/Paste buffer
     21    "Item"      NIL      # Item to find
     22    "Found"     NIL      # Find stack
     23    "Complete"  NIL      # Input completion
     24    "Mark"      NIL      # Position of the mark
     25    "Register"  NIL      # Storage for text snippets
     26 
     27    "HistMax"   1000     # History limit
     28 
     29    *History             # History of input lines
     30    (in (pack "+" (pil "history"))
     31       (ctl NIL
     32          (make (until (eof) (link (line T)))) ) )
     33    "Hist0"     *History )
     34 
     35 
     36 # Switch Crtl-C off
     37 
     38 # Ctrl-C is actually not defined as a special key, but as a signal
     39 # handler. Depending on the 'stty' settings, a SIGINT signal is sent to
     40 # the process when Ctrl-C is pressed.
     41 #
     42 # If this is not desired, then some other key (or none) must be set in the
     43 # terminal settings. This can be done with
     44 #
     45 #    $ stty intr ^A
     46 #
     47 # or, from inside PicoLisp
     48 #
     49 #    (call 'stty "intr" "^A")
     50 
     51 (raw T)
     52 (call 'stty "intr" "^R")  # ^R as replacement for ^C
     53 
     54 # Basic editing routine
     55 (de chgLine (L N)
     56    (let (D (length "Line")  Tsm)
     57       (for (P (dec "LPos") (>= P 1) (dec P))  # To start of old line
     58          (unless
     59             (and
     60                *Tsm
     61                (= "\"" (get "Line" P))
     62                (skipQ "LPos" P "Line") )
     63             (prin "^H") ) )
     64       (for (P . C) (setq "Line" L)  # Output new line
     65          (cond
     66             ((> " " C)
     67                (dec 'D)
     68                (prin "_") )
     69             ((or (not *Tsm) (<> "\"" C) (escQ P L))
     70                (dec 'D)
     71                (prin C) )
     72             (T
     73                (prin
     74                   (and Tsm (cdr *Tsm))
     75                   (unless (skipQ N P L)
     76                      (dec 'D)
     77                      C )
     78                   (and (onOff Tsm) (car *Tsm)) ) ) ) )
     79       (and Tsm (prin (cdr *Tsm)))
     80       (space D)  # Clear rest of old line
     81       (do D (prin "^H"))
     82       (setq "LPos" (inc (length L)))
     83       (until (= N "LPos")  # To new position
     84          (unless
     85             (and
     86                *Tsm
     87                (= "\"" (get "Line" "LPos"))
     88                (skipQ N "LPos" "Line") )
     89             (prin "^H") )
     90          (dec '"LPos") ) )
     91    (flush) )
     92 
     93 # Skipped double quote
     94 (de skipQ (N P L)
     95    (nor
     96       (>= (inc N) P (dec N))
     97       (= "\"" (get L (dec P)))
     98       (= "\"" (get L (inc P)))
     99       (escQ P L) ) )
    100 
    101 # Escaped double quote
    102 (de escQ ()
    103    (let Esc NIL
    104       (for I (dec P)
    105          ((if (= "\\" (get L I)) onOff off) Esc) ) ) )
    106 
    107 # Check for delimiter
    108 (de delim? (C)
    109    (member C '`(chop '" ^I^J^M\"'()[]`~-")) )  # dash added for emacs-style
    110 
    111 # Move left
    112 (de lMove ()
    113    (chgLine "Line" (max 1 (dec "LPos"))) )
    114 
    115 # Move to beginning
    116 (de bMove ()
    117    (chgLine "Line" 1) )
    118 
    119 # Move right
    120 (de rMove (F)
    121    (chgLine "Line"
    122       (min
    123          (inc "LPos")
    124          (if F
    125             (inc (length "Line"))
    126             (length "Line") ) ) ) )
    127 
    128 # Move to end of line
    129 (de eMove ()
    130    (chgLine "Line" (length "Line")) )
    131 
    132 # Move beyond end of line
    133 (de xMove ()
    134    (chgLine "Line" (inc (length "Line"))) )
    135 
    136 # Move up
    137 (de uMove ()
    138    (when (< "HPos" (length *History))
    139       (setHist (inc "HPos")) ) )
    140 
    141 # Move down
    142 (de dMove ()
    143    (unless (=0 "HPos")
    144       (setHist (dec "HPos")) ) )
    145 
    146 # Move word left
    147 (de lWord ()
    148    (use (N L)
    149       (chgLine "Line"
    150          (if (>= 1 (setq N "LPos"))
    151             1
    152             (loop
    153                (T (= 1 (dec 'N)) 1)
    154                (setq L (nth "Line" (dec N)))
    155                (T (and (delim? (car L)) (not (delim? (cadr L))))
    156                   N ) ) ) ) ) )
    157 
    158 # Move word right
    159 # M (Line-lenght) N (Line-positon) L (Line-tail)
    160 (de rWord ()
    161    (use (M N L)
    162       (setq M (length "Line"))
    163       (chgLine "Line"
    164          (if (<= M (setq N "LPos"))
    165             (inc M)
    166             (loop
    167                (T (= M (inc 'N))
    168                   (if (delim? (get "Line" N)) M (inc M)) )
    169                (setq L (nth "Line" (dec N)))
    170                (T (and (delim? (cadr L)) (not (delim? (car L))))
    171                   N ) ) ) ) ) )
    172 
    173 # Match left parenthesis
    174 (de lPar ()
    175    (let (N 1 I (dec "LPos"))
    176       (loop
    177          (T (=0 I))
    178          (case (get "Line" I)
    179             (")" (inc 'N))
    180             ("(" (dec 'N)) )
    181          (T (=0 N) (chgLine "Line" I))
    182          (dec 'I) ) ) )
    183 
    184 # Match right parenthesis
    185 (de rPar ()
    186    (let (N 1 I (inc "LPos"))
    187       (loop
    188          (T (> I (length "Line")))
    189          (case (get "Line" I)
    190             ("(" (inc 'N))
    191             (")" (dec 'N)) )
    192          (T (=0 N) (chgLine "Line" I))
    193          (inc 'I) ) ) )
    194 
    195 # Clear to end of line
    196 (de clrEol ()
    197    (let N (dec "LPos")
    198       (if (=0 N)
    199          (chgLine NIL 1)
    200          (chgLine (head N "Line") N) ) ) )
    201 
    202 # Insert a char
    203 (de insChar (C)
    204    (chgLine (insert "LPos" "Line" C) (inc "LPos")) )
    205 
    206 (de del1 (L)
    207    (ifn (nth L "LPos")
    208       L
    209       (setq "Clip" (append "Clip" (list (get L "LPos"))))
    210       (remove "LPos" L) ) )
    211 
    212 # Delete a char
    213 (de delChar ()
    214    (use L
    215       (off "Clip")
    216       (chgLine
    217          (setq L (del1 "Line"))
    218          (max 1 (min "LPos" (length L))) ) ) )
    219 
    220 # Delete a sexp
    221 (de delSexp ()
    222    (let L "Line"
    223       (off "Clip")
    224       (if (= "(" (get L "LPos"))
    225          (for (N 1 (and (setq L (del1 L)) (< 0 N)))
    226             (case (get L "LPos")
    227                ("(" (inc 'N))
    228                (")" (dec 'N)) ) ) )
    229       (chgLine L (max 1 (min "LPos" (length L)))) ) )
    230 
    231 # Delete a word (F: with trailing blank)
    232 (de delWord (F)
    233    (let L "Line"
    234       ## (off "Clip")
    235       (and (delim? (get L "LPos"))
    236          (while (and (nth L "LPos") (delim? (get L "LPos")))
    237             (setq L (del1 L)) ) )
    238       (unless (delim? (get L "LPos"))
    239          (while (and (nth L "LPos") (not (delim? (get L "LPos"))))
    240             (setq L (del1 L)) ) )
    241       (and
    242          F
    243          (sp? (get L "LPos"))
    244          (setq L (del1 L)) )
    245       (chgLine L (max 1 (min "LPos" (length L))))
    246       (and (= "LPos" (length L) (rMove T))) ) )
    247 
    248 ## (de vi-delWord (F)
    249 ##    (let L "Line"
    250 ##       (off "Clip")
    251 ##       (ifn (= "(" (get L "LPos"))
    252 ##          (while (and (nth L "LPos") (not (delim? (get L "LPos"))))
    253 ##             (setq L (del1 L)) )
    254 ##          (for (N 1 (and (setq L (del1 L)) (< 0 N)))
    255 ##             (case (get L "LPos")
    256 ##                ("(" (inc 'N))
    257 ##                (")" (dec 'N)) ) ) )
    258 ##       (and
    259 ##          F
    260 ##          (sp? (get L "LPos"))
    261 ##          (setq L (del1 L)) )
    262 ##       (chgLine L (max 1 (min "LPos" (length L)))) ) )
    263 
    264 # Replace char
    265 (de rplChar (C)
    266    (chgLine
    267       (insert "LPos" (remove "LPos" "Line") C)
    268       "LPos" ) )
    269 
    270 # Undo mechanism
    271 (de doUndo ()
    272    (setq "UndoLine" "Line" "UndoPos" "LPos") )
    273 
    274 # Paste clip
    275 (de doPaste ()
    276    (if (= 1 "LPos")
    277       (chgLine (append "Clip" "Line") 1)
    278       (chgLine
    279          (append
    280             (head (dec "LPos") "Line")
    281             "Clip"
    282             (nth "Line" "LPos") )
    283          (+ "LPos" (length "Clip") -1) ) ) )
    284 
    285 # Set history line
    286 (de setHist (N)
    287    (chgLine
    288       (if (=0 (setq "HPos" N))
    289          "Line1"
    290          (chop (get *History "HPos")) )
    291       1 ) )
    292 
    293 # Searching
    294 (de ledSearch (L)
    295    (let (H (nth *History (inc "HPos")) S (find '((X) (match "Item" (chop X))) H))
    296       (chgLine
    297          (ifn S
    298             (prog (beep) L)
    299             (push '"Found" "HPos")
    300             (inc '"HPos" (index S H))
    301             (chop S) )
    302          1 ) ) )
    303 
    304 # TAB expansion
    305 (de expandTab ()
    306    (let ("L" (head (dec "LPos") "Line") "S" "L")
    307       (while (find "skipFun" "S")
    308          (pop '"S") )
    309       (ifn "S"
    310          (prog
    311             (off "Complete")
    312             (do 3 (insChar " ")) )
    313          (ifn
    314             (default "Complete"
    315                (let "N" (inc (length "S"))
    316                   (mapcar
    317                      '((X)
    318                         (setq X
    319                            (nth
    320                               (mapcan
    321                                  '((C)
    322                                     (if (or (= "\\" C) (delim? C))
    323                                        (list "\\" C)
    324                                        (cons C) ) )
    325                                  (chop X) )
    326                               "N" ) )
    327                         (cons
    328                            (+ "LPos" (length X))
    329                            (append "L" X (nth "Line" "LPos")) ) )
    330                      ("tabFun" (pack "S")) ) ) )
    331             (beep)
    332             (chgLine (cdar "Complete") (caar "Complete"))
    333             (rot "Complete") ) ) ) )
    334 
    335 # Insert mode
    336 (de insMode ("C")
    337    (if (= "C" "^I")
    338       (expandTab)
    339       (off "Complete")
    340       (case "C"
    341          ("^?"
    342             (when (> "LPos" 1)
    343                (chgLine (remove (dec "LPos") "Line") (dec "LPos")) ) )
    344          ## ("^V" (insChar (key)))
    345 
    346          # 'M-<char>' (Meta or Alt) keymap, implemented with ESC prefix
    347          ("^[" (and (key 500)
    348                   (case @
    349                      ("[" (when (sys "TERM")
    350                              (and (key 500)
    351                                 (case @
    352                                    # arrow keys
    353                                    ("A" (uMove) (xMove))
    354                                    ("B" (dMove) (xMove))
    355                                    ("C" (rMove T))
    356                                    ("D" (lMove)) ) ) ) )
    357                      # forward-word
    358                      # TODO: emacs  (goto end of word!)
    359                      ("f" (rWord))
    360                      # backward-word
    361                      ("b" (lWord))
    362                      # kill-word
    363                      ("d" (doUndo) (delWord T))
    364                      # toggle case of char
    365                      # TODO: capitalize/downcase/upcase word
    366                      ((or "c" "l")
    367                         (doUndo)
    368                         (rplChar
    369                              ((if
    370                                  (low? (setq "C" (get "Line" "LPos")))
    371                                  uppc lowc ) "C" ) )
    372                         (rMove T) )
    373                      # forward-sexp
    374                      ("^f"
    375                       (case (get "Line" "LPos")
    376                          ("(" (rPar))
    377                          (T (beep)) ) )
    378                      # backward-sexp
    379                      ("^b"
    380                       (case (get "Line" "LPos")
    381                          (")" (lPar))
    382                          (T (beep)) ) )
    383                      # show present working directory (pwd)
    384                      # delete sexp
    385                      ("^d" (prinl (pwd)) (quit))
    386                      ("^k" (delSexp))
    387                      # goto/find char
    388                      ("g"
    389                         (ifn (setq "C" (index (key) (nth "Line" (inc "LPos"))))
    390                            (beep)
    391                            (chgLine "Line" (+ "C" "LPos")) ) )
    392                      # accept input pattern for history search
    393                      ("^s"
    394                         (let "L" "Line"
    395                            (_getLine '("/") '((C) (= C "/")))
    396                            (unless (=T "Line")
    397                               (setq "Item" (append '(@) (cdr "Line") '(@)))
    398                               (ledSearch "L")
    399                               ## (off "Insert")
    400                               ) ) )
    401                      # search for next occurrence of pattern
    402                      # in history-search
    403                      ("s" (ledSearch "Line"))
    404                      # search for previous occurrence of pattern
    405                      # in history-search
    406                      ("r" (if "Found" (setHist (pop '"Found")) (beep))) ) ) )
    407 
    408          # 'C-c' (Ctrl-c) keymap
    409          ("^c"  (and (key 1000)
    410                   (case @
    411                      # change directory
    412                      ("^d"
    413                         (prinl "[(pwd) " (pwd) "]")
    414                         (prin "(cd) ")
    415                         (cd (read)) (quit) )
    416                      # make directory (with parents)
    417                      ("+"
    418                         (prinl "[(pwd) " (pwd) "]")
    419                         (prin "(mkdir -p) ")
    420                         (call 'mkdir (read) "-p") (quit) )
    421                      # call shell-command with arguments
    422                      (("^c" "!")
    423                       (prin "[cmd -args] ")
    424                       (eval
    425                          (append '(call)
    426                             (mapcar pack
    427                                (split (chop (line T)) " " ) ) ) )
    428                       (quit) ) ) ) )
    429 
    430          # 'C-u (Ctrl-u) keymap (functions with arguments)
    431          ("^u" (and (key 1000)
    432                  (case @
    433                      ("^x" (and (key 500)
    434                               (case @
    435                                  # list directory files with dotfiles
    436                                  ("^d"
    437                                   (printsp (dir (pwd) T))
    438                                   (prinl) (quit) )
    439                                  # dired-style directory listing with dotfiles
    440                                  ("d" (call 'ls "-al") (quit)) ) ) )
    441                      ("^h" (and (key 500)
    442                               (case @
    443                                  # unbug
    444                                  ("d" (prin "(unbug) ")
    445                                     (unbug (any (line T))) (quit) ) ) ) ) ) ) )
    446 
    447          # 'C-x' (Ctrl-x) keymap
    448          ("^x" (and (key 500)
    449                   (case @
    450                      # undo
    451                      ("u"
    452                         (let ("L" "Line" "P" "LPos")
    453                            (chgLine "UndoLine" "UndoPos")
    454                            (setq "UndoLine" "L" "UndoPos" "P") ) )
    455                      # list directory files
    456                      ("^d" (printsp (dir (pwd))) (prinl) (quit))
    457                      # dired-style directory listing (ls -l)
    458                      ("d" (call 'ls "-l") (quit))
    459                      # find file (with EMACSCLIENT)
    460                      ("^f"
    461                       (prog
    462                         (prinl "[(pwd) " (pwd) "]")
    463                         (prin "(emacsclient -c) ")
    464                         (call 'emacsclient "-c" (line T)) (quit) ) )
    465                      # find-file (with ZILE)
    466                      ("f"
    467                       (prog
    468                         (prinl "[(pwd) " (pwd) "]")
    469                         (prin "(zile) ")
    470                         (call 'zile (line T)) (quit) ) )
    471                      # return (a list with) the number of lines of file(s)
    472                      ("l"
    473                         (prinl "[(pwd) " (pwd) "]")
    474                         (prin "(lines) ")
    475                         (println
    476                            (mapcar lines
    477                               (mapcar pack
    478                                  (split (chop (line T)) " ") ) ) )
    479                            (quit) )
    480 
    481  ) ) )
    482                         ## (case @
    483                         ##    ((call 'test "-f" X)
    484                         ##     (call 'zile X) (quit) )
    485                         ##    ((call 'test "-d" X)
    486                         ##     (prinl "Can't open directory") (quit) )
    487                         ##    (T (case @
    488                         ##          ((call 'test "-d" (dirname X))
    489                         ##           (chdir (dirname X)
    490                         ##              (out (basename X)
    491                         ##              (call -zile X) )
    492                         ##              (quit) ) )
    493                         ##          (T (call 'mkdir (dirname X) "-p")
    494                         ##             (chdir (dirname X)
    495                         ##                (out (basename X)) ) ) ) ) ) ) ) ) ) )
    496 
    497          # 'C-h' (Ctrl-h) keymap (info/help functionality)
    498          ("^h" (and (key 1000)
    499                   (case @
    500                     # current contents of kill-ring (cut buffer)
    501                     ("r" (prinl) (println "Clip")(quit))
    502                     # info
    503                     ("i" (prin "(info) ")
    504                        (let Info (info (any (line T)))
    505                           (printsp
    506                              (car Info)
    507                              (stamp (cadr Info) (cddr Info)) ) )
    508                           (prinl) (quit) )
    509                     # doc
    510                     ("f" (prin "(doc) ")
    511                        (doc (line T)) (quit) )
    512                     # show
    513                     ("s" (prin "(show) ")
    514                        (pp (show (any (line T)))) (quit) )
    515                     # debug
    516                     ("d" (prin "(debug) ")
    517                        (debug (any (line T))) (quit) )
    518                     # pretty print
    519                     ("p" (and (key 500)
    520                              (case @
    521                                 # (pp)
    522                                 ("p" (prin "(pp) ")
    523                                    (pp (any (line T))) (quit) )
    524                                 # (pretty)
    525                                 ("r" (prin "(pretty) ")
    526                                    (pretty (any (line T)))
    527                                    (prinl) (quit) ) ) ) ) ) ) )
    528          # 'C-v' (Ctrl-v) keymap
    529          ## ("^v" (and (key 500)
    530          ##          (case @
    531          ##             # display current contents of
    532          ##             # kill-ring (cut buffer)
    533          ##            ("r" (prinl) (println "Clip")) ) ) )
    534 
    535          # undo
    536          ("^_" (let ("L" "Line" "P" "LPos")
    537                   (chgLine "UndoLine" "UndoPos")
    538                   (setq "UndoLine" "L" "UndoPos" "P") ) )
    539          # move-end-of-line
    540          ("^e" (eMove) (xMove))
    541          # move-beginning-of-line
    542          ("^a" (bMove))
    543          # kill-line
    544          ("^k" (doUndo) (clrEol) (rMove T))
    545          # backward-char
    546          ("^b" (lMove))
    547          # forward-char
    548          ("^f" (and (= "LPos" (length "Line")))(rMove T))
    549          # next-line
    550          ("^n" (dMove))
    551          # previous-line
    552          ("^p" (uMove))
    553          # yank
    554          ("^y" (doUndo) (doPaste))
    555          # delete-char
    556          ("^d" (doUndo) (delChar))
    557          # clear-screen
    558          ("^l" (call 'tput 'clear) (quit))
    559          # self-insertion
    560          (T
    561             (when (= "C" ")")
    562                (chgLine "Line" (prog1 "LPos" (lPar) (wait 200))) )
    563             (insChar  "C") ) ) ) )
    564 
    565 #### TODO: delete, once all functionality ####
    566 #### has been transferred to Insert Mode ####
    567 
    568 # Command mode
    569 ## (de cmdMode ("C")
    570 ## (case "C"
    571 ## ("g" (prinl) (println "Clip"))
    572 ## ("$" (eMove))
    573 ## ("%"
    574 ## (case (get "Line" "LPos")
    575 ## (")" (lPar))
    576 ## ("(" (rPar))
    577 ## (T (beep)) ) )
    578 ## ("/"
    579 ## (let "L" "Line"
    580 ## (_getLine '("/") '((C) (= C "/")))
    581 ## (unless (=T "Line")
    582 ## (setq "Item" (append '(@) (cdr "Line") '(@)))
    583 ## (ledSearch "L")
    584 ## (off "Insert") ) ) )
    585 ## ("0" (bMove))
    586 ## ("A" (doUndo) (xMove) (on "Insert"))
    587 ## ("a" (doUndo) ((if (= "LPos" (length "Line")) xMove rMove T)) (on "Insert"))
    588 ## ("b" (lWord))
    589 ## ("c" (doUndo) (delWord NIL) (on "Insert"))
    590 ## ("C" (doUndo) (clrEol) (xMove) (on "Insert"))
    591 ## ("d" (doUndo) (delWord T))
    592 ## ("D" (doUndo) (clrEol))
    593 ## ("f"
    594 ## (ifn (setq "C" (index (key) (nth "Line" (inc "LPos"))))
    595 ## (beep)
    596 ## (chgLine "Line" (+ "C" "LPos")) ) )
    597 ## ("h" (lMove))
    598 ## ("i" (doUndo) (on "Insert"))
    599 ## ("I" (doUndo) (bMove) (on "Insert"))
    600 ## ("j" (unless (=0 "HPos") (setHist (dec "HPos"))))
    601 ## ("k" (when (< "HPos" (length *History)) (setHist (inc "HPos"))))
    602 ## ("l" (rMove T))
    603 ## ("n" (ledSearch "Line"))
    604 ## ("N" (if "Found" (setHist (pop '"Found")) (beep)))
    605 ## ("p" (doUndo) ((if (= "LPos" (length "Line")) xMove rMove T)) (doPaste))
    606 ## ("P" (doUndo) (doPaste))
    607 ## ("r" (ifn "Line" (beep) (doUndo) (rplChar (key))))
    608 ## ("s" (doUndo) (delChar) (on "Insert"))
    609 ## ("S" (doUndo) (chgLine NIL 1) (on "Insert"))
    610 ## ("U" (setHist "HPos"))
    611 ## ("u"
    612 ## (let ("L" "Line" "P" "LPos")
    613 ## (chgLine "UndoLine" "UndoPos")
    614 ## (setq "UndoLine" "L" "UndoPos" "P") ) )
    615 ## ("w" (rWord))
    616 ## ("x" (doUndo) (delChar))
    617 ## ("X" (lMove) (doUndo) (delChar))
    618 ## ("~"
    619 ## (doUndo)
    620 ## (rplChar
    621 ## ((if (low? (setq "C" (get "Line" "LPos"))) uppc lowc) "C") )
    622 ## (rMove T) )
    623 ## (T (beep)) ) )
    624 
    625 # Get a line from console
    626 (de _getLine ("L" "skipFun")
    627    (use "C"
    628       (chgLine "L" (inc (length "L")))
    629       (on "Insert")
    630       (until
    631          (member
    632             (setq "C" (let *Dbg "*Dbg" (key)))
    633             '("^J" "^M") )
    634          (case "C"
    635             (NIL (bye))
    636             ## ("^D" (prinl) (bye))
    637             ("^Q" (prinl) (bye))
    638             ## ("^X" (prin (cdr *Tsm)) (prinl) (quit)) )
    639             ("^G" (prin (cdr *Tsm)) (prinl) (quit)) )
    640          ((if "Insert" insMode insMode) "C") ) ) ) # only insert mode for emacs
    641          ## ((if "Insert" insMode cmdMode) "C") ) ) )
    642 
    643 # Function keys
    644 (de fkey (Key . Prg)
    645    (setq "FKey"
    646       (cond
    647          ((not Key) "FKey")
    648          ((not Prg) (delete (assoc Key "FKey") "FKey"))
    649          ((assoc Key "FKey")
    650             (cons (cons Key Prg) (delete @ "FKey")) )
    651          (T (cons (cons Key Prg) "FKey")) ) ) )
    652 
    653 # Main editing functions
    654 (de _led ("Line1" "tabFun" "skipFun")
    655    (default "tabFun"
    656       '((S)
    657          (conc
    658             (filter '((X) (pre? S X)) (all))
    659             (let P (rot (split (chop S) "/"))
    660                (setq
    661                   S (pack (car P))
    662                   P (and (cdr P) (pack (glue "/" @) "/")) )
    663                (extract
    664                   '((X)
    665                      (and (pre? S X) (pack P X)) )
    666                   (dir P T) ) ) ) ) )
    667    (setq "LPos" 1 "HPos" 0)
    668    (_getLine "Line1" (or "skipFun" delim?))
    669    (prinl (cdr *Tsm)) )
    670 
    671 (de revise ("X" "tabFun" "skipFun")
    672    (let ("*Dbg" *Dbg *Dbg NIL)
    673       (_led (chop "X") "tabFun" "skipFun")
    674       (pack "Line") ) )
    675 
    676 (de saveHistory ()
    677    (in (pack "+" (pil "history"))
    678       (ctl T
    679          (let (Old (make (until (eof) (link (line T)))) New *History N "HistMax")
    680             (out (pil "history")
    681                (while (and New (n== New "Hist0"))
    682                   (prinl (pop 'New))
    683                   (dec 'N) )
    684                (setq "Hist0" *History)
    685                (do N
    686                   (NIL Old)
    687                   (prinl (pop 'Old)) ) ) ) ) ) )
    688 
    689 # Enable line editing
    690 (de *Led
    691    (let ("*Dbg" *Dbg *Dbg NIL)
    692       (push1 '*Bye '(saveHistory))
    693       (push1 '*Fork '(del '(saveHistory) '*Bye))
    694       (_led)
    695       (let L (pack "Line")
    696          (or
    697             (>= 3 (length "Line"))
    698             (sp? (car "Line"))
    699             (= L (car *History))
    700             (push '*History L) )
    701          (and (nth *History "HistMax") (con @))
    702          L ) ) )
    703 
    704 (mapc zap
    705    (quote
    706       chgLine skipQ escQ delim? lMove bMove rMove eMove xMove uMove dMove lWord
    707       rWord lPar rPar clrEol insChar del1 delChar delWord rplChar doUndo doPaste
    708       setHist ledSearch expandTab insMode cmdMode _getLine _led saveHistory ) )
    709 
    710 # vi:et:ts=3:sw=3