Annotation of 42BSD/ucb/lisp/pearl/history.l, revision 1.1

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:

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.