| blob | d9adad9a7ee40bbfe8f99e7231d8b4635fd6fba1 |
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.
5 ;; Copyright (C) 1995, 1996, 1997, 2000, 2001 Free Software Foundation, Inc.
7 ;; Author: Michael Staats <michael@thp.Uni-Duisburg.DE>
8 ;; Keywords: convenience emulation
9 ;; Created: 26 Sep 1995
11 ;; This file is part of GNU Emacs.
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.
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.
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.
28 ;;; Commentary:
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 ;;
80 ;;; Code:
82 ;; Customization:
84 "Emulate pc bindings."
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."
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."
107 "*Non-nil means move sexp-wise with Meta key, otherwise move word-wise."
112 "The hook to run when pc-selection-mode is toggled."
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
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
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)
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)
162 ([S-next] . scroll-up-mark)
163 ([next] . scroll-up-nomark)
165 ([S-up] . previous-line-mark)
166 ([up] . previous-line-nomark)
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)
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)
180 ([S-prior] . scroll-down-mark)
181 ([prior] . scroll-down-nomark)
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))))
189 (setq pc-select-default-key-bindings lst)))
191 (defvar pc-select-extra-key-bindings nil
192 "Key bindings to set only if `pc-select-selection-keys-only' is nil.")
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)
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)
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
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))))
223 (setq pc-select-extra-key-bindings lst)))
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.")
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.")
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.")
256 ;;;;
257 ;; misc
258 ;;;;
260 (provide 'pc-select)
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.
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"))
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))
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)))
288 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
289 ;;;;; forward and mark
290 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
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))
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))
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 )
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))
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.
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))
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).
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))
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))
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 )
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))))
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.
391 If the buffer is narrowed, this command uses the beginning and size
392 of the accessible part of the buffer.
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)))))
421 ;;;;;;;;;
422 ;;;;; no mark
423 ;;;;;;;;;
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))
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))
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 )
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))
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.
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))
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).
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))
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))
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 )
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))))
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.
524 If the buffer is narrowed, this command uses the beginning and size
525 of the accessible part of the buffer.
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)))))
555 ;;;;;;;;;;;;;;;;;;;;
556 ;;;;;; backwards and mark
557 ;;;;;;;;;;;;;;;;;;;;
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))
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))
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))
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.
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.
591 See `forward-paragraph' for more information."
592 (interactive "p")
593 (ensure-mark)
594 (backward-paragraph arg))
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.
603 a semipermanent goal column to which this command always moves.
604 Then it does not try to move vertically.
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))
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))
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))))
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.
639 If the buffer is narrowed, this command uses the beginning and size
640 of the accessible part of the buffer.
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)))
657 ;;;;;;;;
658 ;;; no mark
659 ;;;;;;;;
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))
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))
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))
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.
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.
693 See `forward-paragraph' for more information."
694 (interactive "p")
695 (setq mark-active nil)
696 (backward-paragraph arg))
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.
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))
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))
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))))
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.
736 If the buffer is narrowed, this command uses the beginning and size
737 of the accessible part of the buffer.
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)))
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)))))
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)))))
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))))))
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)))
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)))
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))))))
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)))))))
826 ;;;###autoload
827 (define-minor-mode pc-selection-mode
828 "Change mark behaviour to emulate Motif, MAC or MS-Windows cut and paste style.
830 This mode enables Delete Selection mode and Transient Mark mode.
832 The arrow keys (and others) are bound to new functions
833 which modify the status of the mark.
835 The ordinary arrow keys disable the mark.
836 The shift-arrow keys move, leaving the mark behind.
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.
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.
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.
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.
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.
858 PRIOR or PAGE-UP scrolls and disables the mark.
859 S-PRIOR or S-PAGE-UP scrolls and leaves the mark behind.
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').
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'):
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
879 :group 'pc-select
880 :global t
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)))
900 (pc-select-define-keys pc-select-key-bindings-alist
901 (current-global-map))
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]))
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.
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))
956 (pc-select-restore-keys
957 pc-select-key-bindings-alist (current-global-map)
958 pc-select-saved-global-map)
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))))
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.
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)
985 ;;; pc-select.el ends here