lisp/obsolete/pc-select.el

   1 ;;; pc-select.el --- emulate mark, cut, copy and paste from Motif
   2 ;;;                  (or MAC GUI or MS-windoze (bah)) look-and-feel
   3 ;;;                  including key bindings.
   4
   5 ;; Copyright (C) 1995-1997, 2000-2017 Free Software Foundation, Inc.
   6
   7 ;; Author: Michael Staats <michael@thp.Uni-Duisburg.DE>
   8 ;; Keywords: convenience emulations
   9 ;; Created: 26 Sep 1995
  10 ;; Obsolete-since: 24.1
  11
  12 ;; This file is part of GNU Emacs.
  13
  14 ;; GNU Emacs is free software: you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation, either version 3 of the License, or
  17 ;; (at your option) any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  26
  27 ;;; Commentary:
  28
  29 ;; This package emulates the mark, copy, cut and paste look-and-feel of motif
  30 ;; programs (which is the same as the MAC gui and (sorry for that) MS-Windows).
  31 ;; It modifies the keybindings of the cursor keys and the next, prior,
  32 ;; home and end keys. They will modify mark-active.
  33 ;; You can still get the old behavior of cursor moving with the
  34 ;; control sequences C-f, C-b, etc.
  35 ;; This package uses transient-mark-mode and
  36 ;; delete-selection-mode.
  37 ;;
  38 ;; In addition to that all key-bindings from the pc-mode are
  39 ;; done here too (as suggested by RMS).
  40 ;;
  41 ;; As I found out after I finished the first version, s-region.el tries
  42 ;; to do the same.... But my code is a little more complete and using
  43 ;; delete-selection-mode is very important for the look-and-feel.
  44 ;; Pete Forman <pete.forman@airgun.wg.waii.com> provided some motif
  45 ;; compliant keybindings which I added. I had to modify them a little
  46 ;; to add the -mark and -nomark functionality of cursor moving.
  47 ;;
  48 ;; Credits:
  49 ;; Many thanks to all who made comments.
  50 ;; Thanks to RMS and Ralf Muschall <prm@rz.uni-jena.de> for criticism.
  51 ;; Kevin Cutts <cutts@ukraine.corp.mot.com> added the beginning-of-buffer
  52 ;; and end-of-buffer functions which I modified a little.
  53 ;; David Biesack <sasdjb@unx.sas.com> suggested some more cleanup.
  54 ;; Thanks to Pete Forman <pete.forman@airgun.wg.waii.com>
  55 ;; for additional motif keybindings.
  56 ;; Thanks to jvromans@squirrel.nl (Johan Vromans) for a bug report
  57 ;; concerning setting of this-command.
  58 ;; Dan Nicolaescu <done@ece.arizona.ro> suggested suppressing the
  59 ;; scroll-up/scroll-down error.
  60 ;; Eli Barzilay (eli@cs.bgu.ac.il) suggested the sexps functions and
  61 ;; keybindings.
  62 ;;
  63 ;; Ok, some details about the idea of PC Selection mode:
  64 ;;
  65 ;;  o The standard keys for moving around (right, left, up, down, home, end,
  66 ;;    prior, next, called "move-keys" from now on) will always de-activate
  67 ;;    the mark.
  68 ;;  o If you press "Shift" together with the "move-keys", the region
  69 ;;    you pass along is activated
  70 ;;  o You have the copy, cut and paste functions (as in many other programs)
  71 ;;    which will operate on the active region
  72 ;;    It was not possible to bind them to C-v, C-x and C-c for obvious
  73 ;;    emacs reasons.
  74 ;;    They will be bound according to the "old" behavior to S-delete (cut),
  75 ;;    S-insert (paste) and C-insert (copy). These keys do the same in many
  76 ;;    other programs.
  77 ;;
  78
  79 ;;; Code:
  80
  81 ;; Customization:
  82 (defgroup pc-select nil
  83   "Emulate pc bindings."
  84   :prefix "pc-select"
  85   :group 'emulations)
  86
  87 (define-obsolete-variable-alias 'pc-select-override-scroll-error
  88                                 'scroll-error-top-bottom
  89                                 "24.1")
  90 (defcustom pc-select-override-scroll-error t
  91   "Non-nil means don't generate error on scrolling past edge of buffer.
  92 This variable applies in PC Selection mode only.
  93 The scroll commands normally generate an error if you try to scroll
  94 past the top or bottom of the buffer.  This is annoying when selecting
  95 text with these commands.  If you set this variable to non-nil, these
  96 errors are suppressed."
  97   :type 'boolean
  98   :group 'pc-select)
  99
 100 (defcustom pc-select-selection-keys-only nil
 101   "Non-nil means only bind the basic selection keys when started.
 102 Other keys that emulate pc-behavior will be untouched.
 103 This gives mostly Emacs-like behavior with only the selection keys enabled."
 104   :type 'boolean
 105   :group 'pc-select)
 106
 107 (defcustom pc-select-meta-moves-sexps nil
 108   "Non-nil means move sexp-wise with Meta key, otherwise move word-wise."
 109   :type 'boolean
 110   :group 'pc-select)
 111
 112 (defcustom pc-selection-mode-hook nil
 113   "The hook to run when PC Selection mode is toggled."
 114   :type 'hook
 115   :group 'pc-select)
 116
 117 (defvar pc-select-saved-settings-alist nil
 118   "The values of the variables before PC Selection mode was toggled on.
 119 When PC Selection mode is toggled on, it sets quite a few variables
 120 for its own purposes.  This alist holds the original values of the
 121 variables PC Selection mode had set, so that these variables can be
 122 restored to their original values when PC Selection mode is toggled off.")
 123
 124 (defvar pc-select-map nil
 125   "The keymap used as the global map when PC Selection mode is on." )
 126
 127 (defvar pc-select-saved-global-map nil
 128   "The global map that was in effect when PC Selection mode was toggled on.")
 129
 130 (defvar pc-select-key-bindings-alist nil
 131   "This alist holds all the key bindings PC Selection mode sets.")
 132
 133 (defvar pc-select-default-key-bindings nil
 134   "These key bindings always get set by PC Selection mode.")
 135
 136 (defvar pc-select-extra-key-bindings
 137   ;; The following keybindings are for standard ISO keyboards
 138   ;; as they are used with IBM compatible PCs, IBM RS/6000,
 139   ;; MACs, many X-Stations and probably more.
 140   '(;; Commented out since it's been standard at least since Emacs-21.
 141     ;;([S-insert]  . yank)
 142     ;;([C-insert]  . copy-region-as-kill)
 143     ;;([S-delete]  . kill-region)
 144
 145     ;; The following bindings are useful on Sun Type 3 keyboards
 146     ;; They implement the Get-Delete-Put (copy-cut-paste)
 147     ;; functions from sunview on the L6, L8 and L10 keys
 148     ;; Sam Steingold <sds@gnu.org> says that f16 is copy and f18 is paste.
 149     ([f16]  . copy-region-as-kill)
 150     ([f18]  . yank)
 151     ([f20]  . kill-region)
 152
 153     ;; The following bindings are from Pete Forman.
 154     ([f6] . other-window)               ; KNextPane     F6
 155     ([C-delete] . kill-line)            ; KEraseEndLine cDel
 156     ("\M-\d" . undo)                    ; KUndo         aBS
 157
 158     ;; The following binding is taken from pc-mode.el
 159     ;; as suggested by RMS.
 160     ;; I only used the one that is not covered above.
 161     ([C-M-delete]  . kill-sexp)
 162     ;; Next line proposed by Eli Barzilay
 163     ([C-escape]    . electric-buffer-list))
 164   "Key bindings to set only if `pc-select-selection-keys-only' is nil.")
 165
 166 (defvar pc-select-meta-moves-sexps-key-bindings
 167   '((([M-right]   . forward-sexp)
 168      ([M-left]    . backward-sexp))
 169     (([M-right]   . forward-word)
 170      ([M-left]    . backward-word)))
 171   "The list of key bindings controlled by `pc-select-meta-moves-sexp'.
 172 The bindings in the car of this list get installed if
 173 `pc-select-meta-moves-sexp' is t, the bindings in the cadr of this
 174 list get installed otherwise.")
 175
 176 ;; This is for tty.  We don't turn on normal-erase-is-backspace,
 177 ;; but bind keys as pc-selection-mode did before
 178 ;; normal-erase-is-backspace was invented, to keep us back
 179 ;; compatible.
 180 (defvar pc-select-tty-key-bindings
 181   '(([delete] . delete-char)            ; KDelete       Del
 182    ([C-backspace] . backward-kill-word))
 183   "The list of key bindings controlled by `pc-select-selection-keys-only'.
 184 These key bindings get installed when running in a tty, but only if
 185 `pc-select-selection-keys-only' is nil.")
 186
 187 (defvar pc-select-old-M-delete-binding nil
 188   "Holds the old mapping of [M-delete] in the `function-key-map'.
 189 This variable holds the value associated with [M-delete] in the
 190 `function-key-map' before PC Selection mode had changed that
 191 association.")
 192
 193 ;;;;
 194 ;; misc
 195 ;;;;
 196
 197 (provide 'pc-select)
 198
 199 (defun pc-select-define-keys (alist keymap)
 200   "Make KEYMAP have the key bindings specified in ALIST."
 201   (let ((lst alist))
 202     (while lst
 203       (define-key keymap (caar lst) (cdar lst))
 204       (setq lst (cdr lst)))))
 205
 206 (defun pc-select-restore-keys (alist keymap saved-map)
 207   "Use ALIST to restore key bindings from SAVED-MAP into KEYMAP.
 208 Go through all the key bindings in ALIST, and, for each key
 209 binding, if KEYMAP and ALIST still agree on the key binding,
 210 restore the previous value of that key binding from SAVED-MAP."
 211   (let ((lst alist))
 212     (while lst
 213       (when (equal (lookup-key keymap (caar lst)) (cdar lst))
 214         (define-key keymap (caar lst) (lookup-key saved-map (caar lst))))
 215       (setq lst (cdr lst)))))
 216
 217 (defmacro pc-select-add-to-alist (alist var val)
 218   "Ensure that ALIST contains the cons cell (VAR . VAL).
 219 If a cons cell whose car is VAR is already on the ALIST, update the
 220 cdr of that cell with VAL.  Otherwise, make a new cons cell
 221 \(VAR . VAL), and prepend it onto ALIST."
 222   (let ((elt (make-symbol "elt")))
 223     `(let ((,elt (assq ',var ,alist)))
 224        (if ,elt
 225            (setcdr ,elt ,val)
 226          (setq ,alist (cons (cons ',var ,val) ,alist))))))
 227
 228 (defmacro pc-select-save-and-set-var (var newval)
 229   "Set VAR to NEWVAL; save the old value.
 230 The old value is saved on the `pc-select-saved-settings-alist'."
 231   `(when (boundp ',var)
 232      (pc-select-add-to-alist pc-select-saved-settings-alist ,var ,var)
 233      (setq ,var ,newval)))
 234
 235 (defmacro pc-select-save-and-set-mode (mode &optional arg mode-var)
 236   "Call the function MODE; save the old value of the variable MODE.
 237 MODE is presumed to be a function which turns on a minor mode.  First,
 238 save the value of the variable MODE on `pc-select-saved-settings-alist'.
 239 Then, if ARG is specified, call MODE with ARG, otherwise call it with
 240 nil as an argument.  If MODE-VAR is specified, save the value of the
 241 variable MODE-VAR (instead of the value of the variable MODE) on
 242 `pc-select-saved-settings-alist'."
 243   (unless mode-var (setq mode-var mode))
 244   `(when (fboundp ',mode)
 245      (pc-select-add-to-alist pc-select-saved-settings-alist
 246                              ,mode-var ,mode-var)
 247      (,mode ,arg)))
 248
 249 (defmacro pc-select-restore-var (var)
 250   "Restore the previous value of the variable VAR.
 251 Look up VAR's previous value in `pc-select-saved-settings-alist', and,
 252 if the value is found, set VAR to that value."
 253   (let ((elt (make-symbol "elt")))
 254     `(let ((,elt (assq ',var pc-select-saved-settings-alist)))
 255        (unless (null ,elt)
 256          (setq ,var (cdr ,elt))))))
 257
 258 (defmacro pc-select-restore-mode (mode)
 259   "Restore the previous state (either on or off) of the minor mode MODE.
 260 Look up the value of the variable MODE on `pc-select-saved-settings-alist'.
 261 If the value is non-nil, call the function MODE with an argument of
 262 1, otherwise call it with an argument of -1."
 263   (let ((elt (make-symbol "elt")))
 264     `(when (fboundp ',mode)
 265        (let ((,elt (assq ',mode pc-select-saved-settings-alist)))
 266          (unless (null ,elt)
 267            (,mode (if (cdr ,elt) 1 -1)))))))
 268
 269
 270 ;;;###autoload
 271 (define-minor-mode pc-selection-mode
 272   "Change mark behavior to emulate Motif, Mac or MS-Windows cut and paste style.
 273
 274 This mode enables Delete Selection mode and Transient Mark mode.
 275
 276 The arrow keys (and others) are bound to new functions
 277 which modify the status of the mark.
 278
 279 The ordinary arrow keys disable the mark.
 280 The shift-arrow keys move, leaving the mark behind.
 281
 282 C-LEFT and C-RIGHT move back or forward one word, disabling the mark.
 283 S-C-LEFT and S-C-RIGHT move back or forward one word, leaving the mark behind.
 284
 285 M-LEFT and M-RIGHT move back or forward one word or sexp, disabling the mark.
 286 S-M-LEFT and S-M-RIGHT move back or forward one word or sexp, leaving the mark
 287 behind.  To control whether these keys move word-wise or sexp-wise set the
 288 variable `pc-select-meta-moves-sexps' after loading pc-select.el but before
 289 turning PC Selection mode on.
 290
 291 C-DOWN and C-UP move back or forward a paragraph, disabling the mark.
 292 S-C-DOWN and S-C-UP move back or forward a paragraph, leaving the mark behind.
 293
 294 HOME moves to beginning of line, disabling the mark.
 295 S-HOME moves to beginning of line, leaving the mark behind.
 296 With Ctrl or Meta, these keys move to beginning of buffer instead.
 297
 298 END moves to end of line, disabling the mark.
 299 S-END moves to end of line, leaving the mark behind.
 300 With Ctrl or Meta, these keys move to end of buffer instead.
 301
 302 PRIOR or PAGE-UP scrolls and disables the mark.
 303 S-PRIOR or S-PAGE-UP scrolls and leaves the mark behind.
 304
 305 S-DELETE kills the region (`kill-region').
 306 S-INSERT yanks text from the kill ring (`yank').
 307 C-INSERT copies the region into the kill ring (`copy-region-as-kill').
 308
 309 In addition, certain other PC bindings are imitated (to avoid this, set
 310 the variable `pc-select-selection-keys-only' to t after loading pc-select.el
 311 but before calling PC Selection mode):
 312
 313   F6           other-window
 314   DELETE       delete-char
 315   C-DELETE     kill-line
 316   M-DELETE     kill-word
 317   C-M-DELETE   kill-sexp
 318   C-BACKSPACE  backward-kill-word
 319   M-BACKSPACE  undo"
 320   ;; FIXME: bring pc-bindings-mode here ?
 321   nil nil nil
 322
 323   :group 'pc-select
 324   :global t
 325
 326   (if pc-selection-mode
 327       (if (null pc-select-key-bindings-alist)
 328           (progn
 329             (setq pc-select-saved-global-map (copy-keymap (current-global-map)))
 330             (setq pc-select-key-bindings-alist
 331                   (append pc-select-default-key-bindings
 332                           (if pc-select-selection-keys-only
 333                               nil
 334                             pc-select-extra-key-bindings)
 335                           (if pc-select-meta-moves-sexps
 336                               (car pc-select-meta-moves-sexps-key-bindings)
 337                             (cadr pc-select-meta-moves-sexps-key-bindings))
 338                           (if  (or pc-select-selection-keys-only
 339                                    (eq window-system 'x)
 340                                    (memq system-type '(ms-dos windows-nt)))
 341                               nil
 342                             pc-select-tty-key-bindings)))
 343
 344             (pc-select-define-keys pc-select-key-bindings-alist
 345                                    (current-global-map))
 346
 347             (unless  (or pc-select-selection-keys-only
 348                          (eq window-system 'x)
 349                          (memq system-type '(ms-dos windows-nt)))
 350               ;; it is not clear that we need the following line
 351               ;; I hope it doesn't do too much harm to leave it in, though...
 352               (setq pc-select-old-M-delete-binding
 353                     (lookup-key function-key-map [M-delete]))
 354               (define-key function-key-map  [M-delete] [?\M-d]))
 355
 356             (when (and (not pc-select-selection-keys-only)
 357                        (or (eq window-system 'x)
 358                            (memq system-type '(ms-dos windows-nt)))
 359                        (fboundp 'normal-erase-is-backspace-mode))
 360               (pc-select-save-and-set-mode normal-erase-is-backspace-mode 1
 361                                            normal-erase-is-backspace))
 362             ;; the original author also had this above:
 363             ;; (setq-default normal-erase-is-backspace t)
 364             ;; However, the documentation for the variable says that
 365             ;; "setting it with setq has no effect", so I'm removing it.
 366
 367             (pc-select-save-and-set-var highlight-nonselected-windows nil)
 368             (pc-select-save-and-set-var transient-mark-mode t)
 369             (pc-select-save-and-set-var shift-select-mode t)
 370             (pc-select-save-and-set-var mark-even-if-inactive t)
 371             (pc-select-save-and-set-mode delete-selection-mode 1))
 372         ;;else
 373         ;; If the user turned on pc-selection-mode a second time
 374         ;; do not clobber the values of the variables that were
 375         ;; saved from before pc-selection mode was activated --
 376         ;; just make sure the values are the way we like them.
 377         (pc-select-define-keys pc-select-key-bindings-alist
 378                                (current-global-map))
 379         (unless  (or pc-select-selection-keys-only
 380                      (eq window-system 'x)
 381                      (memq system-type '(ms-dos windows-nt)))
 382           ;; it is not clear that we need the following line
 383           ;; I hope it doesn't do too much harm to leave it in, though...
 384           (define-key function-key-map  [M-delete] [?\M-d]))
 385         (when (and (not pc-select-selection-keys-only)
 386                    (or (eq window-system 'x)
 387                        (memq system-type '(ms-dos windows-nt)))
 388                    (fboundp 'normal-erase-is-backspace-mode))
 389           (normal-erase-is-backspace-mode 1))
 390         (setq highlight-nonselected-windows nil)
 391         (transient-mark-mode 1)
 392         (setq mark-even-if-inactive t)
 393         (delete-selection-mode 1))
 394     ;;else
 395     (when pc-select-key-bindings-alist
 396       (when (and (not pc-select-selection-keys-only)
 397                  (or (eq window-system 'x)
 398                      (memq system-type '(ms-dos windows-nt))))
 399         (pc-select-restore-mode normal-erase-is-backspace-mode))
 400
 401       (pc-select-restore-keys
 402        pc-select-key-bindings-alist (current-global-map)
 403        pc-select-saved-global-map)
 404
 405       (pc-select-restore-var highlight-nonselected-windows)
 406       (pc-select-restore-var transient-mark-mode)
 407       (pc-select-restore-var shift-select-mode)
 408       (pc-select-restore-var mark-even-if-inactive)
 409       (pc-select-restore-mode delete-selection-mode)
 410       (and pc-select-old-M-delete-binding
 411            (define-key function-key-map [M-delete]
 412              pc-select-old-M-delete-binding))
 413       (setq pc-select-key-bindings-alist nil
 414             pc-select-saved-settings-alist nil))))
 415 (make-obsolete 'pc-selection-mode 'delete-selection-mode "24.1")
 416
 417 ;;; pc-select.el ends here