edt.el 91.3 KB
Newer Older
1
;;; edt.el --- enhanced EDT keypad mode emulation for GNU Emacs 19
Eric S. Raymond's avatar
Eric S. Raymond committed
2

3
;; Copyright (C) 1986, 1992, 1993, 1994, 1995, 2000, 2001, 2002, 2003,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
Eric S. Raymond's avatar
Eric S. Raymond committed
5

6 7
;; Author: Kevin Gallagher <Kevin.Gallagher@boeing.com>
;; Maintainer: Kevin Gallagher <Kevin.Gallagher@boeing.com>
Eric S. Raymond's avatar
Eric S. Raymond committed
8
;; Keywords: emulations
Eric S. Raymond's avatar
Eric S. Raymond committed
9

Richard M. Stallman's avatar
Richard M. Stallman committed
10 11 12
;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
13
;; it under the terms of the GNU General Public License as published
14
;; by the Free Software Foundation; either version 3, or (at your
15
;; option) any later version.
Richard M. Stallman's avatar
Richard M. Stallman committed
16

17 18 19 20
;; GNU Emacs is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
Richard M. Stallman's avatar
Richard M. Stallman committed
21 22

;; You should have received a copy of the GNU General Public License
Erik Naggum's avatar
Erik Naggum committed
23
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
24 25
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Richard M. Stallman's avatar
Richard M. Stallman committed
26

27

28 29

;;; Commentary:
30
;;
31 32 33 34 35 36 37 38 39 40 41 42 43

;; This is Version 4.0 of the EDT Emulation for Emacs 19 and above.
;; It comes with special functions which replicate nearly all of EDT's
;; keypad mode behavior.  It sets up default keypad and function key
;; bindings which closely match those found in EDT.  Support is
;; provided so that users may reconfigure most keypad and function key
;; bindings to their own liking.

;; NOTE: Version 4.0 contains several enhancements.  See the
;; Enhancement section below for the details.

;; Getting Started:

44
;; To start the EDT Emulation, first start Emacs and then enter
45 46
;;
;;    M-x edt-emulation-on
47
;;
48 49 50 51 52 53 54 55 56 57 58 59 60 61
;; to begin the emulation.  After initialization is complete, the
;; following message will appear below the status line informing you
;; that the emulation has been enabled: "Default EDT keymap active".

