From: ADVAX::"nat@drao.nrc.ca" "Natalie Prowse" 27-NOV-1990 14:49:42.95 To: , , , , , , , , , , , , , , , , , To: , , , , , , , , , , , , , , , , , , , Message-Id: <237*nat@drao.nrc.CA> Subject: updated evep.el file This is an updated evep.el file in which rectangular cuts and pastes have been enhanced to work better (correctly). Many thanks to John Sturdy at Cambridge :-) ================== $! ------------------ CUT HERE ----------------------- $ v='f$verify(f$trnlnm("SHARE_VERIFY"))' $! $! This archive created by VMS_SHARE Version 7.1-004 3-AUG-1989 $! On 27-NOV-1990 09:36:14.56 By user NAT $! $! This VMS_SHARE Written by: $! Andy Harper, Kings College London UK $! $! Acknowledgements to: $! James Gray - Original VMS_SHARE $! Michael Bednarek - Original Concept and implementation $! $!+ THIS PACKAGE DISTRIBUTED IN 3 PARTS, TO KEEP EACH PART $! BELOW 30 BLOCKS $! $! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER $! AND EXECUTE AS A COMMAND PROCEDURE ( @name ) $! $! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING: $! 1. EVEP.EL;3 $! $set="set" $set symbol/scope=(nolocal,noglobal) $f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID")) $e="write sys$error ""%UNPACK"", " $w="write sys$output ""%UNPACK"", " $ if f$trnlnm("SHARE_LOG") then $ w = "!" $ if f$getsyi("version") .ges. "V4.4" then $ goto START $ e "-E-OLDVER, Must run at least VMS 4.4" $ v=f$verify(v) $ exit 44 $UNPACK: SUBROUTINE ! P1=filename, P2=checksum $ if f$search(P1) .eqs. "" then $ goto file_absent $ e "-W-EXISTS, File ''P1' exists. Skipped." $ delete/nolog 'f'* $ exit $file_absent: $ if f$parse(P1) .nes. "" then $ goto dirok $ dn=f$parse(P1,,,"DIRECTORY") $ w "-I-CREDIR, Creating directory ''dn'." $ create/dir 'dn' $ if $status then $ goto dirok $ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped." $ delete/nolog 'f'* $ exit $dirok: $ w "-I-PROCESS, Processing file ''P1'." $ define/user sys$output nl: $ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1' PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET( SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name"); buff:=CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(buff)) ;LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION( BEGINNING_OF(buff));g:=0;LOOP EXITIF MARK(NONE)=END_OF(buff);x:= ERASE_CHARACTER(1);IF g = 0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x= "V" THEN APPEND_LINE;MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF; IF x="+" THEN g:=1;ERASE_LINE;ENDIF;ELSE IF x="-" THEN g:=0;ENDIF;ERASE_LINE; ENDIF;ENDLOOP;p:="`";POSITION(BEGINNING_OF(buff));LOOP r:=SEARCH(p,FORWARD); EXITIF r=0;POSITION(r);ERASE(r);COPY_TEXT(ASCII(INT(ERASE_CHARACTER(3)))); ENDLOOP;o:=GET_INFO(COMMAND_LINE,"output_file");WRITE_FILE(buff,o); ENDPROCEDURE;Unpacker;EXIT; $ delete/nolog 'f'* $ CHECKSUM 'P1' $ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT $ e "-E-CHKSMFAIL, Checksum of ''P1' failed." $ ENDSUBROUTINE $START: $ create/nolog 'f' 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 indent-tabs-mode nil) X (setq evh-rect-mode "T")) X X(defun set-norectangular () X "Returns the cut and paste mode to normal" X (interactive) X (setq indent-tabs-mode t) 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(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 (if (and (eobp) (/= (char-after (1- (point-max))) ?\n)) X`009 (insert ?\n)) X (let* ((eol-col (progn (end-of-line 1) (current-column))) X`009 (eol-point (point))) X`009(move-to-column insertcolumn) X`009(if (> insertcolumn eol-col) X`009 (indent-to insertcolumn) X`009 (delete-region (point) (+ (point)`032 X`009`009`009`009 (if (> endinsertcolumn eol-col) X`009`009`009`009`009(- eol-col insertcolumn) X`009`009`009`009 linelength)))) X`009(setq first nil) X`009(insert (car lines)) X`009(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") +-+-+-+-+-+-+-+- END OF PART 1 +-+-+-+-+-+-+-+-