;;; -*- Mode:Lisp; Readtable:T; Package:USER; Base:10; Patch-File:T -*- ;;; Private patches made by NICK ;;; Reason: ;;; ;;; Reason: ;;; Added some additonal logic to :add-new-line that checks for sharpsign substitutions and conditionals. ;;; Reason: ;;; I.e. 'The #=*system-or-select* key is #+LMI blue. #+(or Symbolics TI) beige.' ;;; Written 5-Apr-86 19:04:42 by NICK, ;;; while running on Larry from band 2 ;;; with System 102.160, Local-File 56.11, FILE-Server 13.2, Unix-Interface 5.6, MagTape 40.22, ZMail 57.10, Tiger 20.6, KERMIT 26.20, MEDIUM-RESOLUTION-COLOR 17.4, Experimental Sited 1.0, Experimental window-maker 1.0, Experimental VERIFY 2.1, Experimental RPG-BENCHMARKS 1.0, DOE-Macsyma 9.9, Macsyma-Help-Database 1.1, microcode 783, 3X3 UCLA Show Band and Demo Software by Gary and Sarah and Dick. ; From file NEWVIEW.LISP#> CT-ADA.BROWSER; DJ: (7) #10R USER#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "USER"))) (COMPILER#:PATCH-SOURCE-FILE "CT: BROWSER; NEWVIEW  " (defmethod (viewing_frame :add-new-line) (string &aux (l (string-length string)) (xstring string) (line-array (make-array 10. ':type art-fat-string ':leader-list (list 0)))) (loop with i = 0 with font = curr-font until (>= i l) do (cond ((and (= (aref xstring i) 6.) ;If font change char. (not (= i l))) ;& not @ eol. (setq font (- (aref xstring (1+ i)) #/0) ;update font i (1+ i))) ;; ;; ;logic added by NICK 4/86 ((= (aref xstring i) #\#) ;if it's a sharpsign (cond ((= (aref xstring (1+ i)) #\=) ; and the next char is an = (sharp-substitute (locf xstring) i (locf l))) ; expand sharpsign substitutions ((or (= (aref xstring (1+ i)) #\+) ; and the next char is a + or (= (aref xstring (1+ i)) #\-)) ; a - (just for safety) (sharp-conditional (locf xstring) i (locf l))) ; expand sharpsign conditionals (t (array-push-extend ; else keep char. line-array (dpb font %%ch-font (aref xstring i)))))) ;; ;; ;end of additions by NICK (t (array-push-extend ;else keep char. line-array (dpb font %%ch-font (aref xstring i))))) (setf i (1+ i)) finally (setq curr-font font)) ;update current font ;for next time (array-push-extend line-arrays line-array)) ;Add new line. )) ; From file NEWVIEW.LISP#> CT-ADA.BROWSER; DJ: (7) #10R USER#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "USER"))) (COMPILER#:PATCH-SOURCE-FILE "CT: BROWSER; NEWVIEW  " (defun sharp-conditional (*string index *length &aux insert next begin (string (#+(or LMI TI) contents #+Symbolics location-contents *string)) (length (#+(or LMI TI) contents #+Symbolics location-contents *length))) "Expands sharpsign conditionalization macros. Index points to the sharpsign, which must be followed by a + or a -. Passes the string to READ to expand the macro. Then we destructively modify the input string to replace it with the (suitably lowercased) value returned from READ. Destructively modifies the length of the string as well. * * * Disclaimer This is not intended to be a generalized or generalizable facility. It will deal with simple things like 'The #=*system-or-select* key is #-LMI beige. #+LMI blue.' and 'The shift, hyper, and meta keys are #+LMI blue #+(or Symbolics TI) beige with #-Symbolics black #+Symbolics white lettering.' (note positions of the periods) Don't push it. (read gets upset by periods alone) (see also the functions sharp-substitute and sharp-test)" ;; p.s. I wouldn't have written it this way, but ... (multiple-value-setq (insert next) (read-from-string string nil index length)) (if insert (setf insert (format nil "~a" insert)) (setf insert "")) ;make the new thing a string (if (lower-case-p (aref string (setf begin (1+ (string-reverse-search " " string (1- next) index))))) (setf insert (string-downcase insert)) ;if first char is lower, make whole thing lower (when (lower-case-p (aref string (1+ begin))) ;if second char is lower, lower rest of string (setf insert (string-downcase insert :start 1)))) (setf (#+(or LMI TI) contents #+Symbolics location-contents *string) (string-append (substring string 0 (1+ index)) ;graft the insert into the original string insert)) ; (1+ to co-exist w/earlier code.) (when (> (string-length (setf insert (substring string next length))) 0) (setf (#+(or LMI TI) contents #+Symbolics location-contents *string) (string-append (#+(or LMI TI) contents #+Symbolics location-contents *string) " " insert))) (setf (#+(or LMI TI) contents #+Symbolics location-contents *length) (string-length (#+(or LMI TI) contents #+Symbolics location-contents *string)))) ;so looping will proceed normally )) ; From file NEWVIEW.LISP#> CT-ADA.BROWSER; DJ: (7) #10R USER#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "USER"))) (COMPILER#:PATCH-SOURCE-FILE "CT: BROWSER; NEWVIEW  " (defun conditional-test (string) "Function to test sharp-conditional. Invokes it almost the same way that :add-new-line would." (let ((len (string-length string)) (xtra string)) (sharp-conditional (locf xtra) (string-search "#" string) (locf len)) xtra)) (defun substitute-test (string) "Function to test sharp-substitute. Invokes it almost the same way that :add-new-line would." (let ((len (string-length string)) (xtra string)) (sharp-substitute (locf xtra) (string-search "#" string) (locf len)) xtra)) )) ; From file NEWVIEW.LISP#> CT-ADA.BROWSER; DJ: (7) #10R USER#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "USER"))) (COMPILER#:PATCH-SOURCE-FILE "CT: BROWSER; NEWVIEW  " (defun sharp-test (string &aux next) "Repeatedly calls conditional-test or substitute-test until there are no more #'s. Use this to see if a given string with sharpsign conditionalizations will parse correctly. The sections in sharp-substitute and sharp-conditional that refer to (1+ index) will need to be modified to read simply 'index', since :add-new-line does some things differently." (format t "~& -~a-~%" string) (loop while (setq next (string-search "#" string)) doing (if (= (aref string (1+ next)) #\=) (format t "~& -~a-~%" (setq string (substitute-test string)))) (format t "~& -~a-~%" (setq string (conditional-test string))))) )) ; From file NEWVIEW.LISP#> CT-ADA.BROWSER; DJ: (7) #10R USER#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "USER"))) (COMPILER#:PATCH-SOURCE-FILE "CT: BROWSER; NEWVIEW  " (defvar *system-or-select* #+Symbolics "SELECT" #+(or LMI TI) "SYSTEM") (defvar *refresh-or-clear-screen* #+Symbolics "REFRESH" #+(or LMI TI) "CLEAR-SCREEN") (defvar *function-or-terminal* #+Symbolics "FUNCTION" #+LMI "TERMINAL" #+TI "TERM") (defun sharp-substitute (*string index *length &aux next (string (#+(or LMI TI) contents #+Symbolics location-contents *string))) "Expands sharpsign substitutes. Defined substitutions are defvared above. An example: 'The #+*system-or-select* key is ...' will be expanded into 'The SYSTEM key ...' on an LMI or TI and to 'The SELECT key ...' on a Symbolics. (see also the functions sharp-conditional and sharp-test)" (setf (#+(or LMI TI) contents #+Symbolics location-contents *string) ;graft the insert onto the earlier string (string-append (substring string 0 (1+ index)) ; (1+ to co-exist w/earlier code.) (symbol-value (read-from-string (substring string (+ index 2) (setf next (string-search " " string index))) nil)) (substring string next))) (setf (#+(or LMI TI) contents #+Symbolics location-contents *length) (string-length (#+(or LMI TI) contents #+Symbolics location-contents *string)))) ;so looping will proceed normally )) ; From file NEWVIEW.LISP#> CT-ADA.BROWSER; DJ: (7) #10R USER#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "USER"))) (COMPILER#:PATCH-SOURCE-FILE "CT: BROWSER; NEWVIEW  " (defun send-line-out (line stream) #+Symbolics (send stream :editor-line-out line stream) #+(or LMI TI) (loop with current-font = (window-current-font-number stream) for ch being the array-elements of line doing (let ((font (ldb (byte 8 8) ch)) (char (ldb (byte 8 0) ch))) (unless (or (> font 25) (= font current-font)) (setq current-font font) (send stream :set-current-font font)) (unless (= char 9. )(send stream :tyo char))))) ))