|
|
1.1 ! root 1: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; history.l ;;;;;;;;;;;;;;;;;;;;;;;;;;; ! 2: ; Functions for adding a command to the command history, printing ! 3: ; the command history, processing aliased atoms and handling ! 4: ; the history-invoking splice macros ! and $. ! 5: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ! 6: ; Copyright (c) 1983 , The Regents of the University of California. ! 7: ; All rights reserved. ! 8: ; Authors: Joseph Faletti and Michael Deering. ! 9: ! 10: ; Given two lists of atoms, determine if the first is a prefix of the second. ! 11: (de prefix (item1 item2) ! 12: (prog () ! 13: prefixloop ! 14: (cond ((null item1) (return t)) ; item1 ran out first: succeed. ! 15: ((null item2) (return nil)) ; item2 ran out first: fail. ! 16: ((neq (car item1) (car item2)) ; no match: fail. ! 17: (return nil)) ! 18: ; Otherwise, try next atoms. ! 19: ( t (setq item1 (cdr item1)) ! 20: (setq item2 (cdr item2)) ! 21: (go prefixloop))))) ! 22: ! 23: ; Add the LINE to the *history* hunk in the *historynumber* spot, ! 24: ; after possibly replacing it with its alias (for atoms) saved ! 25: ; on the property list under the ALIAS property. ! 26: (de addhistory (line) ! 27: (let (alias) ! 28: ; Replace with alias if there is one. ! 29: (and *usealiases* ! 30: (litatom line) ! 31: (setq alias (get line 'alias)) ! 32: (setq line alias)) ! 33: ! 34: ; Store in the command history table. ! 35: (setq *historynumber* (1+ *historynumber*)) ! 36: (rplacx (\\ *historynumber* *historysize*) ! 37: *history* ! 38: (copy line)) ; To eliminate macroexpansions. ! 39: ! 40: ; If it has been changed by read macros, print it out again. ! 41: (cond (*readlinechanged* ! 42: (pearlprintfn line) ! 43: (terpri))) ! 44: line)) ! 45: ! 46: ; Print the command history. Optional argument determines how ! 47: ; many commands get printed, otherwise, the whole history. ! 48: (de history narg ! 49: (cond ((\=& 0 narg) ! 50: (cond ((ge *historynumber* *historysize*) ! 51: (for command (1+ (- *historynumber* *historysize*)) ! 52: *historynumber* ! 53: (msg t command ": " ! 54: (cxr (\\ command *historysize*) ! 55: *history*)))) ! 56: ( t (for command 0 *historynumber* ! 57: (msg t command ": " (cxr command *history*)))))) ! 58: ( t ! 59: (cond ((ge *historynumber* (arg 1)) ! 60: (for command (1+ (- *historynumber* (arg 1))) ! 61: *historynumber* ! 62: (msg t command ": " ! 63: (cxr (\\ command *historysize*) ! 64: *history*)))) ! 65: ( t (for command 0 *historynumber* ! 66: (msg t command ": " (cxr command *history*))))))) ! 67: '*invisible*) ! 68: ! 69: ; Look for a command with the next atom as a prefix and return the command. ! 70: (de prefixcommandhistory () ! 71: (let* ((wanted (read)) ! 72: (wanthead (explode wanted)) ! 73: (commandnum *historynumber*) ! 74: (stoppingcommand (cond ((ge *historynumber* *historysize*) ! 75: (- *historynumber* *historysize*)) ! 76: ( t -1.))) ! 77: commandhead) ! 78: (setq *readlinechanged* t) ! 79: (while (and (>& commandnum stoppingcommand) ! 80: (not (prefix wanthead ! 81: (prog2 (setq commandhead ! 82: (cxr (\\ commandnum ! 83: *historysize*) ! 84: *history*)) ! 85: (setq commandhead ! 86: (explode ! 87: (cond ((atom commandhead) ! 88: commandhead) ! 89: ( t (car commandhead))))) ! 90: )))) ! 91: (setq commandnum (1- commandnum))) ! 92: ! 93: (cond ((>& commandnum stoppingcommand) ! 94: (ncons (cxr (\\ commandnum *historysize*) ! 95: *history*))) ! 96: ( t (ncons (concat '\! wanted)))))) ! 97: ! 98: ; History command invoker. ! 99: (dsm \! ! 100: (lambda () ! 101: (let ! 102: (num whole) ! 103: (selectq (tyipeek) ! 104: (33. (readc) ; !! ! 105: (setq *readlinechanged* t) ! 106: (ncons (cxr (\\ *historynumber* *historysize*) ! 107: *history*))) ! 108: (58. (readc) (setq num (read)) ; !: ! 109: (setq *readlinechanged* t) ! 110: (setq whole (cxr (\\ *historynumber* *historysize*) ! 111: *history*)) ! 112: (cond ((atom whole) (ncons whole)) ! 113: ( t (ncons (nth num whole))))) ! 114: (94. (readc) ; !^ ! 115: (setq *readlinechanged* t) ! 116: (setq whole (cxr (\\ *historynumber* *historysize*) ! 117: *history*)) ! 118: (cond ((atom whole) (ncons whole)) ! 119: ( t (ncons (cadr whole))))) ! 120: (42. (readc) ; !* ! 121: (setq *readlinechanged* t) ! 122: (setq whole (cxr (\\ *historynumber* *historysize*) ! 123: *history*)) ! 124: (cond ((atom whole) (ncons whole)) ! 125: ( t (cdr whole)))) ! 126: (36. (readc) ; !$ ! 127: (setq *readlinechanged* t) ! 128: (setq whole (cxr (\\ *historynumber* *historysize*) ! 129: *history*)) ! 130: (cond ((atom whole) (ncons whole)) ! 131: ( t (ncons (last whole))))) ! 132: (9. (ncons '\!)) ; !Tab ! 133: (10. (ncons '\!)) ; !LF ! 134: (13. (ncons '\!)) ; !CR ! 135: (32. (ncons '\!)) ; !Blank ! 136: (41. (ncons '\!)) ; !rpar ! 137: ((48. 49. 50. 51. 52. 53. 54. 55. 56. 57.) ; !Number ! 138: (setq *readlinechanged* t) ! 139: (setq num (read)) ! 140: (ncons (cxr (\\ num *historysize*) ! 141: *history*))) ! 142: (otherwise (prefixcommandhistory))) ; !Prefix ! 143: ))) ! 144: ! 145: ; Look for a command with the next atom as a prefix and return its value. ! 146: (de prefixcommandvalue () ! 147: (let* ((wanted (read)) ! 148: (wanthead (explode wanted)) ! 149: (commandnum *historynumber*) ! 150: (stoppingcommand (cond ((ge *historynumber* *historysize*) ! 151: (- *historynumber* *historysize*)) ! 152: ( t -1.))) ! 153: commandhead) ! 154: (setq *readlinechanged* t) ! 155: (while (and (>& commandnum stoppingcommand) ! 156: (not (prefix wanthead ! 157: (prog2 (setq commandhead ! 158: (cxr (\\ commandnum ! 159: *historysize*) ! 160: *histval*)) ! 161: (setq commandhead ! 162: (explode ! 163: (cond ((atom commandhead) ! 164: commandhead) ! 165: ( t (car commandhead))))) ! 166: )))) ! 167: (setq commandnum (1- commandnum))) ! 168: ! 169: (cond ((>& commandnum stoppingcommand) ! 170: (cxr (\\ commandnum *historysize*) ! 171: *histval*)) ! 172: ( t (concat '\$ wanted))))) ! 173: ! 174: ; History command result invoker. ! 175: (dsm \$ ! 176: (lambda () ! 177: (let ! 178: (num whole) ! 179: (ncons ! 180: (selectq (tyipeek) ! 181: (36. (readc) ; $$ ! 182: (setq *readlinechanged* t) ! 183: (list 'quote ! 184: (cxr (\\ *historynumber* *historysize*) ! 185: *histval*))) ! 186: (9. '\$) ; $Tab ! 187: (10. '\$) ; $LF ! 188: (13. '\$) ; $CR ! 189: (32. '\$) ; $Blank ! 190: (41. '\$) ; !rpar ! 191: ((48. 49. 50. 51. 52. 53. 54. 55. 56. 57.) ; $Number ! 192: (setq *readlinechanged* t) ! 193: (setq num (read)) ! 194: (list 'quote (cxr (\\ num *historysize*) ! 195: *histval*))) ! 196: (otherwise ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; $Prefix ! 197: (list 'quote (prefixcommandvalue)))))))) ! 198: ! 199: ; vi: set lisp:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.