From: Chris Hanson Date: Tue, 23 Apr 1996 23:08:44 +0000 (+0000) Subject: Change all user-visible references to the noun "screen" to use "frame" X-Git-Tag: 20090517-FFI~5592 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=4babc700e8104b9cccacd1e6614db36e849e0b04;p=mit-scheme.git Change all user-visible references to the noun "screen" to use "frame" instead, for consistency with Emacs 19. --- diff --git a/v7/src/edwin/bufcom.scm b/v7/src/edwin/bufcom.scm index ac961c67d..afe687140 100644 --- a/v7/src/edwin/bufcom.scm +++ b/v7/src/edwin/bufcom.scm @@ -1,8 +1,8 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: bufcom.scm,v 1.100 1994/05/13 20:50:10 cph Exp $ +;;; $Id: bufcom.scm,v 1.101 1996/04/23 23:08:44 cph Exp $ ;;; -;;; Copyright (c) 1986, 1989-94 Massachusetts Institute of Technology +;;; Copyright (c) 1986, 1989-96 Massachusetts Institute of Technology ;;; ;;; This material was developed by the Scheme project at the ;;; Massachusetts Institute of Technology, Department of @@ -66,11 +66,13 @@ specifying a non-existent buffer will cause it to be created." (lambda (buffer) (select-buffer-other-window (find-buffer buffer #t)))) -(define-command switch-to-buffer-other-screen - "Select buffer in another screen." - (prompt-for-select-buffer "Switch to buffer in other screen") +(define-command switch-to-buffer-other-frame + "Select buffer in another frame." + (prompt-for-select-buffer "Switch to buffer in other frame") (lambda (buffer) (select-buffer-other-screen (find-buffer buffer #t)))) +(define edwin-command$switch-to-buffer-other-screen + edwin-command$switch-to-buffer-other-frame) (define-command create-buffer "Create a new buffer with a given name, and select it." @@ -78,12 +80,14 @@ specifying a non-existent buffer will cause it to be created." (lambda (name) (select-buffer (new-buffer name)))) -(define-command create-buffer-other-screen - "Create a new buffer with a given name, and select it in another screen." - "sCreate buffer in other screen" +(define-command create-buffer-other-frame + "Create a new buffer with a given name, and select it in another frame." + "sCreate buffer in other frame" (lambda (name) (select-buffer-other-screen (new-buffer name)))) - +(define edwin-command$create-buffer-other-screen + edwin-command$create-buffer-other-frame) + (define-command insert-buffer "Insert the contents of a specified buffer at point." "bInsert buffer" diff --git a/v7/src/edwin/curren.scm b/v7/src/edwin/curren.scm index 67941c327..ba7c66593 100644 --- a/v7/src/edwin/curren.scm +++ b/v7/src/edwin/curren.scm @@ -1,8 +1,8 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: curren.scm,v 1.118 1995/06/07 19:01:43 cph Exp $ +;;; $Id: curren.scm,v 1.119 1996/04/23 23:08:38 cph Exp $ ;;; -;;; Copyright (c) 1986, 1989-95 Massachusetts Institute of Technology +;;; Copyright (c) 1986, 1989-96 Massachusetts Institute of Technology ;;; ;;; This material was developed by the Scheme project at the ;;; Massachusetts Institute of Technology, Department of @@ -74,16 +74,17 @@ (append! (editor-screens current-editor) (list screen))) (event-distributor/invoke! - (variable-default-value (ref-variable-object screen-creation-hook)) + (variable-default-value (ref-variable-object frame-creation-hook)) screen) (update-screen! screen false) screen))))) -(define-variable screen-creation-hook - "An event distributor that is invoked when a screen is created. -The new screen passed as its argument. -The screen is guaranteed to be deselected at that time." +(define-variable frame-creation-hook + "An event distributor that is invoked when a frame is created. +The new frame passed as its argument. +The frame is guaranteed to be deselected at that time." (make-event-distributor)) +(define edwin-variable$screen-creation-hook edwin-variable$frame-creation-hook) (define (delete-screen! screen) (without-interrupts diff --git a/v7/src/edwin/debug.scm b/v7/src/edwin/debug.scm index e52d46dc3..489d05fef 100644 --- a/v7/src/edwin/debug.scm +++ b/v7/src/edwin/debug.scm @@ -1,8 +1,8 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: debug.scm,v 1.34 1995/11/13 23:47:32 cph Exp $ +;;; $Id: debug.scm,v 1.35 1996/04/23 23:08:30 cph Exp $ ;;; -;;; Copyright (c) 1992-94 Massachusetts Institute of Technology +;;; Copyright (c) 1992-96 Massachusetts Institute of Technology ;;; ;;; This material was developed by the Scheme project at the ;;; Massachusetts Institute of Technology, Department of @@ -899,12 +899,14 @@ Set this variable to #F to disable this abbreviation." #T boolean?) -(define-variable debugger-start-new-screen? - "#T means start a new-screen whenever the debugger is invoked. -#F means continue in same screen. -'ASK means ask user whether to start new-screen." +(define-variable debugger-start-new-frame? + "#T means start a new frame whenever the debugger is invoked. +#F means continue in same frame. +'ASK means ask user." #T boolean-or-ask?) +(define edwin-variable$debugger-start-new-screen? + edwin-variable$debugger-start-new-frame?) (define-variable debugger-hide-system-code? "True means don't show subproblems created by the runtime system." diff --git a/v7/src/edwin/dired.scm b/v7/src/edwin/dired.scm index 892374e39..4e4cca392 100644 --- a/v7/src/edwin/dired.scm +++ b/v7/src/edwin/dired.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: dired.scm,v 1.161 1996/04/10 01:06:34 cph Exp $ +;;; $Id: dired.scm,v 1.162 1996/04/23 23:08:24 cph Exp $ ;;; ;;; Copyright (c) 1986, 1989-96 Massachusetts Institute of Technology ;;; @@ -164,6 +164,12 @@ Type `h' after entering dired for more info." (lambda (directory) (select-buffer-other-window (make-dired-buffer directory)))) +(define-command dired-other-frame + "\"Edit\" directory DIRNAME. Like \\[dired] but selects in another frame." + "DDired in other frame (directory)" + (lambda (directory) + (select-buffer-other-screen (make-dired-buffer directory)))) + (define (make-dired-buffer directory #!optional file-list) (let ((directory (pathname-simplify directory)) (file-list (if (default-object? file-list) 'ALL file-list))) diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg index d477de58d..62ae29635 100644 --- a/v7/src/edwin/edwin.pkg +++ b/v7/src/edwin/edwin.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: edwin.pkg,v 1.185 1996/04/23 22:38:27 cph Exp $ +$Id: edwin.pkg,v 1.186 1996/04/23 23:08:15 cph Exp $ Copyright (c) 1989-96 Massachusetts Institute of Technology @@ -85,7 +85,7 @@ MIT in each case. |# "motcom" ; motion commands "replaz" ; replace commands "schmod" ; scheme mode - "scrcom" ; screen commands + "scrcom" ; frame commands "sercom" ; search commands "texcom" ; text commands "wincom" ; window commands @@ -813,6 +813,7 @@ MIT in each case. |# edwin-variable$debugger-quit-on-return? edwin-variable$debugger-show-help-message? edwin-variable$debugger-split-window? + edwin-variable$debugger-start-new-frame? edwin-variable$debugger-start-new-screen? edwin-variable$debugger-start-on-error? edwin-variable$debugger-verbose-mode? @@ -1013,8 +1014,32 @@ MIT in each case. |# (files "xcom") (parent (edwin)) (export (edwin) + edwin-command$auto-raise-mode + edwin-command$lower-frame + edwin-command$raise-frame + edwin-command$set-background-color + edwin-command$set-border-color + edwin-command$set-border-width + edwin-command$set-cursor-color + edwin-command$set-font + edwin-command$set-foreground-color + edwin-command$set-frame-icon-name + edwin-command$set-frame-name + edwin-command$set-frame-position + edwin-command$set-frame-size + edwin-command$set-internal-border-width + edwin-command$set-mouse-color + edwin-command$set-mouse-shape + edwin-command$set-mouse-shape edwin-command$x-auto-raise-mode edwin-command$x-lower-screen + edwin-command$x-mouse-ignore + edwin-command$x-mouse-keep-one-window + edwin-command$x-mouse-select + edwin-command$x-mouse-select-and-split + edwin-command$x-mouse-set-mark + edwin-command$x-mouse-set-point + edwin-command$x-mouse-show-event edwin-command$x-raise-screen edwin-command$x-set-background-color edwin-command$x-set-border-color @@ -1029,6 +1054,10 @@ MIT in each case. |# edwin-command$x-set-position edwin-command$x-set-size edwin-command$x-set-window-name + edwin-variable$frame-icon-name-format + edwin-variable$frame-icon-name-length + edwin-variable$frame-name-format + edwin-variable$frame-name-length edwin-variable$x-screen-icon-name-format edwin-variable$x-screen-icon-name-length edwin-variable$x-screen-name-format @@ -1202,6 +1231,7 @@ MIT in each case. |# os2-screen/set-foreground-color! os2-screen/set-position! os2-screen/set-size! + os2-screen/set-title! os2/desktop-width os2/desktop-height screen-char-width @@ -1352,10 +1382,17 @@ MIT in each case. |# edwin-command$set-background-color edwin-command$set-font edwin-command$set-foreground-color + edwin-command$set-frame-name + edwin-command$set-frame-position + edwin-command$set-frame-size edwin-command$set-screen-position edwin-command$set-screen-size + edwin-command$show-frame-position + edwin-command$show-frame-size edwin-command$show-screen-position - edwin-command$show-screen-size)))) + edwin-command$show-screen-size) + (export (edwin screen os2-screen) + update-os2-screen-names!)))) (define-package (edwin sendmail) (files "sendmail") diff --git a/v7/src/edwin/filcom.scm b/v7/src/edwin/filcom.scm index af5dc97c4..99c1061dd 100644 --- a/v7/src/edwin/filcom.scm +++ b/v7/src/edwin/filcom.scm @@ -1,8 +1,8 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: filcom.scm,v 1.187 1995/09/13 23:00:55 cph Exp $ +;;; $Id: filcom.scm,v 1.188 1996/04/23 23:08:06 cph Exp $ ;;; -;;; Copyright (c) 1986, 1989-95 Massachusetts Institute of Technology +;;; Copyright (c) 1986, 1989-96 Massachusetts Institute of Technology ;;; ;;; This material was developed by the Scheme project at the ;;; Massachusetts Institute of Technology, Department of @@ -68,10 +68,12 @@ May create a window, or reuse one." (define (find-file-other-screen filename) (select-buffer-other-screen (find-file-noselect filename true))) -(define-command find-file-other-screen - "Visit a file in another screen." - "FFind file in other screen" +(define-command find-file-other-frame + "Visit a file in another frame." + "FFind file in other frame" find-file-other-screen) +(define edwin-command$find-file-other-screen + edwin-command$find-file-other-frame) (define-command find-alternate-file "Find file FILENAME, select its buffer, kill previous buffer. diff --git a/v7/src/edwin/os2com.scm b/v7/src/edwin/os2com.scm index fbcee3854..abeb2884e 100644 --- a/v7/src/edwin/os2com.scm +++ b/v7/src/edwin/os2com.scm @@ -1,8 +1,8 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: os2com.scm,v 1.2 1995/05/20 10:19:46 cph Exp $ +;;; $Id: os2com.scm,v 1.3 1996/04/23 23:08:01 cph Exp $ ;;; -;;; Copyright (c) 1994 Massachusetts Institute of Technology +;;; Copyright (c) 1994-96 Massachusetts Institute of Technology ;;; ;;; This material was developed by the Scheme project at the ;;; Massachusetts Institute of Technology, Department of @@ -77,24 +77,24 @@ but changes the meaning of COLOR-NAME when it is used in the future." (os2-screen/set-font! screen font) (update-screen! screen #t)))) -(define-command set-screen-size - "Set size of editor screen to WIDTH x HEIGHT." - "nScreen width (chars)\nnScreen height (chars)" +(define-command set-frame-size + "Set size of editor frame to WIDTH x HEIGHT." + "nFrame width (chars)\nnFrame height (chars)" (lambda (width height) (os2-screen/set-size! (selected-screen) (max 2 width) (max 2 height)))) -(define-command set-screen-position - "Set position of editor screen to (X,Y)." +(define-command set-frame-position + "Set position of editor frame to (X,Y)." "nX position (pels)\nnY position (pels)" (lambda (x y) (os2-screen/set-position! (selected-screen) x y))) -(define-command show-screen-size - "Show size of editor screen." +(define-command show-frame-size + "Show size of editor frame." () (lambda () (let ((screen (selected-screen))) - (message "Screen is " + (message "Frame is " (screen-x-size screen) " chars wide and " (screen-y-size screen) @@ -104,13 +104,38 @@ but changes the meaning of COLOR-NAME when it is used in the future." (screen-pel-height screen) " pels)")))) -(define-command show-screen-position - "Show position of editor screen. +(define-command show-frame-position + "Show position of editor frame. This is the position of the lower left-hand corner of the frame border -surrounding the screen, relative to the lower left-hand corner of the +surrounding the frame, relative to the lower left-hand corner of the desktop." () (lambda () (call-with-values (lambda () (os2-screen/get-position (selected-screen))) (lambda (x y) - (message "Screen's lower left-hand corner is at (" x "," y ")"))))) \ No newline at end of file + (message "Frame's lower left-hand corner is at (" x "," y ")"))))) + +;; For upwards compatibility +(define edwin-command$set-screen-size edwin-command$set-frame-size) +(define edwin-command$set-screen-position edwin-command$set-frame-position) +(define edwin-command$show-screen-size edwin-command$show-frame-size) +(define edwin-command$show-screen-position edwin-command$show-frame-position) + +(define-command set-frame-name + "Set name of selected frame to NAME. +Useful only if `frame-name-format' is false." + "sSet frame name" + (lambda (name) (os2-screen/set-title! (selected-screen) name))) + +(define (update-os2-screen-names! screen) + (let ((window + (if (and (selected-screen? screen) (within-typein-edit?)) + (typein-edit-other-window) + (screen-selected-window screen))) + (format (ref-variable frame-name-format buffer)) + (length (ref-variable frame-name-length buffer))) + (if format + (os2-screen/set-title! + screen + (string-trim-right + (format-modeline-string window format length)))))) \ No newline at end of file diff --git a/v7/src/edwin/os2term.scm b/v7/src/edwin/os2term.scm index a10e58ab5..5dec8d916 100644 --- a/v7/src/edwin/os2term.scm +++ b/v7/src/edwin/os2term.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: os2term.scm,v 1.11 1996/03/20 23:52:27 cph Exp $ +;;; $Id: os2term.scm,v 1.12 1996/04/23 23:07:54 cph Exp $ ;;; ;;; Copyright (c) 1994-96 Massachusetts Institute of Technology ;;; @@ -261,8 +261,15 @@ unspecific) (define (os2-screen/wrap-update! screen thunk) - screen - (thunk)) + (let ((finished? #f)) + (dynamic-wind (lambda () unspecific) + (lambda () + (let ((result (thunk))) + (set! finished? result) + result)) + (lambda () + (if finished? + (update-os2-screen-names! screen)))))) (define (os2-screen/write-cursor! screen x y) (os2win-move-cursor (screen-wid screen) (cx->x screen x) (cy->y screen y))) @@ -444,6 +451,9 @@ (define (os2-screen/set-position! screen x y) (os2win-set-pos (screen-wid screen) x y)) +(define (os2-screen/set-title! screen title) + (os2win-set-title (screen-wid screen) title)) + (define (os2-screen/raise! screen) (os2win-set-state (screen-wid screen) window-state:top)) diff --git a/v7/src/edwin/scrcom.scm b/v7/src/edwin/scrcom.scm index 17d780c45..0e5117095 100644 --- a/v7/src/edwin/scrcom.scm +++ b/v7/src/edwin/scrcom.scm @@ -1,8 +1,8 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: scrcom.scm,v 1.4 1993/09/01 18:03:14 gjr Exp $ +;;; $Id: scrcom.scm,v 1.5 1996/04/23 23:07:48 cph Exp $ ;;; -;;; Copyright (c) 1990-1993 Massachusetts Institute of Technology +;;; Copyright (c) 1990-96 Massachusetts Institute of Technology ;;; ;;; This material was developed by the Scheme project at the ;;; Massachusetts Institute of Technology, Department of @@ -45,17 +45,51 @@ ;;;; Screen Commands (declare (usual-integrations)) - -(define-command delete-screen - "Delete the screen that point is in." + +(define-command delete-frame + "Delete the frame that point is in." () (lambda () (if (null? (cdr (screen-list))) - (editor-error "Can't delete the only screen")) + (editor-error "Can't delete the only frame")) (delete-screen! (selected-screen)))) +(define-command make-frame + "Create a new frame, displaying the current buffer." + () + (lambda () (select-buffer-other-screen (current-buffer)))) + +(define-command other-frame + "Select the ARG'th different visible frame, and raise it. +All frames are arranged in a cyclic order. +This command selects the frame ARG steps away in that order. +A negative ARG moves in the opposite order." + "p" + (lambda (arg) + (let ((screen (other-screen (selected-screen) arg #t))) + (if (not screen) + (editor-error "No other frame")) + (select-screen screen)))) + +(define-variable frame-name-format + "If not false, template for displaying frame name. +Has same format as `mode-line-format'." + 'mode-line-buffer-identification) + +(define-variable frame-name-length + "Maximum length of frame name. +Used only if `frame-name-format' is non-false." + 64 + exact-nonnegative-integer?) + +;; For upwards compatibility: +(define edwin-command$delete-screen edwin-command$delete-frame) +(define edwin-variable$x-screen-name-format edwin-variable$frame-name-format) +(define edwin-variable$x-screen-name-length edwin-variable$frame-name-length) + +;;; This command is for Windows, and shouldn't really be here. +;;; It is for terminal screens only. (define-command resize-screen "Resize the screen that point is in." () - (lambda () - (resize-screen))) \ No newline at end of file + (lambda () (resize-screen))) \ No newline at end of file diff --git a/v7/src/edwin/sendmail.scm b/v7/src/edwin/sendmail.scm index 9111bb133..8b2ef8611 100644 --- a/v7/src/edwin/sendmail.scm +++ b/v7/src/edwin/sendmail.scm @@ -1,8 +1,8 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: sendmail.scm,v 1.32 1995/05/23 11:37:56 cph Exp $ +;;; $Id: sendmail.scm,v 1.33 1996/04/23 23:07:43 cph Exp $ ;;; -;;; Copyright (c) 1991-95 Massachusetts Institute of Technology +;;; Copyright (c) 1991-96 Massachusetts Institute of Technology ;;; ;;; This material was developed by the Scheme project at the ;;; Massachusetts Institute of Technology, Department of @@ -159,24 +159,23 @@ that string is inserted. If mail-archive-file-name is true, an FCC: field with that file name is inserted." "P" - (lambda (no-erase?) - (make-mail-buffer '(("To" "") ("Subject" "")) - #f - select-buffer - (if no-erase? - 'KEEP-PREVIOUS-MAIL - 'QUERY-DISCARD-PREVIOUS-MAIL)))) + (lambda (no-erase?) (mail-command no-erase? select-buffer))) (define-command mail-other-window - "Like `mail' command, but display mail buffer in another window." + "Like \\[mail] command, but display mail buffer in another window." "P" - (lambda (no-erase?) - (make-mail-buffer '(("To" "") ("Subject" "")) - #f - select-buffer-other-window - (if no-erase? - 'KEEP-PREVIOUS-MAIL - 'QUERY-DISCARD-PREVIOUS-MAIL)))) + (lambda (no-erase?) (mail-command no-erase? select-buffer-other-window))) + +(define-command mail-other-frame + "Like \\[mail] command, but display mail buffer in another frame." + "P" + (lambda (no-erase?) (mail-command no-erase? select-buffer-other-screen))) + +(define (mail-command no-erase? select-buffer) + (make-mail-buffer '(("To" "") ("Subject" "")) #f select-buffer + (if no-erase? + 'KEEP-PREVIOUS-MAIL + 'QUERY-DISCARD-PREVIOUS-MAIL))) (define (make-mail-buffer headers reply-buffer #!optional selector handle-previous buffer-name mode) diff --git a/v7/src/edwin/tagutl.scm b/v7/src/edwin/tagutl.scm index 277ebad62..5ec440ef5 100644 --- a/v7/src/edwin/tagutl.scm +++ b/v7/src/edwin/tagutl.scm @@ -1,8 +1,8 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: tagutl.scm,v 1.54 1994/01/14 00:43:39 cph Exp $ +;;; $Id: tagutl.scm,v 1.55 1996/04/23 23:07:32 cph Exp $ ;;; -;;; Copyright (c) 1986, 1989-94 Massachusetts Institute of Technology +;;; Copyright (c) 1986, 1989-96 Massachusetts Institute of Technology ;;; ;;; This material was developed by the Scheme project at the ;;; Massachusetts Institute of Technology, Department of @@ -95,19 +95,16 @@ See documentation of variable tags-table-pathnames." (&find-tag-command string previous-tag? find-file))) (define-command find-tag-other-window - "Find tag (in current list of tag table) whose name contains TAGNAME. - Selects the buffer that the tag is contained in in another window -and puts point at its definition. - If TAGNAME is a null string, the expression in the buffer -around or before point is used as the tag name. - If second arg NEXT is non-false (interactively, with prefix arg), -searches for the next tag in the tag table -that matches the tagname used in the previous find-tag. - -See documentation of variable tags-table-pathnames." + "Like \\[find-tag], but select buffer in another window." (lambda () (find-tag-arguments "Find tag in other window")) (lambda (string previous-tag?) (&find-tag-command string previous-tag? find-file-other-window))) + +(define-command find-tag-other-frame + "Like \\[find-tag], but select buffer in another frame." + (lambda () (find-tag-arguments "Find tag in other frame")) + (lambda (string previous-tag?) + (&find-tag-command string previous-tag? find-file-other-screen))) ;;;; Find Tag diff --git a/v7/src/edwin/wincom.scm b/v7/src/edwin/wincom.scm index b2e312fba..fce6c72ba 100644 --- a/v7/src/edwin/wincom.scm +++ b/v7/src/edwin/wincom.scm @@ -1,8 +1,8 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: wincom.scm,v 1.117 1994/03/11 05:22:42 cph Exp $ +;;; $Id: wincom.scm,v 1.118 1996/04/23 23:07:26 cph Exp $ ;;; -;;; Copyright (c) 1987, 1989-94 Massachusetts Institute of Technology +;;; Copyright (c) 1987, 1989-96 Massachusetts Institute of Technology ;;; ;;; This material was developed by the Scheme project at the ;;; Massachusetts Institute of Technology, Department of @@ -64,11 +64,12 @@ Do not set this variable below 1." 2 exact-nonnegative-integer?) -(define-variable use-multiple-screens - "If true, commands try to use multiple screens rather than multiple windows. -Has no effect unless multiple-screen support is available." +(define-variable use-multiple-frames + "If true, commands try to use multiple frames rather than multiple windows. +Has no effect unless multiple-frame support is available." false boolean?) +(define edwin-variable$use-multiple-screens edwin-variable$use-multiple-frames) (define-variable pop-up-windows "True enables the use of pop-up windows." @@ -376,7 +377,7 @@ or if the window is the only window of its frame." (editor-error "Not implemented for typein window"))) (define (use-multiple-screens?) - (and (ref-variable use-multiple-screens) + (and (ref-variable use-multiple-frames) (multiple-screens?))) (define (select-buffer-other-window buffer) diff --git a/v7/src/edwin/xcom.scm b/v7/src/edwin/xcom.scm index 9c91f4653..690f942bd 100644 --- a/v7/src/edwin/xcom.scm +++ b/v7/src/edwin/xcom.scm @@ -1,8 +1,8 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: xcom.scm,v 1.12 1994/10/26 01:33:47 cph Exp $ +;;; $Id: xcom.scm,v 1.13 1996/04/23 23:07:18 cph Exp $ ;;; -;;; Copyright (c) 1989-94 Massachusetts Institute of Technology +;;; Copyright (c) 1989-96 Massachusetts Institute of Technology ;;; ;;; This material was developed by the Scheme project at the ;;; Massachusetts Institute of Technology, Department of @@ -64,15 +64,15 @@ (define (current-xterm) (screen-xterm (selected-screen))) -(define-command x-set-foreground-color - "Set foreground (text) color to COLOR." +(define-command set-foreground-color + "Set foreground (text) color of selected frame to COLOR." "sSet foreground color" (lambda (color) (x-window-set-foreground-color (current-xterm) color) (update-screen! (selected-screen) true))) -(define-command x-set-background-color - "Set background color to COLOR." +(define-command set-background-color + "Set background color of selected frame to COLOR." "sSet background color" (lambda (color) (let ((xterm (current-xterm))) @@ -80,26 +80,26 @@ (x-window-clear xterm)) (update-screen! (selected-screen) true))) -(define-command x-set-border-color - "Set border color to COLOR." +(define-command set-border-color + "Set border color of selected frame to COLOR." "sSet border color" (lambda (color) (x-window-set-border-color (current-xterm) color))) -(define-command x-set-cursor-color - "Set cursor color to COLOR." +(define-command set-cursor-color + "Set cursor color of selected frame to COLOR." "sSet cursor color" (lambda (color) (x-window-set-cursor-color (current-xterm) color))) -(define-command x-set-mouse-color - "Set mouse color to COLOR." +(define-command set-mouse-color + "Set mouse color of selected frame to COLOR." "sSet mouse color" (lambda (color) (x-window-set-mouse-color (current-xterm) color))) -(define-command x-set-font - "Set font to be used for drawing text." +(define-command set-font + "Set text font of selected frame to FONT." "sSet font" (lambda (font) (let ((xterm (current-xterm))) @@ -109,44 +109,42 @@ (editor-error "Unknown font name: " font)) (xterm-set-size xterm x-size y-size))))) -(define-command x-set-size - "Set size of editor screen to WIDTH x HEIGHT." - "nScreen width (chars)\nnScreen height (chars)" +(define-command set-frame-size + "Set size of selected frame to WIDTH x HEIGHT." + "nFrame width (chars)\nnFrame height (chars)" (lambda (width height) (xterm-set-size (current-xterm) (max 2 width) (max 2 height)))) -(define-command x-set-position - "Set position of editor screen to (X,Y)." +(define-command set-frame-position + "Set position of selected frame to (X,Y)." "nX position (pixels)\nnY position (pixels)" (lambda (x y) (x-window-set-position (current-xterm) x y))) -(define-command x-set-border-width - "Set width of border to WIDTH." +(define-command set-border-width + "Set border width of selected frame to WIDTH." "nSet border width" (lambda (width) (x-window-set-border-width (current-xterm) (max 0 width)) (update-screen! (selected-screen) true))) -(define-command x-set-internal-border-width - "Set width of internal border to WIDTH." +(define-command set-internal-border-width + "Set internal border width of selected frame to WIDTH." "nSet internal border width" (lambda (width) (x-window-set-internal-border-width (current-xterm) (max 0 width)))) -(define-command x-set-window-name - "Set X window name to NAME. -Useful only if `x-screen-name-format' is false." - "sSet X window name" - (lambda (name) - (xterm-screen/set-name (selected-screen) name))) - -(define-command x-set-icon-name - "Set X window icon name to NAME. -Useful only if `x-screen-icon-name-format' is false." - "sSet X window icon name" - (lambda (name) - (xterm-screen/set-icon-name (selected-screen) name))) +(define-command set-frame-name + "Set name of selected frame to NAME. +Useful only if `frame-name-format' is false." + "sSet frame name" + (lambda (name) (xterm-screen/set-name (selected-screen) name))) + +(define-command set-frame-icon-name + "Set icon name of selected frame to NAME. +Useful only if `frame-icon-name-format' is false." + "sSet frame icon name" + (lambda (name) (xterm-screen/set-icon-name (selected-screen) name))) (define (update-xterm-screen-names! screen) (let ((window @@ -154,7 +152,7 @@ Useful only if `x-screen-icon-name-format' is false." (typein-edit-other-window) (screen-selected-window screen)))) (let ((buffer (window-buffer window)) - (update-name + (update-name (lambda (set-name format length) (if format (set-name @@ -162,60 +160,48 @@ Useful only if `x-screen-icon-name-format' is false." (string-trim-right (format-modeline-string window format length))))))) (update-name xterm-screen/set-name - (ref-variable x-screen-name-format buffer) - (ref-variable x-screen-name-length buffer)) + (ref-variable frame-name-format buffer) + (ref-variable frame-name-length buffer)) (update-name xterm-screen/set-icon-name - (ref-variable x-screen-icon-name-format buffer) - (ref-variable x-screen-icon-name-length buffer))))) - -(define-variable x-screen-name-format - "If not false, template for displaying X window name. -Has same format as `mode-line-format'." - 'mode-line-buffer-identification) + (ref-variable frame-icon-name-format buffer) + (ref-variable frame-icon-name-length buffer))))) -(define-variable x-screen-name-length - "Maximum length of X window name. -Used only if `x-screen-name-format' is non-false." - 64 - exact-nonnegative-integer?) - -(define-variable x-screen-icon-name-format - "If not false, template for displaying X window icon name. +(define-variable frame-icon-name-format + "If not false, template for displaying frame icon name. Has same format as `mode-line-format'." "edwin") -(define-variable x-screen-icon-name-length - "Maximum length of X window icon name. -Used only if `x-screen-icon-name-format' is non-false." +(define-variable frame-icon-name-length + "Maximum length of frame icon name. +Used only if `frame-icon-name-format' is non-false." 32 exact-nonnegative-integer?) -(define-command x-raise-screen - "Raise the editor screen so that it is not obscured by other X windows." +(define-command raise-frame + "Raise the selected frame so that it is not obscured by other windows." () (lambda () (x-window-raise (current-xterm)))) -(define-command x-lower-screen - "Lower the editor screen so that it does not obscure other X windows." +(define-command lower-frame + "Lower the selected frame so that it does not obscure other windows." () (lambda () (x-window-lower (current-xterm)))) -(define-command x-auto-raise-mode +(define-command auto-raise-mode "Toggle auto-raise mode. -With argument, turn auto-raise mode on iff argument is positive." +With argument, turn auto-raise mode on if argument is positive. +When auto-raise mode is on, typing in a frame causes it to be raised." "P" (lambda (argument) - (let ((argument (command-argument-value argument))) - (cond ((and (or (not argument) (positive? argument)) - (not x-screen-auto-raise)) - (set! x-screen-auto-raise true)) - ((and (or (not argument) (not (positive? argument))) - x-screen-auto-raise) - (set! x-screen-auto-raise false)))) + (set! x-screen-auto-raise + (let ((argument (command-argument-value argument))) + (if argument + (> argument 0) + (not x-screen-auto-raise)))) (message "Auto-raise " (if x-screen-auto-raise "enabled" "disabled")))) -(define-command x-set-mouse-shape - "Set mouse cursor shape to SHAPE. +(define-command set-mouse-shape + "Set mouse cursor shape for selected frame to SHAPE. SHAPE must be the (string) name of one of the known cursor shapes. When called interactively, completion is available on the input." (lambda () @@ -317,33 +303,43 @@ When called interactively, completion is available on the input." ;;;; Mouse Commands ;;; (For compatibility with old code.) -(define edwin-command$x-mouse-select - (copy-command 'X-MOUSE-SELECT - (ref-command-object mouse-select))) - -(define edwin-command$x-mouse-keep-one-window - (copy-command 'X-MOUSE-KEEP-ONE-WINDOW - (ref-command-object mouse-keep-one-window))) - -(define edwin-command$x-mouse-select-and-split - (copy-command 'X-MOUSE-SELECT-AND-SPLIT - (ref-command-object mouse-select-and-split))) - -(define edwin-command$x-mouse-set-point - (copy-command 'X-MOUSE-SET-POINT - (ref-command-object mouse-set-point))) - -(define edwin-command$x-mouse-set-mark - (copy-command 'X-MOUSE-SET-MARK - (ref-command-object mouse-set-mark))) - -(define edwin-command$x-mouse-show-event - (copy-command 'X-MOUSE-SHOW-EVENT - (ref-command-object mouse-show-event))) - -(define edwin-command$x-mouse-ignore - (copy-command 'X-MOUSE-IGNORE - (ref-command-object mouse-ignore))) +(let-syntax + ((copy + (lambda (name) + `(DEFINE ,(symbol-append 'EDWIN-COMMAND$X- name) + ,(symbol-append 'EDWIN-COMMAND$ name))))) + (copy set-foreground-color) + (copy set-background-color) + (copy set-border-color) + (copy set-cursor-color) + (copy set-mouse-color) + (copy set-font) + (copy set-border-width) + (copy set-internal-border-width) + (copy auto-raise-mode) + (copy set-mouse-shape) + (copy mouse-select) + (copy mouse-keep-one-window) + (copy mouse-select-and-split) + (copy mouse-set-point) + (copy mouse-set-mark) + (copy mouse-show-event) + (copy mouse-ignore)) + +(define edwin-command$x-set-size edwin-command$set-frame-size) +(define edwin-command$x-set-position edwin-command$set-frame-position) +(define edwin-command$x-set-window-name edwin-command$set-frame-name) +(define edwin-command$x-set-icon-name edwin-command$set-frame-icon-name) +(define edwin-command$x-raise-screen edwin-command$raise-frame) +(define edwin-command$x-lower-screen edwin-command$lower-frame) + +(let-syntax + ((copy + (lambda (name) + `(DEFINE ,(symbol-append 'EDWIN-VARIABLE$X-SCREEN- name) + ,(symbol-append 'EDWIN-VARIABLE$FRAME- name))))) + (copy icon-name-format) + (copy icon-name-length)) (define x-button1-down button1-down) (define x-button2-down button2-down)