pc-select.el 28.6 KB
Newer Older
1 2 3
;;; pc-select.el --- emulate mark, cut, copy and paste from Motif
;;;		     (or MAC GUI or MS-windoze (bah)) look-and-feel
;;;		     including key bindings.
Richard M. Stallman's avatar
Richard M. Stallman committed
4

5
;; Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22

;; Author: Michael Staats <michael@thp.Uni-Duisburg.DE>
;; Created: 26 Sep 1995

;; This file is part of GNU Emacs.

;; GNU Emacs 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.

;; GNU Emacs 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
Erik Naggum's avatar
Erik Naggum committed
23 24 25
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
Richard M. Stallman's avatar
Richard M. Stallman committed
26 27

;;; Commentary:
Erik Naggum's avatar
Erik Naggum committed
28

Richard M. Stallman's avatar
Richard M. Stallman committed
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55
;; This package emulates the mark, copy, cut and paste look-and-feel of motif
;; programs (which is the same as the MAC gui and (sorry for that) MS-Windows).
;; It modifies the keybindings of the cursor keys and the next, prior,
;; home and end keys. They will modify mark-active.
;; You can still get the old behaviour of cursor moving with the
;; control sequences C-f, C-b, etc.
;; This package uses transient-mark-mode and
;; delete-selection-mode.
;;
;; In addition to that all key-bindings from the pc-mode are 
;; done here too (as suggested by RMS).
;;
;; As I found out after I finished the first version, s-region.el tries
;; to do the same.... But my code is a little more complete and using
;; delete-selection-mode is very important for the look-and-feel.
;; Pete Forman <pete.forman@airgun.wg.waii.com> provided some motif
;; compliant keybindings which I added. I had to modify them a little
;; to add the -mark and -nomark functionality of cursor moving.
;;
;; Credits:
;; Many thanks to all who made comments.
;; Thanks to RMS and Ralf Muschall <prm@rz.uni-jena.de> for criticism.
;; Kevin Cutts <cutts@ukraine.corp.mot.com> added the beginning-of-buffer
;; and end-of-buffer functions which I modified a little.
;; David Biesack <sasdjb@unx.sas.com> suggested some more cleanup.
;; Thanks to Pete Forman <pete.forman@airgun.wg.waii.com>
;; for additional motif keybindings.
Richard M. Stallman's avatar
Richard M. Stallman committed
56 57
;; Thanks to jvromans@squirrel.nl (Johan Vromans) for a bug report
;; concerning setting of this-command.
Richard M. Stallman's avatar
Richard M. Stallman committed
58
;; Dan Nicolaescu <done@ece.arizona.ro> suggested suppressing the
59
;; scroll-up/scroll-down error.
60 61
;; Eli Barzilay (eli@cs.bgu.ac.il) suggested the sexps functions and
;; keybindings. 
Richard M. Stallman's avatar
Richard M. Stallman committed
62 63 64 65 66 67 68 69 70 71 72 73 74 75 76
;;
;; Ok, some details about the idea of pc-selection-mode:
;;
;;  o The standard keys for moving around (right, left, up, down, home, end,
;;    prior, next, called "move-keys" from now on) will always de-activate
;;    the mark.
;;  o If you press "Shift" together with the "move-keys", the region
;;    you pass along is activated
;;  o You have the copy, cut and paste functions (as in many other programs)
;;    which will operate on the active region
;;    It was not possible to bind them to C-v, C-x and C-c for obvious
;;    emacs reasons.
;;    They will be bound according to the "old" behaviour to S-delete (cut),
;;    S-insert (paste) and C-insert (copy). These keys do the same in many
;;    other programs.
77
;;
Richard M. Stallman's avatar
Richard M. Stallman committed
78

