From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 28 Feb 2000 22:51:28 +0000 (+0000)
Subject: Implement abbrev mode.
X-Git-Tag: 20090517-FFI~4224
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1fae192f121436f321ae3272a8bcd754cb7e74de;p=mit-scheme.git

Implement abbrev mode.
---

diff --git a/v7/src/edwin/basic.scm b/v7/src/edwin/basic.scm
index 00dba8b30..4b2b41118 100644
--- a/v7/src/edwin/basic.scm
+++ b/v7/src/edwin/basic.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: basic.scm,v 1.135 2000/02/25 14:28:52 cph Exp $
+;;; $Id: basic.scm,v 1.136 2000/02/28 22:50:14 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology
 ;;;
@@ -33,23 +33,28 @@ Whichever character you type to run this command is inserted."
       (self-insert char n #t))))
 
 (define (self-insert char n allow-auto-fill?)
-  (if (> n 0)
-      (begin
-	(if (and (current-minor-mode? (ref-mode-object abbrev))
-		 (not (char=? #\w (char-syntax char)))
-		 (buffer-writable? (selected-buffer))
-		 (eqv? #\w (char-syntax (extract-left-char))))
-	    ((ref-command expand-abbrev)))
-	(insert-chars char n)
-	(if (and allow-auto-fill?
-		 (or (char=? #\space char)
-		     (char=? #\newline char))
-		 (current-minor-mode? (ref-mode-object auto-fill)))
-	    (auto-fill-break)))))
-
-;;; Placeholders:
-(define-minor-mode abbrev "Abbrev" "")
-(define-command expand-abbrev "" () (lambda () unspecific))
+  (and (> n 0)
+       (let ((point (current-point))
+	     (hairy? #f))
+	 (if (and (not (group-start? point))
+		  (buffer-minor-mode? (mark-buffer point)
+				      (ref-mode-object abbrev))
+		  (not (char=? #\w (char-syntax char)))
+		  (char=? #\w (char-syntax (extract-left-char point))))
+	     (let ((t (group-modified-tick (mark-group point))))
+	       ((ref-command expand-abbrev) point)
+	       (if (not (fix:= t (group-modified-tick (mark-group point))))
+		   (set! hairy? #t))))
+	 (insert-chars char n)
+	 (if (and allow-auto-fill?
+		  (or (char=? #\space char)
+		      (char=? #\newline char))
+		  (current-minor-mode? (ref-mode-object auto-fill)))
+	     (let ((t (group-modified-tick (mark-group point))))
+	       (auto-fill-break)
+	       (if (not (fix:= t (group-modified-tick (mark-group point))))
+		   (set! hairy? #t))))
+	 hairy?)))
 
 (define (read-quoted-char prompt-string)
   (let ((read-ascii-char
diff --git a/v7/src/edwin/bufwiu.scm b/v7/src/edwin/bufwiu.scm
index 95040331e..08caa6b09 100644
--- a/v7/src/edwin/bufwiu.scm
+++ b/v7/src/edwin/bufwiu.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: bufwiu.scm,v 1.31 1999/01/02 06:11:34 cph Exp $
+;;; $Id: bufwiu.scm,v 1.32 2000/02/28 22:50:37 cph Exp $
 ;;;
-;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
+;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License as
@@ -438,9 +438,6 @@
       ((%window-debug-trace window) 'window window
 				    'direct-output-insert-char! char))
   (let ((mask (set-interrupt-enables! interrupt-mask/gc-ok)))
-    (group-insert-char! (%window-group window)
-			(%window-point-index window)
-			char)
     (let ((x-start (inferior-x-start (%window-cursor-inferior window)))
 	  (y-start (inferior-y-start (%window-cursor-inferior window))))
       (screen-direct-output-char
diff --git a/v7/src/edwin/comred.scm b/v7/src/edwin/comred.scm
index e76d8de90..280a6e04f 100644
--- a/v7/src/edwin/comred.scm
+++ b/v7/src/edwin/comred.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: comred.scm,v 1.115 2000/02/25 14:26:56 cph Exp $
+;;; $Id: comred.scm,v 1.116 2000/02/28 22:50:03 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology
 ;;;
@@ -263,11 +263,7 @@
       (cond ((or *executing-keyboard-macro?* *command-argument*)
 	     (normal))
 	    ((and (char? *command-key*)
-		  (or (and (eq? command
-				(ref-command-object self-insert-command))
-			   (not (and (or (char=? #\space *command-key*)
-					 (char=? #\newline *command-key*))
-				     (auto-fill-break? point))))
+		  (or (eq? command (ref-command-object self-insert-command))
 		      (command-argument-self-insert? command)))
 	     (let ((non-undo-count *non-undo-count*))
 	       (if (or (fix:= non-undo-count 0)
@@ -288,8 +284,12 @@
 			  (and (fix:= (string-length image) 1)
 			       (char=? (string-ref image 0) key)))
 			(fix:< point-x (fix:- (window-x-size window) 1)))
-		   (window-direct-output-insert-char! window key)
-		   (region-insert-char! point key))))
+		   (if (self-insert key 1 #t)
+		       (begin
+			 (set! *non-undo-count* 0)
+			 (undo-boundary! point))
+		       (window-direct-output-insert-char! window key))
+		   (normal))))
 	    ((eq? command (ref-command-object forward-char))
 	     (if (and (not (window-needs-redisplay? window))
 		      (not (group-end? point))
diff --git a/v7/src/edwin/decls.scm b/v7/src/edwin/decls.scm
index 100b12ffe..5db8fc083 100644
--- a/v7/src/edwin/decls.scm
+++ b/v7/src/edwin/decls.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: decls.scm,v 1.67 2000/01/10 04:00:22 cph Exp $
+$Id: decls.scm,v 1.68 2000/02/28 22:51:28 cph Exp $
 
-Copyright (c) 1989-1999 Massachusetts Institute of Technology
+Copyright (c) 1989-2000 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -103,7 +103,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 	    (loop (cdr files) (cons (car files) includes)))))
     (for-each (lambda (filename)
 		(apply sf-edwin filename includes))
-	      '("argred"
+	      '("abbrev"
+		"argred"
 		"artdebug"
 		"autold"
 		"autosv"
diff --git a/v7/src/edwin/ed-ffi.scm b/v7/src/edwin/ed-ffi.scm
index 4851359c3..efcc998ca 100644
--- a/v7/src/edwin/ed-ffi.scm
+++ b/v7/src/edwin/ed-ffi.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: ed-ffi.scm,v 1.48 1999/10/07 17:00:40 cph Exp $
+$Id: ed-ffi.scm,v 1.49 2000/02/28 22:51:24 cph Exp $
 
-Copyright (c) 1990-1999 Massachusetts Institute of Technology
+Copyright (c) 1990-2000 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -24,7 +24,9 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 ;; This list must be kept in alphabetical order by filename.
 
 (standard-scheme-find-file-initialization
- '#(("ansi"	(edwin screen console-screen)
+ '#(("abbrev"	(edwin)
+		edwin-syntax-table)
+    ("ansi"	(edwin screen console-screen)
 		syntax-table/system-internal)
     ("argred"	(edwin command-argument)
 		edwin-syntax-table)
diff --git a/v7/src/edwin/edwin.ldr b/v7/src/edwin/edwin.ldr
index 646285585..4daf0ae5c 100644
--- a/v7/src/edwin/edwin.ldr
+++ b/v7/src/edwin/edwin.ldr
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: edwin.ldr,v 1.68 1999/10/07 17:06:20 cph Exp $
+$Id: edwin.ldr,v 1.69 2000/02/28 22:51:21 cph Exp $
 
-Copyright (c) 1989-1999 Massachusetts Institute of Technology
+Copyright (c) 1989-2000 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -200,6 +200,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 	    ((OS/2) (load "diros2" env))
 	    ((NT) (load "dirw32" env))))
 
+	(load "abbrev" environment)
 	(load "argred" (->environment '(EDWIN COMMAND-ARGUMENT)))
 	(load "autold" environment)
 	(load "autosv" environment)
diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index e21b0a73c..24947d990 100644
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: edwin.pkg,v 1.243 2000/02/25 17:47:08 cph Exp $
+$Id: edwin.pkg,v 1.244 2000/02/28 22:51:15 cph Exp $
 
 Copyright (c) 1989-2000 Massachusetts Institute of Technology
 
@@ -56,6 +56,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 	 "syntax"			; word and list parsing
 	 "fileio"			; file <-> buffer
 
+	 "abbrev"			; abbrevs
 	 "autold"			; autoloaded definitions
 	 "autosv"			; auto save
 	 "basic"			; basic commands
diff --git a/v7/src/edwin/filcom.scm b/v7/src/edwin/filcom.scm
index bda346136..008261ae6 100644
--- a/v7/src/edwin/filcom.scm
+++ b/v7/src/edwin/filcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: filcom.scm,v 1.207 2000/02/28 20:01:12 cph Exp $
+;;; $Id: filcom.scm,v 1.208 2000/02/28 22:51:09 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology
 ;;;
@@ -445,9 +445,6 @@ With argument, saves all with no questions."
       (if (and (null? buffers) (not abbrevs-saved?))
 	  (message "(No files need saving)")))))
 
-;; **** placeholder
-(define (maybe-save-abbrevs no-confirmation?) no-confirmation? #f)
-
 (define-variable-per-buffer buffer-offer-save
   "True in a buffer means offer to save the buffer on exit
 even if the buffer is not visiting a file.  Automatically local in
diff --git a/v7/src/edwin/modefs.scm b/v7/src/edwin/modefs.scm
index 19b797a71..9be9b1da2 100644
--- a/v7/src/edwin/modefs.scm
+++ b/v7/src/edwin/modefs.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: modefs.scm,v 1.156 2000/02/24 01:32:14 cph Exp $
+;;; $Id: modefs.scm,v 1.157 2000/02/28 22:51:02 cph Exp $
 ;;;
 ;;; Copyright (c) 1985, 1989-2000 Massachusetts Institute of Technology
 ;;;
@@ -124,6 +124,7 @@ Like Fundamental mode, but no self-inserting characters.")
 (define-key 'fundamental #\m-space 'just-one-space)
 (define-key 'fundamental #\m-! 'shell-command)
 (define-key 'fundamental #\m-% 'query-replace)
+(define-key 'fundamental #\m-\' 'abbrev-prefix-mark)
 (define-key 'fundamental #\m-, 'tags-loop-continue)
 (define-key 'fundamental #\m-- 'auto-argument)
 (define-key 'fundamental #\m-. 'find-tag)
@@ -235,6 +236,7 @@ Like Fundamental mode, but no self-inserting characters.")
 (define-key 'fundamental '(#\c-h #\v) 'describe-variable)
 (define-key 'fundamental '(#\c-h #\w) 'where-is)
 
+(define-key 'fundamental '(#\c-x #\') 'expand-abbrev)
 (define-key 'fundamental '(#\c-x #\c-\[) 'repeat-complex-command)
 (define-key 'fundamental '(#\c-x #\c-b) 'list-buffers)
 (define-key 'fundamental '(#\c-x #\c-c) 'save-buffers-kill-scheme)
@@ -283,11 +285,23 @@ Like Fundamental mode, but no self-inserting characters.")
 (define-key 'fundamental '(#\c-x #\5 #\f) 'find-file-other-frame)
 (define-key 'fundamental '(#\c-x #\5 #\m) 'mail-other-frame)
 (define-key 'fundamental '(#\c-x #\5 #\o) 'other-frame)
+
 (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)
+(define-prefix-key 'fundamental '(#\c-x #\a))
+(define-key 'fundamental '(#\c-x #\a #\') 'expand-abbrev)
+(define-key 'fundamental '(#\c-x #\a #\+) 'add-mode-abbrev)
+(define-key 'fundamental '(#\c-x #\a #\-) 'inverse-add-global-abbrev)
+(define-key 'fundamental '(#\c-x #\a #\c-a) 'add-mode-abbrev)
+(define-key 'fundamental '(#\c-x #\a #\e) 'expand-abbrev)
+(define-key 'fundamental '(#\c-x #\a #\g) 'add-global-abbrev)
+(define-prefix-key 'fundamental '(#\c-x #\a #\i))
+(define-key 'fundamental '(#\c-x #\a #\i #\g) 'inverse-add-global-abbrev)
+(define-key 'fundamental '(#\c-x #\a #\i #\l) 'inverse-add-mode-abbrev)
+(define-key 'fundamental '(#\c-x #\a #\l) 'add-mode-abbrev)
 (define-key 'fundamental '(#\c-x #\b) 'switch-to-buffer)
 (define-key 'fundamental '(#\c-x #\c) 'save-buffers-kill-edwin)
 (define-key 'fundamental '(#\c-x #\d) 'dired)
diff --git a/v7/src/edwin/winout.scm b/v7/src/edwin/winout.scm
index d2a77b121..3660327d4 100644
--- a/v7/src/edwin/winout.scm
+++ b/v7/src/edwin/winout.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;$Id: winout.scm,v 1.13 1999/02/24 21:35:58 cph Exp $
+;;;$Id: winout.scm,v 1.14 2000/02/28 22:50:27 cph Exp $
 ;;;
-;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
+;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License as
@@ -56,6 +56,7 @@
 			     (char=? (string-ref image 0) char)))
 		      ;; above 3 expressions replace (char-graphic? char)
 		      (< (1+ (window-point-x window)) (window-x-size window)))
+		 (region-insert-char! point char)
 		 (window-direct-output-insert-char! window char))
 		(else
 		 (region-insert-char! point char)))