instead, for consistency with Emacs 19.
;;; -*-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
(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."
(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)
+\f
(define-command insert-buffer
"Insert the contents of a specified buffer at point."
"bInsert buffer"
;;; -*-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
(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
;;; -*-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
#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?)
\f
(define-variable debugger-hide-system-code?
"True means don't show subproblems created by the runtime system."
;;; -*-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
;;;
(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)))
#| -*-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
"motcom" ; motion commands
"replaz" ; replace commands
"schmod" ; scheme mode
- "scrcom" ; screen commands
+ "scrcom" ; frame commands
"sercom" ; search commands
"texcom" ; text commands
"wincom" ; window commands
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?
(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
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
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
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!))))
\f
(define-package (edwin sendmail)
(files "sendmail")
;;; -*-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
(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.
;;; -*-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
(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)
(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)
+\f
+(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
;;; -*-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
;;;
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)))
(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))
;;; -*-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
;;;; Screen Commands
(declare (usual-integrations))
-
-(define-command delete-screen
- "Delete the screen that point is in."
+\f
+(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
;;; -*-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
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)
;;; -*-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
(&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)))
\f
;;;; Find Tag
;;; -*-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
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."
(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)
;;; -*-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
(define (current-xterm)
(screen-xterm (selected-screen)))
\f
-(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)))
(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)))
(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))))
\f
-(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
(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
(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"))))
\f
-(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 ()
;;;; 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)
projects / mit-scheme.git / commitdiff