led.l (12611B)
1 # 16jul13abu 2 # (c) Software Lab. Alexander Burger 3 4 # Line editor 5 # vi-mode, just a subset: 6 # - Only single-key commands 7 # - No repeat count 8 9 (mapc undef 10 '(*Led fkey revise) ) 11 12 (setq 13 "Line" NIL # Holds current input line 14 "LPos" 1 # Position in line (1 .. length) 15 "HPos" 1 # Position in history 16 "UndoLine" NIL # Undo 17 "UndoPos" 0 18 "Line1" NIL # Initial line 19 "Insert" T # Insert mode flag 20 "FKey" NIL # Function key bindings 21 "Clip" NIL # Cut/Copy/Paste buffer 22 "Item" NIL # Item to find 23 "Found" NIL # Find stack 24 "Complete" NIL # Input completion 25 26 "HistMax" 1000 # History limit 27 28 *History # History of input lines 29 (in (pack "+" (pil "history")) 30 (ctl NIL 31 (make (until (eof) (link (line T)))) ) ) 32 "Hist0" *History ) 33 34 35 # Basic editing routine 36 (de chgLine (L N) 37 (let (D (length "Line") Tsm) 38 (for (P (dec "LPos") (>= P 1) (dec P)) # To start of old line 39 (unless 40 (and 41 *Tsm 42 (= "\"" (get "Line" P)) 43 (skipQ "LPos" P "Line") ) 44 (prin "^H") ) ) 45 (for (P . C) (setq "Line" L) # Output new line 46 (cond 47 ((> " " C) 48 (dec 'D) 49 (prin "_") ) 50 ((or (not *Tsm) (<> "\"" C) (escQ P L)) 51 (dec 'D) 52 (prin C) ) 53 (T 54 (prin 55 (and Tsm (cdr *Tsm)) 56 (unless (skipQ N P L) 57 (dec 'D) 58 C ) 59 (and (onOff Tsm) (car *Tsm)) ) ) ) ) 60 (and Tsm (prin (cdr *Tsm))) 61 (space D) # Clear rest of old line 62 (do D (prin "^H")) 63 (setq "LPos" (inc (length L))) 64 (until (= N "LPos") # To new position 65 (unless 66 (and 67 *Tsm 68 (= "\"" (get "Line" "LPos")) 69 (skipQ N "LPos" "Line") ) 70 (prin "^H") ) 71 (dec '"LPos") ) ) 72 (flush) ) 73 74 # Skipped double quote 75 (de skipQ (N P L) 76 (nor 77 (>= (inc N) P (dec N)) 78 (= "\"" (get L (dec P))) 79 (= "\"" (get L (inc P))) 80 (escQ P L) ) ) 81 82 # Escaped double quote 83 (de escQ () 84 (let Esc NIL 85 (for I (dec P) 86 ((if (= "\\" (get L I)) onOff off) Esc) ) ) ) 87 88 # Check for delimiter 89 (de delim? (C) 90 (member C '`(chop '" ^I^J^M\"'()[]`~")) ) 91 92 # Move left 93 (de lMove () 94 (chgLine "Line" (max 1 (dec "LPos"))) ) 95 96 # Move to beginning 97 (de bMove () 98 (chgLine "Line" 1) ) 99 100 # Move right 101 (de rMove (F) 102 (chgLine "Line" 103 (min 104 (inc "LPos") 105 (if F 106 (inc (length "Line")) 107 (length "Line") ) ) ) ) 108 109 # Move to end of line 110 (de eMove () 111 (chgLine "Line" (length "Line")) ) 112 113 # Move beyond end of line 114 (de xMove () 115 (chgLine "Line" (inc (length "Line"))) ) 116 117 # Move up 118 (de uMove () 119 (when (< "HPos" (length *History)) 120 (setHist (inc "HPos")) ) ) 121 122 # Move down 123 (de dMove () 124 (unless (=0 "HPos") 125 (setHist (dec "HPos")) ) ) 126 127 # Move word left 128 (de lWord () 129 (use (N L) 130 (chgLine "Line" 131 (if (>= 1 (setq N "LPos")) 132 1 133 (loop 134 (T (= 1 (dec 'N)) 1) 135 (setq L (nth "Line" (dec N))) 136 (T (and (delim? (car L)) (not (delim? (cadr L)))) 137 N ) ) ) ) ) ) 138 139 # Move word right 140 (de rWord () 141 (use (M N L) 142 (setq M (length "Line")) 143 (chgLine "Line" 144 (if (<= M (setq N "LPos")) 145 M 146 (loop 147 (T (= M (inc 'N)) M) 148 (setq L (nth "Line" (dec N))) 149 (T (and (delim? (car L)) (not (delim? (cadr L)))) 150 N ) ) ) ) ) ) 151 152 # Match left parenthesis 153 (de lPar () 154 (let (N 1 I (dec "LPos")) 155 (loop 156 (T (=0 I)) 157 (case (get "Line" I) 158 (")" (inc 'N)) 159 ("(" (dec 'N)) ) 160 (T (=0 N) (chgLine "Line" I)) 161 (dec 'I) ) ) ) 162 163 # Match right parenthesis 164 (de rPar () 165 (let (N 1 I (inc "LPos")) 166 (loop 167 (T (> I (length "Line"))) 168 (case (get "Line" I) 169 ("(" (inc 'N)) 170 (")" (dec 'N)) ) 171 (T (=0 N) (chgLine "Line" I)) 172 (inc 'I) ) ) ) 173 174 # Clear to end of line 175 (de clrEol () 176 (let N (dec "LPos") 177 (if (=0 N) 178 (chgLine NIL 1) 179 (chgLine (head N "Line") N) ) ) ) 180 181 # Insert a char 182 (de insChar (C) 183 (chgLine (insert "LPos" "Line" C) (inc "LPos")) ) 184 185 (de del1 (L) 186 (ifn (nth L "LPos") 187 L 188 (setq "Clip" (append "Clip" (list (get L "LPos")))) 189 (remove "LPos" L) ) ) 190 191 # Delete a char 192 (de delChar () 193 (use L 194 (off "Clip") 195 (chgLine 196 (setq L (del1 "Line")) 197 (max 1 (min "LPos" (length L))) ) ) ) 198 199 # Delete a word (F: with trailing blank) 200 (de delWord (F) 201 (let L "Line" 202 (off "Clip") 203 (ifn (= "(" (get L "LPos")) 204 (while (and (nth L "LPos") (not (delim? (get L "LPos")))) 205 (setq L (del1 L)) ) 206 (for (N 1 (and (setq L (del1 L)) (< 0 N))) 207 (case (get L "LPos") 208 ("(" (inc 'N)) 209 (")" (dec 'N)) ) ) ) 210 (and 211 F 212 (sp? (get L "LPos")) 213 (setq L (del1 L)) ) 214 (chgLine L (max 1 (min "LPos" (length L)))) ) ) 215 216 # Replace char 217 (de rplChar (C) 218 (chgLine 219 (insert "LPos" (remove "LPos" "Line") C) 220 "LPos" ) ) 221 222 # Undo mechanism 223 (de doUndo () 224 (setq "UndoLine" "Line" "UndoPos" "LPos") ) 225 226 # Paste clip 227 (de doPaste () 228 (if (= 1 "LPos") 229 (chgLine (append "Clip" "Line") 1) 230 (chgLine 231 (append 232 (head (dec "LPos") "Line") 233 "Clip" 234 (nth "Line" "LPos") ) 235 (+ "LPos" (length "Clip") -1) ) ) ) 236 237 # Set history line 238 (de setHist (N) 239 (chgLine 240 (if (=0 (setq "HPos" N)) 241 "Line1" 242 (chop (get *History "HPos")) ) 243 1 ) ) 244 245 # Searching 246 (de ledSearch (L) 247 (let (H (nth *History (inc "HPos")) S (find '((X) (match "Item" (chop X))) H)) 248 (chgLine 249 (ifn S 250 (prog (beep) L) 251 (push '"Found" "HPos") 252 (inc '"HPos" (index S H)) 253 (chop S) ) 254 1 ) ) ) 255 256 # TAB expansion 257 (de expandTab () 258 (let ("L" (head (dec "LPos") "Line") "S" "L") 259 (while (find "skipFun" "S") 260 (pop '"S") ) 261 (ifn "S" 262 (prog 263 (off "Complete") 264 (do 3 (insChar " ")) ) 265 (ifn 266 (default "Complete" 267 (let "N" (inc (length "S")) 268 (mapcar 269 '((X) 270 (setq X 271 (nth 272 (mapcan 273 '((C) 274 (if (or (= "\\" C) (delim? C)) 275 (list "\\" C) 276 (cons C) ) ) 277 (chop X) ) 278 "N" ) ) 279 (cons 280 (+ "LPos" (length X)) 281 (append "L" X (nth "Line" "LPos")) ) ) 282 ("tabFun" (pack "S")) ) ) ) 283 (beep) 284 (chgLine (cdar "Complete") (caar "Complete")) 285 (rot "Complete") ) ) ) ) 286 287 # Insert mode 288 (de insMode ("C") 289 (if (= "C" "^I") 290 (expandTab) 291 (off "Complete") 292 (case "C" 293 (("^H" "^?") 294 (when (> "LPos" 1) 295 (chgLine (remove (dec "LPos") "Line") (dec "LPos")) ) ) 296 ("^V" (insChar (key))) 297 ("^E" (and edit (edit '*History))) 298 ("^[" 299 (loop 300 (NIL 301 (make 302 (while (and (setq "C" (key 40)) (<> "C" "^[")) 303 (link "C") ) ) 304 (off "Insert") 305 (lMove) ) 306 (when (assoc (pack "^[" @) "FKey") 307 (let *Dbg "*Dbg" (run (cdr @))) ) 308 (NIL "C") ) ) 309 (T 310 (if (assoc "C" "FKey") 311 (let *Dbg "*Dbg" (run (cdr @))) 312 (when (= "C" ")") 313 (chgLine "Line" (prog1 "LPos" (lPar) (wait 200))) ) 314 (insChar "C") ) ) ) ) ) 315 316 # Command mode 317 (de cmdMode ("C") 318 (case "C" 319 ("g" (prinl) (println "Clip")) 320 ("$" (eMove)) 321 ("%" 322 (case (get "Line" "LPos") 323 (")" (lPar)) 324 ("(" (rPar)) 325 (T (beep)) ) ) 326 ("/" 327 (let "L" "Line" 328 (_getLine '("/") '((C) (= C "/"))) 329 (unless (=T "Line") 330 (setq "Item" (append '(@) (cdr "Line") '(@))) 331 (ledSearch "L") 332 (off "Insert") ) ) ) 333 ("0" (bMove)) 334 ("A" (doUndo) (xMove) (on "Insert")) 335 ("a" (doUndo) ((if (= "LPos" (length "Line")) xMove rMove)) (on "Insert")) 336 ("b" (lWord)) 337 ("c" (doUndo) (delWord NIL) (on "Insert")) 338 ("C" (doUndo) (clrEol) (xMove) (on "Insert")) 339 ("d" (doUndo) (delWord T)) 340 ("D" (doUndo) (clrEol)) 341 ("f" 342 (ifn (setq "C" (index (key) (nth "Line" (inc "LPos")))) 343 (beep) 344 (chgLine "Line" (+ "C" "LPos")) ) ) 345 ("h" (lMove)) 346 ("i" (doUndo) (on "Insert")) 347 ("I" (doUndo) (bMove) (on "Insert")) 348 ("j" (dMove)) 349 ("k" (uMove)) 350 ("l" (rMove)) 351 ("n" (ledSearch "Line")) 352 ("N" (if "Found" (setHist (pop '"Found")) (beep))) 353 ("p" (doUndo) ((if (= "LPos" (length "Line")) xMove rMove)) (doPaste)) 354 ("P" (doUndo) (doPaste)) 355 ("r" (ifn "Line" (beep) (doUndo) (rplChar (key)))) 356 ("s" (doUndo) (delChar) (on "Insert")) 357 ("S" (doUndo) (chgLine NIL 1) (on "Insert")) 358 ("U" (setHist "HPos")) 359 ("u" 360 (let ("L" "Line" "P" "LPos") 361 (chgLine "UndoLine" "UndoPos") 362 (setq "UndoLine" "L" "UndoPos" "P") ) ) 363 ("w" (rWord)) 364 ("x" (doUndo) (delChar)) 365 ("X" (lMove) (doUndo) (delChar)) 366 ("~" 367 (doUndo) 368 (rplChar 369 ((if (low? (setq "C" (get "Line" "LPos"))) uppc lowc) "C") ) 370 (rMove) ) 371 (T (beep)) ) ) 372 373 # Get a line from console 374 (de _getLine ("L" "skipFun") 375 (use "C" 376 (chgLine "L" (inc (length "L"))) 377 (on "Insert") 378 (until (member (setq "C" (let *Dbg "*Dbg" (key))) '("^J" "^M")) 379 (case "C" 380 (NIL (bye)) 381 ("^D" (prinl) (bye)) 382 ("^X" (prin (cdr *Tsm)) (prinl) (quit)) ) 383 ((if "Insert" insMode cmdMode) "C") ) 384 (eMove) ) ) 385 386 # Function keys 387 (de fkey (Key . Prg) 388 (setq "FKey" 389 (cond 390 ((not Key) "FKey") 391 ((not Prg) (delete (assoc Key "FKey") "FKey")) 392 ((assoc Key "FKey") 393 (cons (cons Key Prg) (delete @ "FKey")) ) 394 (T (cons (cons Key Prg) "FKey")) ) ) ) 395 396 (when (sys "TERM") 397 (fkey "^[[A" (uMove) (xMove)) 398 (fkey "^[[B" (dMove) (xMove)) 399 (fkey "^[[C" (rMove T)) 400 (fkey "^[[D" (lMove)) ) 401 402 # Main editing functions 403 (de _led ("Line1" "tabFun" "skipFun") 404 (default "tabFun" 405 '((S) 406 (conc 407 (filter '((X) (pre? S X)) (all)) 408 (let P (rot (split (chop S) "/")) 409 (setq 410 S (pack (car P)) 411 P (and (cdr P) (pack (glue "/" @) "/")) ) 412 (extract '((X) (and (pre? S X) (pack P X))) 413 (dir P T) ) ) ) ) ) 414 (setq "LPos" 1 "HPos" 0) 415 (_getLine "Line1" (or "skipFun" delim?)) 416 (prinl (cdr *Tsm)) ) 417 418 (de revise ("X" "tabFun" "skipFun") 419 (let ("*Dbg" *Dbg *Dbg NIL) 420 (_led (chop "X") "tabFun" "skipFun") 421 (pack "Line") ) ) 422 423 (de saveHistory () 424 (in (pack "+" (pil "history")) 425 (ctl T 426 (let (Old (make (until (eof) (link (line T)))) New *History N "HistMax") 427 (out (pil "history") 428 (while (and New (n== New "Hist0")) 429 (prinl (pop 'New)) 430 (dec 'N) ) 431 (setq "Hist0" *History) 432 (do N 433 (NIL Old) 434 (prinl (pop 'Old)) ) ) ) ) ) ) 435 436 # Enable line editing 437 (de *Led 438 (let ("*Dbg" *Dbg *Dbg NIL) 439 (push1 '*Bye '(saveHistory)) 440 (push1 '*Fork '(del '(saveHistory) '*Bye)) 441 (_led) 442 (let L (pack "Line") 443 (or 444 (>= 3 (length "Line")) 445 (sp? (car "Line")) 446 (= L (car *History)) 447 (push '*History L) ) 448 (and (nth *History "HistMax") (con @)) 449 L ) ) ) 450 451 (mapc zap 452 (quote 453 chgLine skipQ escQ delim? lMove bMove rMove eMove xMove uMove dMove lWord 454 rWord lPar rPar clrEol insChar del1 delChar delWord rplChar doUndo doPaste 455 setHist ledSearch expandTab insMode cmdMode _getLine _led saveHistory ) ) 456 457 # vi:et:ts=3:sw=3