From:	ADVAX::"nat@drao.nrc.ca" "Natalie Prowse" 26-NOV-1990 18:57:07.28
To:	<ISIS08@ecostat.aau.dk>, <miller@ria.ccs.uwo.ca>, <alberto@pseudo.berkeley.edu>, <ROSS@bio-medical-physics.aberdeen.ac.uk>, <CAIRNS@upei.ca>, <davis@pacific.mps.ohio-state.edu>, <mike@elec.canterbury.ac.nz>, <FAUCONNE%FRSIM51.BITNET@cunyvm.cuny.edu>, <nreadwin@micrognosis.co.uk>, <DMH100@csc1.anu.oz.au>, <mats@efd.lth.se>, <GOLDICK@vulcan.psc.edu>, <peirce@gumby.cc.wmich.edu>, <NRA%ipg.ph.kcl.ac.uk@nsfnet-relay.ac.uk>, <arisia::EVERHART>
CC:	
Subj:	EVEP emulation: Part 2 of 5

Received: by ADVAX.DECnet (utk-mail11 v1.5) ; Mon, 26 Nov 90 18:54:04 EST
Received:  from mcnc by ge-dab.GE.COM (5.61/GE-DAB 1.15) with UUCP
	id AA04362 for everhart; Mon, 26 Nov 90 18:53:02 -0500
Received: from relay.CDNnet.CA by mcnc.mcnc.org (5.59/MCNC/6-11-90)
	id AA08361; Mon, 26 Nov 90 18:13:53 -0500
	for arisia.dnet.ge.com!EVERHART
Received: by relay.CDNnet.CA (4.1/1.14)
	id AA02095; Mon, 26 Nov 90 14:32:09 PST
Date: 26 Nov 90 20:11 -0800
From: Natalie Prowse <nat@drao.nrc.ca>
To: <ISIS08@ecostat.aau.dk>, <miller@ria.ccs.uwo.ca>,
        <alberto@pseudo.berkeley.edu>,
        <ROSS@bio-medical-physics.aberdeen.ac.uk>, <CAIRNS@upei.ca>,
        <davis@pacific.mps.ohio-state.edu>, <mike@elec.canterbury.ac.nz>,
        <FAUCONNE%FRSIM51.BITNET@cunyvm.cuny.edu>,
        <nreadwin@micrognosis.co.uk>, <DMH100@csc1.anu.oz.au>,
        <mats@efd.lth.se>, <GOLDICK@vulcan.psc.edu>,
        <peirce@gumby.cc.wmich.edu>, <NRA%ipg.ph.kcl.ac.uk@nsfnet-relay.ac.uk>,
        <arisia::EVERHART>
Message-Id: <206*nat@drao.nrc.CA>
Subject: EVEP emulation: Part 2 of 5
 
