Commits

steve  committed 45f6883

Created

  • Participants
  • Tags xemacs

Comments (0)

Files changed (7)

+1998-01-12  SL Baur  <steve@altair.xemacs.org>
+
+	* Makefile: Update to newer package interface.
+
+1998-01-03  SL Baur  <steve@altair.xemacs.org>
+
+	* Makefile: Update to newer package spec.
+
+1997-12-30  SL Baur  <steve@altair.xemacs.org>
+
+	* pc-select.el: Update to version 1.4.
+
+	* Makefile (VERSION): Update to 1.02.
+
+1997-12-25  SL Baur  <steve@altair.xemacs.org>
+
+	* delbs.el: Make obsolete.
+
+1997-12-24  SL Baur  <steve@altair.xemacs.org>
+
+	* Makefile: Created.
+# Makefile for miscellaneous PC interface lisp code
+
+# 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, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+# This XEmacs package contains independent single file lisp packages
+
+VERSION = 1.04
+PACKAGE = pc
+PKG_TYPE = single-file
+REQUIRES = xemacs-base
+CATEGORY = oa
+
+ELCS = delbs.elc pc-select.elc pending-del.elc s-region.elc
+
+include ../../XEmacs.rules
+
+all:: $(ELCS) auto-autoloads.elc custom-load.elc
+
+srckit: srckit-std
+
+binkit: binkit-sourceonly
+;;; delbs.el --- a small lisp package to allow you to swap around DEL/BS keys
+
+;; Copyright (C) 1997 Gary Foster
+
+;; Author: Gary Foster <Gary.Foster@corp.sun.com>
+;; Keywords: lisp, 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, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: not in FSF.
+
+;;; Commentary:
+
+;;   This package should, *theoretically*, serve to quieten the DEL/BS rwars
+;;     a little.  By using this package, you can have DEL and BS both do the
+;;     same function (normally delete one char to the left) or you can have
+;;     then bound separately (DEL --> delete-char, BS --> delete-backward-char)
+;;     with all appropriate Meta bindings in each mode.
+;;
+;; Author: Gary Foster <Gary.Foster@corp.sun.com>
+;; Credits due to: Per Abrahamsen <abraham@dina.kvl.dk>
+
+;;; Code:
+
+(provide 'delbs)
+
+(message "Use the variable `delete-key-deletes-forward' instead of delbs")
+(sit-for 5)
+
+;;; delbs.el ends here

File package-info.in

+(pc
+  (version VERSION
+   description "PC style interface emulation."
+   filename FILENAME
+   md5sum MD5SUM
+   size SIZE
+   provides (delbs pc-select pending-del s-region)
+   requires (REQUIRES)
+   type regular
+))

File pc-select.el

+;;; pc-select.el --- PC shift selection minor mode for XEmacs
+
+;; Copyright (C) 1997 Gary D. Foster
+
+;; Author: Gary D. Foster <Gary.Foster@sun.com>
+;; Created: 23 Dec 1997
+;; Version: 1.4
+;; Keywords: hardware, mouse
+
+;; 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, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not synched.
+
+;;; Commentary:
+
+;; This is a complete rewrite of the pc-select package in FSF Emacs
+;; originally written by Michael Staats <michael@thp.Uni-Duisburg.DE>.
+;; The FSF version contained the desired functionality, but at the expense
+;; of being a very lousy citizen of the XEmacs environment.
+
+;; If you need support for this package or wish to request a feature or
+;; report a bug, please contact <gary.foster@sun.com> and do not contact
+;; the original author.  They are not responsible for this, I am.
+
+;; This package is a minor mode and set of bindings to emulate the shift
+;; selection feature of various PC environments.  When the user presses
+;; and holds the shift key while pressing an arrow key (up, down, left, or
+;; right) or any permuation of commands involving S-<arrow> it is desired
+;; that mark be set during the operation.  Thus, to mark an entire line
+;; you could press the S-down key chord, which would set the mark at the
+;; place where the movement began, and then move down one line.  Similar
+;; functionality exists for the rest of the movement combos involving the
+;; arrow keys.
+
+;; Note: This package enables (and is dependant upon) pending-del mode
+;; when the pc-select minor mode is enabled.
+
+;;; Revision 1.4  1997/12/29 21:08:06  gfoster
+;;; Added a bunch of keybindings (prior/next/home/end and various
+;;; permutations thereof).
+;;; Automatically enable pending-del mode when this minor mode is enabled.
+;;; Added doc strings for all the functions.
+
+;; Revision 1.3 1997/12/26 20:04:26   gfoster
+;; Tweaked package profile and comment headers to standardize with XEmacs
+;;
+;; Revision 1.2  1997/12/24 02:34:12  gfoster
+;; Added standard XEmacs comment headers
+;;
+;; Revision 1.1  1997/12/24 02:29:49  gfoster
+;; Initial revision
+;;
+
+;; Code:
+
+;; local variables
+
+(defgroup pc-select nil
+  "PC Selection mode customizable settings."
+  :group 'editing-options)
+
+(defvar pc-select-map (let ((map (make-sparse-keymap)))
+			(set-keymap-parent map (current-global-map))
+			map)
+  "Local keymap for pc-select mode.")
+
+(defcustom pc-select-modeline-string " PC"
+  "*String to display in the modeline when pc-select mode is active."
+  :type 'string
+  :group 'pc-select)
+
+(defvar pc-select-original-keymap (current-global-map)
+  "The original keymap before pc-select mode remaps anything.
+This keymap is restored when the mode is disabled.")
+
+(defvar pc-select-enabled nil
+  "Track status of pc-select mode.
+A value of nil means pc-select mode is not enabled.  A value of t
+indicates it is enabled.")
+
+(defconst pc-select-version "1.4"
+  "The version of the pc-select package.")
+
+;; keymap defines
+
+;; Normal movement keys should deselect the region (I think this is stupid,
+;; but people demanded it)
+
+(define-key pc-select-map [(right)]		'pc-select-move-char-right)
+(define-key pc-select-map [(left)]		'pc-select-move-char-left)
+(define-key pc-select-map [(control right)]     'pc-select-move-word-right)
+(define-key pc-select-map [(control left)]	'pc-select-move-word-left)
+(define-key pc-select-map [(up)]		'pc-select-move-line-up)
+(define-key pc-select-map [(down)]		'pc-select-move-line-down)
+(define-key pc-select-map [(home)]		'pc-select-move-bol)
+(define-key pc-select-map [(end)]		'pc-select-move-eol)
+(define-key pc-select-map [(control home)]	'pc-select-move-bob)
+(define-key pc-select-map [(control end)]	'pc-select-move-eob)
+(define-key pc-select-map [(prior)]		'pc-select-move-page-up)
+(define-key pc-select-map [(next)]		'pc-select-move-page-down)
+
+;; Shift + movement by character or line
+
+(define-key pc-select-map [(shift right)]	'pc-select-mark-char-right)
+(define-key pc-select-map [(shift left)]  	'pc-select-mark-char-left)
+
+;; C-S-arrow marks by word
+
+(define-key pc-select-map [(control shift right)] 'pc-select-mark-word-right)
+(define-key pc-select-map [(control shift left)]  'pc-select-mark-word-left)
+
+;; line marking
+
+(define-key pc-select-map [(shift up)]		'pc-select-mark-line-up)
+(define-key pc-select-map [(shift down)]	'pc-select-mark-line-down)
+(define-key pc-select-map [(shift home)]	'pc-select-mark-to-bol)
+(define-key pc-select-map [(shift end)]		'pc-select-mark-to-eol)
+
+;; page marking
+
+(define-key pc-select-map [(shift prior)]	'pc-select-mark-page-up)
+(define-key pc-select-map [(shift next)]	'pc-select-mark-page-down)
+
+;; buffer marking
+
+(define-key pc-select-map [(control shift home)] 'pc-select-mark-to-bob)
+(define-key pc-select-map [(control shift end)] 'pc-select-mark-to-eob)
+
+;; cut and paste
+
+(define-key pc-select-map [(shift delete)]	'x-kill-primary-selection)
+(define-key pc-select-map [(shift insert)]	'x-yank-clipboard-selection)
+(define-key pc-select-map [(control insert)]	'x-copy-primary-selection)
+
+;; this defun makes sure mark is set.
+
+(defun pc-select-ensure-mark ()
+  "Ensures mark is set at point."
+  (if zmacs-region-active-p
+      (setq zmacs-region-stays t)
+    (set-mark-command nil)))
+
+;; normal (unshifted) movement commands disable the region before moving
+
+(defun pc-select-move-char-right (&optional arg)
+  "Move point right ARG characters, deselecting any marked region.
+Moves left if ARG is negative."
+  (interactive "p")
+  (setq zmacs-region-stays nil)
+  (forward-char arg))
+
+(defun pc-select-move-char-left (&optional arg)
+  "Move point left ARG characters, deselecting any marked region.
+Moves right if ARG negative."
+  (interactive "p")
+  (setq zmacs-region-stays nil)
+  (backward-char arg))
+
+(defun pc-select-move-word-right (&optional arg)
+  "Move point right ARG words, deselecting any marked region.
+Moves left if ARG is negative."
+  (interactive "p")
+  (setq zmacs-region-stays nil)
+  (forward-word arg))
+
+(defun pc-select-move-word-left (&optional arg)
+  "Move point left ARG words, deselecting any marked region.
+Moves right if ARG is negative."
+  (interactive "p")
+  (setq zmacs-region-stays nil)
+  (backward-word arg))
+
+(defun pc-select-move-line-up (&optional arg)
+  "Move point up ARG lines, deselecting any marked region.
+Moves down if ARG is negative."
+  (interactive "p")
+  (setq zmacs-region-stays nil)
+  (next-line (- arg)))
+
+(defun pc-select-move-line-down (&optional arg)
+  "Move point down ARG lines, deselecting any marked region.
+Moves up if ARG is negative."
+  (interactive "p")
+  (setq zmacs-region-stays nil)
+  (next-line arg))
+
+(defun pc-select-move-bol (&optional arg)
+  "Move point to the beginning of the line, deselecting any marked region.
+With argument ARG not nil or 1, move forward ARG - 1 lines first.
+If scan reaches end of buffer, stop there without error."
+  (interactive "p")
+  (setq zmacs-region-stays nil)
+  (beginning-of-line arg))
+
+(defun pc-select-move-eol (&optional arg)
+  "Move point to the end of the line, deselecting any marked region.
+With argument ARG not nil or 1, move forward ARG -1 lines first.
+If scan reaches end of buffer, stop there without error."
+  (interactive "p")
+  (setq zmacs-region-stays nil)
+  (end-of-line arg))
+
+(defun pc-select-move-page-up (&optional arg)
+  "Scroll text of current window down ARG lines, deselecting any marked region.
+Scrolls near full screen if no ARG, scrolls upward if ARG is negative.
+
+See `scroll-down' for further info."
+  (interactive "P")
+  (setq zmacs-region-stays nil)
+  (scroll-down arg))
+
+(defun pc-select-move-page-down (&optional arg)
+  "Scroll text of current window up ARG lines, deselecting any marked region.
+Scrolls near full screen if no ARG, scrolls downward if ARG is negative.
+
+See `scroll-up' for further info."
+  (interactive "P")
+  (setq zmacs-region-stays nil)
+  (scroll-up arg))
+
+(defun pc-select-move-bob (&optional arg)
+  "Move point to the beginning of buffer, deselecting any active region.
+With arg N, put point N/10 of the way from the beginning.
+
+If the buffer is narrowed, this command uses the beginning and size
+of the accessible part of the buffer."
+  (interactive "P")
+  (setq zmacs-region-stays nil)
+  (beginning-of-buffer))
+
+(defun pc-select-move-eob (&optional arg)
+"Move point to the end of buffer, deselecting any active region.
+With arg N, put point N/10 of the way from the end.
+
+If the buffer is narrowed, this command uses the beginning and size
+of the accessible part of the buffer."
+  (interactive "P")
+  (setq zmacs-region-stays nil)
+  (end-of-buffer))
+
+;; marking movement functions
+
+(defun pc-select-mark-char-right (&optional arg)
+  "Move point right and mark ARG characters.
+Moves and selects left if ARG is negative."
+  (interactive "p")
+  (pc-select-ensure-mark)
+  (forward-char arg))
+
+(defun pc-select-mark-char-left (&optional arg)
+  "Move point left and mark ARG characters.
+Moves and selects right if ARG is negative."
+  (interactive "p")
+  (pc-select-ensure-mark)
+  (backward-char arg))
+
+(defun pc-select-mark-word-right (&optional arg)
+  "Move point right and mark ARG words.
+Moves and selects left if ARG is negative."
+  (interactive "p")
+  (pc-select-ensure-mark)
+  (forward-word arg))
+
+(defun pc-select-mark-word-left (&optional arg)
+  "Move point left and mark ARG words.
+Moves and selects right if ARG is negative."
+  (interactive "p")
+  (pc-select-ensure-mark)
+  (backward-word arg))
+
+(defun pc-select-mark-line-up (&optional arg)
+  "Move point up and select ARG lines.
+Moves down if ARG is negative."
+  (interactive "p")
+  (pc-select-ensure-mark)
+  (next-line (- arg)))
+
+(defun pc-select-mark-line-down (&optional arg)
+  "Move point down and select ARG lines.
+Moves up if ARG is negative."
+  (interactive "p")
+  (pc-select-ensure-mark)
+  (next-line arg))
+
+(defun pc-select-mark-to-bol (&optional arg)
+  "Move point and mark to the beginning of the line.
+With argument ARG not nil or 1, move forward ARG - 1 lines first.
+If scan reaches end of buffer, stop there without error."
+  (interactive "p")
+  (pc-select-ensure-mark)
+  (beginning-of-line arg))
+
+(defun pc-select-mark-to-eol (&optional arg)
+  "Move point and mark to the end of the line.
+With argument ARG not nil or 1, move forward ARG -1 lines first.
+If scan reaches end of buffer, stop there without error."
+  (interactive "p")
+  (pc-select-ensure-mark)
+  (end-of-line arg))
+
+(defun pc-select-mark-page-up (&optional arg)
+  "Scroll text of current window down and mark ARG lines.
+Scrolls near full screen if no ARG, scrolls upward if ARG is negative.
+
+See `scroll-down' for further info."
+  (interactive "P")
+  (pc-select-ensure-mark)
+  (scroll-down arg))
+
+(defun pc-select-mark-page-down (&optional arg)
+  "Scroll text of current window up and mark ARG lines.
+Scrolls near full screen if no ARG, scrolls downward if ARG is negative.
+
+See `scroll-up' for further info."
+  (interactive "P")
+  (pc-select-ensure-mark)
+  (scroll-up arg))
+
+(defun pc-select-mark-to-bob (&optional arg)
+    "Move point and mark to the beginning of buffer.
+With arg N, put point N/10 of the way from the beginning.
+
+If the buffer is narrowed, this command uses the beginning and size
+of the accessible part of the buffer."
+  (interactive "P")
+  (pc-select-ensure-mark)
+  (beginning-of-buffer arg))
+
+(defun pc-select-mark-to-eob (&optional arg)
+  "Move point and mark to the end of buffer."
+  (interactive "P")
+  (pc-select-ensure-mark)
+  (end-of-buffer arg))
+
+;; enable the mode
+
+(defun pc-select-mode (&optional arg)
+  "Toggle pc select minor mode.
+With ARG, turn mode on if ARG is positive, off otherwise."
+  (interactive "P")
+  (setq pc-select-enabled (if (null arg)
+			      (not pc-select-enabled)
+			    (> (prefix-numeric-value arg) 0)))
+  (cond
+   ((eq pc-select-enabled 't)
+    (use-global-map pc-select-map)
+    (require 'pending-del)
+    (turn-on-pending-delete))
+   ((eq pc-select-enabled 'nil)
+    (use-global-map pc-select-original-keymap))))
+
+(if (fboundp 'add-minor-mode)
+    (add-minor-mode 'pc-select-enabled 'pc-select-modeline-string
+                    nil nil 'pc-select-mode)
+  (or (assq 'pc-select-enabled minor-mode-alist)
+      (setq minor-mode-alist
+            (cons '(pc-select-enabled pc-select-modeline-string) minor-mode-alist))))
+
+(provide 'pc-select)
+
+;;; pc-select.el ends here

File pending-del.el

+;; pending-del.el --- Making insertions replace any selected text.
+
+;; Copyright (C) 1992, 1994 Free Software Foundation, Inc.
+
+;; Author: Matthieu Devin <devin@lucid.com>, 14 Jul 92.
+;; Maintainer: Hrvoje Niksic <hniksic@srce.hr>
+;; Version 2.2
+
+;; 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Synched up with: 19.34  (distributed as delsel.el in FSF)
+
+;;; Commentary:
+
+;; Much of this code was revamped by Hrvoje Niksic, July 1997, with
+;; version number set to 2.x.
+
+;; Pending-del is now a minor mode, with all the normal toggle
+;; functions.  It should be somewhat faster, too.
+
+
+;;; Code:
+
+(defcustom pending-delete-mode nil
+  "Non-nil when Pending Delete mode is enabled.
+In Pending Delete mode, typed text replaces the selected region."
+  :type 'boolean
+  :set (lambda (symbol value)
+	 (pending-delete-mode (or value 0)))
+  :initialize 'custom-initialize-default
+  :require 'pending-del
+  :group 'keyboard)
+
+(defcustom pending-delete-modeline-string " PenDel"
+  "*String to display in the modeline when Pending Delete mode is active."
+  :type 'string
+  :group 'keyboard)
+
+(add-minor-mode 'pending-delete-mode 'pending-delete-modeline-string)
+
+
+(defun pending-delete-active-region (&optional killp)
+  (when (and (region-active-p)
+	     (eq (extent-object zmacs-region-extent) (current-buffer))
+	     (not buffer-read-only))
+    ;; Here we used to check whether the point lies between the
+    ;; beginning and end of the extent.  I don't see how it is
+    ;; necessary, as the C code makes sure that this is so; it only
+    ;; slow things down.
+    (if killp
+	(kill-region (region-beginning) (region-end))
+      (delete-region (region-beginning) (region-end)))
+    (zmacs-deactivate-region)
+    t))
+
+(defun pending-delete-pre-hook ()
+  (condition-case e
+      (let ((type (and (symbolp this-command)
+		       (get this-command 'pending-delete))))
+	(cond ((eq type 'kill)
+	       (pending-delete-active-region t))
+	      ((eq type 'supersede)
+	       (if (pending-delete-active-region ())
+		   (setq this-command (lambda () (interactive)))))
+	      (type
+	       (pending-delete-active-region ()))))
+    (error
+     (warn "Error caught in `pending-delete-pre-hook': %s"
+	   (error-message-string e)))))
+
+
+(put 'self-insert-command 'pending-delete t)
+
+(put 'yank 'pending-delete t)
+(put 'x-yank-clipboard-selection 'pending-delete t)
+(put 'toolbar-paste 'pending-delete t)
+
+(put 'delete-backward-char 'pending-delete 'supersede)
+(put 'backward-delete-char-untabify 'pending-delete 'supersede)
+(put 'delete-char 'pending-delete 'supersede)
+(put 'c-electric-delete 'pending-delete 'supersede)
+
+;; Support the XEmacs 20.3 'delete functions
+
+(put 'backward-or-forward-delete-char 'pending-delete 'supersede)
+(put 'cperl-electric-backspace 'pending-delete 'supersede)
+(put 'cperl-electric-delete 'pending-delete 'supersede)
+
+;; Don't delete for these.  They're more problematic than helpful.
+;;
+;; (put 'newline-and-indent 'pending-delete t)
+;; (put 'newline 'pending-delete t)
+;; (put 'open-line 'pending-delete t)
+
+(put 'insert-register 'pending-delete t)
+
+
+;;;###autoload
+(defun turn-on-pending-delete (&optional ignored)
+  "Turn on pending delete minor mode unconditionally."
+  (interactive)
+  (pending-delete-mode 1))
+
+;;;###autoload
+(defun turn-off-pending-delete (&optional ignored)
+  "Turn off pending delete minor mode unconditionally."
+  (interactive)
+  (pending-delete-mode 0))
+
+;;;###autoload
+(defun pending-delete-mode (&optional arg)
+  "Toggle Pending Delete minor mode.
+When the pending delete is on, typed text replaces the selection.
+With a positive argument, turns it on.
+With a non-positive argument, turns it off."
+  (interactive "P")
+  (setq pending-delete-mode
+	(if (null arg) (not pending-delete-mode)
+	  (> (prefix-numeric-value arg) 0)))
+  (if pending-delete-mode
+      (add-hook 'pre-command-hook 'pending-delete-pre-hook)
+    (remove-hook 'pre-command-hook 'pending-delete-pre-hook))
+  (force-mode-line-update))
+
+
+;; Backward compatibility:
+;;;###autoload
+(define-obsolete-function-alias 'pending-delete-on 'turn-on-pending-delete)
+;;;###autoload
+(define-obsolete-function-alias 'pending-delete-off 'turn-off-pending-delete)
+
+;; FSF compatibility:
+;;;###autoload
+(define-compatible-function-alias 'delete-selection-mode 'pending-delete-mode)
+
+;; Compatibility and convenience:
+;;;###autoload
+(defalias 'pending-delete 'pending-delete-mode)
+
+
+;; The following code used to turn the mode on unconditionally.
+;; However, this is a very bad idea -- since pending-del is
+;; autoloaded, (turn-on-pending-delete) is as easy to add to `.emacs'
+;; as (require 'pending-del) used to be.
+
+;(pending-delete-on (eq pending-delete-verbose t))
+
+(provide 'pending-del)
+
+;;; pending-del.el ends here
+;;; s-region.el --- set region using shift key.
+
+;;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
+
+;; Author: Morten Welinder (terra@diku.dk)
+;; XEmacs rewrite: Tomasz Cholewo (tjchol01@mecca.spd.louisville.edu)
+;; Version: 0.95
+;; Last modified: Sun Nov  2 17:20:26 EST 1997
+
+;; Keywords: terminals
+
+;;; Synched up with: not synched with FSF
+;;; Requires: XEmacs 20.3
+
+;;; Commentary:
+
+;; This code allows to set the region by holding down the shift key and
+;; moving the cursor to the other end of the region.  The functionality
+;; is similar to that provided by many DOS and Windows editors except
+;; that the standard movement commands deactivate region only if the
+;; previous command was one of shift marking commands.  This ensures
+;; that the standard Emacs method of selecting regions are also still
+;; available.
+
+;; Currently, only movement commands that are interactive "p" or "P"
+;; functions and are bound to single keystrokes may be adapted.
+
+;; Function `s-region-bind-cua' adds several additional PC-like bindings.
+
+;; To use s-region, put the following to `~/.emacs':
+;;
+;;   (require 's-region)
+;;   (s-region-bind)
+;;   (s-region-bind-cua)
+
+
+;;; User variables:
+
+(defvar s-region-key-list
+ (list [right] [left] [up] [down]
+       [(control left)] [(control right)] [(control up)] [(control down)]
+       [(meta left)] [(meta right)] [(meta up)] [(meta down)]
+       [next] [prior] [home] [end]
+       [(control next)] [(control prior)] [(control home)] [(control end)])
+"*A list of movement keystrokes to be used for region marking with a
+shift key.  Only single keystrokes (with modifiers) bound to interactive
+\"p\" or \"P\" functions are allowed.")
+
+;; [(meta next)] [(meta prior)] [(meta home)] [(meta end)] are by
+;; default bound to -other-window commands and hence should not be
+;; modified.
+
+;;; Code:
+
+(defvar s-region-last-mark-p nil
+  "T if shift marking was used and since then no unshifted movement
+commands nor set-mark were used.")
+
+(defun s-region-add-shift (keyseq)
+  "Return the last keystroke in sequence KEYSEQ with added shift modifier.
+For example:
+    (s-region-add-shift [(control u) down]) => [(shift down)]"
+  (let* ((v (key-sequence-list-description keyseq))
+	(key (aref v (1- (length v)))))
+    (vector (append
+	     (list 'shift)
+	     (delq 'shift key)))))
+
+(defun s-region-nomark ()
+  "Deactivate region if shift marking has been used immediately before."
+  (if s-region-last-mark-p
+      (zmacs-deactivate-region))
+  (setq s-region-last-mark-p nil))
+
+(defun s-region-mark ()
+  "Start or continue marking a region."
+  (if (if (region-active-p)
+	  (not s-region-last-mark-p)
+	t)
+      (push-mark nil t t)
+    (zmacs-activate-region))
+  (setq s-region-last-mark-p t))
+
+;; #### This should check for everything which is not a rebound
+;; movement command.
+(defun s-region-restore ()
+  "Restore standard behavior of mark region commands when the
+just-executed command is not shift-marking."
+  (if (eq this-command 'set-mark-command)
+      (setq s-region-last-mark-p nil)))
+
+;;;###autoload
+(defun s-region-bind (&optional keylist map)
+  "Bind shifted keys from KEYLIST to region marking commands.
+Each key in KEYLIST is rebound to deactivate region if the last command
+was one of shift marking commands.  Keys with added shift modifier are
+bound to start or continue marking a region.  Optional argument KEYLIST
+defaults to `s-region-key-list'.  Optional argument MAP specifies keymap
+to add binding to, defaulting to global keymap."
+  (interactive)
+  (let ((p2 (list 'scroll-up 'scroll-down
+		  'beginning-of-buffer 'end-of-buffer)))
+    (or keylist (setq keylist s-region-key-list))
+    (or map (setq map global-map))
+    (mapc #'(lambda (key)
+	      (let ((binding (key-binding key)))
+		(cond ((and (symbolp binding) (commandp binding))
+		    (define-key map key
+		      `(lambda (arg)
+			 ,(concat
+			   "Deactivate region if shift marking was used "
+			   "and call `" (symbol-name binding) "'.")
+			 (interactive
+			  ,(if (memq binding p2)
+			       "_P"
+			     "_p"))
+			 (s-region-nomark)
+			 (,binding arg)
+			 ;; next-line uses last-command to track eol
+			 (setq this-command ',binding)))
+		    (define-key map (s-region-add-shift key)
+		      `(lambda (arg)
+			 ,(concat
+			   "Start or continue shift marking and call `"
+			   (symbol-name binding) "'.")
+			 (interactive
+			  ,(if (memq binding p2)
+			       "P"
+			     "p"))
+			 (s-region-mark)
+			 (,binding arg)
+			 (setq this-command ',binding)))
+		    ))))
+	  keylist))
+  (add-hook 'post-command-hook 's-region-restore))
+
+;;;###autoload
+(defun s-region-bind-cua (&optional map)
+  "Bind some of CUA keys in keymap MAP to kill and yank commands.
+Optional argument MAP defaults to `global-map'.
+New bindings:
+  Sh-delete    kill-region
+  Sh-insert    yank
+  C-insert     copy-region-as-kill
+  C-delete     kill-line
+  C-backspace  backward-kill-word"
+  (interactive)
+  (or map (setq map global-map))
+  (define-key map [(shift delete)] 'kill-region)
+  (define-key map [(shift insert)] 'yank)
+  (define-key map [(control insert)] 'copy-region-as-kill)
+  (define-key map [(control delete)] 'kill-line)
+  (define-key map [(control backspace)] 'backward-kill-word))
+
+(provide 's-region)
+
+;; s-region.el ends here.