Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP Path: utzoo!watmath!clyde!caip!think!nike!cit-vax!ll-xn!mit-amt!mit-eddie!genrad!decvax!decwrl!glacier!cdp!scott From: scott@cdp.UUCP Newsgroups: net.emacs Subject: Re: wordstar emulation for emacs? Message-ID: <3100019@cdp> Date: Sun, 28-Sep-86 22:46:00 EDT Article-I.D.: cdp.3100019 Posted: Sun Sep 28 22:46:00 1986 Date-Received: Wed, 1-Oct-86 01:36:06 EDT References: <603@varian.UUCP> Lines: 556 Nf-ID: #R:varian.UUCP:-60300:cdp:3100019:000:21265 Nf-From: cdp.UUCP!scott Sep 28 19:46:00 1986 I orginally provided Unipress with one of the WordStar packages. I did some more work on it, and tried to talk them into trading me their latest emacs for my lastest WordStar, but they didn't bite. Since any Emacs upgrading I do from here on out will be to Gnumacs, I decided to just post my reworked WordStar stuff. If anyone ports it from Gosmacs to Gnumacs, please repost. -scott ----------------------------------------- ;Copyright (c) 1984 - Community Data Processing ;sw8: 09/ 2/84, scott@CdP: ^Kr/^Kx/^Kd should prompt for file name if none ;sw7: 09/ 2/84, scott@CdP: x menu command to exit ;sw6: 09/ 2/84, scott@CdP: d and n menu commands to read in a file ;sw5: 09/ 2/84, scott@CdP: ^N should be newline-and-backup ;sw4: 09/ 2/84, scott@CdP: "emacs foo" doesn't setup ^X, so need hack ;sw3: 09/ 2/84, scott@CdP: "x" will exit if buffer has no file and is empty ;sw2: 08/18/84, scott@CdP: tell the user about XON/XOFF flow control ;sw1: 08/18/84, scott@CdP: save ^Y on kill-ring ;sw: 07/25/84: this provides rudimentary wordstar key-bindings/compatibility ;watch out for the order of the binds; use-global-keymaps are sprinkled in ; in various places ;if you need to access a TOPS-20 emacs command that was bound to a key ; that the wordstar emulation is now using (e.g. ^e), then access it via ; the metized-shifted keystroke (e.g. M-E, where E must be capital E) (declare-global &wordstar-message &wordstar-is-loaded) (if (! (is-bound &tops-20-is-loaded)) (load "tops-20")) ;we need a lot of normal setup (setq &wordstar-message "WordStar (^\\ for ^X prefix)") ;sw2: using XON/XOFF (ie ^S ^Q) flow control if TERM string ends in "f" (if (= (substr (getenv "TERM") -1 1) "f") ;sw2: using XON/XOFF flow control? (progn (if (! (is-bound &using-xon-xoff-flow-control) (declare-global &using-xon-xoff-flow-control))) (setq &wordstar-message (concat &wordstar-message "; XON/XOFF: ^Q=>^T,^S=>^],^Q^S=>^Qs,^K^S=>^Ks")))) (message "Loading " &wordstar-message " ...") ;sw2: tell the user whats up (sit-for 0) ;let user see message ;tell user what we are up to (declare-buffer-specific &start-mark &last-start-mark &start-mark-visible-f &end-mark &end-mark-visible-f) ;1 pair marks per buffer (setq-default &start-mark (setq-default &last-start-mark (setq-default &end-mark 0))) ;no marks yet (setq-default &start-mark-visible-f (setq-default &end-mark-visible-f 0)) ;so not visible ;deal with rebindings of prefix keys (remove-binding "\^X") ;toss normal one (remove-local-binding "\^X") ;toss normal one (bind-to-key "^X-prefix" "\eX") ;access with M-X (ie cap W) (bind-to-key "^X-prefix" 28) ;^\ for easier typing (bind-to-key "execute-extended-command" 156) ;C-M-\ (remove-binding "\^Q") (remove-local-binding "\^Q") (bind-to-key "quote-character" "\eQ") ;so can access normal quote (remove-binding "\^K") (remove-local-binding "\^K") (bind-to-key "kill-line" "\eK") ;so can access normal quote (define-keymap "wordstar-^Q") ;for ^Q-prefix commands (define-keymap "wordstar-^K") ;for ^K-prefix commands (define-keymap "outfox-^X") ;to defeat normal ^X (use-local-map "outfox-^X") ;make it local ;in ws-menu-exit: (local-bind-to-key "next-line" "\^X") ;and access it ;in ws-menu-exit: (bind-to-key "next-line" "\^X") ;normal keymap (if (is-bound &using-xon-xoff-flow-control) (bind-to-key "wordstar-^Q" "\^T") ;sw2: special (bind-to-key "wordstar-^Q" "\^Q")) ;sw2: normal (bind-to-key "wordstar-^K" "\^K") (if (= (getenv "GROUP") "bin") ;only hackers need buggy comment stuff (progn (remove-binding "\ex") (remove-local-binding "\ex") (bind-to-key "down-comment-line" "\ex") (bind-to-key "up-comment-line" "\ee") (bind-to-key "set-comment-column" "\eX;") (bind-to-key "set-comment-column" "\\;") (bind-to-key "comment-log" "\eXl") (bind-to-key "comment-log" "\\l"))) ;**** ;misc ;**** (autoload "emacs-doc" "emacs-doc") (bind-to-key "emacs-doc" "\^J") (autoload "justify-paragraph" "justify") (bind-to-key "justify-paragraph" "\^B") (bind-to-key "backward-character" "\eB") ;*************** ;"menu" commands ;*************** (defun (ws-menu-mode ;return true if in menu mode (& (= (buffer-size) 0) ;buffer empty and... (= (current-file-name) "")))) ;...no file name means menu (defun (ws-menu-read char ;sw6: (if (ws-menu-mode) ;are we in menu mode? (progn ;then want to read in a file (ws-insert-file) ;get it (if (= (last-key-struck) 'd') ;document mode? (text-mode))) ;then go into text mode (progn (setq char (last-key-struck)) ;need to see if its a command (if (= char '\^N') (newline-and-backup) (if (= char '\^D') (forward-character) (insert-character char))))))) (bind-to-key "ws-menu-read" "n") (bind-to-key "ws-menu-read" "N") (bind-to-key "ws-menu-read" "\^N") (bind-to-key "ws-menu-read" "d") (bind-to-key "ws-menu-read" "D") (bind-to-key "ws-menu-read" "\^D") (defun (ws-menu-exit char ;sw7: exit if in menu mode (if (ws-menu-mode) ;are we in menu mode? (exit-emacs) ;then user hit a kit to exit (progn ;else treat the key normally (setq char (last-key-struck)) ;char user hit to get here (if (= char '\^X') ;was it ^X? (next-line) ;then do cursor control (insert-character char))))));else self-inserting key (bind-to-key "ws-menu-exit" "x") (bind-to-key "ws-menu-exit" "X") (bind-to-key "ws-menu-exit" "\^X") (local-bind-to-key "ws-menu-exit" "\^X") (defun (fix-^X-prefix ;remap ^X to be next-line (local-bind-to-key "ws-menu-exit" "\^X") (next-line) ;what the user probably wanted (error-message "^X was just fixed"))) (bind-to-key "fix-^X-prefix" "\^X\^X") ;in case binding fucked up ;*************** ;cursor movement ;*************** (if (is-bound &using-xon-xoff-flow-control) (bind-to-key "backward-character" "\^]")) ;sw2: ;in ws-menu-read: (bind-to-key "newline-and-backup" "\^N") ;sw5: (bind-to-key "backward-character" "\^S") (bind-to-key "backward-character" "\^H") (bind-to-key "incremental-search" "\eS") (bind-to-key "backward-word" "\^A") (bind-to-key "beginning-of-line" "\eA") ;in ws-menu-read: (bind-to-key "forward-character" "\^D") (bind-to-key "delete-next-character" "\eD") (bind-to-key "forward-word" "\^F") (bind-to-key "forward-character" "\eF") (bind-to-key "previous-line" "\^E") (bind-to-key "end-of-line" "\eE") (bind-to-key "previous-page" "\^R") (bind-to-key "reverse-incremental-search" "\eR") (bind-to-key "next-page" "\^C") (bind-to-key "exit-emacs" "\eC") (bind-to-key "scroll-one-line-down" "\^W") (bind-to-key "quote-character" "\^P") (bind-to-key "previous-line" "\eP") (use-global-map "wordstar-^Q") (bind-to-key "beginning-of-line" "S") (bind-to-key "beginning-of-line" "s") (bind-to-key "beginning-of-line" "\^S") (bind-to-key "beginning-of-file" "R") (bind-to-key "beginning-of-file" "r") (bind-to-key "beginning-of-file" "\^R") (bind-to-key "beginning-of-window" "E") (bind-to-key "beginning-of-window" "e") (bind-to-key "beginning-of-window" "\^E") (bind-to-key "end-of-window" "X") (bind-to-key "end-of-window" "x") (bind-to-key "end-of-window" "\^X") (bind-to-key "end-of-line" "D") (bind-to-key "end-of-line" "d") (bind-to-key "end-of-line" "\^D") (bind-to-key "end-of-file" "C") (bind-to-key "end-of-file" "c") (bind-to-key "end-of-file" "\^C") ;************** ;search-replace ;************** (if (! (is-bound incremental-search)) (autoload "incremental-search" "incr-search")) (bind-to-key "incremental-search" "F") (bind-to-key "incremental-search" "f") (bind-to-key "incremental-search" "\^F") (bind-to-key "query-replace-string" "A") (bind-to-key "query-replace-string" "a") (bind-to-key "query-replace-string" "\^A") (use-global-map "default-global-keymap") ;********************* ;end edit or save file ;********************* (if (! (is-bound find-file)) (progn (autoload "find-file" "find-file") (autoload "buffer-file-path" "find-file"))) (use-global-map "wordstar-^K") (defun (ws-abandon-edit (if buffer-is-modified (progn (message "Buffer is modified; hit 'y' to abandon anyway.") (if (!= (get-tty-character) 'y') (error-message "Aborted.")))) (delete-buffer (current-buffer-name)))) (bind-to-key "ws-abandon-edit" "Q") (bind-to-key "ws-abandon-edit" "q") (bind-to-key "ws-abandon-edit" "\^Q") (defun (&ws-write-file file ;arg true to query for file (if (& (! (arg 1)) ;not asking for query and... (!= (current-file-name) "")) ;...have a file w/this buffer? (write-current-file) ;then write it (progn ;else need to ask for name (push-back-string (buffer-file-path)) ;help the user (setq file (get-tty-file "New file name (use SPACE, ^Y): ")) (if (< (file-exists file) 0) ;file exists & not writeable? (error-message file " exists, and you can't write it.") (> (file-exists file) 0) ;exists and writeable? (progn ;then ask first (message file " exists; hit 'y' to overwrite it.") (if (!= (get-tty-character) 'y') (error-message "Aborted.")))) (write-named-file file) (message "Wrote " file) (sit-for 0))))) ;make sure user sees message (defun (ws-write-current-file visible-f file (if (setq visible-f (| &start-mark-visible-f &end-mark-visible-f)) ;remember if visible (ws-hide-unhide-block)) ;if so, hide it (&ws-write-file (ws-menu-mode)) ;sw8: write the file, w/prompt (if visible-f (ws-hide-unhide-block)) ;unhide if was visible (novalue))) (bind-to-key "ws-write-current-file" "S") (bind-to-key "ws-write-current-file" "s") (bind-to-key "ws-write-current-file" "\^S") (defun (ws-save-and-leave-file (ws-write-current-file) (ws-abandon-edit))) ;toss buffer (bind-to-key "ws-save-and-leave-file" "D") (bind-to-key "ws-save-and-leave-file" "d") (bind-to-key "ws-save-and-leave-file" "\^D") (defun (ws-hide-windows ;hide marks in all windows (save-excursion (&hide-start-mark) (&hide-end-mark) (next-window) ;get in other window (&hide-start-mark) (&hide-end-mark) (next-window) ;in case big terminal (&hide-start-mark) (&hide-end-mark)))) (defun (ws-write-file-exit (ws-hide-windows) ;hide marks in all windows (if (!= (current-file-name) "") ;file with this buffer? (ws-write-current-file)) ;deal with visible markers (error-occurred (write-modified-files)) ;ignore errors (sit-for 0) ;see if * disappears (exit-emacs))) (bind-to-key "ws-write-file-exit" "X") (bind-to-key "ws-write-file-exit" "x") (bind-to-key "ws-write-file-exit" "\^X") (use-global-map "default-global-keymap") ;******** ;deleting ;******** (bind-to-key "delete-next-character" "\^G") (bind-to-key "illegal-operation" "\eG") (bind-to-key "illegal-operation" "\^U") (bind-to-key "argument-prefix" "\eU") (defun (ws-kill-whole-line (beginning-of-line) (set-mark) (next-line) (kill-region))) ;sw1: (bind-to-key "ws-kill-whole-line" "\^Y") (bind-to-key "unkill" "\eY") (bind-to-key "kill-word" "\^T") (bind-to-key "transpose-characters" "\eT") (defun (ws-kill-to-line-end (set-mark) (end-of-line) (erase-region))) (use-global-map "wordstar-^Q") (bind-to-key "ws-kill-to-line-end" "Y") (bind-to-key "ws-kill-to-line-end" "y") (bind-to-key "ws-kill-to-line-end" "\^Y") (defun (ws-kill-to-line-beginning (set-mark) (beginning-of-line) (erase-region))) (bind-to-key "ws-kill-to-line-beginning" "\177") (defun (ws-cursor-to-block-source (if &last-start-mark ;have we done a block op? (goto-character &last-start-mark) ;then go to where block was (error-message "There has been no block operation yet.")))) (bind-to-key "ws-cursor-to-block-source" "V") (bind-to-key "ws-cursor-to-block-source" "v") (bind-to-key "ws-cursor-to-block-source" "\^V") (defun (ws-cursor-to-block-start (if &start-mark (progn (&unhide-start-mark) (goto-character &start-mark)) (error-message "There is no beginning-of-block marker.")))) (bind-to-key "ws-cursor-to-block-start" "B") (bind-to-key "ws-cursor-to-block-start" "b") (bind-to-key "ws-cursor-to-block-start" "\^B") (defun (ws-cursor-to-block-end (if &end-mark (progn (&unhide-end-mark) (goto-character &end-mark)) (error-message "There is no end-of-block marker.")))) (bind-to-key "ws-cursor-to-block-end" "K") (bind-to-key "ws-cursor-to-block-end" "k") (bind-to-key "ws-cursor-to-block-end" "\^K") ;************** ;block commands ;************** ;we maintain a beginning-of-block marker and end-of-block marker, per buffer ;&start-mark points in front of , and &end-mark points in BACK of ; ; this allows us to save the visible representaion for a marker when we ; do block deletes ;we always hide the markers in a window before we disappear it, so that ; we can write modified files and exit without writing out visible markers ;&start-mark or &end-mark are 0 if there is no such mark; ; &start-mark-visible-f and &end-mark-visible-f are 0 if marker not visible (use-global-map "wordstar-^K") (defun ;start a bunch of defs (&hide-start-mark cursor ;ok to call w/no mark, or mark not visible ;avoid using save-excursion, cuz on error want cursor to stay where it is (if &start-mark-visible-f ;only hide if visible (progn (setq cursor (dot)) ;remember where we start (goto-character &start-mark) ;get at front (setq &start-mark-visible-f 0) ;one of us will delete it (if (! (looking-at "")) (error-message "I expected a '' near here; delete any remnants")) (provide-prefix-argument 3 (delete-next-character)) ;toss (goto-character cursor)))) (&hide-end-mark cursor ;ok to call w/no mark, or mark not visible ;avoid using save-excursion, cuz on error want cursor to stay where it is (if &end-mark-visible-f ;only hide if visible (progn (setq cursor (dot)) ;remember where we start (setq &end-mark-visible-f 0) ;one of us will hide it (goto-character (- &end-mark 3)) ;get to front of visible mark (if (! (looking-at "")) (error-message "I expected a '' near here; delete any remnants")) (provide-prefix-argument 3 (delete-next-character)) ;toss (goto-character cursor)))) (&unhide-start-mark ;ok to call with no mark, or mark already visible (if (& &start-mark (! &start-mark-visible-f)) ;only unhide if hidden (save-excursion (goto-character &start-mark) ;get at front (insert-string "") ;make the mark visible (setq &start-mark-visible-f 1)))) ;now visible (&unhide-end-mark ;ok to call with no mark, or mark already visible (if (& &end-mark (! &end-mark-visible-f)) ;only unhide if hidden (save-excursion (goto-character &end-mark) ;get at back (insert-string "") ;make the mark visible (setq &end-mark (dot)) ;want mark after (setq &end-mark-visible-f 1)))) ;now visible (ws-mark-start-of-block ;toss old one if any (if (& &end-mark ;have an end mark and... (>= (dot) ;...not before it? (+ &end-mark (if &end-mark-visible-f -3 0)))) ;(avoid visible mark) (error-message "Beginning-of-block marker must come before end marker.")) (&hide-start-mark) ;hide old start mark (if (!= (dot) &start-mark) ;is cursor not at old marker? (progn ;then create new one (setq &start-mark (dot)) ;remember new one (&unhide-start-mark))) ;show it (novalue)) (ws-mark-end-of-block ;toss old one if any (if (& &start-mark ;have a start mark and... (>= (+ &start-mark ;...not after it? (if &start-mark-visible-f 3 0)) ;(avoid visible mark) (dot))) ;...end mark is not after it? (error-message "End-of-block marker must come after beginning marker.")) (&hide-end-mark) ;hide old mark (if (!= (dot) &end-mark) ;is cursor not at old marker? (progn ;then create new one (setq &end-mark (dot)) ;remember new one (&unhide-end-mark))) ;show it (novalue)) ) ;finished a series of funtions (bind-to-key "ws-mark-start-of-block" "B") (bind-to-key "ws-mark-start-of-block" "b") (bind-to-key "ws-mark-start-of-block" "\^B") (bind-to-key "ws-mark-end-of-block" "K") (bind-to-key "ws-mark-end-of-block" "k") (bind-to-key "ws-mark-end-of-block" "\^K") (defun (&block-operation ;1st arg: neg=save, pos=delete, 0=both ;save visible stuff w/data, but hide in buffer (if (! &start-mark) (error-message "There is no beginning-of-block marker in this buffer.")) (if (! &end-mark) (error-message "There is no end-of-block marker in this buffer.")) (if (! (& &start-mark-visible-f &end-mark-visible-f)) (error-message "Both markers must be visible for that command.")) (&hide-start-mark) (&hide-end-mark) ;make sure visible stuff is OK (&unhide-start-mark) (&unhide-end-mark) ;want to save visible part (setq &last-start-mark &start-mark) ;remember old block (save-excursion (goto-character &start-mark) ;go to front of region (set-mark) ;and mark it (goto-character &end-mark) ;then to end (if (= (arg 1) 0) ;save and delete? (delete-to-killbuffer) ;then do it (> (arg 1) 0) ;just delete? (erase-region) ;then do it (progn ;else just save (delete-to-killbuffer) ;which means delete (yank-from-killbuffer) ;and yank back (&hide-start-mark) ;we will show the new... (&hide-end-mark))) ;...visible stuff instead (if (>= (arg 1) 0) ;did we delete? (setq &start-mark-visible-f (setq &end-mark-visible-f (setq &start-mark (setq &end-mark 0)))))) (novalue))) (defun (&insert-block ;insert killbuffer contents (setq &start-mark (dot)) ;remember new start (yank-from-killbuffer) ;insert the block (setq &end-mark (dot)) ;new end (goto-character &start-mark) ;probably what was expected (setq &start-mark-visible-f (setq &end-mark-visible-f 1)) (novalue))) (defun (ws-move-block-to-cursor (&block-operation 0) ;delete and save the block (&insert-block))) ;insert at cursor (bind-to-key "ws-move-block-to-cursor" "V") (bind-to-key "ws-move-block-to-cursor" "v") (bind-to-key "ws-move-block-to-cursor" "\^V") (defun (ws-copy-block-to-cursor (&block-operation -1) ;no delete, only save block (&insert-block))) ;insert block (bind-to-key "ws-copy-block-to-cursor" "C") (bind-to-key "ws-copy-block-to-cursor" "c") (bind-to-key "ws-copy-block-to-cursor" "\^C") (defun (ws-delete-block cursor (&block-operation 1))) ;delete block, toss data (bind-to-key "ws-delete-block" "Y") (bind-to-key "ws-delete-block" "y") (bind-to-key "ws-delete-block" "\^Y") (defun (ws-write-block-to-file (save-excursion ;cuz of temp-use-buffer (&block-operation -1) ;no delete, just save block (&unhide-start-mark) (&unhide-end-mark) ;keep marks visible (temp-use-buffer "wordstar-buffer") ;get work area (erase-buffer) ;clear it (&insert-block) ;get block (&hide-start-mark) (&hide-end-mark) ;so not write out visible part (&ws-write-file 1) ;query for file name (delete-buffer "wordstar-buffer")))) (bind-to-key "ws-write-block-to-file" "W") (bind-to-key "ws-write-block-to-file" "w") (bind-to-key "ws-write-block-to-file" "\^W") (defun (ws-hide-unhide-block (if (! (| &start-mark &end-mark)) (error-message "No markers to mess with!")) (save-excursion (if (| &start-mark-visible-f &end-mark-visible-f) (progn (&hide-start-mark) (&hide-end-mark) (message "Place markers hidden.")) (progn (&unhide-start-mark) (&unhide-end-mark) (message "Place markers visible.")))) (novalue))) (bind-to-key "ws-hide-unhide-block" "H") (bind-to-key "ws-hide-unhide-block" "h") (bind-to-key "ws-hide-unhide-block" "\^H") (defun (ws-insert-file name (if (ws-menu-mode) ;sw8: null environment? (ws-find-file) ;sw8: then normal read (progn ;sw8: else insert buffer (push-back-string (buffer-file-path)) ;help the user (insert-file (setq name (get-tty-file "ws-insert-file (use SPACE, ^Y): "))) (local-bind-to-key "ws-menu-exit" "\^X") ;make ^X work (novalue))))) (bind-to-key "ws-insert-file" "R") (bind-to-key "ws-insert-file" "r") (bind-to-key "ws-insert-file" "\^R") (defun (ws-find-file (ws-hide-windows) ;hide, cuz changing windows (push-back-string (buffer-file-path)) ;help out user (visit-file (get-tty-file "ws-find-file (use SPACE, ^Y): ")) (local-bind-to-key "ws-menu-exit" "\^X");make ^X work correctly (novalue))) (bind-to-key "ws-find-file" "F") (bind-to-key "ws-find-file" "f") (bind-to-key "ws-find-file" "\^F") (defun (ws-select-buffer (&hide-start-mark) (&hide-end-mark) ;cuz hiding whole buffer (switch-to-buffer (get-tty-buffer "ws-select-buffer (use SPACE, ?): ")) (local-bind-to-key "ws-menu-exit" "\^X");make ^X work correctly (novalue))) (bind-to-key "ws-select-buffer" "O") (bind-to-key "ws-select-buffer" "o") (bind-to-key "ws-select-buffer" "\^O") (use-global-map "default-global-keymap") (bind-to-key "fix-^X-prefix" "\^X\^X") ;sw4: in case hasn't been done (send-string-to-terminal "\^G") ;beep! (message &wordstar-message " loaded.")