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