Mercurial > hg > xemacs-beta

comparison lisp/emulators/crisp.el @ 211:78478c60bfcd r20-4b4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b4
author cvs
date Mon, 13 Aug 2007 10:05:51 +0200
parents e45d5e7c476e
children 1f0dabaa0855
comparison
equal deleted inserted replaced
210:49f55ca3ba57 211:78478c60bfcd
1 ;; @(#) crisp.el -- CRiSP/Brief Emacs emulator 1 ;; @(#) crisp.el -- CRiSP/Brief Emacs emulator
2 2
3 ;; Author: Gary D. Foster <Gary.Foster@corp.sun.com> 3 ;; Author: Gary D. Foster <Gary.Foster@corp.sun.com>
4 ;; Created: 01 Mar 1996 4 ;; Created: 01 Mar 1996
5 ;; Version: 1.21 5 ;; Version: $Revision: 1.7 $
6 ;; Keywords: emulations brief crisp 6 ;; Keywords: emulations brief crisp
7 ;; X-Modified-by: 7 ;; X-Modified-by:
8 ;; crisp.el,v 8 ;; $Log: crisp.el,v $
9 ;; Revision 1.7 1997/11/12 07:09:59 steve
10 ;; Patches to beta4
11 ;;
12 ;; Revision 1.23 1997/11/11 19:47:02 gfoster
13 ;; Merged changes suggested by Hrvoje Niksic
14 ;; make crisp-mode-map a sparse keymap parented from current-global-map
15 ;; don't copy the keymap in (crisp-mode-original-keymap)
16 ;; declare last-last-command to shut up the byte-compiler
17 ;; make (crisp-mode) honor ARG
18 ;;
19 ;; Revision 1.22 1997/11/11 19:37:44 gfoster
20 ;; kp-add/minus now copy/kill the current line if there is no highlighted
21 ;; region. These also honor the universal prefix argument conventions.
22 ;;
23 ;; Revision 1.21 1997/10/16 18:52:54 gfoster
24 ;; Fixed bogus XEmacs/Lucid string-match checking
25 ;; made modeline entry mouse2-able
26 ;;
9 ;; Revision 1.20 1997/08/22 18:49:11 gfoster 27 ;; Revision 1.20 1997/08/22 18:49:11 gfoster
10 ;; Added next-buffer/previous-buffer keybindings (bound to M-n/M-p) 28 ;; Added next-buffer/previous-buffer keybindings (bound to M-n/M-p)
11 ;; Added crisp-unbury-buffer function 29 ;; Added crisp-unbury-buffer function
12 ;; Standardized headers for Steve 30 ;; Standardized headers for Steve
13 ;; 31 ;;
67 85
68 (require 'cl) 86 (require 'cl)
69 87
70 ;; local variables 88 ;; local variables
71 89
72 (defgroup emulations-crisp nil 90 (defgroup crisp nil
73 "CRiSP emulator customizable settings." 91 "CRiSP emulator customizable settings."
74 :group 'emulations) 92 :group 'emulations)
75 93
76 (defvar crisp-mode-map (copy-keymap (current-global-map)) 94 (defvar crisp-mode-map (let ((map (make-sparse-keymap)))
95 (set-keymap-parent map (current-global-map))
96 map)
77 "Local keymap for CRiSP emulation mode. 97 "Local keymap for CRiSP emulation mode.
78 All the bindings are done here instead of globally to try and be 98 All the bindings are done here instead of globally to try and be
79 nice to the world.") 99 nice to the world.")
80 100
81 (defcustom crisp-mode-modeline-string " *CRiSP*" 101 (defcustom crisp-mode-modeline-string " *CRiSP*"
82 "*String to display in the modeline when CRiSP emulation mode is enabled." 102 "*String to display in the modeline when CRiSP emulation mode is enabled."
83 :type 'string 103 :type 'string
84 :group 'emulations-crisp) 104 :group 'crisp)
85 105
86 (defvar crisp-mode-original-keymap (copy-keymap (current-global-map)) 106 (defvar crisp-mode-original-keymap (current-global-map)
87 "The original keymap before CRiSP emulation mode remaps anything. 107 "The original keymap before CRiSP emulation mode remaps anything.
88 This keymap is restored when CRiSP emulation mode is disabled.") 108 This keymap is restored when CRiSP emulation mode is disabled.")
89 109
90 (defvar crisp-mode-enabled nil 110 (defvar crisp-mode-enabled nil
91 "Track status of CRiSP emulation mode. 111 "Track status of CRiSP emulation mode.
96 "*Controls overriding the normal Emacs M-x key binding in the CRiSP emulator. 116 "*Controls overriding the normal Emacs M-x key binding in the CRiSP emulator.
97 Normally the CRiSP emulator rebinds M-x to save-buffers-exit-emacs and 117 Normally the CRiSP emulator rebinds M-x to save-buffers-exit-emacs and
98 provides the usual M-x functionality on the F10 key. If this variable 118 provides the usual M-x functionality on the F10 key. If this variable
99 is non-nil, M-x will exit Emacs." 119 is non-nil, M-x will exit Emacs."
100 :type 'boolean 120 :type 'boolean
101 :group 'emulations-crisp) 121 :group 'crisp)
102 122
103 (defvar crisp-load-scroll-lock nil 123 (defvar crisp-load-scroll-lock nil
104 "Controls loading of the Scroll Lock in the CRiSP emulator. 124 "Controls loading of the Scroll Lock in the CRiSP emulator.
105 Its Default behavior is to load and enable the Scroll Lock minor mode 125 Its Default behavior is to load and enable the Scroll Lock minor mode
106 package when enabling the CRiSP emulator. 126 package when enabling the CRiSP emulator.
109 does not load the scroll-lock package.") 129 does not load the scroll-lock package.")
110 130
111 (defvar crisp-load-hook nil 131 (defvar crisp-load-hook nil
112 "Hooks to run after loading the CRiSP emulator package.") 132 "Hooks to run after loading the CRiSP emulator package.")
113 133
114 (defconst crisp-version "crisp.el release 1.1/1.21" 134 (defconst crisp-version "crisp.el release 1.1/$Revision: 1.7 $"
115 "The release number and RCS version for the CRiSP emulator.") 135 "The release number and RCS version for the CRiSP emulator.")
136
137 ;; Silence the byte-compiler.
138 (defvar last-last-command)
116 139
117 ;; and now the keymap defines 140 ;; and now the keymap defines
118 141
119 (define-key crisp-mode-map [(f1)] 'other-window) 142 (define-key crisp-mode-map [(f1)] 'other-window)
120 143
145 168
146 (define-key crisp-mode-map [(f10)] 'execute-extended-command) 169 (define-key crisp-mode-map [(f10)] 'execute-extended-command)
147 (define-key crisp-mode-map [(meta f10)] 'compile) 170 (define-key crisp-mode-map [(meta f10)] 'compile)
148 171
149 (define-key crisp-mode-map [(SunF37)] 'kill-buffer) 172 (define-key crisp-mode-map [(SunF37)] 'kill-buffer)
150 (define-key crisp-mode-map [(kp-add)] 'x-copy-primary-selection) 173 (define-key crisp-mode-map [(kp-add)] 'crisp-copy-line)
151 (define-key crisp-mode-map [(kp-subtract)] 'x-kill-primary-selection) 174 (define-key crisp-mode-map [(kp-subtract)] 'crisp-kill-line)
152 (define-key crisp-mode-map [(insert)] 'x-yank-clipboard-selection) 175 (define-key crisp-mode-map [(insert)] 'x-yank-clipboard-selection)
153 (define-key crisp-mode-map [(f16)] 'x-copy-primary-selection) ; copy on Sun5 kbd 176 (define-key crisp-mode-map [(f16)] 'x-copy-primary-selection) ; copy on Sun5 kbd
154 (define-key crisp-mode-map [(f20)] 'x-kill-primary-selection) ; cut on Sun5 kbd 177 (define-key crisp-mode-map [(f20)] 'x-kill-primary-selection) ; cut on Sun5 kbd
155 (define-key crisp-mode-map [(f18)] 'x-yank-clipboard-selection) ; paste on Sun5 kbd 178 (define-key crisp-mode-map [(f18)] 'x-yank-clipboard-selection) ; paste on Sun5 kbd
156 179
185 (define-key crisp-mode-map [(control right)] 'forward-word) 208 (define-key crisp-mode-map [(control right)] 'forward-word)
186 209
187 (define-key crisp-mode-map [(home)] 'crisp-home) 210 (define-key crisp-mode-map [(home)] 'crisp-home)
188 (define-key crisp-mode-map [(end)] 'crisp-end) 211 (define-key crisp-mode-map [(end)] 'crisp-end)
189 212
213 (defun crisp-mark-line (arg)
214 "Put mark at the end of line. Arg works as in `end-of-line'."
215 (interactive "p")
216 (mark-something 'crisp-mark-line 'end-of-line arg))
217
218 (defun crisp-kill-line (arg)
219 "Mark and kill line(s).
220 Marks the entire current line (honoring prefix arguments), copies the
221 region to the kill ring and clipboard, and then deletes it."
222 (interactive "*p")
223 (if zmacs-region-active-p
224 (x-kill-primary-selection)
225 (beginning-of-line)
226 (crisp-mark-line arg)
227 (x-kill-primary-selection)))
228
229 (defun crisp-copy-line (arg)
230 "Mark and copy entire current line (honoring prefix arguments), copies the
231 region to the kill ring and clipboard, and then deactivates the region."
232 (interactive "*p")
233 (let ((curpos (point)))
234 (if zmacs-region-active-p
235 (x-copy-primary-selection)
236 (beginning-of-line)
237 (crisp-mark-line arg)
238 (x-copy-primary-selection)
239 (goto-char curpos))))
240
190 (defun crisp-home () 241 (defun crisp-home ()
191 "\"Home\" the point, the way CRiSP would do it. 242 "\"Home\" the point, the way CRiSP would do it.
192 The first use moves point to beginning of the line. Second 243 The first use moves point to beginning of the line. Second
193 consecutive use moves point to beginning of the screen. Third 244 consecutive use moves point to beginning of the screen. Third
194 consecutive use moves point to the beginning of the buffer." 245 consecutive use moves point to the beginning of the buffer."
233 (save-buffers-kill-emacs) 284 (save-buffers-kill-emacs)
234 (call-interactively 'execute-extended-command))) 285 (call-interactively 'execute-extended-command)))
235 286
236 ;; Now enable the mode 287 ;; Now enable the mode
237 288
238 (defun crisp-mode () 289 (defun crisp-mode (&optional arg)
239 "Toggle CRiSP emulation minor mode." 290 "Toggle CRiSP emulation minor mode.
240 (interactive nil) 291 With ARG, turn CRiSP mode on if ARG is positive, off otherwise."
241 (setq crisp-mode-enabled (not crisp-mode-enabled)) 292 (interactive "P")
293 (setq crisp-mode-enabled (if (null arg)
294 (not crisp-mode-enabled)
295 (> (prefix-numeric-value arg) 0)))
242 (cond 296 (cond
243 ((eq crisp-mode-enabled 't) 297 ((eq crisp-mode-enabled 't)
244 (use-global-map crisp-mode-map) 298 (use-global-map crisp-mode-map)
245 (if crisp-load-scroll-lock 299 (if crisp-load-scroll-lock
246 (require 'scroll-lock)) 300 (require 'scroll-lock))
248 (define-key crisp-mode-map [(meta f1)] 'scroll-lock-mode)) 302 (define-key crisp-mode-map [(meta f1)] 'scroll-lock-mode))
249 (run-hooks 'crisp-load-hook)) 303 (run-hooks 'crisp-load-hook))
250 ((eq crisp-mode-enabled 'nil) 304 ((eq crisp-mode-enabled 'nil)
251 (use-global-map crisp-mode-original-keymap)))) 305 (use-global-map crisp-mode-original-keymap))))
252 306
253 (if (string-match "\\(XEmacs\\|Lucid\\)" emacs-version) 307 (if (fboundp 'add-minor-mode)
254 (add-minor-mode 'crisp-mode-enabled 'crisp-mode-modeline-string 308 (add-minor-mode 'crisp-mode-enabled 'crisp-mode-modeline-string
255 nil nil 'crisp-mode) 309 nil nil 'crisp-mode)
256 (or (assq 'crisp-mode-enabled minor-mode-alist) 310 (or (assq 'crisp-mode-enabled minor-mode-alist)
257 (setq minor-mode-alist 311 (setq minor-mode-alist
258 (cons '(crisp-mode-enabled crisp-mode-modeline-string) minor-mode-alist)))) 312 (cons '(crisp-mode-enabled crisp-mode-modeline-string) minor-mode-alist))))