148 lines
5.2 KiB
Scheme
148 lines
5.2 KiB
Scheme
;;;
|
||
;;; Copyright (c) 1985 Massachusetts Institute of Technology
|
||
;;;
|
||
;;; This material was developed by the Scheme project at the
|
||
;;; Massachusetts Institute of Technology, Department of
|
||
;;; Electrical Engineering and Computer Science. Permission to
|
||
;;; copy this software, to redistribute it, and to use it for any
|
||
;;; purpose is granted, subject to the following restrictions and
|
||
;;; understandings.
|
||
;;;
|
||
;;; 1. Any copy made of this software must include this copyright
|
||
;;; notice in full.
|
||
;;;
|
||
;;; 2. Users of this software agree to make their best efforts (a)
|
||
;;; to return to the MIT Scheme project any improvements or
|
||
;;; extensions that they make, so that these may be included in
|
||
;;; future releases; and (b) to inform MIT of noteworthy uses of
|
||
;;; this software.
|
||
;;;
|
||
;;; 3. All materials developed as a consequence of the use of
|
||
;;; this software shall duly acknowledge such use, in accordance
|
||
;;; with the usual standards of acknowledging credit in academic
|
||
;;; research.
|
||
;;;
|
||
;;; 4. MIT has made no warrantee or representation that the
|
||
;;; operation of this software will be error-free, and MIT is
|
||
;;; under no obligation to provide any services, by way of
|
||
;;; maintenance, update, or otherwise.
|
||
;;;
|
||
;;; 5. In conjunction with products arising from the use of this
|
||
;;; material, there shall be no use of the name of the
|
||
;;; Massachusetts Institute of Technology nor of any adaptation
|
||
;;; thereof in any advertising, promotional, or sales literature
|
||
;;; without prior written consent from MIT in each case.
|
||
;;;
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;;;
|
||
;;; Modified by Texas Instruments Inc 8/15/85
|
||
;;;
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
||
;;; modeline messages
|
||
;012345678901234567890123456789012345678901234567890123456789012345678901234567
|
||
;PCS Edwin VVVVVVVVVV Filename for the rest of the line
|
||
; cols 78 and 79 are reserved for the modified stars
|
||
(begin
|
||
(define-integrable name-position 4)
|
||
(define-integrable version-position 11)
|
||
(define-integrable version-length 6)
|
||
(define-integrable mode-position 19)
|
||
(define-integrable file-name-position 35)
|
||
(define-integrable file-name-length 31)
|
||
(define-integrable modified-position 0)
|
||
(define-integrable buffer-position 17)
|
||
)
|
||
|
||
(define reset-modeline-window #!false)
|
||
(define window-modeline-event! #!false)
|
||
(define update-modeline! #!false)
|
||
|
||
(letrec
|
||
((file-name #!false)
|
||
(file-name-changed #!false)
|
||
(version Edwin-Version)
|
||
(modified #!false)
|
||
(modified-changed #!false)
|
||
(mode-changed #!false)
|
||
(mode-scheme? #!true)
|
||
(position-cursor
|
||
(lambda (pos)
|
||
(%reify-port! modeline-screen screen:cursor-x pos)))
|
||
(string-upcase
|
||
(lambda (string)
|
||
(and string
|
||
(let loop ((string1 (make-string (string-length string) #\space))
|
||
(index 0) (end (string-length string)))
|
||
(if (< index end)
|
||
(begin
|
||
(string-set! string1 index
|
||
(char-upcase (string-ref string index)))
|
||
(loop string1 (1+ index) end))
|
||
string1)))))
|
||
(write-modified (lambda ()
|
||
(set! modified-changed #!false)
|
||
(position-cursor modified-position)
|
||
(princ (if modified "**" " ") modeline-screen)))
|
||
(write-mode (lambda ()
|
||
(set! mode-changed #!false)
|
||
(position-cursor mode-position)
|
||
(princ (if mode-scheme? " [Scheme] "
|
||
" [Fundamental] ")
|
||
modeline-screen)))
|
||
(write-file-name (lambda ()
|
||
(set! file-name-changed #!false)
|
||
(clear-subscreen! modeline-screen
|
||
file-name-position 0 0
|
||
file-name-length)
|
||
(position-cursor file-name-position)
|
||
(if file-name (princ file-name modeline-screen)))))
|
||
|
||
(set! reset-modeline-window
|
||
(lambda ()
|
||
(let ((buffer (current-buffer)))
|
||
(set! modified (buffer-modified? buffer))
|
||
(set! modified-changed #!true)
|
||
(set! file-name (string-upcase (buffer-pathname buffer)))
|
||
(set! file-name-changed #!true)
|
||
(set! mode-scheme? *current-mode-scheme?*)
|
||
(set! mode-changed #!true)
|
||
(%clear-window modeline-screen)
|
||
(%reify-port! modeline-screen screen:cursor-y 0)
|
||
(position-cursor name-position)
|
||
(princ "Edwin" modeline-screen)
|
||
(position-cursor version-position)
|
||
(princ version modeline-screen)
|
||
;;; (position-cursor buffer-position)
|
||
;;; (princ " Buffer : Main " modeline-screen)
|
||
(update-modeline!))))
|
||
|
||
(set! window-modeline-event!
|
||
(lambda (window event)
|
||
(let ((buffer (current-buffer)))
|
||
(cond ((eq? event 'buffer-modified)
|
||
(let ((buffer-modified (buffer-modified? buffer)))
|
||
(if (not (eq? buffer-modified modified))
|
||
(set! modified-changed #!true))
|
||
(set! modified buffer-modified)))
|
||
((eq? event 'buffer-pathname)
|
||
(set! file-name-changed #!true)
|
||
(set! file-name (string-upcase (buffer-pathname buffer))))
|
||
((eq? event 'mode-changed)
|
||
(set! mode-scheme? *current-mode-scheme?*)
|
||
(set! mode-changed #!true))
|
||
(else #!false)))))
|
||
|
||
|
||
(set! update-modeline!
|
||
(lambda ()
|
||
(if modified-changed (write-modified))
|
||
(if file-name-changed (write-file-name))
|
||
(if mode-changed (write-mode)))))
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|