lisp/emulation/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, 1996, 1997, 2000, 2001 Free Software Foundation, Inc.
   6
   7 ;; Author: Michael Staats <michael@thp.Uni-Duisburg.DE>
   8 ;; Keywords: convenience emulation
   9 ;; Created: 26 Sep 1995
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Commentary:
  29
  30 ;; This package emulates the mark, copy, cut and paste look-and-feel of motif
  31 ;; programs (which is the same as the MAC gui and (sorry for that) MS-Windows).
  32 ;; It modifies the keybindings of the cursor keys and the next, prior,
  33 ;; home and end keys. They will modify mark-active.
  34 ;; You can still get the old behaviour of cursor moving with the
  35 ;; control sequences C-f, C-b, etc.
  36 ;; This package uses transient-mark-mode and
  37 ;; delete-selection-mode.
  38 ;;
  39 ;; In addition to that all key-bindings from the pc-mode are
  40 ;; done here too (as suggested by RMS).
  41 ;;
  42 ;; As I found out after I finished the first version, s-region.el tries
  43 ;; to do the same.... But my code is a little more complete and using
  44 ;; delete-selection-mode is very important for the look-and-feel.
  45 ;; Pete Forman <pete.forman@airgun.wg.waii.com> provided some motif
  46 ;; compliant keybindings which I added. I had to modify them a little
  47 ;; to add the -mark and -nomark functionality of cursor moving.
  48 ;;
  49 ;; Credits:
  50 ;; Many thanks to all who made comments.
  51 ;; Thanks to RMS and Ralf Muschall <prm@rz.uni-jena.de> for criticism.
  52 ;; Kevin Cutts <cutts@ukraine.corp.mot.com> added the beginning-of-buffer
  53 ;; and end-of-buffer functions which I modified a little.
  54 ;; David Biesack <sasdjb@unx.sas.com> suggested some more cleanup.
  55 ;; Thanks to Pete Forman <pete.forman@airgun.wg.waii.com>
  56 ;; for additional motif keybindings.
  57 ;; Thanks to jvromans@squirrel.nl (Johan Vromans) for a bug report
  58 ;; concerning setting of this-command.
  59 ;; Dan Nicolaescu <done@ece.arizona.ro> suggested suppressing the
  60 ;; scroll-up/scroll-down error.
  61 ;; Eli Barzilay (eli@cs.bgu.ac.il) suggested the sexps functions and
  62 ;; keybindings.
  63 ;;
  64 ;; Ok, some details about the idea of pc-selection-mode:
  65 ;;
  66 ;;  o The standard keys for moving around (right, left, up, down, home, end,
  67 ;;    prior, next, called "move-keys" from now on) will always de-activate
  68 ;;    the mark.
  69 ;;  o If you press "Shift" together with the "move-keys", the region
  70 ;;    you pass along is activated
  71 ;;  o You have the copy, cut and paste functions (as in many other programs)
  72 ;;    which will operate on the active region
  73 ;;    It was not possible to bind them to C-v, C-x and C-c for obvious
  74 ;;    emacs reasons.
  75 ;;    They will be bound according to the "old" behaviour to S-delete (cut),
  76 ;;    S-insert (paste) and C-insert (copy). These keys do the same in many
  77 ;;    other programs.
  78 ;;
  79
  80 ;;; Code:
  81
  82 ;; Customization:
  83 (defgroup pc-select nil
  84   "Emulate pc bindings."
  85   :prefix "pc-select"
  86   :group 'editing-basics
  87   :group 'convenience)
  88
  89 (defcustom pc-select-override-scroll-error t
  90   "*Non-nil means don't generate error on scrolling past edge of buffer.
  91 This variable applies in PC Selection mode only.
  92 The scroll commands normally generate an error if you try to scroll
  93 past the top or bottom of the buffer.  This is annoying when selecting
  94 text with these commands.  If you set this variable to non-nil, these
  95 errors are suppressed."
  96   :type 'boolean
  97   :group 'pc-select)
  98
  99 (defcustom pc-select-selection-keys-only nil
 100   "*Non-nil means only bind the basic selection keys when started.
 101 Other keys that emulate pc-behavior will be untouched.
 102 This gives mostly Emacs-like behaviour with only the selection keys enabled."
 103   :type 'boolean
 104   :group 'pc-select)
 105
 106 (defcustom pc-select-meta-moves-sexps nil
 107   "*Non-nil means move sexp-wise with Meta key, otherwise move word-wise."
 108   :type 'boolean
 109   :group 'pc-select)
 110
 111 (defcustom pc-selection-mode-hook nil
 112   "The hook to run when pc-selection-mode is toggled."
 113   :type 'hook
 114   :group 'pc-select)
 115
 116 (defvar pc-select-saved-settings-alist nil
 117   "The values of the variables before `pc-selection-mode' was toggled on.
 118 When `pc-selection-mode' is toggled on, it sets quite a few variables
 119 for its own purposes.  This alist holds the original values of the
 120 variables `pc-selection-mode' had set, so that these variables can be
 121 restored to their original values when `pc-selection-mode' is toggled off.")
 122
 123 (defvar pc-select-map nil
 124   "The keymap used as the global map when `pc-selection-mode' is on." )
 125
 126 (defvar pc-select-saved-global-map nil
 127   "The global map that was in effect when `pc-selection-mode' was toggled on.")
 128
 129 (defvar pc-select-key-bindings-alist nil
 130   "This alist holds all the key bindings `pc-selection-mode' sets.")
 131
 132 (defvar pc-select-default-key-bindings nil
 133   "These key bindings always get set by `pc-selection-mode'.")
 134
 135 (unless pc-select-default-key-bindings
 136   (let ((lst
 137          ;; This is to avoid confusion with the delete-selection-mode
 138         ;; On simple displays you cant see that a region is active and
 139          ;; will be deleted on the next keypress IMHO especially for
 140          ;; copy-region-as-kill this is confusing.
 141          ;; The same goes for exchange-point-and-mark
 142          '(("\M-w" . copy-region-as-kill-nomark)
 143            ("\C-x\C-x" . exchange-point-and-mark-nomark)
 144            ([S-right]   . forward-char-mark)
 145            ([right]     . forward-char-nomark)
 146            ([C-S-right] . forward-word-mark)
 147            ([C-right]   . forward-word-nomark)
 148            ([S-left]    . backward-char-mark)
 149            ([left]      . backward-char-nomark)
 150            ([C-S-left]  . backward-word-mark)
 151            ([C-left]    . backward-word-nomark)
 152            ([S-down]    . next-line-mark)
 153            ([down]      . next-line-nomark)
 154
 155            ([S-end]     . end-of-line-mark)
 156            ([end]       . end-of-line-nomark)
 157            ([S-C-end]   . end-of-buffer-mark)
 158            ([C-end]     . end-of-buffer-nomark)
 159            ([S-M-end]   . end-of-buffer-mark)
 160            ([M-end]     . end-of-buffer-nomark)
 161
 162            ([S-next]    . scroll-up-mark)
 163            ([next]      . scroll-up-nomark)
 164
 165            ([S-up]      . previous-line-mark)
 166            ([up]        . previous-line-nomark)
 167
 168            ([S-home]    . beginning-of-line-mark)
 169            ([home]      . beginning-of-line-nomark)
 170            ([S-C-home]  . beginning-of-buffer-mark)
 171            ([C-home]    . beginning-of-buffer-nomark)
 172            ([S-M-home]  . beginning-of-buffer-mark)
 173            ([M-home]    . beginning-of-buffer-nomark)
 174
 175            ([M-S-down]  . forward-line-mark)
 176            ([M-down]    . forward-line-nomark)
 177            ([M-S-up]    . backward-line-mark)
 178            ([M-up]      . backward-line-nomark)
 179
 180            ([S-prior]   . scroll-down-mark)
 181            ([prior]     . scroll-down-nomark)
 182
 183            ;; Next four lines are from Pete Forman.
 184            ([C-down]    . forward-paragraph-nomark) ; KNextPara     cDn
 185            ([C-up]      . backward-paragraph-nomark) ; KPrevPara     cUp
 186            ([S-C-down]  . forward-paragraph-mark)
 187            ([S-C-up]    . backward-paragraph-mark))))
 188
 189     (setq pc-select-default-key-bindings lst)))
 190
 191 (defvar pc-select-extra-key-bindings nil
 192   "Key bindings to set only if `pc-select-selection-keys-only' is nil.")
 193
 194 ;; The following keybindings are for standard ISO keyboards
 195 ;; as they are used with IBM compatible PCs, IBM RS/6000,
 196 ;; MACs, many X-Stations and probably more
 197 (unless pc-select-extra-key-bindings
 198   (let ((lst
 199          '(([S-insert]  . yank)
 200            ([C-insert]  . copy-region-as-kill)
 201            ([S-delete]  . kill-region)
 202
 203            ;; The following bindings are useful on Sun Type 3 keyboards
 204            ;; They implement the Get-Delete-Put (copy-cut-paste)
 205            ;; functions from sunview on the L6, L8 and L10 keys
 206            ;; Sam Steingold <sds@gnu.org> says that f16 is copy and f18 is paste.
 207            ([f16]  . copy-region-as-kill)
 208            ([f18]  . yank)
 209            ([f20]  . kill-region)
 210
 211            ;; The following bindings are from Pete Forman.
 212            ([f6] . other-window)                ; KNextPane     F6
 213            ([C-delete] . kill-line)             ; KEraseEndLine cDel
 214            ("\M-\d" . undo)                     ; KUndo         aBS
 215
 216            ;; The following binding is taken from pc-mode.el
 217            ;; as suggested by RMS.
 218            ;; I only used the one that is not covered above.
 219            ([C-M-delete]  . kill-sexp)
 220            ;; Next line proposed by Eli Barzilay
 221            ([C-escape]    . electric-buffer-list))))
 222
 223     (setq pc-select-extra-key-bindings lst)))
 224
 225 (defvar pc-select-meta-moves-sexps-key-bindings
 226   '((([M-S-right] . forward-sexp-mark)
 227      ([M-right]   . forward-sexp-nomark)
 228      ([M-S-left]  . backward-sexp-mark)
 229      ([M-left]    . backward-sexp-nomark))
 230     (([M-S-right] . forward-word-mark)
 231      ([M-right]   . forward-word-nomark)
 232      ([M-S-left]  . backward-word-mark)
 233      ([M-left]    . backward-word-nomark)))
 234   "The list of key bindings controlled by `pc-select-meta-moves-sexp'.
 235 The bindings in the car of this list get installed if
 236 `pc-select-meta-moves-sexp' is t, the bindings in the cadr of this
 237 list get installed otherwise.")
 238
 239 ;; This is for tty.  We don't turn on normal-erase-is-backspace,
 240 ;; but bind keys as pc-selection-mode did before
 241 ;; normal-erase-is-backspace was invented, to keep us back
 242 ;; compatible.
 243 (defvar pc-select-tty-key-bindings
 244   '(([delete] . delete-char)            ; KDelete       Del
 245    ([C-backspace] . backward-kill-word))
 246   "The list of key bindings controlled by `pc-select-selection-keys-only'.
 247 These key bindings get installed when running in a tty, but only if
 248 `pc-select-selection-keys-only' is nil.")
 249
 250 (defvar pc-select-old-M-delete-binding nil
 251   "Holds the old mapping of [M-delete] in the `function-key-map'.
 252 This variable holds the value associated with [M-delete] in the
 253 `function-key-map' before `pc-selection-mode' had changed that
 254 association.")
 255
 256 ;;;;
 257 ;; misc
 258 ;;;;
 259
 260 (provide 'pc-select)
 261
 262 (defun copy-region-as-kill-nomark (beg end)
 263   "Save the region as if killed; but don't kill it; deactivate mark.
 264 If `interprogram-cut-function' is non-nil, also save the text for a window
 265 system cut and paste.
 266
 267 Deactivating mark is to avoid confusion with `delete-selection-mode'
 268 and `transient-mark-mode'."
 269  (interactive "r")
 270  (copy-region-as-kill beg end)
 271  (setq mark-active nil)
 272  (message "Region saved"))
 273
 274 (defun exchange-point-and-mark-nomark  ()
 275   "Like `exchange-point-and-mark' but without activating the mark."
 276   (interactive)
 277   (exchange-point-and-mark)
 278   (setq mark-active nil))
 279
 280 ;;;;
 281 ;; non-interactive
 282 ;;;;
 283 (defun ensure-mark()
 284   ;; make sure mark is active
 285   ;; test if it is active, if it isn't, set it and activate it
 286   (or mark-active (set-mark-command nil)))
 287
 288 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
 289 ;;;;; forward and mark
 290 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
 291
 292 (defun forward-char-mark (&optional arg)
 293   "Ensure mark is active; move point right ARG characters (left if ARG negative).
 294 On reaching end of buffer, stop and signal error."
 295   (interactive "p")
 296   (ensure-mark)
 297   (forward-char arg))
 298
 299 (defun forward-word-mark (&optional arg)
 300   "Ensure mark is active; move point right ARG words (backward if ARG is negative).
 301 Normally returns t.
 302 If an edge of the buffer is reached, point is left there
 303 and nil is returned."
 304   (interactive "p")
 305   (ensure-mark)
 306   (forward-word arg))
 307
 308 (defun forward-line-mark (&optional arg)
 309   "Ensure mark is active; move cursor vertically down ARG lines."
 310   (interactive "p")
 311   (ensure-mark)
 312   (forward-line arg)
 313   (setq this-command 'forward-line)
 314 )
 315
 316 (defun forward-sexp-mark (&optional arg)
 317   "Ensure mark is active; move forward across one balanced expression (sexp).
 318 With argument, do it that many times.  Negative arg -N means
 319 move backward across N balanced expressions."
 320   (interactive "p")
 321   (ensure-mark)
 322   (forward-sexp arg))
 323
 324 (defun forward-paragraph-mark (&optional arg)
 325   "Ensure mark is active; move forward to end of paragraph.
 326 With arg N, do it N times; negative arg -N means move backward N paragraphs.
 327
 328 A line which `paragraph-start' matches either separates paragraphs
 329 \(if `paragraph-separate' matches it also) or is the first line of a paragraph.
 330 A paragraph end is the beginning of a line which is not part of the paragraph
 331 to which the end of the previous line belongs, or the end of the buffer."
 332   (interactive "p")
 333   (ensure-mark)
 334   (forward-paragraph arg))
 335
 336 (defun next-line-mark (&optional arg)
 337   "Ensure mark is active; move cursor vertically down ARG lines.
 338 If there is no character in the target line exactly under the current column,
 339 the cursor is positioned after the character in that line which spans this
 340 column, or at the end of the line if it is not long enough.
 341 If there is no line in the buffer after this one, behavior depends on the
 342 value of `next-line-add-newlines'.  If non-nil, it inserts a newline character
 343 to create a line, and moves the cursor to that line.  Otherwise it moves the
 344 cursor to the end of the buffer \(if already at the end of the buffer, an error
 345 is signaled).
 346
 347 The command \\[set-goal-column] can be used to create
 348 a semipermanent goal column to which this command always moves.
 349 Then it does not try to move vertically.  This goal column is stored
 350 in `goal-column', which is nil when there is none."
 351   (interactive "p")
 352   (ensure-mark)
 353   (next-line arg)
 354   (setq this-command 'next-line))
 355
 356 (defun end-of-line-mark (&optional arg)
 357   "Ensure mark is active; move point to end of current line.
 358 With argument ARG not nil or 1, move forward ARG - 1 lines first.
 359 If scan reaches end of buffer, stop there without error."
 360   (interactive "p")
 361   (ensure-mark)
 362   (end-of-line arg)
 363   (setq this-command 'end-of-line))
 364
 365 (defun backward-line-mark (&optional arg)
 366   "Ensure mark is active; move cursor vertically up ARG lines."
 367   (interactive "p")
 368   (ensure-mark)
 369   (if (null arg)
 370       (setq arg 1))
 371   (forward-line (- arg))
 372   (setq this-command 'forward-line)
 373 )
 374
 375 (defun scroll-down-mark (&optional arg)
 376   "Ensure mark is active; scroll down ARG lines; or near full screen if no ARG.
 377 A near full screen is `next-screen-context-lines' less than a full screen.
 378 Negative ARG means scroll upward.
 379 When calling from a program, supply a number as argument or nil."
 380   (interactive "P")
 381   (ensure-mark)
 382   (cond (pc-select-override-scroll-error
 383          (condition-case nil (scroll-down arg)
 384            (beginning-of-buffer (goto-char (point-min)))))
 385         (t (scroll-down arg))))
 386
 387 (defun end-of-buffer-mark (&optional arg)
 388   "Ensure mark is active; move point to the end of the buffer.
 389 With arg N, put point N/10 of the way from the end.
 390
 391 If the buffer is narrowed, this command uses the beginning and size
 392 of the accessible part of the buffer.
 393
 394 Don't use this command in Lisp programs!
 395 \(goto-char \(point-max)) is faster and avoids clobbering the mark."
 396   (interactive "P")
 397   (ensure-mark)
 398   (let ((size (- (point-max) (point-min))))
 399     (goto-char (if arg
 400                    (- (point-max)
 401                       (if (> size 10000)
 402                           ;; Avoid overflow for large buffer sizes!
 403                           (* (prefix-numeric-value arg)
 404                              (/ size 10))
 405                         (/ (* size (prefix-numeric-value arg)) 10)))
 406                  (point-max))))
 407   ;; If we went to a place in the middle of the buffer,
 408   ;; adjust it to the beginning of a line.
 409   (if arg (forward-line 1)
 410     ;; If the end of the buffer is not already on the screen,
 411     ;; then scroll specially to put it near, but not at, the bottom.
 412     (if (let ((old-point (point)))
 413           (save-excursion
 414                     (goto-char (window-start))
 415                     (vertical-motion (window-height))
 416                     (< (point) old-point)))
 417         (progn
 418           (overlay-recenter (point))
 419           (recenter -3)))))
 420
 421 ;;;;;;;;;
 422 ;;;;; no mark
 423 ;;;;;;;;;
 424
 425 (defun forward-char-nomark (&optional arg)
 426   "Deactivate mark; move point right ARG characters \(left if ARG negative).
 427 On reaching end of buffer, stop and signal error."
 428   (interactive "p")
 429   (setq mark-active nil)
 430   (forward-char arg))
 431
 432 (defun forward-word-nomark (&optional arg)
 433   "Deactivate mark; move point right ARG words \(backward if ARG is negative).
 434 Normally returns t.
 435 If an edge of the buffer is reached, point is left there
 436 and nil is returned."
 437   (interactive "p")
 438   (setq mark-active nil)
 439   (forward-word arg))
 440
 441 (defun forward-line-nomark (&optional arg)
 442   "Deactivate mark; move cursor vertically down ARG lines."
 443   (interactive "p")
 444   (setq mark-active nil)
 445   (forward-line arg)
 446   (setq this-command 'forward-line)
 447 )
 448
 449 (defun forward-sexp-nomark (&optional arg)
 450   "Deactivate mark; move forward across one balanced expression (sexp).
 451 With argument, do it that many times.  Negative arg -N means
 452 move backward across N balanced expressions."
 453   (interactive "p")
 454   (setq mark-active nil)
 455   (forward-sexp arg))
 456
 457 (defun forward-paragraph-nomark (&optional arg)
 458   "Deactivate mark; move forward to end of paragraph.
 459 With arg N, do it N times; negative arg -N means move backward N paragraphs.
 460
 461 A line which `paragraph-start' matches either separates paragraphs
 462 \(if `paragraph-separate' matches it also) or is the first line of a paragraph.
 463 A paragraph end is the beginning of a line which is not part of the paragraph
 464 to which the end of the previous line belongs, or the end of the buffer."
 465   (interactive "p")
 466   (setq mark-active nil)
 467   (forward-paragraph arg))
 468
 469 (defun next-line-nomark (&optional arg)
 470   "Deactivate mark; move cursor vertically down ARG lines.
 471 If there is no character in the target line exactly under the current column,
 472 the cursor is positioned after the character in that line which spans this
 473 column, or at the end of the line if it is not long enough.
 474 If there is no line in the buffer after this one, behavior depends on the
 475 value of `next-line-add-newlines'.  If non-nil, it inserts a newline character
 476 to create a line, and moves the cursor to that line.  Otherwise it moves the
 477 cursor to the end of the buffer (if already at the end of the buffer, an error
 478 is signaled).
 479
 480 The command \\[set-goal-column] can be used to create
 481 a semipermanent goal column to which this command always moves.
 482 Then it does not try to move vertically.  This goal column is stored
 483 in `goal-column', which is nil when there is none."
 484   (interactive "p")
 485   (setq mark-active nil)
 486   (next-line arg)
 487   (setq this-command 'next-line))
 488
 489 (defun end-of-line-nomark (&optional arg)
 490   "Deactivate mark; move point to end of current line.
 491 With argument ARG not nil or 1, move forward ARG - 1 lines first.
 492 If scan reaches end of buffer, stop there without error."
 493   (interactive "p")
 494   (setq mark-active nil)
 495   (end-of-line arg)
 496   (setq this-command 'end-of-line))
 497
 498 (defun backward-line-nomark (&optional arg)
 499   "Deactivate mark; move cursor vertically up ARG lines."
 500   (interactive "p")
 501   (setq mark-active nil)
 502   (if (null arg)
 503       (setq arg 1))
 504   (forward-line (- arg))
 505   (setq this-command 'forward-line)
 506 )
 507
 508 (defun scroll-down-nomark (&optional arg)
 509   "Deactivate mark; scroll down ARG lines; or near full screen if no ARG.
 510 A near full screen is `next-screen-context-lines' less than a full screen.
 511 Negative ARG means scroll upward.
 512 When calling from a program, supply a number as argument or nil."
 513   (interactive "P")
 514   (setq mark-active nil)
 515   (cond (pc-select-override-scroll-error
 516          (condition-case nil (scroll-down arg)
 517            (beginning-of-buffer (goto-char (point-min)))))
 518         (t (scroll-down arg))))
 519
 520 (defun end-of-buffer-nomark (&optional arg)
 521   "Deactivate mark; move point to the end of the buffer.
 522 With arg N, put point N/10 of the way from the end.
 523
 524 If the buffer is narrowed, this command uses the beginning and size
 525 of the accessible part of the buffer.
 526
 527 Don't use this command in Lisp programs!
 528 \(goto-char (point-max)) is faster and avoids clobbering the mark."
 529   (interactive "P")
 530   (setq mark-active nil)
 531   (let ((size (- (point-max) (point-min))))
 532     (goto-char (if arg
 533                    (- (point-max)
 534                       (if (> size 10000)
 535                           ;; Avoid overflow for large buffer sizes!
 536                           (* (prefix-numeric-value arg)
 537                              (/ size 10))
 538                         (/ (* size (prefix-numeric-value arg)) 10)))
 539                  (point-max))))
 540   ;; If we went to a place in the middle of the buffer,
 541   ;; adjust it to the beginning of a line.
 542   (if arg (forward-line 1)
 543     ;; If the end of the buffer is not already on the screen,
 544     ;; then scroll specially to put it near, but not at, the bottom.
 545     (if (let ((old-point (point)))
 546           (save-excursion
 547                     (goto-char (window-start))
 548                     (vertical-motion (window-height))
 549                     (< (point) old-point)))
 550         (progn
 551           (overlay-recenter (point))
 552           (recenter -3)))))
 553
 554
 555 ;;;;;;;;;;;;;;;;;;;;
 556 ;;;;;; backwards and mark
 557 ;;;;;;;;;;;;;;;;;;;;
 558
 559 (defun backward-char-mark (&optional arg)
 560 "Ensure mark is active; move point left ARG characters (right if ARG negative).
 561 On attempt to pass beginning or end of buffer, stop and signal error."
 562   (interactive "p")
 563   (ensure-mark)
 564   (backward-char arg))
 565
 566 (defun backward-word-mark (&optional arg)
 567   "Ensure mark is active; move backward until encountering the end of a word.
 568 With argument, do this that many times."
 569   (interactive "p")
 570   (ensure-mark)
 571   (backward-word arg))
 572
 573 (defun backward-sexp-mark (&optional arg)
 574   "Ensure mark is active; move backward across one balanced expression (sexp).
 575 With argument, do it that many times.  Negative arg -N means
 576 move forward across N balanced expressions."
 577   (interactive "p")
 578   (ensure-mark)
 579   (backward-sexp arg))
 580
 581 (defun backward-paragraph-mark (&optional arg)
 582   "Ensure mark is active; move backward to start of paragraph.
 583 With arg N, do it N times; negative arg -N means move forward N paragraphs.
 584
 585 A paragraph start is the beginning of a line which is a
 586 `first-line-of-paragraph' or which is ordinary text and follows a
 587 paragraph-separating line; except: if the first real line of a
 588 paragraph is preceded by a blank line, the paragraph starts at that
 589 blank line.
 590
 591 See `forward-paragraph' for more information."
 592   (interactive "p")
 593   (ensure-mark)
 594   (backward-paragraph arg))
 595
 596 (defun previous-line-mark (&optional arg)
 597   "Ensure mark is active; move cursor vertically up ARG lines.
 598 If there is no character in the target line exactly over the current column,
 599 the cursor is positioned after the character in that line which spans this
 600 column, or at the end of the line if it is not long enough.
 601
 602 The command \\[set-goal-column] can be used to create
 603 a semipermanent goal column to which this command always moves.
 604 Then it does not try to move vertically.
 605
 606 If you are thinking of using this in a Lisp program, consider using
 607 `forward-line' with a negative argument instead.  It is usually easier
 608 to use and more reliable (no dependence on goal column, etc.)."
 609   (interactive "p")
 610   (ensure-mark)
 611   (previous-line arg)
 612   (setq this-command 'previous-line))
 613
 614 (defun beginning-of-line-mark (&optional arg)
 615   "Ensure mark is active; move point to beginning of current line.
 616 With argument ARG not nil or 1, move forward ARG - 1 lines first.
 617 If scan reaches end of buffer, stop there without error."
 618   (interactive "p")
 619   (ensure-mark)
 620   (beginning-of-line arg))
 621
 622
 623 (defun scroll-up-mark (&optional arg)
 624 "Ensure mark is active; scroll upward ARG lines; or near full screen if no ARG.
 625 A near full screen is `next-screen-context-lines' less than a full screen.
 626 Negative ARG means scroll downward.
 627 When calling from a program, supply a number as argument or nil."
 628   (interactive "P")
 629   (ensure-mark)
 630   (cond (pc-select-override-scroll-error
 631          (condition-case nil (scroll-up arg)
 632            (end-of-buffer (goto-char (point-max)))))
 633         (t (scroll-up arg))))
 634
 635 (defun beginning-of-buffer-mark (&optional arg)
 636   "Ensure mark is active; move point to the beginning of the buffer.
 637 With arg N, put point N/10 of the way from the beginning.
 638
 639 If the buffer is narrowed, this command uses the beginning and size
 640 of the accessible part of the buffer.
 641
 642 Don't use this command in Lisp programs!
 643 \(goto-char (p\oint-min)) is faster and avoids clobbering the mark."
 644   (interactive "P")
 645   (ensure-mark)
 646   (let ((size (- (point-max) (point-min))))
 647     (goto-char (if arg
 648                    (+ (point-min)
 649                       (if (> size 10000)
 650                           ;; Avoid overflow for large buffer sizes!
 651                           (* (prefix-numeric-value arg)
 652                              (/ size 10))
 653                         (/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
 654                  (point-min))))
 655   (if arg (forward-line 1)))
 656
 657 ;;;;;;;;
 658 ;;; no mark
 659 ;;;;;;;;
 660
 661 (defun backward-char-nomark (&optional arg)
 662   "Deactivate mark; move point left ARG characters (right if ARG negative).
 663 On attempt to pass beginning or end of buffer, stop and signal error."
 664   (interactive "p")
 665   (setq mark-active nil)
 666   (backward-char arg))
 667
 668 (defun backward-word-nomark (&optional arg)
 669   "Deactivate mark; move backward until encountering the end of a word.
 670 With argument, do this that many times."
 671   (interactive "p")
 672   (setq mark-active nil)
 673   (backward-word arg))
 674
 675 (defun backward-sexp-nomark (&optional arg)
 676   "Deactivate mark; move backward across one balanced expression (sexp).
 677 With argument, do it that many times.  Negative arg -N means
 678 move forward across N balanced expressions."
 679   (interactive "p")
 680   (setq mark-active nil)
 681   (backward-sexp arg))
 682
 683 (defun backward-paragraph-nomark (&optional arg)
 684   "Deactivate mark; move backward to start of paragraph.
 685 With arg N, do it N times; negative arg -N means move forward N paragraphs.
 686
 687 A paragraph start is the beginning of a line which is a
 688 `first-line-of-paragraph' or which is ordinary text and follows a
 689 paragraph-separating line; except: if the first real line of a
 690 paragraph is preceded by a blank line, the paragraph starts at that
 691 blank line.
 692
 693 See `forward-paragraph' for more information."
 694   (interactive "p")
 695   (setq mark-active nil)
 696   (backward-paragraph arg))
 697
 698 (defun previous-line-nomark (&optional arg)
 699   "Deactivate mark; move cursor vertically up ARG lines.
 700 If there is no character in the target line exactly over the current column,
 701 the cursor is positioned after the character in that line which spans this
 702 column, or at the end of the line if it is not long enough.
 703
 704 The command \\[set-goal-column] can be used to create
 705 a semipermanent goal column to which this command always moves.
 706 Then it does not try to move vertically."
 707   (interactive "p")
 708   (setq mark-active nil)
 709   (previous-line arg)
 710   (setq this-command 'previous-line))
 711
 712 (defun beginning-of-line-nomark (&optional arg)
 713   "Deactivate mark; move point to beginning of current line.
 714 With argument ARG not nil or 1, move forward ARG - 1 lines first.
 715 If scan reaches end of buffer, stop there without error."
 716   (interactive "p")
 717   (setq mark-active nil)
 718   (beginning-of-line arg))
 719
 720 (defun scroll-up-nomark (&optional arg)
 721   "Deactivate mark; scroll upward ARG lines; or near full screen if no ARG.
 722 A near full screen is `next-screen-context-lines' less than a full screen.
 723 Negative ARG means scroll downward.
 724 When calling from a program, supply a number as argument or nil."
 725   (interactive "P")
 726   (setq mark-active nil)
 727   (cond (pc-select-override-scroll-error
 728          (condition-case nil (scroll-up arg)
 729            (end-of-buffer (goto-char (point-max)))))
 730         (t (scroll-up arg))))
 731
 732 (defun beginning-of-buffer-nomark (&optional arg)
 733   "Deactivate mark; move point to the beginning of the buffer.
 734 With arg N, put point N/10 of the way from the beginning.
 735
 736 If the buffer is narrowed, this command uses the beginning and size
 737 of the accessible part of the buffer.
 738
 739 Don't use this command in Lisp programs!
 740 \(goto-char (point-min)) is faster and avoids clobbering the mark."
 741   (interactive "P")
 742   (setq mark-active nil)
 743   (let ((size (- (point-max) (point-min))))
 744     (goto-char (if arg
 745                    (+ (point-min)
 746                       (if (> size 10000)
 747                           ;; Avoid overflow for large buffer sizes!
 748                           (* (prefix-numeric-value arg)
 749                              (/ size 10))
 750                         (/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
 751                  (point-min))))
 752   (if arg (forward-line 1)))
 753
 754
 755 (defun pc-select-define-keys (alist keymap)
 756   "Make KEYMAP have the key bindings specified in ALIST."
 757   (let ((lst alist))
 758     (while lst
 759       (define-key keymap (caar lst) (cdar lst))
 760       (setq lst (cdr lst)))))
 761
 762 (defun pc-select-restore-keys (alist keymap saved-map)
 763   "Use ALIST to restore key bindings from SAVED-MAP into KEYMAP.
 764 Go through all the key bindings in ALIST, and, for each key
 765 binding, if KEYMAP and ALIST still agree on the key binding,
 766 restore the previous value of that key binding from SAVED-MAP."
 767   (let ((lst alist))
 768     (while lst
 769       (when (equal (lookup-key keymap (caar lst)) (cdar lst))
 770         (define-key keymap (caar lst) (lookup-key saved-map (caar lst))))
 771       (setq lst (cdr lst)))))
 772
 773 (defmacro pc-select-add-to-alist (alist var val)
 774   "Ensure that ALIST contains the cons cell (VAR . VAL).
 775 If a cons cell whose car is VAR is already on the ALIST, update the
 776 cdr of that cell with VAL.  Otherwise, make a new cons cell
 777 \(VAR . VAL), and prepend it onto ALIST."
 778   (let ((elt (make-symbol "elt")))
 779     `(let ((,elt (assq ',var ,alist)))
 780        (if ,elt
 781            (setcdr ,elt ,val)
 782          (setq ,alist (cons (cons ',var ,val) ,alist))))))
 783
 784 (defmacro pc-select-save-and-set-var (var newval)
 785   "Set VAR to NEWVAL; save the old value.
 786 The old value is saved on the `pc-select-saved-settings-alist'."
 787   `(when (boundp ',var)
 788      (pc-select-add-to-alist pc-select-saved-settings-alist ,var ,var)
 789      (setq ,var ,newval)))
 790
 791 (defmacro pc-select-save-and-set-mode (mode &optional arg mode-var)
 792   "Call the function MODE; save the old value of the variable MODE.
 793 MODE is presumed to be a function which turns on a minor mode.  First,
 794 save the value of the variable MODE on `pc-select-saved-settings-alist'.
 795 Then, if ARG is specified, call MODE with ARG, otherwise call it with
 796 nil as an argument.  If MODE-VAR is specified, save the value of the
 797 variable MODE-VAR (instead of the value of the variable MODE) on
 798 `pc-select-saved-settings-alist'."
 799   (unless mode-var (setq mode-var mode))
 800   `(when (fboundp ',mode)
 801      (pc-select-add-to-alist pc-select-saved-settings-alist
 802                              ,mode-var ,mode-var)
 803      (,mode ,arg)))
 804
 805 (defmacro pc-select-restore-var (var)
 806   "Restore the previous value of the variable VAR.
 807 Look up VAR's previous value in `pc-select-saved-settings-alist', and,
 808 if the value is found, set VAR to that value."
 809   (let ((elt (make-symbol "elt")))
 810     `(let ((,elt (assq ',var pc-select-saved-settings-alist)))
 811        (unless (null ,elt)
 812          (setq ,var (cdr ,elt))))))
 813
 814 (defmacro pc-select-restore-mode (mode)
 815   "Restore the previous state (either on or off) of the minor mode MODE.
 816 Look up the value of the variable MODE on `pc-select-saved-settings-alist'.
 817 If the value is non-nil, call the function MODE with an argument of
 818 1, otherwise call it with an argument of -1."
 819   (let ((elt (make-symbol "elt")))
 820     `(when (fboundp ',mode)
 821        (let ((,elt (assq ',mode pc-select-saved-settings-alist)))
 822          (unless (null ,elt)
 823            (,mode (if (cdr ,elt) 1 -1)))))))
 824
 825
 826 ;;;###autoload
 827 (define-minor-mode pc-selection-mode
 828   "Change mark behaviour to emulate Motif, MAC or MS-Windows cut and paste style.
 829
 830 This mode enables Delete Selection mode and Transient Mark mode.
 831
 832 The arrow keys (and others) are bound to new functions
 833 which modify the status of the mark.
 834
 835 The ordinary arrow keys disable the mark.
 836 The shift-arrow keys move, leaving the mark behind.
 837
 838 C-LEFT and C-RIGHT move back or forward one word, disabling the mark.
 839 S-C-LEFT and S-C-RIGHT move back or forward one word, leaving the mark behind.
 840
 841 M-LEFT and M-RIGHT move back or forward one word or sexp, disabling the mark.
 842 S-M-LEFT and S-M-RIGHT move back or forward one word or sexp, leaving the mark
 843 behind.  To control whether these keys move word-wise or sexp-wise set the
 844 variable `pc-select-meta-moves-sexps' after loading pc-select.el but before
 845 turning `pc-selection-mode' on.
 846
 847 C-DOWN and C-UP move back or forward a paragraph, disabling the mark.
 848 S-C-DOWN and S-C-UP move back or forward a paragraph, leaving the mark behind.
 849
 850 HOME moves to beginning of line, disabling the mark.
 851 S-HOME moves to beginning of line, leaving the mark behind.
 852 With Ctrl or Meta, these keys move to beginning of buffer instead.
 853
 854 END moves to end of line, disabling the mark.
 855 S-END moves to end of line, leaving the mark behind.
 856 With Ctrl or Meta, these keys move to end of buffer instead.
 857
 858 PRIOR or PAGE-UP scrolls and disables the mark.
 859 S-PRIOR or S-PAGE-UP scrolls and leaves the mark behind.
 860
 861 S-DELETE kills the region (`kill-region').
 862 S-INSERT yanks text from the kill ring (`yank').
 863 C-INSERT copies the region into the kill ring (`copy-region-as-kill').
 864
 865 In addition, certain other PC bindings are imitated (to avoid this, set
 866 the variable `pc-select-selection-keys-only' to t after loading pc-select.el
 867 but before calling `pc-selection-mode'):
 868
 869   F6           other-window
 870   DELETE       delete-char
 871   C-DELETE     kill-line
 872   M-DELETE     kill-word
 873   C-M-DELETE   kill-sexp
 874   C-BACKSPACE  backward-kill-word
 875   M-BACKSPACE  undo"
 876   ;; FIXME: bring pc-bindings-mode here ?
 877   nil nil nil
 878
 879   :group 'pc-select
 880   :global t
 881
 882   (if pc-selection-mode
 883       (if (null pc-select-key-bindings-alist)
 884           (progn
 885             (setq pc-select-saved-global-map (copy-keymap (current-global-map)))
 886             (setq pc-select-key-bindings-alist
 887                   (append pc-select-default-key-bindings
 888                           (if pc-select-selection-keys-only
 889                               nil
 890                             pc-select-extra-key-bindings)
 891                           (if pc-select-meta-moves-sexps
 892                               (car pc-select-meta-moves-sexps-key-bindings)
 893                             (cadr pc-select-meta-moves-sexps-key-bindings))
 894                           (if  (or pc-select-selection-keys-only
 895                                    (eq window-system 'x)
 896                                    (memq system-name '(ms-dos windows-nt)))
 897                               nil
 898                             pc-select-tty-key-bindings)))
 899
 900             (pc-select-define-keys pc-select-key-bindings-alist
 901                                    (current-global-map))
 902
 903             (unless  (or pc-select-selection-keys-only
 904                          (eq window-system 'x)
 905                          (memq system-name '(ms-dos windows-nt)))
 906               ;; it is not clear that we need the following line
 907               ;; I hope it doesn't do too much harm to leave it in, though...
 908               (setq pc-select-old-M-delete-binding
 909                     (lookup-key function-key-map [M-delete]))
 910               (define-key function-key-map  [M-delete] [?\M-d]))
 911
 912             (when (and (not pc-select-selection-keys-only)
 913                        (or (eq window-system 'x)
 914                            (memq system-name '(ms-dos windows-nt)))
 915                        (fboundp 'normal-erase-is-backspace-mode))
 916               (pc-select-save-and-set-mode normal-erase-is-backspace-mode 1
 917                                            normal-erase-is-backspace))
 918             ;; the original author also had this above:
 919             ;; (setq-default normal-erase-is-backspace t)
 920             ;; However, the documentation for the variable says that
 921             ;; "setting it with setq has no effect", so I'm removing it.
 922
 923             (pc-select-save-and-set-var highlight-nonselected-windows nil)
 924             (pc-select-save-and-set-var transient-mark-mode t)
 925             (pc-select-save-and-set-var mark-even-if-inactive t)
 926             (pc-select-save-and-set-mode delete-selection-mode 1))
 927         ;;else
 928         ;; If the user turned on pc-selection-mode a second time
 929         ;; do not clobber the values of the variables that were
 930         ;; saved from before pc-selection mode was activated --
 931         ;; just make sure the values are the way we like them.
 932         (pc-select-define-keys pc-select-key-bindings-alist
 933                                (current-global-map))
 934         (unless  (or pc-select-selection-keys-only
 935                      (eq window-system 'x)
 936                      (memq system-name '(ms-dos windows-nt)))
 937           ;; it is not clear that we need the following line
 938           ;; I hope it doesn't do too much harm to leave it in, though...
 939           (define-key function-key-map  [M-delete] [?\M-d]))
 940         (when (and (not pc-select-selection-keys-only)
 941                    (or (eq window-system 'x)
 942                        (memq system-name '(ms-dos windows-nt)))
 943                    (fboundp 'normal-erase-is-backspace-mode))
 944           (normal-erase-is-backspace-mode 1))
 945         (setq highlight-nonselected-windows nil)
 946         (setq transient-mark-mode t)
 947         (setq mark-even-if-inactive t)
 948         (delete-selection-mode 1))
 949     ;;else
 950     (when pc-select-key-bindings-alist
 951       (when (and (not pc-select-selection-keys-only)
 952                  (or (eq window-system 'x)
 953                      (memq system-name '(ms-dos windows-nt))))
 954         (pc-select-restore-mode normal-erase-is-backspace-mode))
 955
 956       (pc-select-restore-keys
 957        pc-select-key-bindings-alist (current-global-map)
 958        pc-select-saved-global-map)
 959
 960       (pc-select-restore-var highlight-nonselected-windows)
 961       (pc-select-restore-var transient-mark-mode)
 962       (pc-select-restore-var mark-even-if-inactive)
 963       (pc-select-restore-mode delete-selection-mode)
 964       (and pc-select-old-M-delete-binding
 965            (define-key function-key-map [M-delete]
 966              pc-select-old-M-delete-binding))
 967       (setq pc-select-key-bindings-alist nil
 968             pc-select-saved-settings-alist nil))))
 969
 970
 971 ;;;###autoload
 972 (defcustom pc-selection-mode nil
 973   "Toggle PC Selection mode.
 974 Change mark behaviour to emulate Motif, MAC or MS-Windows cut and paste style,
 975 and cursor movement commands.
 976 This mode enables Delete Selection mode and Transient Mark mode.
 977 You must modify via \\[customize] for this variable to have an effect."
 978   :set (lambda (symbol value)
 979          (pc-selection-mode (if value 1 -1)))
 980   :initialize 'custom-initialize-default
 981   :type 'boolean
 982   :group 'pc-select
 983   :require 'pc-select)
 984
 985 ;;; arch-tag: 10697b70-ae07-4f3e-ad23-7814a3f418c2
 986 ;;; pc-select.el ends here