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-1997, 2000-2011 Free Software Foundation, Inc.
7 ;; Author: Michael Staats <michael@thp.Uni-Duisburg.DE>
8 ;; Keywords: convenience emulations
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 3 of the License, or
16 ;; (at your option) 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. If not, see <http://www.gnu.org/licenses/>.
28 ;; This package emulates the mark, copy, cut and paste look-and-feel of motif
29 ;; programs (which is the same as the MAC gui and (sorry for that) MS-Windows).
30 ;; It modifies the keybindings of the cursor keys and the next, prior,
31 ;; home and end keys. They will modify mark-active.
32 ;; You can still get the old behavior of cursor moving with the
33 ;; control sequences C-f, C-b, etc.
34 ;; This package uses transient-mark-mode and
35 ;; delete-selection-mode.
37 ;; In addition to that all key-bindings from the pc-mode are
38 ;; done here too (as suggested by RMS).
40 ;; As I found out after I finished the first version, s-region.el tries
41 ;; to do the same.... But my code is a little more complete and using
42 ;; delete-selection-mode is very important for the look-and-feel.
43 ;; Pete Forman <pete.forman@airgun.wg.waii.com> provided some motif
44 ;; compliant keybindings which I added. I had to modify them a little
45 ;; to add the -mark and -nomark functionality of cursor moving.
48 ;; Many thanks to all who made comments.
49 ;; Thanks to RMS and Ralf Muschall <prm@rz.uni-jena.de> for criticism.
50 ;; Kevin Cutts <cutts@ukraine.corp.mot.com> added the beginning-of-buffer
51 ;; and end-of-buffer functions which I modified a little.
52 ;; David Biesack <sasdjb@unx.sas.com> suggested some more cleanup.
53 ;; Thanks to Pete Forman <pete.forman@airgun.wg.waii.com>
54 ;; for additional motif keybindings.
55 ;; Thanks to jvromans@squirrel.nl (Johan Vromans) for a bug report
56 ;; concerning setting of this-command.
57 ;; Dan Nicolaescu <done@ece.arizona.ro> suggested suppressing the
58 ;; scroll-up/scroll-down error.
59 ;; Eli Barzilay (eli@cs.bgu.ac.il) suggested the sexps functions and
62 ;; Ok, some details about the idea of PC Selection mode:
64 ;; o The standard keys for moving around (right, left, up, down, home, end,
65 ;; prior, next, called "move-keys" from now on) will always de-activate
67 ;; o If you press "Shift" together with the "move-keys", the region
68 ;; you pass along is activated
69 ;; o You have the copy, cut and paste functions (as in many other programs)
70 ;; which will operate on the active region
71 ;; It was not possible to bind them to C-v, C-x and C-c for obvious
73 ;; They will be bound according to the "old" behavior to S-delete (cut),
74 ;; S-insert (paste) and C-insert (copy). These keys do the same in many
81 (defgroup pc-select nil
82 "Emulate pc bindings."
86 (defcustom pc-select-override-scroll-error t
87 "Non-nil means don't generate error on scrolling past edge of buffer.
88 This variable applies in PC Selection mode only.
89 The scroll commands normally generate an error if you try to scroll
90 past the top or bottom of the buffer. This is annoying when selecting
91 text with these commands. If you set this variable to non-nil, these
92 errors are suppressed."
95 (define-obsolete-variable-alias 'pc-select-override-scroll-error
96 'scroll-error-top-bottom
99 (defcustom pc-select-selection-keys-only nil
100 "Non-nil means only bind the basic selection keys when started.
101 Other keys that emulate pc-behavior will be untouched.
102 This gives mostly Emacs-like behavior with only the selection keys enabled."
106 (defcustom pc-select-meta-moves-sexps nil
107 "Non-nil means move sexp-wise with Meta key, otherwise move word-wise."
111 (defcustom pc-selection-mode-hook nil
112 "The hook to run when PC Selection mode is toggled."
116 (defvar pc-select-saved-settings-alist nil
117 "The values of the variables before PC Selection mode was toggled on.
118 When PC Selection mode is toggled on, it sets quite a few variables
119 for its own purposes. This alist holds the original values of the
120 variables PC Selection mode had set, so that these variables can be
121 restored to their original values when PC Selection mode is toggled off.")
123 (defvar pc-select-map nil
124 "The keymap used as the global map when PC Selection mode is on." )
126 (defvar pc-select-saved-global-map nil
127 "The global map that was in effect when PC Selection mode was toggled on.")
129 (defvar pc-select-key-bindings-alist nil
130 "This alist holds all the key bindings PC Selection mode sets.")
132 (defvar pc-select-default-key-bindings nil
133 "These key bindings always get set by PC Selection mode.")
135 (unless pc-select-default-key-bindings
137 ;; This is to avoid confusion with the delete-selection-mode.
138 ;; On simple displays you can't see that a region is active and
139 ;; will be deleted on the next keypress IMHO especially for
140 ;; copy-region-as-kill this is confusing.
141 ;; The same goes for exchange-point-and-mark
142 '(("\M-w" . copy-region-as-kill-nomark
)
143 ("\C-x\C-x" . exchange-point-and-mark-nomark
)
144 ([S-right
] . forward-char-mark
)
145 ([right] . forward-char-nomark)
146 ([C-S-right] . forward-word-mark)
147 ([C-right] . forward-word-nomark)
148 ([S-left] . backward-char-mark)
149 ([left] . backward-char-nomark)
150 ([C-S-left] . backward-word-mark)
151 ([C-left] . backward-word-nomark)
152 ([S-down] . next-line-mark)
153 ([down] . next-line-nomark)
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
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)
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
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
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'."
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."
277 (exchange-point-and-mark)
278 (setq mark-active nil))
283 (defun pc-select-ensure-mark ()
284 ;; make sure mark is active
285 ;; test if it is active, if it isn't, set it and activate it
286 (or mark-active (set-mark-command nil))
287 ;; Remember who activated the mark.
288 (setq mark-active 'pc-select))
290 (defun pc-select-maybe-deactivate-mark ()
291 ;; maybe switch off mark (only if *we* switched it on)
292 (when (eq mark-active 'pc-select)
295 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
296 ;;;;; forward and mark
297 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
299 (defun forward-char-mark (&optional arg)
300 "Ensure mark is active; move point right ARG characters (left if ARG negative).
301 On reaching end of buffer, stop and signal error."
303 (pc-select-ensure-mark)
306 (defun forward-word-mark (&optional arg)
307 "Ensure mark is active; move point right ARG words (backward if ARG is negative).
309 If an edge of the buffer is reached, point is left there
310 and nil is returned."
312 (pc-select-ensure-mark)
315 (defun forward-line-mark (&optional arg)
316 "Ensure mark is active; move cursor vertically down ARG lines."
318 (pc-select-ensure-mark)
320 (setq this-command 'forward-line)
323 (defun forward-sexp-mark (&optional arg)
324 "Ensure mark is active; move forward across one balanced expression (sexp).
325 With argument, do it that many times. Negative arg -N means
326 move backward across N balanced expressions."
328 (pc-select-ensure-mark)
331 (defun forward-paragraph-mark (&optional arg)
332 "Ensure mark is active; move forward to end of paragraph.
333 With arg N, do it N times; negative arg -N means move backward N paragraphs.
335 A line which `paragraph-start' matches either separates paragraphs
336 \(if `paragraph-separate' matches it also) or is the first line of a paragraph.
337 A paragraph end is the beginning of a line which is not part of the paragraph
338 to which the end of the previous line belongs, or the end of the buffer."
340 (pc-select-ensure-mark)
341 (forward-paragraph arg))
343 (defun next-line-mark (&optional arg)
344 "Ensure mark is active; move cursor vertically down ARG lines.
345 If there is no character in the target line exactly under the current column,
346 the cursor is positioned after the character in that line which spans this
347 column, or at the end of the line if it is not long enough.
348 If there is no line in the buffer after this one, behavior depends on the
349 value of `next-line-add-newlines'. If non-nil, it inserts a newline character
350 to create a line, and moves the cursor to that line. Otherwise it moves the
351 cursor to the end of the buffer \(if already at the end of the buffer, an error
354 The command \\[set-goal-column] can be used to create
355 a semipermanent goal column to which this command always moves.
356 Then it does not try to move vertically. This goal column is stored
357 in `goal-column', which is nil when there is none."
359 (pc-select-ensure-mark)
360 (with-no-warnings (next-line arg))
361 (setq this-command 'next-line))
363 (defun end-of-line-mark (&optional arg)
364 "Ensure mark is active; move point to end of current line.
365 With argument ARG not nil or 1, move forward ARG - 1 lines first.
366 If scan reaches end of buffer, stop there without error."
368 (pc-select-ensure-mark)
370 (setq this-command 'end-of-line))
372 (defun backward-line-mark (&optional arg)
373 "Ensure mark is active; move cursor vertically up ARG lines."
375 (pc-select-ensure-mark)
378 (forward-line (- arg))
379 (setq this-command 'forward-line)
382 (defun scroll-down-mark (&optional arg)
383 "Ensure mark is active; scroll down ARG lines; or near full screen if no ARG.
384 A near full screen is `next-screen-context-lines' less than a full screen.
385 Negative ARG means scroll upward.
386 When calling from a program, supply a number as argument or nil.
387 Attempting to scroll past the edge of buffer does not raise an
388 error, unless `pc-select-override-scroll-error' is nil."
390 (pc-select-ensure-mark)
391 (cond (pc-select-override-scroll-error
392 (condition-case nil (scroll-down arg)
393 (beginning-of-buffer (goto-char (point-min)))))
394 (t (scroll-down arg))))
396 (defun end-of-buffer-mark (&optional arg)
397 "Ensure mark is active; move point to the end of the buffer.
398 With arg N, put point N/10 of the way from the end.
400 If the buffer is narrowed, this command uses the beginning and size
401 of the accessible part of the buffer.
403 Don't use this command in Lisp programs!
404 \(goto-char \(point-max)) is faster and avoids clobbering the mark."
406 (pc-select-ensure-mark)
407 (let ((size (- (point-max) (point-min))))
411 ;; Avoid overflow for large buffer sizes!
412 (* (prefix-numeric-value arg)
414 (/ (* size (prefix-numeric-value arg)) 10)))
416 ;; If we went to a place in the middle of the buffer,
417 ;; adjust it to the beginning of a line.
418 (if arg (forward-line 1)
419 ;; If the end of the buffer is not already on the screen,
420 ;; then scroll specially to put it near, but not at, the bottom.
421 (if (let ((old-point (point)))
423 (goto-char (window-start))
424 (vertical-motion (window-height))
425 (< (point) old-point)))
427 (overlay-recenter (point))
434 (defun forward-char-nomark (&optional arg)
435 "Deactivate mark; move point right ARG characters \(left if ARG negative).
436 On reaching end of buffer, stop and signal error."
438 (pc-select-maybe-deactivate-mark)
441 (defun forward-word-nomark (&optional arg)
442 "Deactivate mark; move point right ARG words \(backward if ARG is negative).
444 If an edge of the buffer is reached, point is left there
445 and nil is returned."
447 (pc-select-maybe-deactivate-mark)
450 (defun forward-line-nomark (&optional arg)
451 "Deactivate mark; move cursor vertically down ARG lines."
453 (pc-select-maybe-deactivate-mark)
455 (setq this-command 'forward-line)
458 (defun forward-sexp-nomark (&optional arg)
459 "Deactivate mark; move forward across one balanced expression (sexp).
460 With argument, do it that many times. Negative arg -N means
461 move backward across N balanced expressions."
463 (pc-select-maybe-deactivate-mark)
466 (defun forward-paragraph-nomark (&optional arg)
467 "Deactivate mark; move forward to end of paragraph.
468 With arg N, do it N times; negative arg -N means move backward N paragraphs.
470 A line which `paragraph-start' matches either separates paragraphs
471 \(if `paragraph-separate' matches it also) or is the first line of a paragraph.
472 A paragraph end is the beginning of a line which is not part of the paragraph
473 to which the end of the previous line belongs, or the end of the buffer."
475 (pc-select-maybe-deactivate-mark)
476 (forward-paragraph arg))
478 (defun next-line-nomark (&optional arg)
479 "Deactivate mark; move cursor vertically down ARG lines.
480 If there is no character in the target line exactly under the current column,
481 the cursor is positioned after the character in that line which spans this
482 column, or at the end of the line if it is not long enough.
483 If there is no line in the buffer after this one, behavior depends on the
484 value of `next-line-add-newlines'. If non-nil, it inserts a newline character
485 to create a line, and moves the cursor to that line. Otherwise it moves the
486 cursor to the end of the buffer (if already at the end of the buffer, an error
489 The command \\[set-goal-column] can be used to create
490 a semipermanent goal column to which this command always moves.
491 Then it does not try to move vertically. This goal column is stored
492 in `goal-column', which is nil when there is none."
494 (pc-select-maybe-deactivate-mark)
495 (with-no-warnings (next-line arg))
496 (setq this-command 'next-line))
498 (defun end-of-line-nomark (&optional arg)
499 "Deactivate mark; move point to end of current line.
500 With argument ARG not nil or 1, move forward ARG - 1 lines first.
501 If scan reaches end of buffer, stop there without error."
503 (pc-select-maybe-deactivate-mark)
505 (setq this-command 'end-of-line))
507 (defun backward-line-nomark (&optional arg)
508 "Deactivate mark; move cursor vertically up ARG lines."
510 (pc-select-maybe-deactivate-mark)
513 (forward-line (- arg))
514 (setq this-command 'forward-line)
517 (defun scroll-down-nomark (&optional arg)
518 "Deactivate mark; scroll down ARG lines; or near full screen if no ARG.
519 A near full screen is `next-screen-context-lines' less than a full screen.
520 Negative ARG means scroll upward.
521 When calling from a program, supply a number as argument or nil.
522 Attempting to scroll past the edge of buffer does not raise an
523 error, unless `pc-select-override-scroll-error' is nil."
525 (pc-select-maybe-deactivate-mark)
526 (cond (pc-select-override-scroll-error
527 (condition-case nil (scroll-down arg)
528 (beginning-of-buffer (goto-char (point-min)))))
529 (t (scroll-down arg))))
531 (defun end-of-buffer-nomark (&optional arg)
532 "Deactivate mark; move point to the end of the buffer.
533 With arg N, put point N/10 of the way from the end.
535 If the buffer is narrowed, this command uses the beginning and size
536 of the accessible part of the buffer.
538 Don't use this command in Lisp programs!
539 \(goto-char (point-max)) is faster and avoids clobbering the mark."
541 (pc-select-maybe-deactivate-mark)
542 (let ((size (- (point-max) (point-min))))
546 ;; Avoid overflow for large buffer sizes!
547 (* (prefix-numeric-value arg)
549 (/ (* size (prefix-numeric-value arg)) 10)))
551 ;; If we went to a place in the middle of the buffer,
552 ;; adjust it to the beginning of a line.
553 (if arg (forward-line 1)
554 ;; If the end of the buffer is not already on the screen,
555 ;; then scroll specially to put it near, but not at, the bottom.
556 (if (let ((old-point (point)))
558 (goto-char (window-start))
559 (vertical-motion (window-height))
560 (< (point) old-point)))
562 (overlay-recenter (point))
567 ;;;;;; backwards and mark
570 (defun backward-char-mark (&optional arg)
571 "Ensure mark is active; move point left ARG characters (right if ARG negative).
572 On attempt to pass beginning or end of buffer, stop and signal error."
574 (pc-select-ensure-mark)
577 (defun backward-word-mark (&optional arg)
578 "Ensure mark is active; move backward until encountering the end of a word.
579 With argument, do this that many times."
581 (pc-select-ensure-mark)
584 (defun backward-sexp-mark (&optional arg)
585 "Ensure mark is active; move backward across one balanced expression (sexp).
586 With argument, do it that many times. Negative arg -N means
587 move forward across N balanced expressions."
589 (pc-select-ensure-mark)
592 (defun backward-paragraph-mark (&optional arg)
593 "Ensure mark is active; move backward to start of paragraph.
594 With arg N, do it N times; negative arg -N means move forward N paragraphs.
596 A paragraph start is the beginning of a line which is a
597 `first-line-of-paragraph' or which is ordinary text and follows a
598 paragraph-separating line; except: if the first real line of a
599 paragraph is preceded by a blank line, the paragraph starts at that
602 See `forward-paragraph' for more information."
604 (pc-select-ensure-mark)
605 (backward-paragraph arg))
607 (defun previous-line-mark (&optional arg)
608 "Ensure mark is active; move cursor vertically up ARG lines.
609 If there is no character in the target line exactly over the current column,
610 the cursor is positioned after the character in that line which spans this
611 column, or at the end of the line if it is not long enough.
613 The command \\[set-goal-column] can be used to create
614 a semipermanent goal column to which this command always moves.
615 Then it does not try to move vertically.
617 If you are thinking of using this in a Lisp program, consider using
618 `forward-line' with a negative argument instead. It is usually easier
619 to use and more reliable (no dependence on goal column, etc.)."
621 (pc-select-ensure-mark)
622 (with-no-warnings (previous-line arg))
623 (setq this-command 'previous-line))
625 (defun beginning-of-line-mark (&optional arg)
626 "Ensure mark is active; move point to beginning of current line.
627 With argument ARG not nil or 1, move forward ARG - 1 lines first.
628 If scan reaches end of buffer, stop there without error."
630 (pc-select-ensure-mark)
631 (beginning-of-line arg))
634 (defun scroll-up-mark (&optional arg)
635 "Ensure mark is active; scroll upward ARG lines; or near full screen if no ARG.
636 A near full screen is `next-screen-context-lines' less than a full screen.
637 Negative ARG means scroll downward.
638 When calling from a program, supply a number as argument or nil.
639 Attempting to scroll past the edge of buffer does not raise an
640 error, unless `pc-select-override-scroll-error' is nil."
642 (pc-select-ensure-mark)
643 (cond (pc-select-override-scroll-error
644 (condition-case nil (scroll-up arg)
645 (end-of-buffer (goto-char (point-max)))))
646 (t (scroll-up arg))))
648 (defun beginning-of-buffer-mark (&optional arg)
649 "Ensure mark is active; move point to the beginning of the buffer.
650 With arg N, put point N/10 of the way from the beginning.
652 If the buffer is narrowed, this command uses the beginning and size
653 of the accessible part of the buffer.
655 Don't use this command in Lisp programs!
656 \(goto-char (point-min)) is faster and avoids clobbering the mark."
658 (pc-select-ensure-mark)
659 (let ((size (- (point-max) (point-min))))
663 ;; Avoid overflow for large buffer sizes!
664 (* (prefix-numeric-value arg)
666 (/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
668 (if arg (forward-line 1)))
674 (defun backward-char-nomark (&optional arg)
675 "Deactivate mark; move point left ARG characters (right if ARG negative).
676 On attempt to pass beginning or end of buffer, stop and signal error."
678 (pc-select-maybe-deactivate-mark)
681 (defun backward-word-nomark (&optional arg)
682 "Deactivate mark; move backward until encountering the end of a word.
683 With argument, do this that many times."
685 (pc-select-maybe-deactivate-mark)
688 (defun backward-sexp-nomark (&optional arg)
689 "Deactivate mark; move backward across one balanced expression (sexp).
690 With argument, do it that many times. Negative arg -N means
691 move forward across N balanced expressions."
693 (pc-select-maybe-deactivate-mark)
696 (defun backward-paragraph-nomark (&optional arg)
697 "Deactivate mark; move backward to start of paragraph.
698 With arg N, do it N times; negative arg -N means move forward N paragraphs.
700 A paragraph start is the beginning of a line which is a
701 `first-line-of-paragraph' or which is ordinary text and follows a
702 paragraph-separating line; except: if the first real line of a
703 paragraph is preceded by a blank line, the paragraph starts at that
706 See `forward-paragraph' for more information."
708 (pc-select-maybe-deactivate-mark)
709 (backward-paragraph arg))
711 (defun previous-line-nomark (&optional arg)
712 "Deactivate mark; move cursor vertically up ARG lines.
713 If there is no character in the target line exactly over the current column,
714 the cursor is positioned after the character in that line which spans this
715 column, or at the end of the line if it is not long enough.
717 The command \\[set-goal-column] can be used to create
718 a semipermanent goal column to which this command always moves.
719 Then it does not try to move vertically."
721 (pc-select-maybe-deactivate-mark)
722 (with-no-warnings (previous-line arg))
723 (setq this-command 'previous-line))
725 (defun beginning-of-line-nomark (&optional arg)
726 "Deactivate mark; move point to beginning of current line.
727 With argument ARG not nil or 1, move forward ARG - 1 lines first.
728 If scan reaches end of buffer, stop there without error."
730 (pc-select-maybe-deactivate-mark)
731 (beginning-of-line arg))
733 (defun scroll-up-nomark (&optional arg)
734 "Deactivate mark; scroll upward ARG lines; or near full screen if no ARG.
735 A near full screen is `next-screen-context-lines' less than a full screen.
736 Negative ARG means scroll downward.
737 When calling from a program, supply a number as argument or nil.
738 Attempting to scroll past the edge of buffer does not raise an
739 error, unless `pc-select-override-scroll-error' is nil."
741 (pc-select-maybe-deactivate-mark)
742 (cond (pc-select-override-scroll-error
743 (condition-case nil (scroll-up arg)
744 (end-of-buffer (goto-char (point-max)))))
745 (t (scroll-up arg))))
747 (defun beginning-of-buffer-nomark (&optional arg)
748 "Deactivate mark; move point to the beginning of the buffer.
749 With arg N, put point N/10 of the way from the beginning.
751 If the buffer is narrowed, this command uses the beginning and size
752 of the accessible part of the buffer.
754 Don't use this command in Lisp programs!
755 \(goto-char (point-min)) is faster and avoids clobbering the mark."
757 (pc-select-maybe-deactivate-mark)
758 (let ((size (- (point-max) (point-min))))
762 ;; Avoid overflow for large buffer sizes!
763 (* (prefix-numeric-value arg)
765 (/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
767 (if arg (forward-line 1)))
770 (defun pc-select-define-keys (alist keymap)
771 "Make KEYMAP have the key bindings specified in ALIST."
774 (define-key keymap (caar lst) (cdar lst))
775 (setq lst (cdr lst)))))
777 (defun pc-select-restore-keys (alist keymap saved-map)
778 "Use ALIST to restore key bindings from SAVED-MAP into KEYMAP.
779 Go through all the key bindings in ALIST, and, for each key
780 binding, if KEYMAP and ALIST still agree on the key binding,
781 restore the previous value of that key binding from SAVED-MAP."
784 (when (equal (lookup-key keymap (caar lst)) (cdar lst))
785 (define-key keymap (caar lst) (lookup-key saved-map (caar lst))))
786 (setq lst (cdr lst)))))
788 (defmacro pc-select-add-to-alist (alist var val)
789 "Ensure that ALIST contains the cons cell (VAR . VAL).
790 If a cons cell whose car is VAR is already on the ALIST, update the
791 cdr of that cell with VAL. Otherwise, make a new cons cell
792 \(VAR . VAL), and prepend it onto ALIST."
793 (let ((elt (make-symbol "elt")))
794 `(let ((,elt (assq ',var ,alist)))
797 (setq ,alist (cons (cons ',var ,val) ,alist))))))
799 (defmacro pc-select-save-and-set-var (var newval)
800 "Set VAR to NEWVAL; save the old value.
801 The old value is saved on the `pc-select-saved-settings-alist'."
802 `(when (boundp ',var)
803 (pc-select-add-to-alist pc-select-saved-settings-alist ,var ,var)
804 (setq ,var ,newval)))
806 (defmacro pc-select-save-and-set-mode (mode &optional arg mode-var)
807 "Call the function MODE; save the old value of the variable MODE.
808 MODE is presumed to be a function which turns on a minor mode. First,
809 save the value of the variable MODE on `pc-select-saved-settings-alist'.
810 Then, if ARG is specified, call MODE with ARG, otherwise call it with
811 nil as an argument. If MODE-VAR is specified, save the value of the
812 variable MODE-VAR (instead of the value of the variable MODE) on
813 `pc-select-saved-settings-alist'."
814 (unless mode-var (setq mode-var mode))
815 `(when (fboundp ',mode)
816 (pc-select-add-to-alist pc-select-saved-settings-alist
820 (defmacro pc-select-restore-var (var)
821 "Restore the previous value of the variable VAR.
822 Look up VAR's previous value in `pc-select-saved-settings-alist', and,
823 if the value is found, set VAR to that value."
824 (let ((elt (make-symbol "elt")))
825 `(let ((,elt (assq ',var pc-select-saved-settings-alist)))
827 (setq ,var (cdr ,elt))))))
829 (defmacro pc-select-restore-mode (mode)
830 "Restore the previous state (either on or off) of the minor mode MODE.
831 Look up the value of the variable MODE on `pc-select-saved-settings-alist'.
832 If the value is non-nil, call the function MODE with an argument of
833 1, otherwise call it with an argument of -1."
834 (let ((elt (make-symbol "elt")))
835 `(when (fboundp ',mode)
836 (let ((,elt (assq ',mode pc-select-saved-settings-alist)))
838 (,mode (if (cdr ,elt) 1 -1)))))))
842 (define-minor-mode pc-selection-mode
843 "Change mark behavior to emulate Motif, Mac or MS-Windows cut and paste style.
845 This mode enables Delete Selection mode and Transient Mark mode.
847 The arrow keys (and others) are bound to new functions
848 which modify the status of the mark.
850 The ordinary arrow keys disable the mark.
851 The shift-arrow keys move, leaving the mark behind.
853 C-LEFT and C-RIGHT move back or forward one word, disabling the mark.
854 S-C-LEFT and S-C-RIGHT move back or forward one word, leaving the mark behind.
856 M-LEFT and M-RIGHT move back or forward one word or sexp, disabling the mark.
857 S-M-LEFT and S-M-RIGHT move back or forward one word or sexp, leaving the mark
858 behind. To control whether these keys move word-wise or sexp-wise set the
859 variable `pc-select-meta-moves-sexps' after loading pc-select.el but before
860 turning PC Selection mode on.
862 C-DOWN and C-UP move back or forward a paragraph, disabling the mark.
863 S-C-DOWN and S-C-UP move back or forward a paragraph, leaving the mark behind.
865 HOME moves to beginning of line, disabling the mark.
866 S-HOME moves to beginning of line, leaving the mark behind.
867 With Ctrl or Meta, these keys move to beginning of buffer instead.
869 END moves to end of line, disabling the mark.
870 S-END moves to end of line, leaving the mark behind.
871 With Ctrl or Meta, these keys move to end of buffer instead.
873 PRIOR or PAGE-UP scrolls and disables the mark.
874 S-PRIOR or S-PAGE-UP scrolls and leaves the mark behind.
876 S-DELETE kills the region (`kill-region').
877 S-INSERT yanks text from the kill ring (`yank').
878 C-INSERT copies the region into the kill ring (`copy-region-as-kill').
880 In addition, certain other PC bindings are imitated (to avoid this, set
881 the variable `pc-select-selection-keys-only' to t after loading pc-select.el
882 but before calling PC Selection mode):
889 C-BACKSPACE backward-kill-word
891 ;; FIXME: bring pc-bindings-mode here ?
897 (if pc-selection-mode
898 (if (null pc-select-key-bindings-alist)
900 (setq pc-select-saved-global-map (copy-keymap (current-global-map)))
901 (setq pc-select-key-bindings-alist
902 (append pc-select-default-key-bindings
903 (if pc-select-selection-keys-only
905 pc-select-extra-key-bindings)
906 (if pc-select-meta-moves-sexps
907 (car pc-select-meta-moves-sexps-key-bindings)
908 (cadr pc-select-meta-moves-sexps-key-bindings))
909 (if (or pc-select-selection-keys-only
910 (eq window-system 'x)
911 (memq system-name '(ms-dos windows-nt)))
913 pc-select-tty-key-bindings)))
915 (pc-select-define-keys pc-select-key-bindings-alist
916 (current-global-map))
918 (unless (or pc-select-selection-keys-only
919 (eq window-system 'x)
920 (memq system-name '(ms-dos windows-nt)))
921 ;; it is not clear that we need the following line
922 ;; I hope it doesn't do too much harm to leave it in, though...
923 (setq pc-select-old-M-delete-binding
924 (lookup-key function-key-map [M-delete]))
925 (define-key function-key-map [M-delete] [?\M-d]))
927 (when (and (not pc-select-selection-keys-only)
928 (or (eq window-system 'x)
929 (memq system-name '(ms-dos windows-nt)))
930 (fboundp 'normal-erase-is-backspace-mode))
931 (pc-select-save-and-set-mode normal-erase-is-backspace-mode 1
932 normal-erase-is-backspace))
933 ;; the original author also had this above:
934 ;; (setq-default normal-erase-is-backspace t)
935 ;; However, the documentation for the variable says that
936 ;; "setting it with setq has no effect", so I'm removing it.
938 (pc-select-save-and-set-var highlight-nonselected-windows nil)
939 (pc-select-save-and-set-var transient-mark-mode t)
940 (pc-select-save-and-set-var mark-even-if-inactive t)
941 (pc-select-save-and-set-mode delete-selection-mode 1))
943 ;; If the user turned on pc-selection-mode a second time
944 ;; do not clobber the values of the variables that were
945 ;; saved from before pc-selection mode was activated --
946 ;; just make sure the values are the way we like them.
947 (pc-select-define-keys pc-select-key-bindings-alist
948 (current-global-map))
949 (unless (or pc-select-selection-keys-only
950 (eq window-system 'x)
951 (memq system-name '(ms-dos windows-nt)))
952 ;; it is not clear that we need the following line
953 ;; I hope it doesn't do too much harm to leave it in, though...
954 (define-key function-key-map [M-delete] [?\M-d]))
955 (when (and (not pc-select-selection-keys-only)
956 (or (eq window-system 'x)
957 (memq system-name '(ms-dos windows-nt)))
958 (fboundp 'normal-erase-is-backspace-mode))
959 (normal-erase-is-backspace-mode 1))
960 (setq highlight-nonselected-windows nil)
961 (setq transient-mark-mode t)
962 (setq mark-even-if-inactive t)
963 (delete-selection-mode 1))
965 (when pc-select-key-bindings-alist
966 (when (and (not pc-select-selection-keys-only)
967 (or (eq window-system 'x)
968 (memq system-name '(ms-dos windows-nt))))
969 (pc-select-restore-mode normal-erase-is-backspace-mode))
971 (pc-select-restore-keys
972 pc-select-key-bindings-alist (current-global-map)
973 pc-select-saved-global-map)
975 (pc-select-restore-var highlight-nonselected-windows)
976 (pc-select-restore-var transient-mark-mode)
977 (pc-select-restore-var mark-even-if-inactive)
978 (pc-select-restore-mode delete-selection-mode)
979 (and pc-select-old-M-delete-binding
980 (define-key function-key-map [M-delete]
981 pc-select-old-M-delete-binding))
982 (setq pc-select-key-bindings-alist nil
983 pc-select-saved-settings-alist nil))))
985 ;;; pc-select.el ends here