;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/basic.scm,v 1.100 1989/08/04 03:30:48 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/basic.scm,v 1.101 1989/08/07 08:44:14 cph Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
(editor-error "Trying to modify read only text."))
(define-variable debug-on-editor-error
- "If not false, signal Scheme error when an editor error occurs."
+ "True means signal Scheme error when an editor error occurs."
false)
+(define condition-type:editor-error
+ (make-error-type '()
+ (lambda (condition port)
+ (write-string "Editor error: " port)
+ (write-string (message-args->string (condition/irritants condition))
+ port))))
+
(define (editor-error . strings)
(if (ref-variable debug-on-editor-error)
- (error "editor error" (message-args->string strings))
+ (call-with-current-continuation
+ (lambda (continuation)
+ (debug-scheme-error
+ (make-condition condition-type:editor-error
+ strings
+ continuation))
+ (%editor-error)))
(begin
(if (not (null? strings)) (apply temporary-message strings))
- (editor-beep)
- (abort-current-command))))
+ (%editor-error))))
+
+(define (%editor-error)
+ (editor-beep)
+ (abort-current-command))
(define (editor-failure . strings)
(cond ((not (null? strings)) (apply temporary-message strings))
()
(lambda ()
(editor-abort *the-non-printing-object*)))
+
+(define-command save-buffers-kill-scheme
+ "Offer to save each buffer, then kill Scheme.
+With prefix arg, silently save all file-visiting buffers, then kill."
+ "P"
+ (lambda (no-confirmation?)
+ (save-some-buffers no-confirmation?)
+ (set! edwin-finalization
+ (lambda ()
+ (set! edwin-finalization false)
+ (%exit))) ((ref-command suspend-edwin))))
+
(define-command exit-recursive-edit
"Exit normally from a subsystem of a level of editing."
()
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/calias.scm,v 1.5 1989/04/28 22:48:15 cph Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/calias.scm,v 1.6 1989/08/07 08:44:17 cph Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
(else char))))
(define (unmap-alias-char char)
- (if (ascii-controlified? char)
+ (if (and (ascii-controlified? char) (even? (quotient (char-bits char) 2)))
(unmap-alias-char
(make-char (let ((code (char-code char)))
(+ code (if (<= #x01 code #x1A) #x60 #x40)))
(unmap-alias-char (car entry))
char))))
-(define (ascii-controlified? char)
- (and (even? (quotient (char-bits char) 2))
- (let ((code (char-code char)))
- (or (< code #x09)
- (= code #x0B)
- (if (< code #x1B)
- (< #x0D code)
- (and (< code #x20)
- (< #x1B code)))))))
+(define-integrable (ascii-controlified? char)
+ (< (char-code char) #x20))
+
(define-integrable (char-name char)
(char->name (unmap-alias-char char)))
\ No newline at end of file
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comred.scm,v 1.75 1989/08/03 01:31:16 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comred.scm,v 1.76 1989/08/07 08:44:21 cph Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
(reset-command-state!)
(let ((char (with-editor-interrupts-disabled keyboard-read-char)))
(set! *command-char* char)
+ (clear-message)
(set-command-prompt! (char-name char))
(let ((window (current-window)))
(%dispatch-on-command window
(reset-command-state!)
(%dispatch-on-command (current-window) command false))
-(define-integrable (read-and-dispatch-on-char) (dispatch-on-char (current-comtabs)
+(define (read-and-dispatch-on-char)
+ (dispatch-on-char (current-comtabs)
(with-editor-interrupts-disabled keyboard-read-char)))
(define (dispatch-on-char comtab char)
"comman"
"comred"
"curren"
- ;; "debug" "debuge"
+ "debug"
+ "debuge"
"dired" "editor"
"edtstr"
"evlcom"
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/dired.scm,v 1.103 1989/08/04 03:17:42 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/dired.scm,v 1.104 1989/08/07 08:44:35 cph Rel $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
(map pathname-name-string pathnames)))))))))
(define (read&sort-directory pathname)
- (or/dired-sort-pathnames (directory-read pathname false)))
\ No newline at end of file
+ (os/dired-sort-pathnames (directory-read pathname false)))
\ No newline at end of file
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/editor.scm,v 1.187 1989/04/28 22:49:21 cph Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/editor.scm,v 1.188 1989/08/07 08:44:38 cph Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
(declare (usual-integrations))
\f
-(define edwin-reset-args
- '())
-
(define (edwin)
(if (not edwin-editor)
(apply edwin-reset edwin-reset-args))
(call-with-current-continuation
(lambda (continuation)
- (bind-condition-handler
- '()
- (lambda (condition)
- (and (not (condition/internal? condition))
- (error? condition)
- (if (ref-variable debug-on-error)
- (begin
- (with-output-to-temporary-buffer "*Error*"
- (lambda ()
- (format-error-message (condition/message condition)
- (condition/irritants condition)
- (current-output-port))))
- (editor-error "Scheme error"))
- (within-continuation continuation
- (lambda ()
- (signal-error condition))))))
- (lambda ()
- (using-screen edwin-screen
- (lambda ()
- (with-editor-input-port edwin-input-port
+ (fluid-let ((editor-abort continuation)
+ (*auto-save-keystroke-count* 0))
+ (within-editor edwin-editor
+ (lambda ()
+ (using-screen edwin-screen
(lambda ()
- (with-editor-interrupts
- (lambda ()
- (within-editor edwin-editor
- (lambda ()
- (perform-buffer-initializations! (current-buffer))
- (dynamic-wind
- (lambda ()
- (update-screens! true))
- (lambda ()
- ;; Should this be in a dynamic wind? -- Jinx
- (if edwin-initialization (edwin-initialization))
- (let ((message (cmdl-message/null)))
- (push-cmdl (lambda (cmdl)
- cmdl ;ignore
- (top-level-command-reader)
- message)
- false
- message)))
- (lambda ()
- unspecific))))))))))
- ;; Should this be here or in a dynamic wind? -- Jinx
- (if edwin-finalization (edwin-finalization))))))
+ (with-editor-input-port edwin-input-port
+ (lambda ()
+ (with-editor-interrupts
+ (lambda ()
+ (bind-condition-handler '() internal-error-handler
+ (lambda ()
+ (perform-buffer-initializations! (current-buffer))
+ (dynamic-wind
+ (lambda () (update-screens! true))
+ (lambda ()
+ ;; Should this be in a dynamic wind? -- Jinx
+ (if edwin-initialization (edwin-initialization))
+ (let ((message (cmdl-message/null)))
+ (push-cmdl (lambda (cmdl)
+ cmdl ;ignore
+ (top-level-command-reader)
+ message)
+ false
+ message)))
+ (lambda () unspecific))))))))))))))) ;; Should this be here or in a dynamic wind? -- Jinx
+ (if edwin-finalization (edwin-finalization))
unspecific)
-(define-variable debug-on-error
- "*True means enter debugger if an error is signalled.
-Does not apply to editor errors."
- false)
+(define edwin-reset-args '())
+(define editor-abort)
;; Set this before entering the editor to get something done after the
;; editor's dynamic environment is initialized, but before the command
;; reset and then reenter the editor.
(define edwin-finalization false)
\f
-(define (within-editor editor thunk)
- (call-with-current-continuation
- (lambda (continuation)
- (fluid-let ((editor-continuation continuation)
- (recursive-edit-continuation false)
- (recursive-edit-level 0)
- (current-editor editor)
- (*auto-save-keystroke-count* 0))
- (thunk)))))
-
-(define editor-continuation)
-(define recursive-edit-continuation)
-(define recursive-edit-level)
-(define current-editor)
+;;;; Recursive Edit Levels
+(define (within-editor editor thunk)
+ (fluid-let ((current-editor editor)
+ (recursive-edit-continuation false)
+ (recursive-edit-level 0))
+ (thunk)))
(define (enter-recursive-edit)
(let ((value
(call-with-current-continuation
(recursive-edit-continuation value)
(editor-error "No recursive edit is in progress")))
-(define (editor-abort value)
- (editor-continuation value))
+(define recursive-edit-continuation)
+(define recursive-edit-level)
+(define current-editor)
+\f
+;;;; Internal Errors
-(define *^G-interrupt-continuations*
- '())
+(define (internal-error-handler condition)
+ (and (not (condition/internal? condition))
+ (error? condition)
+ (if (ref-variable debug-on-internal-error)
+ (begin
+ (debug-scheme-error condition)
+ (message "Scheme error")
+ (%editor-error))
+ (exit-editor-and-signal-error condition))))
+
+(define-variable debug-on-internal-error
+ "True means enter debugger if error is signalled while the editor is running.
+This does not affect editor errors or evaluation errors."
+ false)
+
+(define (exit-editor-and-signal-error condition)
+ (within-continuation editor-abort
+ (lambda ()
+ (signal-error condition))))
+
+;;;; C-g Interrupts
(define (^G-signal)
(let ((continuations *^G-interrupt-continuations*))
(thunk))))))
(if (eq? value signal-tag)
(interceptor)
- value))))
\ No newline at end of file
+ value))))
+
+(define *^G-interrupt-continuations*
+ '())
\ No newline at end of file
;;; -*-Scheme-*-
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.ldr,v 1.5 1989/08/07 08:44:42 cph Exp $
;;; program to load package contents
+;;; **** This program (unlike most .ldr files) is not generated by a program.
(declare (usual-integrations))
(load "basic" environment)
(load "bufcom" environment)
(load "bufmnu" (->environment '(EDWIN BUFFER-MENU)))
+ (load "debug" (->environment '(EDWIN DEBUGGER)))
(load "evlcom" environment)
(load "filcom" environment)
(load "fill" environment)
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.6 1989/08/03 01:34:32 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.7 1989/08/07 08:44:45 cph Exp $
Copyright (c) 1989 Massachusetts Institute of Technology
(define-package (edwin command-summary)
(files "keymap")
(parent (edwin)))
-#|
+
(define-package (edwin debugger)
(files "debug")
- (parent (edwin)))
-|#(define-package (edwin dired)
+ (parent (edwin))
+ (export (edwin)
+ debug-scheme-error)
+ (import (runtime debugger)
+ command/earlier-reduction
+ command/earlier-subproblem
+ command/frame
+ command/goto
+ command/later-reduction
+ command/later-subproblem
+ command/move-to-child-environment
+ command/move-to-parent-environment
+ command/print-environment-procedure
+ command/print-expression
+ command/print-reduction
+ command/print-reductions
+ command/return
+ command/show-all-frames
+ command/show-current-frame
+ command/summarize-history
+ dstate/environment-list
+ make-initial-dstate
+ show-error-info)
+ (import (runtime debugger-utilities)
+ hook/debugger-failure
+ hook/debugger-message
+ hook/presentation)
+ (import (runtime rep)
+ hook/prompt-for-confirmation
+ hook/prompt-for-expression))
+
+(define-package (edwin dired)
(files "dired")
(parent (edwin))
(export (edwin)
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/evlcom.scm,v 1.14 1989/04/28 22:49:39 cph Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/evlcom.scm,v 1.15 1989/08/07 08:44:48 cph Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
"The last expression evaluated in the typein window."
false)
+(define-variable debug-on-evaluation-error
+ "True means enter debugger if error is signalled while evaluating.
+This does not affect editor errors."
+ true)
+
(define-command eval-definition
"Evaluate the definition at point.
Prints the result in the typein window.
(lambda (condition)
(and (not (condition/internal? condition))
(error? condition)
- (begin
- (with-output-to-temporary-buffer "*Error*"
- (lambda ()
- (format-error-message (condition/message condition)
- (condition/irritants condition)
- (current-output-port))))
- (editor-error "Error while evaluating expression"))))
+ (if (ref-variable debug-on-evaluation-error)
+ (debug-scheme-error condition)
+ (let ((string
+ (with-output-to-string
+ (lambda ()
+ ((condition/reporter condition)
+ condition
+ (current-output-port))))))
+ (if (and (not (string-find-next-char string #\newline))
+ (< (string-column-length string 18) 80))
+ (message "Evaluation error: " string)
+ (begin
+ (with-output-to-temporary-buffer "*error*" string)
+ (message "Evaluation error")))))
+ (%editor-error)))
(lambda ()
- (with-new-history (lambda () (scode-eval scode environment)))))))
+ (with-new-history
+ (lambda () (extended-scode-eval scode environment)))))))
+
(define (prompt-for-expression-value prompt default)
(eval-with-history (prompt-for-expression prompt default)
(evaluation-environment false)))
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/filcom.scm,v 1.136 1989/04/28 22:49:44 cph Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/filcom.scm,v 1.137 1989/08/07 08:44:52 cph Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
(pathname->string pathname))))
(let ((where (mark-index (buffer-point buffer))))
(read-buffer buffer pathname)
- (set-current-point!
- (mark+ (buffer-start buffer) where 'LIMIT))
- (after-find-file buffer false))))))))\f
+ (set-buffer-point!
+ buffer
+ (mark+ (buffer-start buffer) where 'LIMIT)))
+ (after-find-file buffer false)))))))
+\f
(define-command copy-file
"Copy a file; the old and new names are read in the typein window.
If a file with the new name already exists, confirmation is requested first."
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/input.scm,v 1.79 1989/04/28 22:50:22 cph Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/input.scm,v 1.80 1989/08/07 08:44:56 cph Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
a : there is a command prompt
b : the command prompt is displayed
c : there is a message
-d : the message should be erased
+d : the message should be erased (also implies it is displayed)
Constraints:
012345
0 082300
-8 08230C
-C *C230C * is special -- see the code.
+8 08238C
+C *C23CC * is special -- see the code.
2 2A2302
3 3B2300
A 2AAB8C
(set-message! string)))
(define (clear-message)
- (set! command-prompt-string false)
- (set! command-prompt-displayed? false)
- (set! message-string false)
- (set! message-should-be-erased? false)
- (clear-message!))
+ (if message-string
+ (begin
+ (set! message-string false)
+ (set! message-should-be-erased? false)
+ (if (not command-prompt-displayed?)
+ (clear-message!)))))
\f
(define editor-input-port)
(define (keyboard-peek-char)
(if *executing-keyboard-macro?*
(keyboard-macro-peek-char)
- (begin
- (read-char-preface)
- (remap-alias-char (peek-char editor-input-port)))))
+ (keyboard-read-char-1 peek-char)))
(define (keyboard-read-char)
(set! keyboard-chars-read (1+ keyboard-chars-read))
(if *executing-keyboard-macro?*
(keyboard-macro-read-char)
- (begin
- (read-char-preface)
- (let ((char (remap-alias-char (read-char editor-input-port))))
- (set! *auto-save-keystroke-count* (1+ *auto-save-keystroke-count*))
- (ring-push! (current-char-history) char)
- (if *defining-keyboard-macro?* (keyboard-macro-write-char char))
- char))))
+ (let ((char (keyboard-read-char-1 read-char)))
+ (set! *auto-save-keystroke-count* (1+ *auto-save-keystroke-count*))
+ (ring-push! (current-char-history) char)
+ (if *defining-keyboard-macro?* (keyboard-macro-write-char char))
+ char)))
(define read-char-timeout/fast 500)
(define read-char-timeout/slow 2000)
-(define-integrable (read-char-preface)
+(define (keyboard-read-char-1 read-char)
+ ;; Perform redisplay if needed.
(if (not (keyboard-active? 0))
(begin
(update-screens! false)
(begin
(do-auto-save)
(set! *auto-save-keystroke-count* 0)))))
+ ;; Perform the appropriate juggling of the minibuffer message.
(cond ((within-typein-edit?)
(if message-string
(begin
(begin
(set! command-prompt-displayed? true)
(set-message! command-prompt-string))
- (clear-message!)))))
\ No newline at end of file
+ (clear-message!))))
+ (remap-alias-char (read-char editor-input-port)))
\ No newline at end of file
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/make.scm,v 3.11 1989/08/03 01:34:55 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/make.scm,v 3.12 1989/08/07 08:44:59 cph Exp $
Copyright (c) 1989 Massachusetts Institute of Technology
(declare (usual-integrations))
(package/system-loader "edwin" '() 'QUERY)
-(add-system! (make-system "Edwin" 3 11 '()))
\ No newline at end of file
+(add-system! (make-system "Edwin" 3 12 '()))
\ No newline at end of file
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modefs.scm,v 1.117 1989/04/28 22:51:27 cph Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modefs.scm,v 1.118 1989/08/07 08:45:08 cph Exp $
;;;
;;; Copyright (c) 1985, 1989 Massachusetts Institute of Technology
;;;
(define-key 'fundamental char-set:numeric 'auto-digit-argument)
(define-key 'fundamental #\- 'auto-negative-argument)
-(define-key 'fundamental #\tab 'indent-for-tab-command)
-(define-key 'fundamental #\linefeed 'newline-and-indent)
-(define-key 'fundamental #\page 'recenter)
-(define-key 'fundamental #\return 'newline)
-(define-key 'fundamental #\altmode 'meta-prefix)
(define-key 'fundamental #\rubout 'backward-delete-char)
-
-(define-prefix-key 'fundamental #\backspace 'help-prefix)
-(define-key 'fundamental '(#\backspace #\a) 'command-apropos)
-(define-key 'fundamental '(#\backspace #\c) 'describe-key-briefly)
-(define-key 'fundamental '(#\backspace #\d) 'describe-command)
-(define-key 'fundamental '(#\backspace #\i) 'info)
-(define-key 'fundamental '(#\backspace #\k) 'describe-key)
-(define-key 'fundamental '(#\backspace #\l) 'view-lossage)
-(define-key 'fundamental '(#\backspace #\m) 'describe-mode)
-(define-key 'fundamental '(#\backspace #\t) 'help-with-tutorial)
-(define-key 'fundamental '(#\backspace #\v) 'describe-variable)
-(define-key 'fundamental '(#\backspace #\w) 'where-is)
\f
(define-key 'fundamental #\c-space 'set-mark-command)
-;!"#$
(define-key 'fundamental #\c-% 'replace-string)
-;'()*+,
(define-key 'fundamental #\c-- 'negative-argument)
-;./
(define-key 'fundamental #\c-0 'digit-argument)
(define-key 'fundamental #\c-1 'digit-argument)
(define-key 'fundamental #\c-2 'digit-argument)
(define-key 'fundamental #\c-7 'digit-argument)
(define-key 'fundamental #\c-8 'digit-argument)
(define-key 'fundamental #\c-9 'digit-argument)
-;:
(define-key 'fundamental #\c-\; 'indent-for-comment)
(define-key 'fundamental #\c-< 'mark-beginning-of-buffer)
(define-key 'fundamental #\c-= 'what-cursor-position)
(define-key 'fundamental #\c-> 'mark-end-of-buffer)
-;?
(define-key 'fundamental #\c-@ 'set-mark-command)
(define-key 'fundamental #\c-a 'beginning-of-line)
(define-key 'fundamental #\c-b 'backward-char)
(define-key 'fundamental #\c-e 'end-of-line)
(define-key 'fundamental #\c-f 'forward-char)
(define-key 'fundamental #\c-g 'keyboard-quit)
-;(define-prefix-key 'fundamental #\c-h 'help-prefix)
-;(define-key 'fundamental #\c-i 'indent-for-tab-command)
-;(define-key 'fundamental #\c-j 'newline-and-indent)
+(define-prefix-key 'fundamental #\c-h 'help-prefix)
+(define-key 'fundamental #\c-i 'indent-for-tab-command)
+(define-key 'fundamental #\c-j 'newline-and-indent)
(define-key 'fundamental #\c-k 'kill-line)
-;(define-key 'fundamental #\c-l 'recenter)
-;(define-key 'fundamental #\c-m 'newline)
+(define-key 'fundamental #\c-l 'recenter)
+(define-key 'fundamental #\c-m 'newline)
(define-key 'fundamental #\c-n 'next-line)
(define-key 'fundamental #\c-o 'open-line)
(define-key 'fundamental #\c-p 'previous-line)
(define-prefix-key 'fundamental #\c-x 'prefix-char)
(define-key 'fundamental #\c-y 'yank)
(define-key 'fundamental #\c-z 'control-meta-prefix)
-;(define-key 'fundamental #\c-\[ 'meta-prefix)
-;\
+(define-key 'fundamental #\c-\[ 'meta-prefix)
(define-key 'fundamental #\c-\] 'abort-recursive-edit)
(define-key 'fundamental #\c-^ 'control-prefix)
(define-key 'fundamental #\c-_ 'undo)
-;`{|}~
(define-key 'fundamental #\c-rubout 'backward-delete-char-untabify)
\f
-(define-key 'fundamental #\m-backspace 'mark-definition)
-;(define-key 'fundamental #\m-tab 'insert-tab)
-(define-key 'fundamental #\m-linefeed 'indent-new-comment-line)
-(define-key 'fundamental #\m-page 'twiddle-buffers)
-;(define-key 'fundamental #\m-return 'back-to-indentation)
-(define-key 'fundamental #\m-altmode 'eval-expression)
(define-key 'fundamental #\m-space 'just-one-space)
-;!"#$
(define-key 'fundamental #\m-% 'query-replace)
-;'()*+
(define-key 'fundamental #\m-, 'tags-loop-continue)
(define-key 'fundamental #\m-- 'auto-argument)
(define-key 'fundamental #\m-. 'find-tag)
-;(define-key 'fundamental #\m-/ 'describe-command)
(define-key 'fundamental #\m-0 'auto-argument)
(define-key 'fundamental #\m-1 'auto-argument)
(define-key 'fundamental #\m-2 'auto-argument)
(define-key 'fundamental #\m-7 'auto-argument)
(define-key 'fundamental #\m-8 'auto-argument)
(define-key 'fundamental #\m-9 'auto-argument)
-;:
(define-key 'fundamental #\m-\; 'indent-for-comment)
(define-key 'fundamental #\m-< 'beginning-of-buffer)
(define-key 'fundamental #\m-= 'count-lines-region)
(define-key 'fundamental #\m-> 'end-of-buffer)
-;?
(define-key 'fundamental #\m-@ 'mark-word)
(define-key 'fundamental #\m-\[ 'backward-paragraph)
(define-key 'fundamental #\m-\\ 'delete-horizontal-space)
(define-key 'fundamental #\m-\] 'forward-paragraph)
(define-key 'fundamental #\m-^ 'delete-indentation)
-;_`
(define-key 'fundamental #\m-a 'backward-sentence)
(define-key 'fundamental #\m-b 'backward-word)
(define-key 'fundamental #\m-c 'capitalize-word)
(define-key 'fundamental #\m-k 'kill-sentence)
(define-key 'fundamental #\m-l 'downcase-word)
(define-key 'fundamental #\m-m 'back-to-indentation)
-;nop
(define-key 'fundamental #\m-q 'fill-paragraph)
(define-key 'fundamental #\m-r 'move-to-window-line)
-;s
(define-key 'fundamental #\m-t 'transpose-words)
(define-key 'fundamental #\m-u 'upcase-word)
(define-key 'fundamental #\m-v 'scroll-down)
(define-key 'fundamental #\m-x 'execute-extended-command)
(define-key 'fundamental #\m-y 'yank-pop)
(define-key 'fundamental #\m-z 'zap-to-char)
-;{|}
(define-key 'fundamental #\m-~ 'not-modified)
(define-key 'fundamental #\m-rubout 'backward-kill-word)
\f
(define-key 'fundamental #\c-m-8 'digit-argument)
(define-key 'fundamental #\c-m-9 'digit-argument)
(define-key 'fundamental #\c-m-- 'negative-argument)
-
(define-key 'fundamental #\c-m-\\ 'indent-region)
(define-key 'fundamental #\c-m-^ 'delete-indentation)
(define-key 'fundamental #\c-m-\( 'backward-up-list)
(define-key 'fundamental #\c-m-\) 'up-list)
(define-key 'fundamental #\c-m-@ 'mark-sexp)
(define-key 'fundamental #\c-m-\; 'kill-comment)
-
+(define-key 'fundamental #\c-m-\[ 'eval-expression)
(define-key 'fundamental #\c-m-a 'beginning-of-definition)
(define-key 'fundamental #\c-m-b 'backward-sexp)
(define-key 'fundamental #\c-m-c 'exit-recursive-edit)
(define-key 'fundamental #\c-m-d 'down-list)
(define-key 'fundamental #\c-m-e 'end-of-definition)
(define-key 'fundamental #\c-m-f 'forward-sexp)
-;G
(define-key 'fundamental #\c-m-h 'mark-definition)
-;I
-;(define-key 'fundamental #\c-m-j 'indent-new-comment-line)
+(define-key 'fundamental #\c-m-j 'indent-new-comment-line)
(define-key 'fundamental #\c-m-k 'kill-sexp)
-;(define-key 'fundamental #\c-m-l 'twiddle-buffers)
-;M
+(define-key 'fundamental #\c-m-l 'twiddle-buffers)
(define-key 'fundamental #\c-m-n 'forward-list)
(define-key 'fundamental #\c-m-o 'split-line)
(define-key 'fundamental #\c-m-p 'backward-list)
-;Q
(define-key 'fundamental #\c-m-r 'align-definition)
(define-key 'fundamental #\c-m-s 'isearch-forward-regexp)
(define-key 'fundamental #\c-m-t 'transpose-sexps)
(define-key 'fundamental #\c-m-u 'backward-up-list)
(define-key 'fundamental #\c-m-v 'scroll-other-window)
(define-key 'fundamental #\c-m-w 'append-next-kill)
-;XYZ
(define-key 'fundamental #\c-m-rubout 'backward-kill-sexp)
-\f;backspace
-(define-key 'fundamental '(#\c-x #\tab) 'indent-rigidly)
-;linefeed
-(define-key 'fundamental '(#\c-x #\page) 'downcase-region)
-;return
-(define-key 'fundamental '(#\c-x #\altmode) 'repeat-complex-command)
-;A
+\f(define-key 'fundamental '(#\c-h #\a) 'command-apropos)(define-key 'fundamental '(#\c-h #\c) 'describe-key-briefly)
+(define-key 'fundamental '(#\c-h #\d) 'describe-command)(define-key 'fundamental '(#\c-h #\i) 'info)
+(define-key 'fundamental '(#\c-h #\k) 'describe-key)
+(define-key 'fundamental '(#\c-h #\l) 'view-lossage)
+(define-key 'fundamental '(#\c-h #\m) 'describe-mode)
+(define-key 'fundamental '(#\c-h #\t) 'help-with-tutorial)
+(define-key 'fundamental '(#\c-h #\v) 'describe-variable)
+(define-key 'fundamental '(#\c-h #\w) 'where-is)
+
+(define-key 'fundamental '(#\c-x #\c-\[) 'repeat-complex-command)
(define-key 'fundamental '(#\c-x #\c-b) 'list-buffers)
-;C
+(define-key 'fundamental '(#\c-x #\c-c) 'save-buffers-kill-scheme)
(define-key 'fundamental '(#\c-x #\c-d) 'list-directory)
(define-key 'fundamental '(#\c-x #\c-e) 'eval-previous-sexp)
(define-key 'fundamental '(#\c-x #\c-f) 'find-file)
-;GH
-;(define-key 'fundamental '(#\c-x #\c-i) 'indent-rigidly)
-;JK
-;(define-key 'fundamental '(#\c-x #\c-l) 'downcase-region)
-;M
+(define-key 'fundamental '(#\c-x #\c-i) 'indent-rigidly)
+(define-key 'fundamental '(#\c-x #\c-l) 'downcase-region)
(define-key 'fundamental '(#\c-x #\c-n) 'set-goal-column)
(define-key 'fundamental '(#\c-x #\c-o) 'delete-blank-lines)
(define-key 'fundamental '(#\c-x #\c-p) 'mark-page)
(define-key 'fundamental '(#\c-x #\c-q) 'toggle-read-only)
-;R
(define-key 'fundamental '(#\c-x #\c-s) 'save-buffer)
(define-key 'fundamental '(#\c-x #\c-t) 'transpose-lines)
(define-key 'fundamental '(#\c-x #\c-u) 'upcase-region)
(define-key 'fundamental '(#\c-x #\c-w) 'write-file)
(define-key 'fundamental '(#\c-x #\c-x) 'exchange-point-and-mark)
(define-key 'fundamental '(#\c-x #\c-z) 'suspend-scheme)
-;!"#$%&'
(define-key 'fundamental '(#\c-x #\() 'start-kbd-macro)
(define-key 'fundamental '(#\c-x #\)) 'end-kbd-macro)
-;*+,-
(define-key 'fundamental '(#\c-x #\.) 'set-fill-prefix)
(define-key 'fundamental '(#\c-x #\/) 'point-to-register)
(define-key 'fundamental '(#\c-x #\0) 'delete-window)
(define-key 'fundamental '(#\c-x #\1) 'delete-other-windows)
(define-key 'fundamental '(#\c-x #\2) 'split-window-vertically)
-;(define-key 'fundamental '(#\c-x #\3) 'kill-pop-up-buffer)
(define-prefix-key 'fundamental '(#\c-x #\4) 'prefix-char)
(define-key 'fundamental '(#\c-x #\4 #\c-f) 'find-file-other-window)
(define-key 'fundamental '(#\c-x #\4 #\.) 'find-tag-other-window)
(define-key 'fundamental '(#\c-x #\4 #\d) 'dired-other-window)
(define-key 'fundamental '(#\c-x #\4 #\f) 'find-file-other-window)
(define-key 'fundamental '(#\c-x #\5) 'split-window-horizontally)
-;:
(define-key 'fundamental '(#\c-x #\;) 'set-comment-column)
-;<
(define-key 'fundamental '(#\c-x #\=) 'what-cursor-position)
-;>?
(define-key 'fundamental '(#\c-x #\[) 'backward-page)
-;\
(define-key 'fundamental '(#\c-x #\]) 'forward-page)
(define-key 'fundamental '(#\c-x #\^) 'enlarge-window)
-;_`
-;a
-(define-key 'fundamental '(#\c-x #\b) 'switch-to-buffer);c
-(define-key 'fundamental '(#\c-x #\d) 'dired)
+(define-key 'fundamental '(#\c-x #\b) 'switch-to-buffer)(define-key 'fundamental '(#\c-x #\d) 'dired)
(define-key 'fundamental '(#\c-x #\e) 'call-last-kbd-macro)
(define-key 'fundamental '(#\c-x #\f) 'set-fill-column)
(define-key 'fundamental '(#\c-x #\g) 'insert-register)
(define-key 'fundamental '(#\c-x #\j) 'register-to-point)
(define-key 'fundamental '(#\c-x #\k) 'kill-buffer)
(define-key 'fundamental '(#\c-x #\l) 'count-lines-page)
-;m
(define-key 'fundamental '(#\c-x #\n) 'narrow-to-region)
(define-key 'fundamental '(#\c-x #\o) 'other-window)
(define-key 'fundamental '(#\c-x #\p) 'narrow-to-page)
(define-key 'fundamental '(#\c-x #\s) 'save-some-buffers)
;(define-key 'fundamental '(#\c-x #\t) 'transpose-regions)
(define-key 'fundamental '(#\c-x #\u) 'undo)
-;v
(define-key 'fundamental '(#\c-x #\w) 'widen)
(define-key 'fundamental '(#\c-x #\x) 'copy-to-register)
-;y
(define-key 'fundamental '(#\c-x #\z) 'suspend-edwin)
(define-key 'fundamental '(#\c-x #\{) 'shrink-window-horizontally)
-;|
(define-key 'fundamental '(#\c-x #\}) 'enlarge-window-horizontally)
-;~(define-key 'fundamental '(#\c-x #\rubout) 'backward-kill-sentence)
\ No newline at end of file
+(define-key 'fundamental '(#\c-x #\rubout) 'backward-kill-sentence)
\ No newline at end of file
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/schmod.scm,v 1.11 1989/05/16 18:52:49 cph Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/schmod.scm,v 1.12 1989/08/07 08:45:12 cph Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
(WITH-INPUT-FROM-PORT . 1)
(WITH-INPUT-FROM-STRING . 1)
(WITH-OUTPUT-TO-PORT . 1)
- (WITH-OUTPUT-TO-STRING . 1) (WITH-VALUES . 1)
+ (WITH-OUTPUT-TO-STRING . 0)
+ (WITH-VALUES . 1)
(BIND-CONDITION-HANDLER . 2)
(LIST-TRANSFORM-POSITIVE . 1)
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/unix.scm,v 1.7 1989/08/04 03:17:28 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/unix.scm,v 1.8 1989/08/07 08:45:16 cph Exp $
;;;
;;; Copyright (c) 1989 Massachusetts Institute of Technology
;;;
4
16)
" "
- (pathname-name-string pathname)))))
+ (pathname-name-string pathname)
+ (let ((type (file-attributes/type attributes)))
+ (if (string? type)
+ (string-append " -> " type)
+ ""))))))
(define (os/dired-filename-region lstart)
(let ((lend (line-end lstart 0)))
- (char-search-backward #\Space lend lstart 'LIMIT) (make-region (re-match-end 0) lend)))
+ (if (not (re-search-forward
+ "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\) +[0-9]+ +[0-9:]+ "
+ lstart
+ lend))
+ (editor-error "No filename on this line"))
+ (make-region (re-match-end 0) lend)))
(define (os/dired-sort-pathnames pathnames)
(sort pathnames
projects / mit-scheme.git / commitdiff