79
;;;; Customization:
Richard M. Stallman's avatar
Richard M. Stallman committed
80 81 82 83
(defgroup pc-select nil
  "Emulate pc bindings."
  :prefix "pc-select"
  :group 'editing-basics)
84

Richard M. Stallman's avatar
Richard M. Stallman committed
85
(defcustom pc-select-override-scroll-error t
86 87 88 89 90
  "*Non-nil means don't generate error on scrolling past edge of buffer.
This variable applies in PC Selection mode only.
The scroll commands normally generate an error if you try to scroll
past the top or bottom of the buffer.  This is annoying when selecting
text with these commands.  If you set this variable to non-nil, these
Richard M. Stallman's avatar
Richard M. Stallman committed
91 92 93
errors are suppressed."
  :type 'boolean
  :group 'pc-select)
Richard M. Stallman's avatar
Richard M. Stallman committed
94

Richard M. Stallman's avatar
Richard M. Stallman committed
95
(defcustom pc-select-selection-keys-only nil
96 97
  "*Non-nil means only bind the basic selection keys when started.
Other keys that emulate pc-behavior will be untouched.
Richard M. Stallman's avatar
Richard M. Stallman committed
98 99 100
This gives mostly Emacs-like behaviour with only the selection keys enabled."
  :type 'boolean
  :group 'pc-select)
101

Richard M. Stallman's avatar
Richard M. Stallman committed
102 103 104 105
(defcustom pc-select-meta-moves-sexps nil
  "*Non-nil means move sexp-wise with Meta key, otherwise move word-wise."
  :type 'boolean
  :group 'pc-select)
106

Richard M. Stallman's avatar
Richard M. Stallman committed
107 108 109 110 111 112 113 114 115
;;;;
;; misc
;;;;

(provide 'pc-select)

(defun copy-region-as-kill-nomark (beg end)
  "Save the region as if killed; but don't kill it; deactivate mark.
If `interprogram-cut-function' is non-nil, also save the text for a window
116 117
system cut and paste.

Richard M. Stallman's avatar
Richard M. Stallman committed
118 119 120 121 122 123 124
Deactivating mark is to avoid confusion with delete-selection-mode
and transient-mark-mode."
 (interactive "r")
 (copy-region-as-kill beg end)
 (setq mark-active nil)
 (message "Region saved"))

125 126 127 128 129
(defun exchange-point-and-mark-nomark  ()
  (interactive)
  (exchange-point-and-mark)
  (setq mark-active nil))

Richard M. Stallman's avatar
Richard M. Stallman committed
130 131 132 133 134 135
;;;;
;; non-interactive
;;;;
(defun ensure-mark()
  ;; make sure mark is active
  ;; test if it is active, if it isn't, set it and activate it
136
  (or mark-active (set-mark-command nil)))
Richard M. Stallman's avatar
Richard M. Stallman committed
137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157

;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; forward and mark
;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun forward-char-mark (&optional arg)
  "Ensure mark is active; move point right ARG characters (left if ARG negative).
On reaching end of buffer, stop and signal error."
  (interactive "p")
  (ensure-mark)
  (forward-char arg))

(defun forward-word-mark (&optional arg)
  "Ensure mark is active; move point right ARG words (backward if ARG is negative).
Normally returns t.
If an edge of the buffer is reached, point is left there
and nil is returned."
  (interactive "p")
  (ensure-mark)
  (forward-word arg))

158 159 160 161 162 163 164 165
(defun forward-line-mark (&optional arg)
  "Ensure mark is active; move cursor vertically down ARG lines."
  (interactive "p")
  (ensure-mark)
  (forward-line arg)
  (setq this-command 'forward-line)
)

166 167 168 169 170 171 172 173
(defun forward-sexp-mark (&optional arg)
  "Ensure mark is active; move forward across one balanced expression (sexp).
With argument, do it that many times.  Negative arg -N means
move backward across N balanced expressions."
  (interactive "p")
  (ensure-mark)
  (forward-sexp arg))

Richard M. Stallman's avatar
Richard M. Stallman committed
174 175
(defun forward-paragraph-mark (&optional arg)
  "Ensure mark is active; move forward to end of paragraph.
176 177
With arg N, do it N times; negative arg -N means move backward N paragraphs.

Richard M. Stallman's avatar
Richard M. Stallman committed
178
A line which `paragraph-start' matches either separates paragraphs
Richard M. Stallman's avatar
Richard M. Stallman committed
179
\(if `paragraph-separate' matches it also) or is the first line of a paragraph.
Richard M. Stallman's avatar
Richard M. Stallman committed
180 181 182 183 184
A paragraph end is the beginning of a line which is not part of the paragraph
to which the end of the previous line belongs, or the end of the buffer."
  (interactive "p")
  (ensure-mark)
  (forward-paragraph arg))
185

Richard M. Stallman's avatar
Richard M. Stallman committed
186 187 188 189 190 191 192 193 194
(defun next-line-mark (&optional arg)
  "Ensure mark is active; move cursor vertically down ARG lines.
If there is no character in the target line exactly under the current column,
the cursor is positioned after the character in that line which spans this
column, or at the end of the line if it is not long enough.
If there is no line in the buffer after this one, behavior depends on the
value of `next-line-add-newlines'.  If non-nil, it inserts a newline character
to create a line, and moves the cursor to that line.  Otherwise it moves the
cursor to the end of the buffer \(if already at the end of the buffer, an error
195 196
is signaled).

Richard M. Stallman's avatar
Richard M. Stallman committed
197 198 199 200 201 202
The command C-x C-n can be used to create
a semipermanent goal column to which this command always moves.
Then it does not try to move vertically.  This goal column is stored
in `goal-column', which is nil when there is none."
  (interactive "p")
  (ensure-mark)
Richard M. Stallman's avatar
Richard M. Stallman committed
203 204
  (next-line arg)
  (setq this-command 'next-line))
Richard M. Stallman's avatar
Richard M. Stallman committed
205 206 207 208 209 210 211

(defun end-of-line-mark (&optional arg)
  "Ensure mark is active; move point to end of current 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")
  (ensure-mark)
Richard M. Stallman's avatar
Richard M. Stallman committed
212 213
  (end-of-line arg)
  (setq this-command 'end-of-line))
Richard M. Stallman's avatar
Richard M. Stallman committed
214

215 216 217 218 219 220 221 222 223 224
(defun backward-line-mark (&optional arg)
  "Ensure mark is active; move cursor vertically up ARG lines."
  (interactive "p")
  (ensure-mark)
  (if (null arg)
      (setq arg 1))
  (forward-line (- arg))
  (setq this-command 'forward-line)
)

Richard M. Stallman's avatar
Richard M. Stallman committed
225 226 227 228 229 230 231
(defun scroll-down-mark (&optional arg)
  "Ensure mark is active; scroll down ARG lines; or near full screen if no ARG.
A near full screen is `next-screen-context-lines' less than a full screen.
Negative ARG means scroll upward.
When calling from a program, supply a number as argument or nil."
  (interactive "P") 
  (ensure-mark)
232 233 234 235
  (cond (pc-select-override-scroll-error
	 (condition-case nil (scroll-down arg)
	   (beginning-of-buffer (goto-char (point-min)))))
	(t (scroll-down arg))))
Richard M. Stallman's avatar
Richard M. Stallman committed
236 237 238

(defun end-of-buffer-mark (&optional arg)
  "Ensure mark is active; move point to the end of the buffer.
239 240
With arg N, put point N/10 of the way from the end.

Richard M. Stallman's avatar
Richard M. Stallman committed
241
If the buffer is narrowed, this command uses the beginning and size
242 243
of the accessible part of the buffer.

Richard M. Stallman's avatar
Richard M. Stallman committed
244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290
Don't use this command in Lisp programs!
\(goto-char \(point-max)) is faster and avoids clobbering the mark."
  (interactive "P")
  (ensure-mark)
  (let ((size (- (point-max) (point-min))))
    (goto-char (if arg
		   (- (point-max)
		      (if (> size 10000)
			  ;; Avoid overflow for large buffer sizes!
			  (* (prefix-numeric-value arg)
			     (/ size 10))
			(/ (* size (prefix-numeric-value arg)) 10)))
		 (point-max))))
  ;; If we went to a place in the middle of the buffer,
  ;; adjust it to the beginning of a line.
  (if arg (forward-line 1)
    ;; If the end of the buffer is not already on the screen,
    ;; then scroll specially to put it near, but not at, the bottom.
    (if (let ((old-point (point)))
	  (save-excursion
		    (goto-char (window-start))
		    (vertical-motion (window-height))
		    (< (point) old-point)))
	(progn
	  (overlay-recenter (point))
	  (recenter -3)))))

;;;;;;;;;
;;;;; no mark
;;;;;;;;;

(defun forward-char-nomark (&optional arg)
  "Deactivate mark; move point right ARG characters \(left if ARG negative).
On reaching end of buffer, stop and signal error."
  (interactive "p")
  (setq mark-active nil)
  (forward-char arg))

(defun forward-word-nomark (&optional arg)
  "Deactivate mark; move point right ARG words \(backward if ARG is negative).
Normally returns t.
If an edge of the buffer is reached, point is left there
and nil is returned."
  (interactive "p")
  (setq mark-active nil)
  (forward-word arg))

291 292 293 294 295 296 297 298
(defun forward-line-nomark (&optional arg)
  "Deactivate mark; move cursor vertically down ARG lines."
  (interactive "p")
  (setq mark-active nil)
  (forward-line arg)
  (setq this-command 'forward-line)
)

299 300 301 302 303 304 305 306
(defun forward-sexp-nomark (&optional arg)
  "Deactivate mark; move forward across one balanced expression (sexp).
With argument, do it that many times.  Negative arg -N means
move backward across N balanced expressions."
  (interactive "p")
  (setq mark-active nil)
  (forward-sexp arg))

Richard M. Stallman's avatar
Richard M. Stallman committed
307 308
(defun forward-paragraph-nomark (&optional arg)
  "Deactivate mark; move forward to end of paragraph.
309 310
With arg N, do it N times; negative arg -N means move backward N paragraphs.

Richard M. Stallman's avatar
Richard M. Stallman committed
311
A line which `paragraph-start' matches either separates paragraphs
Richard M. Stallman's avatar
Richard M. Stallman committed
312
\(if `paragraph-separate' matches it also) or is the first line of a paragraph.
Richard M. Stallman's avatar
Richard M. Stallman committed
313 314 315 316 317 318 319 320 321 322 323 324 325 326 327
A paragraph end is the beginning of a line which is not part of the paragraph
to which the end of the previous line belongs, or the end of the buffer."
  (interactive "p")
  (setq mark-active nil)
  (forward-paragraph arg))

(defun next-line-nomark (&optional arg)
  "Deactivate mark; move cursor vertically down ARG lines.
If there is no character in the target line exactly under the current column,
the cursor is positioned after the character in that line which spans this
column, or at the end of the line if it is not long enough.
If there is no line in the buffer after this one, behavior depends on the
value of `next-line-add-newlines'.  If non-nil, it inserts a newline character
to create a line, and moves the cursor to that line.  Otherwise it moves the
cursor to the end of the buffer (if already at the end of the buffer, an error
328 329
is signaled).

Richard M. Stallman's avatar
Richard M. Stallman committed
330 331 332 333 334 335
The command C-x C-n can be used to create
a semipermanent goal column to which this command always moves.
Then it does not try to move vertically.  This goal column is stored
in `goal-column', which is nil when there is none."
  (interactive "p")
  (setq mark-active nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
336 337
  (next-line arg)
  (setq this-command 'next-line))
Richard M. Stallman's avatar
Richard M. Stallman committed
338 339 340 341 342 343 344

(defun end-of-line-nomark (&optional arg)
  "Deactivate mark; move point to end of current 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")
  (setq mark-active nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
345 346
  (end-of-line arg)
  (setq this-command 'end-of-line))
Richard M. Stallman's avatar
Richard M. Stallman committed
347

348 349 350 351 352 353 354 355 356 357
(defun backward-line-nomark (&optional arg)
  "Deactivate mark; move cursor vertically up ARG lines."
  (interactive "p")
  (setq mark-active nil)
  (if (null arg)
      (setq arg 1))
  (forward-line (- arg))
  (setq this-command 'forward-line)
)

Richard M. Stallman's avatar
Richard M. Stallman committed
358 359 360 361 362 363 364
(defun scroll-down-nomark (&optional arg)
  "Deactivate mark; scroll down ARG lines; or near full screen if no ARG.
A near full screen is `next-screen-context-lines' less than a full screen.
Negative ARG means scroll upward.
When calling from a program, supply a number as argument or nil."
  (interactive "P")
  (setq mark-active nil)
365 366 367 368
  (cond (pc-select-override-scroll-error
	 (condition-case nil (scroll-down arg)
	   (beginning-of-buffer (goto-char (point-min)))))
	(t (scroll-down arg))))
Richard M. Stallman's avatar
Richard M. Stallman committed
369 370 371

(defun end-of-buffer-nomark (&optional arg)
  "Deactivate mark; move point to the end of the buffer.
372 373
With arg N, put point N/10 of the way from the end.

Richard M. Stallman's avatar
Richard M. Stallman committed
374
If the buffer is narrowed, this command uses the beginning and size
375 376
of the accessible part of the buffer.

Richard M. Stallman's avatar
Richard M. Stallman committed
377
Don't use this command in Lisp programs!
Richard M. Stallman's avatar
Richard M. Stallman committed
378
\(goto-char (point-max)) is faster and avoids clobbering the mark."
Richard M. Stallman's avatar
Richard M. Stallman committed
379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422
  (interactive "P")
  (setq mark-active nil)
  (let ((size (- (point-max) (point-min))))
    (goto-char (if arg
		   (- (point-max)
		      (if (> size 10000)
			  ;; Avoid overflow for large buffer sizes!
			  (* (prefix-numeric-value arg)
			     (/ size 10))
			(/ (* size (prefix-numeric-value arg)) 10)))
		 (point-max))))
  ;; If we went to a place in the middle of the buffer,
  ;; adjust it to the beginning of a line.
  (if arg (forward-line 1)
    ;; If the end of the buffer is not already on the screen,
    ;; then scroll specially to put it near, but not at, the bottom.
    (if (let ((old-point (point)))
	  (save-excursion
		    (goto-char (window-start))
		    (vertical-motion (window-height))
		    (< (point) old-point)))
	(progn
	  (overlay-recenter (point))
	  (recenter -3)))))


;;;;;;;;;;;;;;;;;;;;
;;;;;; backwards and mark
;;;;;;;;;;;;;;;;;;;;

(defun backward-char-mark (&optional arg)
"Ensure mark is active; move point left ARG characters (right if ARG negative).
On attempt to pass beginning or end of buffer, stop and signal error."
  (interactive "p")
  (ensure-mark)
  (backward-char arg))

(defun backward-word-mark (&optional arg)
  "Ensure mark is active; move backward until encountering the end of a word.
With argument, do this that many times."
  (interactive "p")
  (ensure-mark)
  (backward-word arg))

423 424 425 426 427 428 429 430
(defun backward-sexp-mark (&optional arg)
  "Ensure mark is active; move backward across one balanced expression (sexp).
With argument, do it that many times.  Negative arg -N means
move forward across N balanced expressions."
  (interactive "p")
  (ensure-mark)
  (backward-sexp arg))

Richard M. Stallman's avatar
Richard M. Stallman committed
431 432
(defun backward-paragraph-mark (&optional arg)
  "Ensure mark is active; move backward to start of paragraph.
433 434
With arg N, do it N times; negative arg -N means move forward N paragraphs.

Richard M. Stallman's avatar
Richard M. Stallman committed
435 436 437 438
A paragraph start is the beginning of a line which is a
`first-line-of-paragraph' or which is ordinary text and follows a
paragraph-separating line; except: if the first real line of a
paragraph is preceded by a blank line, the paragraph starts at that
439 440
blank line.

Richard M. Stallman's avatar
Richard M. Stallman committed
441 442 443 444 445 446 447 448 449
See `forward-paragraph' for more information."
  (interactive "p")
  (ensure-mark)
  (backward-paragraph arg))

(defun previous-line-mark (&optional arg)
  "Ensure mark is active; move cursor vertically up ARG lines.
If there is no character in the target line exactly over the current column,
the cursor is positioned after the character in that line which spans this
450 451
column, or at the end of the line if it is not long enough.

Richard M. Stallman's avatar
Richard M. Stallman committed
452 453
The command C-x C-n can be used to create
a semipermanent goal column to which this command always moves.
454 455
Then it does not try to move vertically.

Richard M. Stallman's avatar
Richard M. Stallman committed
456 457 458 459 460
If you are thinking of using this in a Lisp program, consider using
`forward-line' with a negative argument instead.  It is usually easier
to use and more reliable (no dependence on goal column, etc.)."
  (interactive "p")
  (ensure-mark)
Richard M. Stallman's avatar
Richard M. Stallman committed
461 462
  (previous-line arg)
  (setq this-command 'previous-line))
Richard M. Stallman's avatar
Richard M. Stallman committed
463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479

(defun beginning-of-line-mark (&optional arg)
  "Ensure mark is active; move point to beginning of current 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")
  (ensure-mark)
  (beginning-of-line arg))


(defun scroll-up-mark (&optional arg)
"Ensure mark is active; scroll upward ARG lines; or near full screen if no ARG.
A near full screen is `next-screen-context-lines' less than a full screen.
Negative ARG means scroll downward.
When calling from a program, supply a number as argument or nil."
  (interactive "P")
  (ensure-mark)
480 481 482 483
  (cond (pc-select-override-scroll-error
	 (condition-case nil (scroll-up arg)
	   (end-of-buffer (goto-char (point-max)))))
	(t (scroll-up arg))))
Richard M. Stallman's avatar
Richard M. Stallman committed
484 485 486

(defun beginning-of-buffer-mark (&optional arg)
  "Ensure mark is active; move point to the beginning of the buffer.
487 488
With arg N, put point N/10 of the way from the beginning.

Richard M. Stallman's avatar
Richard M. Stallman committed
489
If the buffer is narrowed, this command uses the beginning and size
490 491
of the accessible part of the buffer.

Richard M. Stallman's avatar
Richard M. Stallman committed
492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524
Don't use this command in Lisp programs!
\(goto-char (p\oint-min)) is faster and avoids clobbering the mark."
  (interactive "P")
  (ensure-mark) 
  (let ((size (- (point-max) (point-min))))
    (goto-char (if arg
		   (+ (point-min)
		      (if (> size 10000)
			  ;; Avoid overflow for large buffer sizes!
			  (* (prefix-numeric-value arg)
			     (/ size 10))
			(/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
		 (point-min))))
  (if arg (forward-line 1)))

;;;;;;;;
;;; no mark
;;;;;;;;

(defun backward-char-nomark (&optional arg)
  "Deactivate mark; move point left ARG characters (right if ARG negative).
On attempt to pass beginning or end of buffer, stop and signal error."
  (interactive "p")
  (setq mark-active nil)
  (backward-char arg))

(defun backward-word-nomark (&optional arg)
  "Deactivate mark; move backward until encountering the end of a word.
With argument, do this that many times."
  (interactive "p")
  (setq mark-active nil)
  (backward-word arg))

525 526 527 528 529 530 531 532
(defun backward-sexp-nomark (&optional arg)
  "Deactivate mark; move backward across one balanced expression (sexp).
With argument, do it that many times.  Negative arg -N means
move forward across N balanced expressions."
  (interactive "p")
  (setq mark-active nil)
  (backward-sexp arg))

Richard M. Stallman's avatar
Richard M. Stallman committed
533 534
(defun backward-paragraph-nomark (&optional arg)
  "Deactivate mark; move backward to start of paragraph.
535 536
With arg N, do it N times; negative arg -N means move forward N paragraphs.

Richard M. Stallman's avatar
Richard M. Stallman committed
537 538 539 540
A paragraph start is the beginning of a line which is a
`first-line-of-paragraph' or which is ordinary text and follows a
paragraph-separating line; except: if the first real line of a
paragraph is preceded by a blank line, the paragraph starts at that
541 542
blank line.

Richard M. Stallman's avatar
Richard M. Stallman committed
543 544 545 546 547 548 549 550 551
See `forward-paragraph' for more information."
  (interactive "p")
  (setq mark-active nil)
  (backward-paragraph arg))

(defun previous-line-nomark (&optional arg)
  "Deactivate mark; move cursor vertically up ARG lines.
If there is no character in the target line exactly over the current column,
the cursor is positioned after the character in that line which spans this
552 553
column, or at the end of the line if it is not long enough.

Richard M. Stallman's avatar
Richard M. Stallman committed
554 555 556 557 558
The command C-x C-n can be used to create
a semipermanent goal column to which this command always moves.
Then it does not try to move vertically."
  (interactive "p")
  (setq mark-active nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
559 560
  (previous-line arg)
  (setq this-command 'previous-line))
Richard M. Stallman's avatar
Richard M. Stallman committed
561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576

(defun beginning-of-line-nomark (&optional arg)
  "Deactivate mark; move point to beginning of current 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")
  (setq mark-active nil)
  (beginning-of-line arg))

(defun scroll-up-nomark (&optional arg)
  "Deactivate mark; scroll upward ARG lines; or near full screen if no ARG.
A near full screen is `next-screen-context-lines' less than a full screen.
Negative ARG means scroll downward.
When calling from a program, supply a number as argument or nil."
  (interactive "P")
  (setq mark-active nil)
577 578 579 580
  (cond (pc-select-override-scroll-error
	 (condition-case nil (scroll-up arg)
	   (end-of-buffer (goto-char (point-max)))))
	(t (scroll-up arg))))
Richard M. Stallman's avatar
Richard M. Stallman committed
581 582 583

(defun beginning-of-buffer-nomark (&optional arg)
  "Deactivate mark; move point to the beginning of the buffer.
584 585
With arg N, put point N/10 of the way from the beginning.

Richard M. Stallman's avatar
Richard M. Stallman committed
586
If the buffer is narrowed, this command uses the beginning and size
587 588
of the accessible part of the buffer.

Richard M. Stallman's avatar
Richard M. Stallman committed
589
Don't use this command in Lisp programs!
Richard M. Stallman's avatar
Richard M. Stallman committed
590
\(goto-char (point-min)) is faster and avoids clobbering the mark."
Richard M. Stallman's avatar
Richard M. Stallman committed
591 592 593 594 595 596 597 598 599 600 601 602 603
  (interactive "P")
  (setq mark-active nil)
  (let ((size (- (point-max) (point-min))))
    (goto-char (if arg
		   (+ (point-min)
		      (if (> size 10000)
			  ;; Avoid overflow for large buffer sizes!
			  (* (prefix-numeric-value arg)
			     (/ size 10))
			(/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
		 (point-min))))
  (if arg (forward-line 1)))

604
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
605
(defun pc-selection-mode ()
606 607 608 609 610 611 612 613 614 615 616 617 618
  "Change mark behaviour to emulate Motif, MAC or MS-Windows cut and paste style.

This mode enables Delete Selection mode and Transient Mark mode.

The arrow keys (and others) are bound to new functions
which modify the status of the mark.

The ordinary arrow keys disable the mark.
The shift-arrow keys move, leaving the mark behind.

C-LEFT and C-RIGHT move back or forward one word, disabling the mark.
S-C-LEFT and S-C-RIGHT move back or forward one word, leaving the mark behind.

619 620 621 622 623 624
M-LEFT and M-RIGHT move back or forward one word or sexp, disabling the mark.
S-M-LEFT and S-M-RIGHT move back or forward one word or sexp, leaving the mark
behind. To control wether these keys move word-wise or sexp-wise set the
variable pc-select-meta-moves-sexps after loading pc-select.el but before
turning pc-selection-mode on.

625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642
C-DOWN and C-UP move back or forward a paragraph, disabling the mark.
S-C-DOWN and S-C-UP move back or forward a paragraph, leaving the mark behind.

HOME moves to beginning of line, disabling the mark.
S-HOME moves to beginning of line, leaving the mark behind.
With Ctrl or Meta, these keys move to beginning of buffer instead.

END moves to end of line, disabling the mark.
S-END moves to end of line, leaving the mark behind.
With Ctrl or Meta, these keys move to end of buffer instead.

PRIOR or PAGE-UP scrolls and disables the mark.
S-PRIOR or S-PAGE-UP scrolls and leaves the mark behind.

S-DELETE kills the region (`kill-region').
S-INSERT yanks text from the kill ring (`yank').
C-INSERT copies the region into the kill ring (`copy-region-as-kill').

643 644 645
In addition, certain other PC bindings are imitated (to avoid this, set
the variable pc-select-selection-keys-only to t after loading pc-select.el
but before calling pc-selection-mode):
646 647 648 649 650 651 652 653 654

  F6           other-window
  DELETE       delete-char
  C-DELETE     kill-line
  M-DELETE     kill-word
  C-M-DELETE   kill-sexp
  C-BACKSPACE  backward-kill-word
  M-BACKSPACE  undo"

Richard M. Stallman's avatar
Richard M. Stallman committed
655 656 657 658 659 660 661
  (interactive)
  ;;
  ;; keybindings
  ;;

  ;; This is to avoid confusion with the delete-selection-mode
  ;; On simple displays you can't see that a region is active and
662 663 664
  ;; will be deleted on the next keypress.  IMHO especially for
  ;; copy-region-as-kill this is confusing.
  ;; The same goes for exchange-point-and-mark
Richard M. Stallman's avatar
Richard M. Stallman committed
665
  (define-key global-map "\M-w" 'copy-region-as-kill-nomark) 
666
  (define-key global-map "\C-x\C-x" 'exchange-point-and-mark-nomark) 
Karl Heuer's avatar
Karl Heuer committed
667
  ;; The following keybindings are for standard ISO keyboards
Richard M. Stallman's avatar
Richard M. Stallman committed
668 669 670 671 672 673
  ;; as they are used with IBM compatible PCs, IBM RS/6000,
  ;; MACs, many X-Stations and probably more
  (define-key global-map [S-right]   'forward-char-mark)
  (define-key global-map [right]     'forward-char-nomark)
  (define-key global-map [C-S-right] 'forward-word-mark)
  (define-key global-map [C-right]   'forward-word-nomark)
674 675 676 677 678 679 680 681 682 683 684 685 686 687
  (define-key global-map [S-left]    'backward-char-mark)
  (define-key global-map [left]      'backward-char-nomark)
  (define-key global-map [C-S-left]  'backward-word-mark)
  (define-key global-map [C-left]    'backward-word-nomark)
  (cond (pc-select-meta-moves-sexps
	 (define-key global-map [M-S-right] 'forward-sexp-mark)
	 (define-key global-map [M-right]   'forward-sexp-nomark)
	 (define-key global-map [M-S-left]  'backward-sexp-mark)
	 (define-key global-map [M-left]    'backward-sexp-nomark))
	(t
	 (define-key global-map [M-S-right] 'forward-word-mark)
	 (define-key global-map [M-right]   'forward-word-nomark)
	 (define-key global-map [M-S-left]  'backward-word-mark)
	 (define-key global-map [M-left]    'backward-word-nomark)))
Richard M. Stallman's avatar
Richard M. Stallman committed
688 689 690 691 692 693 694 695

  (define-key global-map [S-down]    'next-line-mark)
  (define-key global-map [down]      'next-line-nomark)

  (define-key global-map [S-end]     'end-of-line-mark)
  (define-key global-map [end]       'end-of-line-nomark)
  (global-set-key [S-C-end]          'end-of-buffer-mark)
  (global-set-key [C-end]            'end-of-buffer-nomark)
Richard M. Stallman's avatar
Richard M. Stallman committed
696 697
  (global-set-key [S-M-end]          'end-of-buffer-mark)
  (global-set-key [M-end]            'end-of-buffer-nomark)
Richard M. Stallman's avatar
Richard M. Stallman committed
698 699 700 701 702 703 704 705 706 707 708

  (define-key global-map [S-next]    'scroll-up-mark)
  (define-key global-map [next]      'scroll-up-nomark)

  (define-key global-map [S-up]      'previous-line-mark)
  (define-key global-map [up]        'previous-line-nomark)

  (define-key global-map [S-home]    'beginning-of-line-mark)
  (define-key global-map [home]      'beginning-of-line-nomark)
  (global-set-key [S-C-home]         'beginning-of-buffer-mark)
  (global-set-key [C-home]           'beginning-of-buffer-nomark)
Richard M. Stallman's avatar
Richard M. Stallman committed
709 710
  (global-set-key [S-M-home]         'beginning-of-buffer-mark)
  (global-set-key [M-home]           'beginning-of-buffer-nomark)
Richard M. Stallman's avatar
Richard M. Stallman committed
711

712 713 714 715 716
  (define-key global-map [M-S-down]  'forward-line-mark)
  (define-key global-map [M-down]    'forward-line-nomark)
  (define-key global-map [M-S-up]    'backward-line-mark)
  (define-key global-map [M-up]      'backward-line-nomark)

717 718 719 720 721 722
  (define-key global-map [S-prior]   'scroll-down-mark)
  (define-key global-map [prior]     'scroll-down-nomark)

  ;; Next four lines are from Pete Forman.
  (global-set-key [C-down] 'forward-paragraph-nomark)	; KNextPara     cDn
  (global-set-key [C-up] 'backward-paragraph-nomark)	; KPrevPara     cUp
Richard M. Stallman's avatar
Richard M. Stallman committed
723 724 725
  (global-set-key [S-C-down] 'forward-paragraph-mark)
  (global-set-key [S-C-up] 'backward-paragraph-mark) 

726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753
  (or pc-select-selection-keys-only
      (progn 
	(define-key global-map [S-insert]  'yank)
	(define-key global-map [C-insert]  'copy-region-as-kill)
	(define-key global-map [S-delete]  'kill-region)

	;; The following bindings are useful on Sun Type 3 keyboards
	;; They implement the Get-Delete-Put (copy-cut-paste)
	;; functions from sunview on the L6, L8 and L10 keys
	;; Sam Steingold <sds@ptc.com> says that f16 is copy and f18 is paste.
	(define-key global-map [f16]  'copy-region-as-kill)
	(define-key global-map [f18]  'yank)
	(define-key global-map [f20]  'kill-region)

	;; The following bindings are from Pete Forman.
	(global-set-key [f6] 'other-window)	; KNextPane     F6
	(global-set-key [delete] 'delete-char)	; KDelete       Del
	(global-set-key [C-delete] 'kill-line)	; KEraseEndLine cDel
	(global-set-key [M-backspace] 'undo)	; KUndo         aBS

	;; The following bindings are taken from pc-mode.el
	;; as suggested by RMS.
	;; I only used the ones that are not covered above.
	(define-key function-key-map  [M-delete] [?\M-d])
	(global-set-key [C-M-delete]  'kill-sexp)
	(global-set-key [C-backspace] 'backward-kill-word)
	;; Next line proposed by Eli Barzilay
	(global-set-key [C-escape]    'electric-buffer-list)))
Richard M. Stallman's avatar
Richard M. Stallman committed
754 755 756
  ;;        
  ;; setup
  ;;
757 758
  ;; Next line proposed by Eli Barzilay
  (setq highlight-nonselected-windows nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
759 760
  (setq transient-mark-mode t)
  (setq mark-even-if-inactive t)
761
  (delete-selection-mode 1)
762
)
Richard M. Stallman's avatar
Richard M. Stallman committed
763 764 765 766 767 768 769 770 771 772 773 774 775 776

;;;###autoload
(defcustom pc-selection-mode nil
  "Toggle PC Selection mode.
Change mark behaviour to emulate Motif, MAC or MS-Windows cut and paste style,
and cursor movement commands.
This mode enables Delete Selection mode and Transient Mark mode.
You must modify via \\[customize] for this variable to have an effect."
  :set (lambda (symbol value)
	(if value (pc-selection-mode)))
  :type 'boolean
  :group 'pc-select
  :require 'pc-select)

Richard M. Stallman's avatar
Richard M. Stallman committed
777
;;; pc-select.el ends here