pc-select.el 17 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418
  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. ;; Copyright (C) 1995-1997, 2000-2012 Free Software Foundation, Inc.
  5. ;; Author: Michael Staats <michael@thp.Uni-Duisburg.DE>
  6. ;; Keywords: convenience emulations
  7. ;; Created: 26 Sep 1995
  8. ;; Obsolete-since: 24.1
  9. ;; This file is part of GNU Emacs.
  10. ;; GNU Emacs is free software: you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation, either version 3 of the License, or
  13. ;; (at your option) any later version.
  14. ;; GNU Emacs is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17. ;; GNU General Public License for more details.
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  20. ;;; Commentary:
  21. ;; This package emulates the mark, copy, cut and paste look-and-feel of motif
  22. ;; programs (which is the same as the MAC gui and (sorry for that) MS-Windows).
  23. ;; It modifies the keybindings of the cursor keys and the next, prior,
  24. ;; home and end keys. They will modify mark-active.
  25. ;; You can still get the old behavior of cursor moving with the
  26. ;; control sequences C-f, C-b, etc.
  27. ;; This package uses transient-mark-mode and
  28. ;; delete-selection-mode.
  29. ;;
  30. ;; In addition to that all key-bindings from the pc-mode are
  31. ;; done here too (as suggested by RMS).
  32. ;;
  33. ;; As I found out after I finished the first version, s-region.el tries
  34. ;; to do the same.... But my code is a little more complete and using
  35. ;; delete-selection-mode is very important for the look-and-feel.
  36. ;; Pete Forman <pete.forman@airgun.wg.waii.com> provided some motif
  37. ;; compliant keybindings which I added. I had to modify them a little
  38. ;; to add the -mark and -nomark functionality of cursor moving.
  39. ;;
  40. ;; Credits:
  41. ;; Many thanks to all who made comments.
  42. ;; Thanks to RMS and Ralf Muschall <prm@rz.uni-jena.de> for criticism.
  43. ;; Kevin Cutts <cutts@ukraine.corp.mot.com> added the beginning-of-buffer
  44. ;; and end-of-buffer functions which I modified a little.
  45. ;; David Biesack <sasdjb@unx.sas.com> suggested some more cleanup.
  46. ;; Thanks to Pete Forman <pete.forman@airgun.wg.waii.com>
  47. ;; for additional motif keybindings.
  48. ;; Thanks to jvromans@squirrel.nl (Johan Vromans) for a bug report
  49. ;; concerning setting of this-command.
  50. ;; Dan Nicolaescu <done@ece.arizona.ro> suggested suppressing the
  51. ;; scroll-up/scroll-down error.
  52. ;; Eli Barzilay (eli@cs.bgu.ac.il) suggested the sexps functions and
  53. ;; keybindings.
  54. ;;
  55. ;; Ok, some details about the idea of PC Selection mode:
  56. ;;
  57. ;; o The standard keys for moving around (right, left, up, down, home, end,
  58. ;; prior, next, called "move-keys" from now on) will always de-activate
  59. ;; the mark.
  60. ;; o If you press "Shift" together with the "move-keys", the region
  61. ;; you pass along is activated
  62. ;; o You have the copy, cut and paste functions (as in many other programs)
  63. ;; which will operate on the active region
  64. ;; It was not possible to bind them to C-v, C-x and C-c for obvious
  65. ;; emacs reasons.
  66. ;; They will be bound according to the "old" behavior to S-delete (cut),
  67. ;; S-insert (paste) and C-insert (copy). These keys do the same in many
  68. ;; other programs.
  69. ;;
  70. ;;; Code:
  71. ;; Customization:
  72. (defgroup pc-select nil
  73. "Emulate pc bindings."
  74. :prefix "pc-select"
  75. :group 'emulations)
  76. (define-obsolete-variable-alias 'pc-select-override-scroll-error
  77. 'scroll-error-top-bottom
  78. "24.1")
  79. (defcustom pc-select-override-scroll-error t
  80. "Non-nil means don't generate error on scrolling past edge of buffer.
  81. This variable applies in PC Selection mode only.
  82. The scroll commands normally generate an error if you try to scroll
  83. past the top or bottom of the buffer. This is annoying when selecting
  84. text with these commands. If you set this variable to non-nil, these
  85. errors are suppressed."
  86. :type 'boolean
  87. :group 'pc-select)
  88. (defcustom pc-select-selection-keys-only nil
  89. "Non-nil means only bind the basic selection keys when started.
  90. Other keys that emulate pc-behavior will be untouched.
  91. This gives mostly Emacs-like behavior with only the selection keys enabled."
  92. :type 'boolean
  93. :group 'pc-select)
  94. (defcustom pc-select-meta-moves-sexps nil
  95. "Non-nil means move sexp-wise with Meta key, otherwise move word-wise."
  96. :type 'boolean
  97. :group 'pc-select)
  98. (defcustom pc-selection-mode-hook nil
  99. "The hook to run when PC Selection mode is toggled."
  100. :type 'hook
  101. :group 'pc-select)
  102. (defvar pc-select-saved-settings-alist nil
  103. "The values of the variables before PC Selection mode was toggled on.
  104. When PC Selection mode is toggled on, it sets quite a few variables
  105. for its own purposes. This alist holds the original values of the
  106. variables PC Selection mode had set, so that these variables can be
  107. restored to their original values when PC Selection mode is toggled off.")
  108. (defvar pc-select-map nil
  109. "The keymap used as the global map when PC Selection mode is on." )
  110. (defvar pc-select-saved-global-map nil
  111. "The global map that was in effect when PC Selection mode was toggled on.")
  112. (defvar pc-select-key-bindings-alist nil
  113. "This alist holds all the key bindings PC Selection mode sets.")
  114. (defvar pc-select-default-key-bindings nil
  115. "These key bindings always get set by PC Selection mode.")
  116. (defvar pc-select-extra-key-bindings
  117. ;; The following keybindings are for standard ISO keyboards
  118. ;; as they are used with IBM compatible PCs, IBM RS/6000,
  119. ;; MACs, many X-Stations and probably more.
  120. '(;; Commented out since it's been standard at least since Emacs-21.
  121. ;;([S-insert] . yank)
  122. ;;([C-insert] . copy-region-as-kill)
  123. ;;([S-delete] . kill-region)
  124. ;; The following bindings are useful on Sun Type 3 keyboards
  125. ;; They implement the Get-Delete-Put (copy-cut-paste)
  126. ;; functions from sunview on the L6, L8 and L10 keys
  127. ;; Sam Steingold <sds@gnu.org> says that f16 is copy and f18 is paste.
  128. ([f16] . copy-region-as-kill)
  129. ([f18] . yank)
  130. ([f20] . kill-region)
  131. ;; The following bindings are from Pete Forman.
  132. ([f6] . other-window) ; KNextPane F6
  133. ([C-delete] . kill-line) ; KEraseEndLine cDel
  134. ("\M-\d" . undo) ; KUndo aBS
  135. ;; The following binding is taken from pc-mode.el
  136. ;; as suggested by RMS.
  137. ;; I only used the one that is not covered above.
  138. ([C-M-delete] . kill-sexp)
  139. ;; Next line proposed by Eli Barzilay
  140. ([C-escape] . electric-buffer-list))
  141. "Key bindings to set only if `pc-select-selection-keys-only' is nil.")
  142. (defvar pc-select-meta-moves-sexps-key-bindings
  143. '((([M-right] . forward-sexp)
  144. ([M-left] . backward-sexp))
  145. (([M-right] . forward-word)
  146. ([M-left] . backward-word)))
  147. "The list of key bindings controlled by `pc-select-meta-moves-sexp'.
  148. The bindings in the car of this list get installed if
  149. `pc-select-meta-moves-sexp' is t, the bindings in the cadr of this
  150. list get installed otherwise.")
  151. ;; This is for tty. We don't turn on normal-erase-is-backspace,
  152. ;; but bind keys as pc-selection-mode did before
  153. ;; normal-erase-is-backspace was invented, to keep us back
  154. ;; compatible.
  155. (defvar pc-select-tty-key-bindings
  156. '(([delete] . delete-char) ; KDelete Del
  157. ([C-backspace] . backward-kill-word))
  158. "The list of key bindings controlled by `pc-select-selection-keys-only'.
  159. These key bindings get installed when running in a tty, but only if
  160. `pc-select-selection-keys-only' is nil.")
  161. (defvar pc-select-old-M-delete-binding nil
  162. "Holds the old mapping of [M-delete] in the `function-key-map'.
  163. This variable holds the value associated with [M-delete] in the
  164. `function-key-map' before PC Selection mode had changed that
  165. association.")
  166. ;;;;
  167. ;; misc
  168. ;;;;
  169. (provide 'pc-select)
  170. (defun pc-select-define-keys (alist keymap)
  171. "Make KEYMAP have the key bindings specified in ALIST."
  172. (let ((lst alist))
  173. (while lst
  174. (define-key keymap (caar lst) (cdar lst))
  175. (setq lst (cdr lst)))))
  176. (defun pc-select-restore-keys (alist keymap saved-map)
  177. "Use ALIST to restore key bindings from SAVED-MAP into KEYMAP.
  178. Go through all the key bindings in ALIST, and, for each key
  179. binding, if KEYMAP and ALIST still agree on the key binding,
  180. restore the previous value of that key binding from SAVED-MAP."
  181. (let ((lst alist))
  182. (while lst
  183. (when (equal (lookup-key keymap (caar lst)) (cdar lst))
  184. (define-key keymap (caar lst) (lookup-key saved-map (caar lst))))
  185. (setq lst (cdr lst)))))
  186. (defmacro pc-select-add-to-alist (alist var val)
  187. "Ensure that ALIST contains the cons cell (VAR . VAL).
  188. If a cons cell whose car is VAR is already on the ALIST, update the
  189. cdr of that cell with VAL. Otherwise, make a new cons cell
  190. \(VAR . VAL), and prepend it onto ALIST."
  191. (let ((elt (make-symbol "elt")))
  192. `(let ((,elt (assq ',var ,alist)))
  193. (if ,elt
  194. (setcdr ,elt ,val)
  195. (setq ,alist (cons (cons ',var ,val) ,alist))))))
  196. (defmacro pc-select-save-and-set-var (var newval)
  197. "Set VAR to NEWVAL; save the old value.
  198. The old value is saved on the `pc-select-saved-settings-alist'."
  199. `(when (boundp ',var)
  200. (pc-select-add-to-alist pc-select-saved-settings-alist ,var ,var)
  201. (setq ,var ,newval)))
  202. (defmacro pc-select-save-and-set-mode (mode &optional arg mode-var)
  203. "Call the function MODE; save the old value of the variable MODE.
  204. MODE is presumed to be a function which turns on a minor mode. First,
  205. save the value of the variable MODE on `pc-select-saved-settings-alist'.
  206. Then, if ARG is specified, call MODE with ARG, otherwise call it with
  207. nil as an argument. If MODE-VAR is specified, save the value of the
  208. variable MODE-VAR (instead of the value of the variable MODE) on
  209. `pc-select-saved-settings-alist'."
  210. (unless mode-var (setq mode-var mode))
  211. `(when (fboundp ',mode)
  212. (pc-select-add-to-alist pc-select-saved-settings-alist
  213. ,mode-var ,mode-var)
  214. (,mode ,arg)))
  215. (defmacro pc-select-restore-var (var)
  216. "Restore the previous value of the variable VAR.
  217. Look up VAR's previous value in `pc-select-saved-settings-alist', and,
  218. if the value is found, set VAR to that value."
  219. (let ((elt (make-symbol "elt")))
  220. `(let ((,elt (assq ',var pc-select-saved-settings-alist)))
  221. (unless (null ,elt)
  222. (setq ,var (cdr ,elt))))))
  223. (defmacro pc-select-restore-mode (mode)
  224. "Restore the previous state (either on or off) of the minor mode MODE.
  225. Look up the value of the variable MODE on `pc-select-saved-settings-alist'.
  226. If the value is non-nil, call the function MODE with an argument of
  227. 1, otherwise call it with an argument of -1."
  228. (let ((elt (make-symbol "elt")))
  229. `(when (fboundp ',mode)
  230. (let ((,elt (assq ',mode pc-select-saved-settings-alist)))
  231. (unless (null ,elt)
  232. (,mode (if (cdr ,elt) 1 -1)))))))
  233. ;;;###autoload
  234. (define-minor-mode pc-selection-mode
  235. "Change mark behavior to emulate Motif, Mac or MS-Windows cut and paste style.
  236. This mode enables Delete Selection mode and Transient Mark mode.
  237. The arrow keys (and others) are bound to new functions
  238. which modify the status of the mark.
  239. The ordinary arrow keys disable the mark.
  240. The shift-arrow keys move, leaving the mark behind.
  241. C-LEFT and C-RIGHT move back or forward one word, disabling the mark.
  242. S-C-LEFT and S-C-RIGHT move back or forward one word, leaving the mark behind.
  243. M-LEFT and M-RIGHT move back or forward one word or sexp, disabling the mark.
  244. S-M-LEFT and S-M-RIGHT move back or forward one word or sexp, leaving the mark
  245. behind. To control whether these keys move word-wise or sexp-wise set the
  246. variable `pc-select-meta-moves-sexps' after loading pc-select.el but before
  247. turning PC Selection mode on.
  248. C-DOWN and C-UP move back or forward a paragraph, disabling the mark.
  249. S-C-DOWN and S-C-UP move back or forward a paragraph, leaving the mark behind.
  250. HOME moves to beginning of line, disabling the mark.
  251. S-HOME moves to beginning of line, leaving the mark behind.
  252. With Ctrl or Meta, these keys move to beginning of buffer instead.
  253. END moves to end of line, disabling the mark.
  254. S-END moves to end of line, leaving the mark behind.
  255. With Ctrl or Meta, these keys move to end of buffer instead.
  256. PRIOR or PAGE-UP scrolls and disables the mark.
  257. S-PRIOR or S-PAGE-UP scrolls and leaves the mark behind.
  258. S-DELETE kills the region (`kill-region').
  259. S-INSERT yanks text from the kill ring (`yank').
  260. C-INSERT copies the region into the kill ring (`copy-region-as-kill').
  261. In addition, certain other PC bindings are imitated (to avoid this, set
  262. the variable `pc-select-selection-keys-only' to t after loading pc-select.el
  263. but before calling PC Selection mode):
  264. F6 other-window
  265. DELETE delete-char
  266. C-DELETE kill-line
  267. M-DELETE kill-word
  268. C-M-DELETE kill-sexp
  269. C-BACKSPACE backward-kill-word
  270. M-BACKSPACE undo"
  271. ;; FIXME: bring pc-bindings-mode here ?
  272. nil nil nil
  273. :group 'pc-select
  274. :global t
  275. (if pc-selection-mode
  276. (if (null pc-select-key-bindings-alist)
  277. (progn
  278. (setq pc-select-saved-global-map (copy-keymap (current-global-map)))
  279. (setq pc-select-key-bindings-alist
  280. (append pc-select-default-key-bindings
  281. (if pc-select-selection-keys-only
  282. nil
  283. pc-select-extra-key-bindings)
  284. (if pc-select-meta-moves-sexps
  285. (car pc-select-meta-moves-sexps-key-bindings)
  286. (cadr pc-select-meta-moves-sexps-key-bindings))
  287. (if (or pc-select-selection-keys-only
  288. (eq window-system 'x)
  289. (memq system-name '(ms-dos windows-nt)))
  290. nil
  291. pc-select-tty-key-bindings)))
  292. (pc-select-define-keys pc-select-key-bindings-alist
  293. (current-global-map))
  294. (unless (or pc-select-selection-keys-only
  295. (eq window-system 'x)
  296. (memq system-name '(ms-dos windows-nt)))
  297. ;; it is not clear that we need the following line
  298. ;; I hope it doesn't do too much harm to leave it in, though...
  299. (setq pc-select-old-M-delete-binding
  300. (lookup-key function-key-map [M-delete]))
  301. (define-key function-key-map [M-delete] [?\M-d]))
  302. (when (and (not pc-select-selection-keys-only)
  303. (or (eq window-system 'x)
  304. (memq system-name '(ms-dos windows-nt)))
  305. (fboundp 'normal-erase-is-backspace-mode))
  306. (pc-select-save-and-set-mode normal-erase-is-backspace-mode 1
  307. normal-erase-is-backspace))
  308. ;; the original author also had this above:
  309. ;; (setq-default normal-erase-is-backspace t)
  310. ;; However, the documentation for the variable says that
  311. ;; "setting it with setq has no effect", so I'm removing it.
  312. (pc-select-save-and-set-var highlight-nonselected-windows nil)
  313. (pc-select-save-and-set-var transient-mark-mode t)
  314. (pc-select-save-and-set-var shift-select-mode t)
  315. (pc-select-save-and-set-var mark-even-if-inactive t)
  316. (pc-select-save-and-set-mode delete-selection-mode 1))
  317. ;;else
  318. ;; If the user turned on pc-selection-mode a second time
  319. ;; do not clobber the values of the variables that were
  320. ;; saved from before pc-selection mode was activated --
  321. ;; just make sure the values are the way we like them.
  322. (pc-select-define-keys pc-select-key-bindings-alist
  323. (current-global-map))
  324. (unless (or pc-select-selection-keys-only
  325. (eq window-system 'x)
  326. (memq system-name '(ms-dos windows-nt)))
  327. ;; it is not clear that we need the following line
  328. ;; I hope it doesn't do too much harm to leave it in, though...
  329. (define-key function-key-map [M-delete] [?\M-d]))
  330. (when (and (not pc-select-selection-keys-only)
  331. (or (eq window-system 'x)
  332. (memq system-name '(ms-dos windows-nt)))
  333. (fboundp 'normal-erase-is-backspace-mode))
  334. (normal-erase-is-backspace-mode 1))
  335. (setq highlight-nonselected-windows nil)
  336. (setq transient-mark-mode t)
  337. (setq mark-even-if-inactive t)
  338. (delete-selection-mode 1))
  339. ;;else
  340. (when pc-select-key-bindings-alist
  341. (when (and (not pc-select-selection-keys-only)
  342. (or (eq window-system 'x)
  343. (memq system-name '(ms-dos windows-nt))))
  344. (pc-select-restore-mode normal-erase-is-backspace-mode))
  345. (pc-select-restore-keys
  346. pc-select-key-bindings-alist (current-global-map)
  347. pc-select-saved-global-map)
  348. (pc-select-restore-var highlight-nonselected-windows)
  349. (pc-select-restore-var transient-mark-mode)
  350. (pc-select-restore-var shift-select-mode)
  351. (pc-select-restore-var mark-even-if-inactive)
  352. (pc-select-restore-mode delete-selection-mode)
  353. (and pc-select-old-M-delete-binding
  354. (define-key function-key-map [M-delete]
  355. pc-select-old-M-delete-binding))
  356. (setq pc-select-key-bindings-alist nil
  357. pc-select-saved-settings-alist nil))))
  358. (make-obsolete 'pc-selection-mode 'delete-selection-mode "24.1")
  359. ;;; pc-select.el ends here