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