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