;;; post-x-win.el --- second phase of runtime initialization for X windows
;; Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc.
;; Copyright (C) 1995 Board of Trustees, University of Illinois.

;; Author: FSF
;; Keywords: terminals

;; This file is part of XEmacs.

;; XEmacs is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XEmacs is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary:

;; post-x-win.el: this file is loaded either from ../term/x-win.el or
;; by make-device when it creates the first X device.

;;; Code:


;; We can't load this until after the initial X device is created
;; because the icon initialization needs to access the display to get
;; any toolbar-related color resources.
(require 'x-toolbar)


;;; selections and active regions

;;; If and only if zmacs-regions is true:
;;;
;;; When a mark is pushed and the region goes into the "active" state, we
;;; assert it as the Primary selection.  This causes it to be hilighted.
;;; When the region goes into the "inactive" state, we disown the Primary
;;; selection, causing the region to be dehilighted.
;;;
;;; Note that it is possible for the region to be in the "active" state
;;; and not be hilighted, if it is in the active state and then some other
;;; application asserts the selection.  This is probably not a big deal.

(defun x-activate-region-as-selection ()
  (if (marker-buffer (mark-marker t))
      (x-own-selection (cons (point-marker t) (mark-marker t)))))

;;; these are only ever called if zmacs-regions is true.
(add-hook 'zmacs-deactivate-region-hook 'x-disown-selection)
(add-hook 'zmacs-activate-region-hook 'x-activate-region-as-selection)
(add-hook 'zmacs-update-region-hook 'x-activate-region-as-selection)


;; Keypad type things

(defun fkey-popup-mode-menu ()
  (interactive)
  (call-interactively (key-binding [(button3)])))

;;; These aren't bound to kbd macros like "\C-b" so that they have the
;; expected behavior even in, for example, vi-mode.

;; We use here symbolic names, assuming that the corresponding keys will
;; generate these keysyms.  This is not true on Suns, but x-win-sun.el 
;; fixes that.  If it turns out that the semantics of these keys should
;; differ from server to server, this should be moved into server-specific
;; files, but these appear to be the standard Motif and PC bindings.

;; potential R6isms
(define-key global-map 'kp_left		'fkey-backward-char)
(define-key global-map 'kp_up		'fkey-previous-line)
(define-key global-map 'kp_right	'fkey-forward-char)
(define-key global-map 'kp_down		'fkey-next-line)


;; movement by larger blocks
(define-key global-map '(control left)	'fkey-backward-word)
(define-key global-map '(control up)	#'(lambda ()
					    (interactive "_")
					    (forward-line -6)))
(define-key global-map '(control right)	'fkey-forward-word)
(define-key global-map '(control down)	#'(lambda ()
					    (interactive "_")
					    (forward-line 6)))

;; context-sensitive movement
(define-key global-map '(meta left)  'fkey-backward-sexp)
(define-key global-map '(meta right) 'fkey-forward-sexp)
(define-key global-map '(meta up)    'fkey-backward-paragraph)
(define-key global-map '(meta down)  'fkey-forward-paragraph)

;; movement by pages
(define-key global-map '(control prior)	'fkey-scroll-right)
(define-key global-map '(control next)	'fkey-scroll-left)
;; potential R6isms
(define-key global-map 'kp_prior	'fkey-scroll-down)
(define-key global-map 'kp_next		'fkey-scroll-up)
(define-key global-map '(control kp_prior) 'fkey-scroll-right)
(define-key global-map '(control kp_next) 'fkey-scroll-left)
;; potential Sunisms
(define-key global-map 'pgup		'fkey-scroll-down)
(define-key global-map 'pgdn		'fkey-scroll-up)
(define-key global-map '(control pgup)	'fkey-scroll-right)
(define-key global-map '(control pgdn)	'fkey-scroll-left)


;; movement to the limits
(define-key global-map '(control home)	'fkey-beginning-of-buffer)
(define-key global-map '(control end)	'fkey-end-of-buffer)
(define-key global-map 'begin		'fkey-beginning-of-line)
(define-key global-map '(control begin)	'fkey-beginning-of-buffer)
;; potential R6isms
(define-key global-map 'kp_home		'fkey-beginning-of-line)
(define-key global-map '(control kp_home) 'fkey-beginning-of-buffer)
(define-key global-map 'kp_end		'fkey-end-of-line)
(define-key global-map '(control kp_end) 'fkey-end-of-buffer)

;; movement between windows
(define-key global-map '(control tab)	'fkey-other-window)
(define-key global-map '(control shift tab) 'fkey-backward-other-window)

;; movement in other windows
(define-key global-map '(meta next)	'fkey-scroll-other-window)
(define-key global-map '(meta prior)	'scroll-other-window-down)
(define-key global-map '(meta home)	'beginning-of-buffer-other-window)
(define-key global-map '(meta end)	'end-of-buffer-other-window)
;; potential R6isms
(define-key global-map '(meta kp_next)	'fkey-scroll-other-window)
(define-key global-map '(meta kp_prior)	'scroll-other-window-down)
(define-key global-map '(meta kp_home)	'beginning-of-buffer-other-window)
(define-key global-map '(meta kp_end)	'end-of-buffer-other-window)
;; potential Sunisms
(define-key global-map '(meta pgdn)	'fkey-scroll-other-window)
(define-key global-map '(meta pgup)	'scroll-other-window-down)


;; potential R6isms
(define-key global-map 'redo		'fkey-repeat-complex-command)
(define-key global-map 'kp_insert	'fkey-overwrite-mode)
(define-key global-map 'kp_delete	'backward-delete-char-untabify)

(define-key global-map 'kp_enter	[return]) ; do whatever RET does now
(define-key global-map 'kp_tab		[tab])

(define-key global-map 'undo		'undo)
(define-key global-map 'help		'help-for-help)
(define-key help-map   'help		'help-for-help)

;; Motif-ish bindings
;; The following two were generally unliked.
;(define-key global-map '(shift delete)	'x-kill-primary-selection)
;(define-key global-map '(control delete) 'x-delete-primary-selection)
(define-key global-map '(shift insert)	'x-yank-clipboard-selection)
(define-key global-map '(control insert)	'x-copy-primary-selection)
;; (Are these Sunisms?)
(define-key global-map 'copy		'x-copy-primary-selection)
(define-key global-map 'paste		'x-yank-clipboard-selection)
(define-key global-map 'cut		'x-kill-primary-selection)

(define-key global-map 'menu		'fkey-popup-mode-menu)
;(define-key global-map '(shift menu)	'x-goto-menubar) ;NYI

;; if we define these this way (instead of leaving them bound to self-
;; insert-command), then the show-bindings display is hideously cluttered.
;(define-key global-map 'kp_space	" ")
;(define-key global-map 'kp_equal	"=")
;(define-key global-map 'kp_multiply	"*")
;(define-key global-map 'kp_add		"+")
;(define-key global-map 'kp_separator	",")
;(define-key global-map 'kp_subtract	"-")
;(define-key global-map 'kp_decimal	".")
;(define-key global-map 'kp_divide	"/")


;;; OpenWindows-like "find" processing.  These functions are really Sunisms,
;;; but we put them here instead of in x-win-sun.el in case someone wants
;;; to use them when not running on a Sun console (presumably after adding
;;; the to different keys, or putting them on menus.)

(defvar ow-find-last-string nil)
(defvar ow-find-last-clipboard nil)

(defun ow-find (&optional backward-p)
  "Search forward the next occurence of the text of the selection."
  (interactive)
  (let ((sel (condition-case () (x-get-selection) (error nil)))
	(clip (condition-case () (x-get-clipboard) (error nil)))
	text)
    (setq text (cond
		(sel)
		((not (equal clip ow-find-last-clipboard))
		 (setq ow-find-last-clipboard clip))
		(ow-find-last-string)
		(t (error "No selection available"))))
    (setq ow-find-last-string text)
    (cond (backward-p
	   (search-backward text)
	   (set-mark (+ (point) (length text))))
	  (t
	   (search-forward text)
	   (set-mark (- (point) (length text)))))
    (zmacs-activate-region)))

(defun ow-find-backward ()
  "Search backward the previous occurence of the text of the selection."
  (interactive)
  (ow-find t))


;;; Load X-server specific code.
;;; Specifically, load some code to repair the grievous damage that MIT and
;;; Sun have done to the default keymap for the Sun keyboards.

(defun x-initialize-keyboard ()
  (cond (;; This is some heuristic junk that tries to guess whether this is
	 ;; a Sun keyboard.
	 ;;
	 ;; One way of implementing this (which would require C support) would
	 ;; be to examine the X keymap itself and see if the layout looks even
	 ;; remotely like a Sun - check for the Find key on a particular
	 ;; keycode, for example.  It'd be nice to have a table of this to
	 ;; recognize various keyboards; see also xkeycaps.
	 ;;
	 (let ((vendor (x-server-vendor)))
	   (or (string-match "Sun Microsystems" vendor)
	       ;; MIT losingly fails to tell us what hardware the X server
	       ;; is managing, so assume all MIT displays are Suns...  HA HA!
	       (string-equal "MIT X Consortium" vendor)
	       (string-equal "X Consortium" vendor)))
       ;;
       ;; Ok, we think this could be a Sun keyboard.  Load the Sun code.
       ;;
       (load (concat term-file-prefix "x-win-sun") nil t)
       )
	((string-match "XFree86" (x-server-vendor))
	 ;; Those XFree86 people do some weird keysym stuff, too.
	 (load (concat term-file-prefix "x-win-xfree86") nil t))
      ))

;; This runs after the first frame has been created (we can't talk to the X
;; server before that) but before the site-start-file or .emacs file, so sites
;; and users have a chance to override it.
(add-hook 'before-init-hook 'x-initialize-keyboard)

(provide 'post-x-win)

;;; post-x-win.el ends here