;; You can have the EDT Emulation start up automatically, each time
;; you initiate a GNU Emacs session, by adding the following line to
;; your .emacs file:
;;
;;    (add-hook term-setup-hook 'edt-emulation-on)

;; IMPORTANT: Be sure to read the file, edt-user.doc, located in the
;; Emacs "etc" directory.  It contains very helpful user information.

;; The EDT emulation consists of the following files:
62
;;
63 64 65 66 67
;; edt-user.doc     - User Instructions and Sample Customization File
;; edt.el           - EDT Emulation Functions and Default Configuration
;; edt-lk201.el     - Built-in support for DEC LK-201 Keyboards
;; edt-vt100.el     - Built-in support for DEC VT-100 (and above) terminals
;; edt-pc.el        - Built-in support for PC 101 Keyboards under MS-DOS
68
;; edt-mapper.el    - Create an EDT LK-201 Map File for Keyboards Without
69 70 71 72 73 74 75 76 77 78 79 80 81 82 83
;;                      Built-in Support

;; Enhancements:

;; Version 4.0 contains the following enhancements:

;;  1.  Scroll margins at the top and bottom of the window are now
;;      supported.  (The design was copied from tpu-extras.el.)  By
;;      default, this feature is enabled, with the top margin set to
;;      10% of the window and the bottom margin set to 15% of the
;;      window.  To change these settings, you can invoke the function
;;      edt-set-scroll-margins in your .emacs file.  For example, the
;;      following line
;;
;;           (edt-set-scroll-margins "20%" "25%")
84
;;
85 86 87 88 89 90 91 92 93
;;      sets the top margin to 20% of the window and the bottom margin
;;      to 25% of the window.  To disable this feature, set each
;;      margin to 0%.  You can also invoke edt-set-scroll-margins
;;      interactively while EDT Emulation is active to change the
;;      settings for that session.
;;
;;      NOTE: Another way to set the scroll margins is to use the
;;      Emacs customization feature (not available in Emacs 19) to set
;;      the following two variables directly:
94
;;
95 96 97 98 99
;;           edt-top-scroll-margin and edt-bottom-scroll-margin
;;
;;      Enter the Emacs `customize' command.  First select the Editing
;;      group and then select the Emulations group.  Finally, select
;;      the Edt group and follow the directions.
100
;;
101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151
;;  2.  The SUBS command is now supported and bound to GOLD-Enter by
;;      default.  (This design was copied from tpu-edt.el.)  Note, in
;;      earlier versions of EDT Emulation, GOLD-Enter was assigned to
;;      the Emacs function `query-replace'.  The binding of
;;      `query-replace' has been moved to GOLD-/.  If you prefer to
;;      restore `query-replace' to GOLD-Enter, then use an EDT user
;;      customization file, edt-user.el, to do this.  See edt-user.doc
;;      for details.

;;  3.  EDT Emulation now also works in XEmacs, including the
;;      highlighting of selected text.

;;  4.  If you access a workstation using an X Server, observe that
;;      the initialization file generated by edt-mapper.el will now
;;      contain the name of the X Server vendor.  This is a
;;      convenience for those who have access to their Unix account
;;      from more than one type of X Server.  Since different X
;;      Servers typically require different EDT emulation
;;      initialization files, edt-mapper.el will now generate these
;;      different initialization files and save them with different
;;      names.  Then, the correct initialization file for the
;;      particular X server in use is loaded correctly automatically.

;;  5.  Also, edt-mapper.el is now capable of binding an ASCII key
;;      sequence, providing the ASCII key sequence prefix is already
;;      known by Emacs to be a prefix.  As a result of providing this
;;      support, some terminal/keyboard/window system configurations,
;;      which don't have a complete set of sensible function key
;;      bindings built into Emacs in `function-key-map', can still be
;;      configured for use with EDT Emulation.  (Note: In a few rare
;;      circumstances this does not work properly.  In particular, it
;;      does not work if a subset of the leading ASCII characters in a
;;      key sequence are recognized by Emacs as having an existing
;;      binding.  For example, if the keypad 7 (KP-7) key generates
;;      the sequence \"<ESC>Ow\" and \"<ESC>O\" is already bound to a
;;      function, pressing KP-7 when told to do so by edt-mapper.el
;;      will result in edt-mapper.el incorrectly mapping \"<ESC>O\" to
;;      KP-7 and \"w\" to KP-8.  If something like this happens to
;;      you, it is probably a bug in the support for your keyboard
;;      within Emacs OR a bug in the Unix termcap/terminfo support for
;;      your terminal OR a bug in the terminal emulation software you
;;      are using.)

;;  6.  The edt-quit function (bound to GOLD-q by default) has been
;;      modified to warn the user when file-related buffer
;;      modifications exist.  It now cautions the user that those
;;      modifications will be lost if the user quits without saving
;;      those buffers.


;;; History:
152
;;
153
;;  Version 4.0    2000    Added New Features and Fixed a Few Bugs
154
;;
155 156


157 158
;;; Code:

159 160
;;;  Electric Help functions are used for keypad help displays.  A few
;;;  picture functions are used in rectangular cut and paste commands.
161

162 163 164 165 166 167 168
(require 'ehelp)
(require 'picture)

;;;;
;;;; VARIABLES and CONSTANTS
;;;;

169 170 171 172
(defgroup edt nil
  "Emacs emulating EDT."
  :prefix "edt-"
  :group 'emulations)
173

174
;; To silence the byte-compiler
175 176 177 178 179 180 181 182 183 184 185
(defvar *EDT-keys*)
(defvar edt-default-global-map)
(defvar edt-last-copied-word)
(defvar edt-learn-macro-count)
(defvar edt-orig-page-delimiter)
(defvar edt-orig-transient-mark-mode)
(defvar edt-rect-start-point)
(defvar edt-user-global-map)
(defvar rect-start-point)
(defvar time-string)
(defvar zmacs-region-stays)
186

187 188 189 190 191 192 193 194 195
;;;
;;;  Version Information
;;;
(defconst edt-version "4.0" "EDT Emulation version number.")

;;;
;;;  User Configurable Variables
;;;

Markus Rost's avatar
Markus Rost committed
196 197
(defcustom edt-keep-current-page-delimiter nil
  "*Emacs MUST be restarted for a change in value to take effect!
198 199 200 201 202
Non-nil leaves Emacs value of `page-delimiter' unchanged within EDT
Emulation.  If set to nil (the default), the `page-delimiter' variable
is set to \"\\f\" when edt-emulation-on is first invoked.  This
setting replicates EDT's page delimiter behavior.  The original value
is restored when edt-emulation-off is called."
Markus Rost's avatar
Markus Rost committed
203 204
  :type 'boolean
  :group 'edt)
205

Markus Rost's avatar
Markus Rost committed
206 207
(defcustom edt-use-EDT-control-key-bindings nil
  "*Emacs MUST be restarted for a change in value to take effect!
208 209 210 211
Non-nil causes the control key bindings to be replaced with EDT
bindings.  If set to nil (the default), EDT control key bindings are
not used and the current Emacs control key bindings are retained for
use within the EDT emulation."
Markus Rost's avatar
Markus Rost committed
212 213
  :type 'boolean
  :group 'edt)
214

Markus Rost's avatar
Markus Rost committed
215
(defcustom edt-word-entities '(?\t)
216
  "*Specifies the list of EDT word entity characters.
217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236
The default list, (\?\\t), contains just the TAB character, which
emulates EDT.  Characters are specified in the list using their
decimal ASCII values.  A question mark, followed by the actual
character, can be used to indicate the numerical value of the
character, instead of the actual decimal value.  So, ?A means the
numerical value for the letter A, \?/ means the numerical value for /,
etc.  Several unprintable and special characters have special
representations, which you can also use:

            \?\\b  specifies  BS, C-h
            \?\\t  specifies  TAB, C-i
            \?\\n  specifies  LFD, C-j
            \?\\v  specifies  VTAB, C-k
            \?\\f  specifies  FF, C-l
            \?\\r  specifies  CR, C-m
            \?\\e  specifies  ESC, C-[
            \?\\\\  specifies  \\

In EDT Emulation movement-by-word commands, each character in the list
will be treated as if it were a separate word."
Markus Rost's avatar
Markus Rost committed
237 238
  :type '(repeat integer)
  :group 'edt)
239

Markus Rost's avatar
Markus Rost committed
240 241
(defcustom edt-top-scroll-margin 10
  "*Scroll margin at the top of the screen.
242 243
Interpreted as a percent of the current window size with a default
setting of 10%.  If set to 0, top scroll margin is disabled."
Markus Rost's avatar
Markus Rost committed
244 245
  :type 'integer
  :group 'edt)
246

Markus Rost's avatar
Markus Rost committed
247 248
(defcustom edt-bottom-scroll-margin 15
  "*Scroll margin at the bottom of the screen.
249 250
Interpreted as a percent of the current window size with a default
setting of 15%.  If set to 0, bottom scroll margin is disabled."
Markus Rost's avatar
Markus Rost committed
251 252
  :type 'integer
  :group 'edt)
253 254 255 256 257

;;;
;;; Internal Variables
;;;

Richard M. Stallman's avatar
Richard M. Stallman committed
258
(defvar edt-last-deleted-lines ""
259
  "Last text deleted by the EDT emulation DEL L command.")
260

Richard M. Stallman's avatar
Richard M. Stallman committed
261
(defvar edt-last-deleted-words ""
262
  "Last text deleted by the EDT emulation DEL W command.")
263

Richard M. Stallman's avatar
Richard M. Stallman committed
264
(defvar edt-last-deleted-chars ""
265 266 267 268
  "Last text deleted by the EDT emulation DEL C command.")

(defvar edt-find-last-text ""
  "Last text found by the EDT emulation FIND command.")
269

270 271 272 273 274 275 276 277
(defvar edt-match-beginning-mark (make-marker)
  "Used internally by the EDT emulation SUBS command.")

(defvar edt-match-end-mark (make-marker)
  "Used internally by the EDT emulation SUBS command.")

(defvar edt-last-replaced-key-definition nil
  "Key definition replaced with `edt-define-key' or `edt-learn' command.")
278 279

(defvar edt-direction-string ""
Karl Heuer's avatar
Karl Heuer committed
280
  "String indicating current direction of movement.")
281 282

(defvar edt-select-mode nil
Karl Heuer's avatar
Karl Heuer committed
283
  "Non-nil means select mode is active.")
284

285 286 287
(defvar edt-select-mode-current ""
  "Text displayed in mode line to indicate the state of EDT select mode.
When select mode is inactive, it is set to an empty string.")
288 289

(defconst edt-select-mode-string " Select"
290
  "Used in mode line to indicate select mode is active.")
291 292

(defconst edt-forward-string " ADVANCE"
Karl Heuer's avatar
Karl Heuer committed
293
  "Direction string in mode line to indicate forward movement.")
294 295

(defconst edt-backward-string "  BACKUP"
Karl Heuer's avatar
Karl Heuer committed
296
  "Direction string in mode line to indicate backward movement.")
297 298

(defvar edt-default-map-active nil
Karl Heuer's avatar
Karl Heuer committed
299
  "Non-nil indicates that default EDT emulation key bindings are active.
Pavel Janík's avatar
Pavel Janík committed
300
nil means user-defined custom bindings are active.")
301 302

(defvar edt-user-map-configured nil
Karl Heuer's avatar
Karl Heuer committed
303
  "Non-nil indicates that user custom EDT key bindings are configured.
304
This means that an edt-user.el file was found in the user's `load-path'.")
305

306 307
(defvar edt-term nil
  "Specifies the terminal type, if applicable.")
Richard M. Stallman's avatar
Richard M. Stallman committed
308

309 310 311
;;;
;;;  Emacs version identifiers - currently referenced by
;;;
312
;;;     o edt-emulation-on      o edt-load-keys
313
;;;
314
(defconst edt-emacs-variant (if (featurep 'emacs) "gnu" "xemacs")
315 316
  "Indicates Emacs variant:  GNU Emacs or XEmacs \(aka Lucid Emacs\).")

317
(defconst edt-window-system (if (featurep 'emacs) window-system (console-type))
318 319 320
  "Indicates window system \(in GNU Emacs\) or console type \(in XEmacs\).")

(defconst edt-xserver (if (eq edt-window-system 'x)
321
			  (if (featurep 'xemacs)
322 323 324 325 326 327
			      ;; The Cygwin window manager has a `/' in its
			      ;; name, which breaks the generated file name of
			      ;; the custom key map file.  Replace `/' with a
			      ;; `-' to work around that.
			      (replace-in-string (x-server-vendor) "[ /]" "-")
			    (subst-char-in-string ?/ ?- (subst-char-in-string ?  ?- (x-server-vendor))))
328 329 330 331 332
			nil)
  "Indicates X server vendor name, if applicable.")

(defvar edt-keys-file nil
  "User's custom keypad and function keys mappings to emulate LK-201 keyboard.")
333 334 335 336

(defvar edt-last-copied-word nil
  "Last word that the user copied.")

337 338 339 340 341

;;;;
;;;; EDT Emulation Commands
;;;;

342 343 344
;;; Almost all of EDT's keypad mode commands have equivalent Emacs
;;; function counterparts.  But many of these counterparts behave
;;; somewhat differently in Emacs.
345
;;;
346 347 348 349
;;; So, the following Emacs functions emulate, where practical, the
;;; exact behavior of the corresponding EDT keypad mode commands.  In
;;; a few cases, the emulation is not exact, but it should be close
;;; enough for most EDT die-hards.
350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369
;;;

;;;
;;; PAGE
;;;
;;; Emacs uses the regexp assigned to page-delimiter to determine what
;;; marks a page break.  This is normally "^\f", which causes the
;;; edt-page command to ignore form feeds not located at the beginning
;;; of a line.  To emulate the EDT PAGE command exactly,
;;; page-delimiter is set to "\f" when EDT emulation is turned on, and
;;; restored to its original value when EDT emulation is turned off.
;;; But this can be overridden if the EDT definition is not desired by
;;; placing
;;;
;;;         (setq edt-keep-current-page-delimiter t)
;;;
;;; in your .emacs file.

(defun edt-page-forward (num)
  "Move forward to just after next page delimiter.
370
Argument NUM is the number of page delimiters to move."
371 372 373 374
  (interactive "p")
  (edt-check-prefix num)
  (if (eobp)
      (error "End of buffer")
375 376 377 378 379
	(progn
	  (forward-page num)
	  (if (eobp)
		  (edt-line-to-bottom-of-window)
		(edt-line-to-top-of-window)))))
380 381 382

(defun edt-page-backward (num)
  "Move backward to just after previous page delimiter.
383
Argument NUM is the number of page delimiters to move."
384 385 386 387
  (interactive "p")
  (edt-check-prefix num)
  (if (bobp)
      (error "Beginning of buffer")
388 389 390
	(progn
	  (backward-page num)
      (edt-line-to-top-of-window)
391
	  (if (featurep 'xemacs) (setq zmacs-region-stays t)))))
392 393 394

(defun edt-page (num)
  "Move in current direction to next page delimiter.
395
Argument NUM is the number of page delimiters to move."
Richard M. Stallman's avatar
Richard M. Stallman committed
396
  (interactive "p")
397 398
  (if (equal edt-direction-string edt-forward-string)
      (edt-page-forward num)
399
    (edt-page-backward num)))
400 401 402 403 404 405

;;;
;;; SECT
;;;
;;; EDT defaults a section size to be 16 lines of its one and only
;;; 24-line window.  That's two-thirds of the window at a time.  The
406
;;; EDT SECT commands moves the cursor, not the window.
407
;;;
408 409
;;; This emulation of EDT's SECT moves the cursor approximately
;;; two-thirds of the current window at a time.
410 411

(defun edt-sect-forward (num)
412 413
  "Move cursor forward two-thirds of a window's number of lines.
Argument NUM is the number of sections to move."
414 415 416 417
  (interactive "p")
  (edt-check-prefix num)
  (edt-line-forward (* (* (/ (- (window-height) 1) 3) 2) num)))

418

419 420
(defun edt-sect-backward (num)
  "Move cursor backward two-thirds of a window.
421
Argument NUM is the number of sections to move."
422 423 424 425 426 427
  (interactive "p")
  (edt-check-prefix num)
  (edt-line-backward (* (* (/ (- (window-height) 1) 3) 2) num)))

(defun edt-sect (num)
  "Move in current direction a full window.
428
Argument NUM is the number of sections to move."
429 430 431
  (interactive "p")
  (if (equal edt-direction-string edt-forward-string)
      (edt-sect-forward num)
432
    (edt-sect-backward num)))
433 434 435 436 437 438 439 440 441

;;;
;;; BEGINNING OF LINE
;;;
;;; EDT's beginning-of-line command is not affected by current
;;; direction, for some unknown reason.

(defun edt-beginning-of-line (num)
  "Move backward to next beginning of line mark.
442
Argument NUM is the number of BOL marks to move."
443 444
  (interactive "p")
  (edt-check-prefix num)
445 446 447
  (let ((beg (edt-current-line)))
    (if (bolp)
	(forward-line (* -1 num))
448
      (progn
449 450 451
	(setq num (1- num))
	(forward-line (* -1 num))))
    (edt-top-check beg num))
452
  (if (featurep 'xemacs) (setq zmacs-region-stays t)))
453

454 455 456 457 458 459 460

;;;
;;; EOL (End of Line)
;;;

(defun edt-end-of-line-forward (num)
  "Move forward to next end of line mark.
461
Argument NUM is the number of EOL marks to move."
462 463
  (interactive "p")
  (edt-check-prefix num)
464 465 466 467
  (let ((beg (edt-current-line)))
    (forward-char)
    (end-of-line num)
    (edt-bottom-check beg num))
468
  (if (featurep 'xemacs) (setq zmacs-region-stays t)))
469

470 471 472

(defun edt-end-of-line-backward (num)
  "Move backward to next end of line mark.
473
Argument NUM is the number of EOL marks to move."
474 475
  (interactive "p")
  (edt-check-prefix num)
476 477 478
  (let ((beg (edt-current-line)))
    (end-of-line (1- num))
    (edt-top-check beg num))
479
  (if (featurep 'xemacs) (setq zmacs-region-stays t)))
480

481 482 483

(defun edt-end-of-line (num)
  "Move in current direction to next end of line mark.
484
Argument NUM is the number of EOL marks to move."
485 486 487
  (interactive "p")
  (if (equal edt-direction-string edt-forward-string)
      (edt-end-of-line-forward num)
488
    (edt-end-of-line-backward num)))
489 490 491 492 493 494

;;;
;;; WORD
;;;
;;; This one is a tad messy.  To emulate EDT's behavior everywhere in
;;; the file (beginning of file, end of file, beginning of line, end
495
;;; of line, etc.) it takes a bit of special handling.
496
;;;
497 498
;;; The variable edt-word-entities contains a list of characters which
;;; are to be viewed as distinct words where ever they appear in the
499
;;; buffer.  This emulates the EDT line mode command SET ENTITY WORD.
500 501 502 503 504 505 506 507 508


(defun edt-one-word-forward ()
  "Move forward to first character of next word."
  (interactive)
  (if (eobp)
      (error "End of buffer"))
  (if (eolp)
      (forward-char)
509 510 511 512 513 514 515 516 517 518 519 520 521 522 523
    (progn
      (if (memq (following-char) edt-word-entities)
	  (forward-char)
	(while (and
		(not (eolp))
		(not (eobp))
		(not (eq ?\  (char-syntax (following-char))))
		(not (memq (following-char) edt-word-entities)))
	  (forward-char)))
      (while (and
	      (not (eolp))
	      (not (eobp))
	      (eq ?\  (char-syntax (following-char)))
	      (not (memq (following-char) edt-word-entities)))
	(forward-char))))
524
  (if (featurep 'xemacs) (setq zmacs-region-stays t)))
525 526 527 528 529 530 531 532

(defun edt-one-word-backward ()
  "Move backward to first character of previous word."
  (interactive)
  (if (bobp)
      (error "Beginning of buffer"))
  (if (bolp)
      (backward-char)
533 534 535 536 537 538 539 540 541 542 543 544 545 546 547
    (progn
      (backward-char)
      (while (and
	      (not (bolp))
	      (not (bobp))
	      (eq ?\  (char-syntax (following-char)))
	      (not (memq (following-char) edt-word-entities)))
	(backward-char))
      (if (not (memq (following-char) edt-word-entities))
	  (while (and
		  (not (bolp))
		  (not (bobp))
		  (not (eq ?\  (char-syntax (preceding-char))))
		  (not (memq (preceding-char) edt-word-entities)))
	    (backward-char)))))
548
  (if (featurep 'xemacs) (setq zmacs-region-stays t)))
549 550 551

(defun edt-word-forward (num)
  "Move forward to first character of next word.
552
Argument NUM is the number of words to move."
553 554 555 556 557 558 559 560
  (interactive "p")
  (edt-check-prefix num)
  (while (> num 0)
    (edt-one-word-forward)
    (setq num (1- num))))

(defun edt-word-backward (num)
  "Move backward to first character of previous word.
561
Argument NUM is the number of words to move."
562 563 564 565 566 567 568 569
  (interactive "p")
  (edt-check-prefix num)
  (while (> num 0)
    (edt-one-word-backward)
    (setq num (1- num))))

(defun edt-word (num)
  "Move in current direction to first character of next word.
570
Argument NUM is the number of words to move."
571 572 573
  (interactive "p")
  (if (equal edt-direction-string edt-forward-string)
      (edt-word-forward num)
574
    (edt-word-backward num)))
575 576 577 578 579 580 581

;;;
;;; CHAR
;;;

(defun edt-character (num)
  "Move in current direction to next character.
582
Argument NUM is the number of characters to move."
583 584 585 586
  (interactive "p")
  (edt-check-prefix num)
  (if (equal edt-direction-string edt-forward-string)
      (forward-char num)
587
    (backward-char num))
588
  (if (featurep 'xemacs) (setq zmacs-region-stays t)))
589 590 591 592 593 594 595 596 597 598

;;;
;;; LINE
;;;
;;; When direction is set to BACKUP, LINE behaves just like BEGINNING
;;; OF LINE in EDT.  So edt-line-backward is not really needed as a
;;; separate function.

(defun edt-line-backward (num)
  "Move backward to next beginning of line mark.
599
Argument NUM is the number of BOL marks to move."
600 601 602 603 604
  (interactive "p")
  (edt-beginning-of-line num))

(defun edt-line-forward (num)
  "Move forward to next beginning of line mark.
605
Argument NUM is the number of BOL marks to move."
606 607
  (interactive "p")
  (edt-check-prefix num)
608 609 610
  (let ((beg (edt-current-line)))
    (forward-line num)
    (edt-bottom-check beg num))
611
  (if (featurep 'xemacs) (setq zmacs-region-stays t)))
612 613 614

(defun edt-line (num)
  "Move in current direction to next beginning of line mark.
615
Argument NUM is the number of BOL marks to move."
616 617 618
  (interactive "p")
  (if (equal edt-direction-string edt-forward-string)
      (edt-line-forward num)
619 620 621 622 623 624 625 626 627 628 629 630
    (edt-line-backward num)))

;;;
;;; UP and DOWN Arrows
;;;

(defun edt-next-line (num)
  "Move cursor down one line.
Argument NUM is the number of lines to move."
  (interactive "p")
  (edt-check-prefix num)
  (let ((beg (edt-current-line)))
631
    (forward-line num)
632
    (edt-bottom-check beg num))
633
  (if (featurep 'xemacs) (setq zmacs-region-stays t)))
634 635 636 637 638 639 640

(defun edt-previous-line (num)
  "Move cursor up one line.
Argument NUM is the number of lines to move."
  (interactive "p")
  (edt-check-prefix num)
  (let ((beg (edt-current-line)))
641
    (forward-line (- num))
642
    (edt-top-check beg num))
643
  (if (featurep 'xemacs) (setq zmacs-region-stays t)))
644

645 646 647 648 649 650 651 652

;;;
;;; TOP
;;;

(defun edt-top ()
  "Move cursor to the beginning of buffer."
  (interactive)
653
  (goto-char (point-min))
654
  (if (featurep 'xemacs) (setq zmacs-region-stays t)))
655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670

;;;
;;; BOTTOM
;;;

(defun edt-bottom ()
  "Move cursor to the end of buffer."
  (interactive)
  (goto-char (point-max))
  (edt-line-to-bottom-of-window))

;;;
;;; FIND
;;;

(defun edt-find-forward (&optional find)
671 672
  "Find first occurrence of a string in forward direction and save it.
Optional argument FIND is t is this function is called from `edt-find'."
673 674
  (interactive)
  (if (not find)
675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699
      (set 'edt-find-last-text (read-string "Search forward: ")))
  (let* ((left nil)
	 (beg (edt-current-line))
	 (height (window-height))
	 (top-percent
	  (if (= 0 edt-top-scroll-margin) 10 edt-top-scroll-margin))
	 (bottom-percent
	  (if (= 0 edt-bottom-scroll-margin) 15 edt-bottom-scroll-margin))
	 (top-margin (/ (* height top-percent) 100))
	 (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100)))
	 (bottom-margin (max beg (- height bottom-up-margin 1)))
	 (top (save-excursion (move-to-window-line top-margin) (point)))
	 (bottom (save-excursion (move-to-window-line bottom-margin) (point)))
	 (far (save-excursion
		(goto-char bottom) (forward-line (- height 2)) (point))))
    (if (search-forward edt-find-last-text)
	(progn
	  (search-backward edt-find-last-text)
	  (edt-set-match)
	  (cond((> (point) far)
		(setq left (save-excursion (forward-line height)))
		(if (= 0 left) (recenter top-margin)
		  (recenter (- left bottom-up-margin))))
	       (t
		(and (> (point) bottom) (recenter bottom-margin)))))))
700
  (if (featurep 'xemacs) (setq zmacs-region-stays t)))
701 702

(defun edt-find-backward (&optional find)
703 704
  "Find first occurrence of a string in the backward direction and save it.
Optional argument FIND is t if this function is called from `edt-find'."
705 706
  (interactive)
  (if (not find)
707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724
      (set 'edt-find-last-text (read-string "Search backward: ")))
  (let* ((left nil)
	 (beg (edt-current-line))
	 (height (window-height))
	 (top-percent
	  (if (= 0 edt-top-scroll-margin) 10 edt-top-scroll-margin))
	 (bottom-percent
	  (if (= 0 edt-bottom-scroll-margin) 15 edt-bottom-scroll-margin))
	 (top-margin (/ (* height top-percent) 100))
	 (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100)))
	 (bottom-margin (max beg (- height bottom-up-margin 1)))
	 (top (save-excursion (move-to-window-line top-margin) (point)))
	 (bottom (save-excursion (move-to-window-line bottom-margin) (point)))
	 (far (save-excursion
		(goto-char bottom) (forward-line (- height 2)) (point))))
    (if (search-backward edt-find-last-text)
	(edt-set-match))
    (and (< (point) top) (recenter (min beg top-margin))))
725
  (if (featurep 'xemacs) (setq zmacs-region-stays t)))
726 727

(defun edt-find ()
728
  "Find first occurrence of string in current direction and save it."
729
  (interactive)
730
  (set 'edt-find-last-text (read-string "Search: "))
731 732 733
  (if (equal edt-direction-string edt-forward-string)
      (edt-find-forward t)
      (edt-find-backward t)))
734

735 736 737 738 739 740

;;;
;;; FNDNXT
;;;

(defun edt-find-next-forward ()
741
  "Find next occurrence of a string in forward direction."
742
  (interactive)
743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767
  (let* ((left nil)
	 (beg (edt-current-line))
	 (height (window-height))
	 (top-percent
	  (if (= 0 edt-top-scroll-margin) 10 edt-top-scroll-margin))
	 (bottom-percent
	  (if (= 0 edt-bottom-scroll-margin) 15 edt-bottom-scroll-margin))
	 (top-margin (/ (* height top-percent) 100))
	 (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100)))
	 (bottom-margin (max beg (- height bottom-up-margin 1)))
	 (top (save-excursion (move-to-window-line top-margin) (point)))
	 (bottom (save-excursion (move-to-window-line bottom-margin) (point)))
	 (far (save-excursion
		(goto-char bottom) (forward-line (- height 2)) (point))))
    (forward-char 1)
    (if (search-forward edt-find-last-text nil t)
	(progn
	  (search-backward edt-find-last-text)
	  (edt-set-match)
	  (cond((> (point) far)
		(setq left (save-excursion (forward-line height)))
		(if (= 0 left) (recenter top-margin)
		  (recenter (- left bottom-up-margin))))
	       (t
		(and (> (point) bottom) (recenter bottom-margin)))))
768
      (progn
769 770
	(backward-char 1)
	(error "Search failed: \"%s\"" edt-find-last-text))))
771
  (if (featurep 'xemacs) (setq zmacs-region-stays t)))
772 773

(defun edt-find-next-backward ()
774
  "Find next occurrence of a string in backward direction."
775
  (interactive)
776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791
  (let* ((left nil)
	 (beg (edt-current-line))
	 (height (window-height))
	 (top-percent
	  (if (= 0 edt-top-scroll-margin) 10 edt-top-scroll-margin))
	 (bottom-percent
	  (if (= 0 edt-bottom-scroll-margin) 15 edt-bottom-scroll-margin))
	 (top-margin (/ (* height top-percent) 100))
	 (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100)))
	 (bottom-margin (max beg (- height bottom-up-margin 1)))
	 (top (save-excursion (move-to-window-line top-margin) (point)))
	 (bottom (save-excursion (move-to-window-line bottom-margin) (point)))
	 (far (save-excursion
		(goto-char bottom) (forward-line (- height 2)) (point))))
    (if (not (search-backward edt-find-last-text nil t))
	(error "Search failed: \"%s\"" edt-find-last-text)
792
      (progn
793 794
	(edt-set-match)
	(and (< (point) top) (recenter (min beg top-margin))))))
795
  (if (featurep 'xemacs) (setq zmacs-region-stays t)))
796 797

(defun edt-find-next ()
798
  "Find next occurrence of a string in current direction."
799 800 801
  (interactive)
  (if (equal edt-direction-string edt-forward-string)
      (edt-find-next-forward)
802
    (edt-find-next-backward)))
803

804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821
;;;
;;; APPEND
;;;

(defun edt-append ()
  "Append this kill region to last killed region."
  (interactive "*")
  (edt-check-selection)
  (append-next-kill)
  (kill-region (mark) (point))
  (message "Selected text APPENDED to kill ring"))

;;;
;;; DEL L
;;;

(defun edt-delete-line (num)
  "Delete from cursor up to and including the end of line mark.
822
Argument NUM is the number of lines to delete."
823 824
  (interactive "*p")
  (edt-check-prefix num)
Richard M. Stallman's avatar
Richard M. Stallman committed
825 826 827
  (let ((beg (point)))
    (forward-line num)
    (if (not (eq (preceding-char) ?\n))
828
        (insert "\n"))
Richard M. Stallman's avatar
Richard M. Stallman committed
829
    (setq edt-last-deleted-lines
830
          (buffer-substring beg (point)))
Richard M. Stallman's avatar
Richard M. Stallman committed
831 832
    (delete-region beg (point))))

833 834 835 836 837 838
;;;
;;; DEL EOL
;;;

(defun edt-delete-to-end-of-line (num)
  "Delete from cursor up to but excluding the end of line mark.
839
Argument NUM is the number of lines to delete."
840 841
  (interactive "*p")
  (edt-check-prefix num)
Richard M. Stallman's avatar
Richard M. Stallman committed
842 843 844 845
  (let ((beg (point)))
    (forward-char 1)
    (end-of-line num)
    (setq edt-last-deleted-lines
846
          (buffer-substring beg (point)))
Richard M. Stallman's avatar
Richard M. Stallman committed
847 848
    (delete-region beg (point))))

849 850 851 852 853
;;;
;;; SELECT
;;;

(defun edt-select-mode (arg)
Karl Heuer's avatar
Karl Heuer committed
854
  "Turn EDT select mode off if ARG is nil; otherwise, turn EDT select mode on.
855 856 857 858
In select mode, selected text is highlighted."
  (if arg
      (progn
	(make-local-variable 'edt-select-mode)
859
	(setq edt-select-mode 'edt-select-mode-current)
860 861 862 863 864 865 866
	(setq rect-start-point (window-point)))
    (progn
      (kill-local-variable 'edt-select-mode)))
  (force-mode-line-update))

(defun edt-select ()
  "Set mark at cursor and start text selection."
867 868
  (interactive)
  (set-mark-command nil))
869 870 871 872

(defun edt-reset ()
  "Cancel text selection."
  (interactive)
873
  (if (featurep 'emacs)
874 875
      (deactivate-mark)
    (zmacs-deactivate-region)))
876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892

;;;
;;; CUT
;;;

(defun edt-cut ()
  "Deletes selected text but copies to kill ring."
  (interactive "*")
  (edt-check-selection)
  (kill-region (mark) (point))
  (message "Selected text CUT to kill ring"))

;;;
;;; DELETE TO BEGINNING OF LINE
;;;

(defun edt-delete-to-beginning-of-line (num)
Karl Heuer's avatar
Karl Heuer committed
893
  "Delete from cursor to beginning of line.
894
Argument NUM is the number of lines to delete."
895 896
  (interactive "*p")
  (edt-check-prefix num)
Richard M. Stallman's avatar
Richard M. Stallman committed
897
  (let ((beg (point)))
898 899 900
    (edt-beginning-of-line num)
    (setq edt-last-deleted-lines
          (buffer-substring (point) beg))
Richard M. Stallman's avatar
Richard M. Stallman committed
901 902
    (delete-region beg (point))))

903 904 905 906 907 908
;;;
;;; DEL W
;;;

(defun edt-delete-word (num)
  "Delete from cursor up to but excluding first character of next word.
909
Argument NUM is the number of words to delete."
910 911
  (interactive "*p")
  (edt-check-prefix num)
Richard M. Stallman's avatar
Richard M. Stallman committed
912
  (let ((beg (point)))
913 914
    (edt-word-forward num)
    (setq edt-last-deleted-words (buffer-substring beg (point)))
Richard M. Stallman's avatar
Richard M. Stallman committed
915 916
    (delete-region beg (point))))

917 918 919 920 921 922
;;;
;;; DELETE TO BEGINNING OF WORD
;;;

(defun edt-delete-to-beginning-of-word (num)
  "Delete from cursor to beginning of word.
923
Argument NUM is the number of words to delete."
924 925 926 927 928 929 930 931 932 933 934 935 936
  (interactive "*p")
  (edt-check-prefix num)
  (let ((beg (point)))
    (edt-word-backward num)
    (setq edt-last-deleted-words (buffer-substring (point) beg))
    (delete-region beg (point))))

;;;
;;; DEL C
;;;

(defun edt-delete-character (num)
  "Delete character under cursor.
937
Argument NUM is the number of characters to delete."
938 939
  (interactive "*p")
  (edt-check-prefix num)
Richard M. Stallman's avatar
Richard M. Stallman committed
940
  (setq edt-last-deleted-chars
941
        (buffer-substring (point) (min (point-max) (+ (point) num))))
Richard M. Stallman's avatar
Richard M. Stallman committed
942 943
  (delete-region (point) (min (point-max) (+ (point) num))))

944 945 946 947 948 949
;;;
;;; DELETE CHAR
;;;

(defun edt-delete-previous-character (num)
  "Delete character in front of cursor.
950
Argument NUM is the number of characters to delete."
951 952
  (interactive "*p")
  (edt-check-prefix num)
Richard M. Stallman's avatar
Richard M. Stallman committed
953
  (setq edt-last-deleted-chars
954
        (buffer-substring (max (point-min) (- (point) num)) (point)))
Richard M. Stallman's avatar
Richard M. Stallman committed
955 956
  (delete-region (max (point-min) (- (point) num)) (point)))

957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972
;;;
;;; UND L
;;;

(defun edt-undelete-line ()
  "Undelete previous deleted line(s)."
  (interactive "*")
  (point-to-register 1)
  (insert edt-last-deleted-lines)
  (register-to-point 1))

;;;
;;; UND W
;;;

(defun edt-undelete-word ()
Karl Heuer's avatar
Karl Heuer committed
973
  "Undelete previous deleted word(s)."
974 975 976 977 978 979 980 981 982 983
  (interactive "*")
  (point-to-register 1)
  (insert edt-last-deleted-words)
  (register-to-point 1))

;;;
;;; UND C
;;;

(defun edt-undelete-character ()
Karl Heuer's avatar
Karl Heuer committed
984
  "Undelete previous deleted character(s)."
985 986 987 988 989 990 991 992 993 994 995 996
  (interactive "*")
  (point-to-register 1)
  (insert edt-last-deleted-chars)
  (register-to-point 1))

;;;
;;; REPLACE
;;;

(defun edt-replace ()
  "Replace marked section with last CUT (killed) text."
  (interactive "*")
997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012
  (if (edt-check-match)
      (replace-match (car kill-ring-yank-pointer))
    (progn
      (exchange-point-and-mark)
      (let ((beg (point)))
	(exchange-point-and-mark)
	(delete-region beg (point)))
      (yank))))

;;;
;;; SUBS
;;;

(defun edt-substitute (num)
  "Replace the selected region with the contents of the CUT buffer and.
Repeat the most recent FIND command.  (The Emacs kill ring is used as
1013
the CUT buffer.)
1014
Argument NUM is the repeat count.  A positive value indicates the of times
1015
to repeat the substitution.  A negative argument means replace all occurrences
1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075
of the search text."
  (interactive "p")
  (cond ((or edt-select-mode (edt-check-match))
	 (while (and (not (= num 0)) (or edt-select-mode (edt-check-match)))
	   (edt-replace)
	   (edt-find-next)
	   (setq num (1- num))))
	(t
	 (error "No selection active"))))

(defun edt-set-match nil
  "Set markers at match beginning and end."
  ;; Add one to beginning mark so it stays with the first character of
  ;;   the string even if characters are added just before the string.
  (setq edt-match-beginning-mark (copy-marker (1+ (match-beginning 0))))
  (setq edt-match-end-mark (copy-marker (match-end 0))))

(defun edt-unset-match nil
  "Unset match beginning and end markers."
  (set-marker edt-match-beginning-mark nil)
  (set-marker edt-match-end-mark nil))

(defun edt-match-beginning nil
  "Return the location of the last match beginning."
  (1- (marker-position edt-match-beginning-mark)))

(defun edt-match-end nil
  "Return the location of the last match end."
  (marker-position edt-match-end-mark))

(defun edt-check-match nil
  "Return t if point is between edt-match markers.
Otherwise sets the edt-match markers to nil and returns nil."
  ;; make sure 1- marker is in this buffer
  ;;           2- point is at or after beginning marker
  ;;           3- point is before ending marker, or in the case of
  ;;              zero length regions (like bol, or eol) that the
  ;;              beginning, end, and point are equal.
  (cond ((and
	  (equal (marker-buffer edt-match-beginning-mark) (current-buffer))
	  (>= (point) (1- (marker-position edt-match-beginning-mark)))
	  (or
	   (< (point) (marker-position edt-match-end-mark))
	   (and (= (1- (marker-position edt-match-beginning-mark))
		   (marker-position edt-match-end-mark))
		(= (marker-position edt-match-end-mark) (point))))) t)
	(t
	 (edt-unset-match) nil)))

(defun edt-show-match-markers nil
  "Show the values of the match markers."
  (interactive)
  (if (markerp edt-match-beginning-mark)
      (let ((beg (marker-position edt-match-beginning-mark)))
	(message "(%s, %s) in %s -- current %s in %s"
		 (if beg (1- beg) nil)
		 (marker-position edt-match-end-mark)
		 (marker-buffer edt-match-end-mark)
		 (point) (current-buffer)))))

1076 1077 1078 1079 1080 1081

;;;
;;; ADVANCE
;;;

(defun edt-advance ()
Karl Heuer's avatar
Karl Heuer committed
1082 1083
  "Set movement direction forward.
Also, execute command specified if in Minibuffer."
Richard M. Stallman's avatar
Richard M. Stallman committed
1084
  (interactive)
1085
  (setq edt-direction-string edt-forward-string)
1086
  (force-mode-line-update)
1087
  (if (string-equal " *Minibuf"
1088
                    (substring (buffer-name) 0 (min (length (buffer-name)) 9)))
1089
      (exit-minibuffer))
1090
  (if (featurep 'xemacs) (setq zmacs-region-stays t)))
1091

1092

1093 1094 1095
;;;
;;; BACKUP
;;;
Richard M. Stallman's avatar
Richard M. Stallman committed
1096

1097
(defun edt-backup ()
Karl Heuer's avatar
Karl Heuer committed
1098 1099
  "Set movement direction backward.
Also, execute command specified if in Minibuffer."
Richard M. Stallman's avatar
Richard M. Stallman committed
1100
  (interactive)
1101
  (setq edt-direction-string edt-backward-string)
1102
  (force-mode-line-update)
1103
  (if (string-equal " *Minibuf"
1104
                    (substring (buffer-name) 0 (min (length (buffer-name)) 9)))
1105
      (exit-minibuffer))
1106
  (if (featurep 'xemacs) (setq zmacs-region-stays t)))