-+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+
X;; Copyright (C) 1985 Free Software Foundation, Inc.
X
X;; This file is part of GNU Emacs.
X;;
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY.  No author or distributor
X;; Accepts responsibility to anyone for the consequences of using it;`032
X;; or for whether it serves any particular purpose or works at all
X;; unless he says so in writing.  Refer to the GNU Emacs General Public
X;; License for  full details.
X
X;; Everyone is granted permission to copy, modify and redistribute
X;; GNU Emacs, but only under the conditions described in the
X;; GNU Emacs General Public License.   A copy of this license is
X;; supposed to have been given to you along with GNU Emacs so you
X;; can know your rights and responsibilities.  It should be in a
X;; file named COPYING.  Among other things, the copyright notice
X;; and this notice must be preserved on all copies.
X
X;; This file was modified by Natalie Prowse (nat@drao.nrc.ca) in November/90
X;; to emulate eve-plus.  Assistance was provided by Pierre Valiron, and
X;; John Sturdy (who gave much assistance in the rectangular cut-and-paste ar
Vea)
X;; The above disclaimer applies in full!
X
X(load "rect.el")
X(require 'keypad)
X
X(defvar evep-direction-string "" "ADVANCE")
X(defvar save-string "" "")
X(defvar string-val "" "")
X(defvar buffname "" "paste")
X(defvar evep-last-deleted-lines ""
X  "Last text deleted by an EVEP emulation line-delete command.")
X(defvar evep-last-deleted-words ""
X  "Last text deleted by an EVEP emulation word-delete command.")
X(defvar evep-last-deleted-chars ""
X  "Last text deleted by an EVEP emulation character-delete command.")
X(defvar buff-assgn-1 "" "buffer name mapped to slot 1")
X(defvar buff-assgn-2 "" "buffer name mapped to slot 2")
X(defvar buff-assgn-3 "" "buffer name mapped to slot 3")
X(defvar buff-assgn-4 "" "buffer name mapped to slot 4")
X(defvar buff-assgn-5 "" "buffer name mapped to slot 5")
X(defvar buff-assgn-6 "" "buffer name mapped to slot 6")
X(defvar buff-assgn-7 "" "buffer name mapped to slot 7")
X(defvar buff-assgn-8 "" "buffer name mapped to slot 8")
X(defvar buff-assgn-9 "" "buffer name mapped to slot 9")
X(defvar evh-rect-mode "F" "*mode switch for cutting and pasting rectangular"
V)
X
X(defvar buff-map "" "*name of buffer symbol")
X(defvar keynum  nil "*number of top-row key that was pressed") `032
X(defvar nat-fill-string "                                                 "
V "nats fillprefix")
X
X(defun map-keyboard-macro (key-input)
X" End a keyboard macro definition and map it to KEY-INPUT key."
X (end-kbd-macro)
X (interactive "kPress key to map macro to: ")
X (define-key global-map key-input last-kbd-macro))
X
X(defun repeat (key-input)
X" repeat the KEY-INPUT defined keyboard macro."
X (interactive "kPress key to repeat: ")
X (setq last-kbd-macro key-input)
X (setq numtimes (read-from-minibuffer "Number of times to repeat: "))
X (repeat-last-kbd-macro (string-to-int numtimes)))
X
X(defun set-rectangular ()
X  "Sets the cut and paste mode to rectangular"
X  (interactive)
X  (setq evh-rect-mode "T"))
X
X(defun set-norectangular ()
X  (interactive)
X  "Returns the cut and paste mode to normal"
X  (setq evh-rect-mode "F"))
X
X(defun repeat-last-kbd-macro (numtimes)
X  "Repeat last keyboard macro ARG times."
X  (interactive "NNumber of times to repeat Key: ")
X  (while (/= numtimes 0)
X    (call-last-kbd-macro)
X    (setq numtimes (- numtimes 1))))
X
X
X
X
X(defun initial-file-load ()
X (setq keynum 1)
X (setq found nil)
X (setq intbuf (buffer-name))
X (cond ((or (string-match ".txt" intbuf)
X`009    (string-match ".TXT" intbuf)
X`009    (string-match ".TEX" intbuf)
X`009    (string-match ".Tex" intbuf)
X`009    (string-match ".TeX" intbuf)
X`009    (string-match ".lis" intbuf)
X`009    (string-match ".LIS" intbuf))
X`009(text-mode))
X       ((or (string-match ".frc" intbuf)
X`009    (string-match ".f"   intbuf))
X`009(setq blink-matching-paren t)
X`009(setq indent-tabs-mode t)
X`009(fortran-mode)))
X`009
X (while (and (/= keynum 10) (not found))
X   (setq buff-map (symbol-value (intern (concat "buff-assgn-" keynum))))
X   (cond ((string= buff-map "")
X`009  (set (intern (concat "buff-assgn-" keynum)) (buffer-name))
X`009  (setq found t))
X`009 (t
X`009  (cond ((get-buffer buff-map)     ;; if there is already a buffer assig
Vned
X`009`009 (setq keynum (+ keynum 1))) ;; then try the next key
X`009`009(t                           ;; if the buffer has been killed, use i
Vt
X`009`009 (setq found t)
X`009`009 (set (intern (concat "buff-assgn-" keynum)) (buffer-name)))))))
X`032
X (cond ((eq keynum 10)  ;; if we finished the loop and we couldn't find a ke
Vy
X`009(message (concat "All top-row keys are full, file: " (buffer-name) " loa
Vded anyway.")))
X       (t
X`009(message (concat "File: " (buffer-name) " mapped to top-row key GOLD-" k
Veynum)))))
X
X
X
X
X(defun map-buffer-to-key ()
X  " Map a buffer to a top-row numeric key equivalent.
XWith the find-file-hooks in place, the next available key will be chosen, if
V there
Xis space, otherwise, if the key is already mapped to an active buffer, the u
Vser`032
Xwill be switched to the buffer. `032
XIe.  if this procedure invokes find-file, it also will invoke intial-load-fi
Vle,`032
Xwhich will try to map the new filebuffer to a top row numeric key."
X
X  (interactive)
X  ;; get the keynumber of the last key pressed (a top row numeric)
X  (setq keynum (- last-command-char 48)) ;; key 1 is 49... key 9 is 57
X
X      ;; get the contents of the variable that maps to the key
X  (setq buff-map (symbol-value (intern (concat "buff-assgn-" keynum))))
X`032
X  ;;if the buffer has not yet been mapped, get a file
X  (cond ((string= buff-map "")
X`009 (setq buff-map (read-string "File to get: " default-directory ))
X`009 (cond ((not (string= buff-map default-directory))
X`009`009(cond ((get-buffer buff-map)
X`009`009       (switch-to-buffer buff-map)
X`009`009       (initial-file-load))
X`009`009      (t
X`009`009       (find-file buff-map))))))
X    ;;else
X`009;; if the buffer is mapped to a file, but the buffer no longer exists,
X`009;; get a new file to fill the buffer
X`009(t
X`009 (cond ((get-buffer buff-map)
X`009`009(switch-to-buffer buff-map))
X`009       (t
X`009`009(setq buff-map (read-string "File to get: " default-directory ))
X`009`009(cond ((not (string= buff-map default-directory))
X`009`009       (find-file buff-map))))))))
X
X
X
X(defun open-line-above ()
X  " Open a line above the current line.
XLike open-line, but ensures that point is at start of current line
XBEFORE open-line is invoked."
X  (beginning-of-line)
X  (open-line))
X
X
X
X(defun set-tabs-every (new-size)
X  "Set the tab size."
X  (interactive "p")
X  (if (/= new-size 0)
X      (setq new-size`032
X`009    (read-string (concat "Current tab size = " tab-width "     New tab-s
Vize: ") "")))
X  (setq tab-size (string-to-int new-size))
X  (message (concat "Tab size is now set to " tab-width ".")))
X
X(defun set-left-margin (new-lmarg)
X  "Set the left margin."
X  (interactive "p")
X  (if (/= new-lmarg 0)
X      (setq new-lmarg
X`009    (read-string (concat "Current left margin = " left-margin "   New le
Vft margin: ") "")))
X  (setq fill-prefix (substring nat-fill-string 0 (string-to-int new-lmarg)))
X  (setq left-margin (string-to-int new-lmarg))
X  (message (concat "Left margin set to: " new-lmarg)))
X
X(defun set-right-margin (new-rmarg)
X  "Set the right margin."
X  (interactive "p")
X  (if (/= new-rmarg 0)
X      (setq new-rmarg
X`009    (read-string (concat "Current right margin = " fill-column "   New r
Vight margin: ") "")))
X  (setq fill-column (string-to-int new-rmarg))
X  (message (concat "Right margin set to: " new-rmarg)))`009   `032
X
X
X(defun shift-screen-left ()
X"Shift the screen left 40 columns."
X  (interactive)
X  (scroll-left 40))
X
X(defun shift-screen-right ()
X"Shift screen right 40 columns."
X  (interactive)
X  (scroll-right 40))
X
X(defun nat-toggle-window ()
X  "Toggle between one and two windows on the screen."
X  (interactive)
X  (cond ((one-window-p)
X`009 (split-window-vertically))
X`009(t
X`009 (delete-other-windows))))
X`009`032
X
X;
X;
X; Cut and Paste Definitions
X;
X(defun append-to-buffer (buffer start end)
X  "(Natalie's) Append to specified buffer the text of the region.
XIt is inserted into that buffer before its point.
XWhen calling from a program, give 3 arguments:
Xa buffer or the name of one and 2 character numbers
Xspecifying the portion of the current buffer to be copied."
X   (interactive "B")
X   (let ((oldbuf (current-buffer)))
X     (save-excursion
X       (set-buffer buffer)
X       (end-of-buffer)
X       (newline)
X       (insert-buffer-substring oldbuf start end))))
X
X
X(defun refresh ()
X  "Alias this function to the RECENTER function for eve-plus emulation"
X (interactive)
X (recenter))
X
X; Time stamp <90/11/21 19:53:52 John Sturdy>
X
X(defun cut-and-clear-rectangle (a b)
X  "Cut and clear the rectangle in region A B."
X  (interactive "r")
X  (setq killed-rectangle (extract-rectangle a b))
X  (clear-rectangle a b))
X
X(defun yank-overwrite-rectangle ()
X  "overwrite-Yank the last killed rectangle with upper left corner at point.
V"
X  (interactive)
X  (overwrite-rectangle killed-rectangle))
X
X
X(defun overwrite-rectangle (rectangle)
X  "Overwrite text of RECTANGLE with upper left corner at point.
XRECTANGLE's first line is overwritten at point,
Xits second line is overwritten at a point vertically under point, etc.
XRECTANGLE should be a list of strings."
X  (let* ((lines rectangle)
X`009 (linelength (length (car lines)))
X`009 (insertcolumn (current-column))
X`009 (endinsertcolumn (+ insertcolumn linelength))
X`009 (first t))
X    (while lines
X      (if (not first)
X`009  (forward-line 1))
X      (let* ((eol-col (progn (end-of-line 1) (current-column)))
X`009     (eol-point (point)))
X`009(move-to-column insertcolumn)
X`009(delete-region (point) (+ (point)`032
X`009`009`009`009  (if (> endinsertcolumn eol-col)
X`009`009`009`009      (- eol-col insertcolumn)
X`009`009`009`009    linelength)))
X      (setq first nil)
X      (insert (car lines))
X      (setq lines (cdr lines))))))
X
X(defun delete-to-cutbuffer (start end)
X  "Remove a section of the buffer either in rectangular or normal mode.
X Checks evh-rect-mode (set to 't' by set-rectangular) to determine type
X of cut to make.  In normal mode, section is deleted and put in the *paste*
X buffer.  Use yank-from-cutbuffer to retrieve cut section."
X  (interactive "r")
X  (if (string= evh-rect-mode "T")
X      (cut-and-clear-rectangle start end)
X    (progn
X      (setq buffname "paste")
X      (save-excursion
X`009(copy-to-buffer buffname start end)
X`009(delete-region start end)
X`009(message "Region CUT to paste")
X`009(clean-up-cut-buffers)))))
X
X(defun yank-from-cutbuffer ()
X  "Insert (paste) a section from the buffer *paste*, either in rectangular o
Vr normal mode.
X Checks evh-rect-mode (set to 't' by set-rectangular) to determine type
X of paste to make.  In normal mode, section is restored from *paste* buffer.
V"
X  (interactive)
X  (if (string= evh-rect-mode "T")
X      (yank-overwrite-rectangle)
X    (progn
X      (setq buffname "paste")
X      (insert-buffer buffname)
X      (exchange-point-and-mark)
X      (clean-up-cut-buffers))))
X
X;(global-set-key "\e_" 'cut-and-clear-rectangle)
X;(global-set-key "\C-x_" 'yank-overwrite-rectangle)
X
X; end of to-nat.el
X
X
X
X(defun append-to-cutbuffer ()
X  " Append region to buffer named 'paste'."
X  (interactive)
X  (setq buffname "paste")
X  (save-excursion
X    (append-to-buffer buffname (point) (mark))
X    (message "Region APPENDED to paste")
X    (clean-up-cut-buffers)))
X
X
X(defun swap-region-to-cutbuffer ()
X  (interactive)
X  (delete-region-to-buffer "garbage")
X  (yank-from-cutbuffer)
X  (save-window-excursion
X    (set-buffer "garbage")
X    (beginning-of-buffer)
X    (set-mark-command)
X    (end-of-buffer)
X    (delete-to-cutbuffer)
X    (clean-up-cut-buffers)))
X;
X(defun clean-up-cut-buffers ()
X  (save-window-excursion
X    (set-buffer "paste")
X    (setq you-lose-on-needs-checkpointing 0)
X    (novalue)))
X
X(defun novalue () nil)
X
X;
X;
X; Search Command Definitions
X;
X(defun nat-search-reverse (string-val)
X" Search reverse for next occurance.  If not found query user about searchin
Vg forward."
X  (cond ((not (string= string-val ""))
X`009 (setq save-string string-val)))
X  (cond ((not (search-backward save-string nil t))
X`009 (setq answ "n")
X`009 (setq answ (read-string`032
X`009`009     (concat "'"save-string "' was not found. Should I Search Forwar
Vd? ") ""))
X`009 (cond ((or (string= answ "y") (string= answ "Y"))
X`009`009(change-direction)
X`009`009(nat-search-forward save-string))))))
X
X
X(defun nat-search-forward (string-val)
X" Search forward for next occurance.  If not found query user about searchin
Vg in reverse."
X  (cond ((not (string= string-val ""))
X`009 (setq save-string string-val)))
X  (cond ((not (search-forward save-string nil t))
X`009 (setq answ "n")
X`009 (setq answ (read-string`032
X`009`009     (concat "'"save-string "' was not found. Should I Search revers
Ve? ") ""))
X`009 (cond ((or (string= answ "y") (string= answ "Y"))
X`009`009(change-direction)
X`009`009(nat-search-reverse save-string))))))
X;
X(defun search-forward-query()
X  "Query the user for a search string, and search forward for next occurance
V."
X (interactive)
X (nat-search-forward (read-string "Search For: " "")))
X
X(defun search-reverse-query()
X  "Query the user for a search string, and search backwards for next occuran
Vce."
X (interactive)
X (nat-search-reverse (read-string "Search For: " "")))
X
X(defun search-forward-next()
X  "Find the next occurance (forward) of the previous search string."
X  (interactive)
X  (forward-char)
X  (nat-search-forward ""))
X
X(defun search-reverse-next ()
X  "Find the next occurance (backwards) of the previous search string."
X  (interactive)`032
X  (nat-search-reverse ""))
X
X(defun delete-current-line (num)
X  "Delete one or specified number of lines after point.
XThis includes the newline character at the end of each line.
XThey are saved for the EVEP undelete-lines command."
X  (interactive "p")
X  (let ((beg (point)))
X    (forward-line num)
X    (if (not (eq (preceding-char) ?\n))
+-+-+-+-+-+-+-+-  END  OF PART 2 +-+-+-+-+-+-+-+-
