;;; -*-Scheme-*-
;;;
-;;; $Id: comred.scm,v 1.101 1993/08/09 19:38:13 jawilson Exp $
+;;; $Id: comred.scm,v 1.102 1993/08/10 06:35:38 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
;;;
(let ((window (current-window)))
(%dispatch-on-command
window
- (let ((txtprp-comtab
- (get-property-at
- 'command-table
- (mark-index
- (buffer-point (window-buffer window)))
- (buffer-group (window-buffer window)))))
- (or
- (and
- txtprp-comtab
- (let ((command
- (comtab-entry (cadr txtprp-comtab) input)))
- (if (eq? command
- (ref-command-object undefined))
- false
- command)))
- (comtab-entry
- (buffer-comtabs (window-buffer window))
- input)))
+ (local-comtab-entry (buffer-comtabs
+ (window-buffer window))
+ input
+ (window-point window))
false)))))
- ((dequeue! command-reader-override-queue)))))))))))))
+ ((dequeue! command-reader-override-queue)))))))))))))
(define (bind-abort-editor-command thunk)
(call-with-current-continuation
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comtab.scm,v 1.62 1992/01/14 18:34:34 cph Exp $
+;;; $Id: comtab.scm,v 1.63 1993/08/10 06:35:40 cph Exp $
;;;
-;;; Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
+;;; Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
;;;
;;; This material was developed by the Scheme project at the
;;; Massachusetts Institute of Technology, Department of
(error "Illegal comtab datum:" datum))))))))
\f
(define (comtab-entry comtabs key)
+ (or (%comtab-entry comtabs key)
+ (and (not (button? key))
+ (ref-command-object undefined))))
+
+(define (local-comtab-entry comtabs key mark)
+ (or (and mark
+ (let ((local-comtabs (local-comtabs mark)))
+ (and local-comtabs
+ (%comtab-entry local-comtabs key))))
+ (comtab-entry comtabs key)))
+
+(define (%comtab-entry comtabs key)
(let ((object (lookup-key comtabs key)))
(cond ((not object)
- (and (not (button? key))
- (ref-command-object undefined)))
+ #f)
((command? object)
object)
((command&comtab? object)
syntax-table/system-internal)
("tximod" (edwin)
edwin-syntax-table)
- ("txtprp" (edwin text-props)
+ ("txtprp" (edwin text-properties)
edwin-syntax-table)
("undo" (edwin undo)
edwin-syntax-table)
;;; -*-Scheme-*-
;;;
-;;; $Id: edtfrm.scm,v 1.86 1993/08/09 19:22:40 jawilson Exp $
+;;; $Id: edtfrm.scm,v 1.87 1993/08/10 06:35:44 cph Exp $
;;;
;;; Copyright (c) 1985, 1989-93 Massachusetts Institute of Technology
;;;
;; Make sure the event is inside the text portion of the
;; buffer, not in the modeline or other decoration.
(cond ((and (< -1 relative-x (buffer-frame-x-size frame))
- (< -1 relative-y (buffer-frame-y-size frame)))
- (let* ((point (window-coordinates->mark frame relative-x relative-y))
- (txtprp-comtab (and point
- (get-property-at
- 'command-table
- (mark-index point)
- (mark-group point)))))
- (let ((command
- (or (and txtprp-comtab (comtab-entry (cadr txtprp-comtab)
- button))
- (comtab-entry (buffer-comtabs (window-buffer frame))
- button))))
- (cond (command
- (with-current-button-event
- (make-button-event frame relative-x relative-y)
- (lambda () (execute-command command))))
- ((button/down? button)
- (editor-beep))))))
+ (< -1 relative-y (buffer-frame-y-size frame))
+ (local-comtab-entry
+ (buffer-comtabs (window-buffer frame))
+ button
+ (window-coordinates->mark frame
+ relative-x
+ relative-y)))
+ => (lambda (command)
+ (with-current-button-event
+ (make-button-event frame relative-x relative-y)
+ (lambda () (execute-command command)))))
((button/down? button)
- (editor-beep)))))))
+ (editor-beep)))))))
\ No newline at end of file
#| -*-Scheme-*-
-$Id: edwin.ldr,v 1.39 1993/08/09 19:20:36 jawilson Exp $
+$Id: edwin.ldr,v 1.40 1993/08/10 06:35:46 cph Exp $
-Copyright (c) 1989-1992 Massachusetts Institute of Technology
+Copyright (c) 1989-93 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
(load "clscon" (->environment '(EDWIN CLASS-CONSTRUCTOR)))
(load "clsmac" (->environment '(EDWIN CLASS-MACROS)))
(load "xform"
- (->environment '(EDWIN CLASS-MACROS TRANSFORM-INSTANCE-VARIABLES)))
+ (->environment
+ '(EDWIN CLASS-MACROS TRANSFORM-INSTANCE-VARIABLES)))
(load "paths" environment)
(load "struct" environment)
(load "grpops" (->environment '(EDWIN GROUP-OPERATIONS)))
- (load "txtprp" (->environment '(EDWIN TEXT-PROPS)))
+ (load "txtprp" (->environment '(EDWIN TEXT-PROPERTIES)))
(load "regops" environment)
(load "motion" environment)
(load "search" environment)
#| -*-Scheme-*-
-$Id: edwin.pkg,v 1.123 1993/08/02 23:54:24 cph Exp $
+$Id: edwin.pkg,v 1.124 1993/08/10 06:35:49 cph Exp $
Copyright (c) 1989-1993 Massachusetts Institute of Technology
comtab?
define-key
define-prefix-key
+ local-comtab-entry
make-comtab
prefix-key-list?))
undo-more
undo-record-deletion!
undo-record-insertion!
+ undo-record-property-changes!
undo-start
with-group-undo-disabled))
edwin-variable$rmail-primary-inbox-list
edwin-variable$rmail-reply-with-re
rmail-spool-directory))
+
+(define-package (edwin text-properties)
+ (files "txtprp")
+ (parent (edwin))
+ (export (edwin)
+ add-text-properties
+ get-property
+ get-property-at
+ group-extract-properties
+ group-reinsert-properties!
+ local-comtabs
+ next-property-change
+ next-specific-property-change
+ prev-specific-property-change
+ previous-property-change
+ remove-text-properties
+ set-text-properties
+ text-not-deleteable?
+ text-not-insertable?
+ text-properties-at
+ update-intervals-for-deletion!
+ update-intervals-for-insertion!)
+ (export (edwin window)
+ find-interval
+ interval-end
+ interval-property
+ next-interval))
#|
(define-package (edwin bochser)
(files "bochser"
;;; -*-Scheme-*-
;;;
-;;; $Id: fill.scm,v 1.58 1993/02/22 19:32:01 cph Exp $
+;;; $Id: fill.scm,v 1.59 1993/08/10 06:35:50 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
;;;
;; invoked, and performs the auto-fill action only when the context
;; is the expected one.
(let ((command
- (comtab-entry
+ (local-comtab-entry
(let ((comtabs (current-comtabs)))
(let ((tail
(memq (minor-mode-comtab (ref-mode-object auto-fill))
(if (or (null? tail) (null? (cdr tail)))
comtabs
(cdr tail))))
- (current-command-key))))
+ (current-command-key)
+ (current-point))))
(if (or (eq? command overriding)
(eq? command overridden)
(eq? command (ref-command-object undefined)))
;;; -*-Scheme-*-
;;;
-;;; $Id: hlpcom.scm,v 1.105 1992/11/13 22:16:17 cph Exp $
+;;; $Id: hlpcom.scm,v 1.106 1993/08/10 06:35:52 cph Exp $
;;;
-;;; Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
+;;; Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
;;;
;;; This material was developed by the Scheme project at the
;;; Massachusetts Institute of Technology, Department of
Prints the brief documentation for that command."
"kDescribe key briefly"
(lambda (key)
- (let ((command (comtab-entry (current-comtabs) key)))
+ (let ((command (local-comtab-entry (current-comtabs) key (current-point))))
(if (eq? command (ref-command-object undefined))
(help-describe-unbound-key key)
(message (xkey->name key)
Prints the full documentation for that command."
"kDescribe key"
(lambda (key)
- (let ((command (comtab-entry (current-comtabs) key)))
+ (let ((command (local-comtab-entry (current-comtabs) key (current-point))))
(if (eq? command (ref-command-object undefined))
(help-describe-unbound-key key)
(help-describe-command command)))))
;;; -*-Scheme-*-
;;;
-;;; $Id: txtprp.scm,v 1.1 1993/08/09 19:12:51 jawilson Exp $
+;;; $Id: txtprp.scm,v 1.2 1993/08/10 06:35:54 cph Exp $
;;;
;;; Copyright (c) 1993 Massachusetts Institute of Technology
;;;
(get-property prop (interval-properties (find-interval group index)))
#f))
+(define (local-comtabs mark)
+ (let ((property
+ (get-property-at 'COMMAND-TABLE (mark-index mark) (mark-group mark))))
+ (and property
+ (cadr property))))
+
;;; The next four procedures are all about the same
;;; and none have been tested.
(and next
(fix:> end (interval-start next))
(loop next)))))))
-
+\f
;; export
#|
(define (update-intervals-for-deletion! group start end)
(if (and (fix:= start start*)
(fix:= end end*))
(delete-interval interval group)
- (add-amount-up-tree interval (fix:- 0 (fix:- end start))))
+ (add-amount-up-tree interval
+ (fix:- 0 (fix:- end start))))
(begin
(if (fix:= start start*)
(delete-interval interval group)
- (add-amount-up-tree interval (fix:- 0 (fix:- end* start))))
+ (add-amount-up-tree interval
+ (fix:- 0 (fix:- end* start))))
(loop end*)))))))))
|#
(define (update-intervals-for-deletion! group start end)
(connect-left! c y2)
(set-interval-total-length! a (fix:+ (fix:+ lx ly1) la))
- (set-interval-total-length! b (fix:+ (fix:+ (fix:+ lx ly1) (fix:+ ly2 lz))
- (fix:+ (fix:+ la lc) lb)))
+ (set-interval-total-length! b
+ (fix:+ (fix:+ (fix:+ lx ly1) (fix:+ ly2 lz))
+ (fix:+ (fix:+ la lc) lb)))
(set-interval-total-length! c (fix:+ (fix:+ ly2 lz) lc))
(set-interval-size! a (fix:+ (fix:+ nx ny1) 1))
(set-interval-size! c (fix:+ (fix:+ ny2 nz) 1))
(connect-right! c y2)
(set-interval-total-length! a (fix:+ (fix:+ lx ly1) la))
- (set-interval-total-length! b (fix:+ (fix:+ (fix:+ lx ly1) (fix:+ ly2 lz))
- (fix:+ (fix:+ la lb) lc)))
+ (set-interval-total-length! b
+ (fix:+ (fix:+ (fix:+ lx ly1) (fix:+ ly2 lz))
+ (fix:+ (fix:+ la lb) lc)))
(set-interval-total-length! c (fix:+ (fix:+ ly2 lz) lc))
(set-interval-size! a (fix:+ (fix:+ ny1 nx) 1))
(else
(set-interval-size! t (fix:+ (interval-size t)
size-inc-amount))
- (balance (interval-parent t) group size-inc-amount))))))
-\f
-;; Edwin Variables:
-;; scheme-environment: '(edwin text-props)
-;; scheme-syntax-table: (access edwin-syntax-table (->environment '(edwin)))
-;; End:
\ No newline at end of file
+ (balance (interval-parent t) group size-inc-amount))))))
\ No newline at end of file
projects / mit-scheme.git / commitdiff