bug-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Viper: Modularize ex commands


From: Scott Bronson
Subject: Viper: Modularize ex commands
Date: Wed, 28 Feb 2001 03:24:50 -0800
User-agent: Mutt/1.2.5i

Hello.  I submitted the following patch to the xemacs-patches list.
I would also like to submit it for inclusion into emacs proper.
Is there anyone there who I could talk to about this?  Thanks,

        - Scott


---------------------------------------------------------------------------
From: Scott Bronson <bronson@trestle.com>
Date: Tue, 27 Feb 2001 12:56:51 -0800
To: xemacs-patches@xemacs.org, kifer@cs.sunysb.edu
Subject: Viper: Modularize ex commands
Message-ID: <20010227125651.A32447@trestle.com>

This patch puts viper's ex commands into an alist, rather than
using acres of string= as before.  Previously, to add an ex
command, you needed to change viper-ex.el in 3+ places.  Now
any lisp code simply adds an entry to ex-token-alist at any time.

Other Benefits: 
        cleaner code: all ex commands are now located in ex-token-alist
        minor bug fix: fixed some completions.  For instance, :ab<tab> used
                to claim "no match", even though :ab<ret> would succeed.  Now
                ab<tab> completes as it should.
        less code: 40-60 line savings, depending on comments

This is my first elisp project, so please tell me if there's anything
at all that I should do differently.

        - Scott


Index: viper-ex.el
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs-packages/wp/viper/viper-ex.el,v
retrieving revision 1.10
diff -u -r1.10 viper-ex.el
--- viper-ex.el 2001/02/12 08:31:34     1.10
+++ viper-ex.el 2001/02/27 19:14:53
@@ -66,20 +66,138 @@
 (defconst viper-ex-tmp-buf-name " *ex-tmp*")
 
 
-;;; Variable completion in :set command
-  
-;; The list of Ex commands.  Used for completing command names.
-(defconst ex-token-alist
-  '(("!") ("=") (">") ("&") ("~")
-    ("yank") ("xit") ("WWrite") ("Write") ("write") ("wq") ("visual") 
-    ("version") ("vglobal") ("unmap") ("undo") ("tag") ("transfer") ("suspend")
-    ("substitute") ("submitReport") ("stop")  ("sr") ("source") ("shell")
-    ("set") ("rewind") ("recover") ("read") ("quit") ("pwd")
-    ("put") ("preserve") ("PreviousRelatedFile") ("RelatedFile")
-    ("next") ("Next") ("move") ("mark") ("map") ("kmark") ("join")
-    ("help") ("goto") ("global") ("file") ("edit") ("delete") ("customize")
-    ("copy") ("chdir") ("cd") ("Buffer") ("buffer") ("args"))  )
+;;; ex-commands...
+
+(defun ex-cmd-obsolete (name)
+  (error "`%s': Obsolete command, not supported by Viper" name))
+
+(defun ex-cmd-not-yet (name)
+  (error "`%s': Command not implemented in Viper" name))
+
+;; alist entries: name (in any order), command, cont(??)
+;; If command is a string, then that is an alias to the real command
+;; to execute (for instance, ":m" -> ":move").
+;; command attributes:
+;;   is-mashed: the command's args may be jammed right up against the command
+;;   one-letter: this is a one-letter token.  Any text appearing after
+;;                  the name gets appended as an argument for the command
+;;               i.e. ":kabc" gets turned into (ex-mark "abc")
+(defconst ex-token-alist '(
+       ("!"                    (ex-command))
+       ("&"                    (ex-substitute t))
+       ("="                    (ex-line-no))
+       (">"                    (ex-line "right"))
+       ("<"                    (ex-line "left"))
+       ("Buffer"               (if ex-cycle-other-window
+                            (viper-switch-to-buffer)
+                                                
(viper-switch-to-buffer-other-window)))
+       ("Next"                 (ex-next (not ex-cycle-other-window)))
+       ("PreviousRelatedFile" (ex-next-related-buffer -1))
+       ("RelatedFile"  (ex-next-related-buffer 1))
+       ("W"                    "Write")
+       ("WWrite"               (save-some-buffers t))
+       ("Write"                (save-some-buffers))
+       ("a"                    "append")
+       ("args"                 (ex-args))
+       ("buffer"               (if ex-cycle-other-window
+                                               
(viper-switch-to-buffer-other-window)
+                                               (viper-switch-to-buffer)))
+       ("c"                    "change")
+       ("ch"                   "chdir") ; should be "change" but we'll 
maintain old viper compatibility
+       ("cd"                   (ex-cd))
+       ("chdir"                (ex-cd))
+       ("copy"                 (ex-copy nil))
+       ("customize"    (customize-group "viper"))
+       ("delete"               (ex-delete))
+       ("edit"                 (ex-edit))
+       ("file"                 (viper-info-on-file))
+       ("g"                    "global")
+       ("global"               (ex-global nil) is-mashed)
+       ("goto"                 (ex-goto))
+       ("help"                 (ex-help))
+       ("join"                 (ex-line "join"))
+       ("k"                    (ex-mark) one-letter)
+       ("kmark"                (ex-mark))
+       ("m"                    "move")
+       ; old viper doesn't specify a default for "ma" so leave it undefined
+       ("map"                  (ex-map))
+       ("mark"                 (ex-mark))
+       ("move"                 (ex-copy t))
+       ("next"                 (ex-next ex-cycle-other-window))
+       ("p"                    "print")
+       ("preserve"             (ex-preserve))
+       ("put"                  (ex-put))
+       ("pwd"                  (ex-pwd))
+       ("quit"                 (ex-quit))
+       ("r"                    "read")
+       ("re"                   "read")
+       ("read"                 (ex-read))
+       ("recover"              (ex-recover))
+       ("rewind"               (ex-rewind))
+       ("s"                    "substitute")
+       ("su"                   "substitute")
+       ("sub"                  "substitute")
+       ("set"                  (ex-set))
+       ("shell"                (ex-shell))
+       ("source"               (ex-source))
+       ("stop"                 (suspend-emacs)) 
+       ("sr"                   (ex-substitute t t))
+       ("submitReport" (viper-submit-report))
+       ("substitute"   (ex-substitute) is-mashed)
+       ("suspend"              (suspend-emacs))
+       ("t"                    "transfer")
+       ("tag"                  (ex-tag))
+       ("transfer"             (ex-copy nil))
+       ("u"                    "undo")
+       ("un"                   "undo")
+       ("undo"                 (viper-undo))
+       ("unmap"                (ex-unmap))
+       ("v"                    "vglobal")
+       ("version"              (viper-version))
+       ("vglobal"              (ex-global t) is-mashed)
+       ("visual"               (ex-edit)) 
+       ("w"                    "write")
+       ("wq"                   (ex-write t))
+       ("write"                (ex-write nil))
+       ("xit"                  (ex-write t))
+       ("yank"                 (ex-yank))
+       ("~"                    (ex-substitute t t))
+
+       ("append"               (ex-cmd-obsolete "append"))
+       ("change"               (ex-cmd-obsolete "change"))
+       ("insert"               (ex-cmd-obsolete "insert"))
+       ("open"                 (ex-cmd-obsolete "open"))
+
+       ("list"                 (ex-cmd-not-yet "list"))
+       ("print"                (ex-cmd-not-yet "print"))
+       ("z"                    (ex-cmd-not-yet "z"))
+       ("#"                    (ex-cmd-not-yet "#"))
+
+       ("abbreviate"   (error "`%s': Vi abbreviations are obsolete.  Use the 
more powerful Emacs abbrevs" ex-token))
+       ("unabbreviate" (error "`%s': Vi abbreviations are obsolete.  Use the 
more powerful Emacs abbrevs" ex-token))
+  ))
+
+;; No code should touch anything in the alist entry!  (other than the name,
+;; "car entry", of course)   This way, changing this data structure
+;; requires changing only the following ex-cmd functions...
+
+;; Returns cmd if the command may be jammed right up against its
+;; arguments, nil if there must be a space.
+;; examples of mashable commands: g// g!// v// s// sno// sm//
+(defun ex-cmd-is-mashed-with-args (cmd)
+       (if (eq 'is-mashed (car (nthcdr 2 cmd))) cmd))
+
+;; Returns true if this is a one-letter command that may be followed
+;; by anything, no whitespace needed.  This is a special-case for ":k".
+(defun ex-cmd-is-one-letter (cmd)
+       (if (eq 'one-letter (car (nthcdr 2 cmd))) cmd))
+
+;; Executes the function associated with the command
+(defun ex-cmd-execute (cmd)
+       (eval (cadr cmd)))
+
 
+
 ;; A-list of Ex variables that can be set using the :set command.
 (defconst ex-variable-alist 
   '(("wrapscan") ("ws") ("wrapmargin") ("wm")
@@ -233,105 +351,16 @@
 (defvar viper-last-ex-prompt "")
 
 
-;;; Code
-  
-;; Check if ex-token is an initial segment of STR
-(defun viper-check-sub (str)
-  (let ((length (length ex-token)))
-    (if (and (<= length (length str))
-            (string= ex-token (substring str 0 length)))
-       (setq ex-token str)
-      (setq ex-token-type 'non-command))))
-
 ;; Get a complete ex command
 (defun viper-get-ex-com-subr ()
-  (let (case-fold-search)
+  (let (cmd case-fold-search)
     (set-mark (point))
     (re-search-forward "[a-zA-Z][a-zA-Z]*")
     (setq ex-token-type 'command)
     (setq ex-token (buffer-substring (point) (mark t)))
-    (exchange-point-and-mark)
-    (cond ((looking-at "a")
-          (cond ((looking-at "ab") (viper-check-sub "abbreviate"))
-                ((looking-at "ar") (viper-check-sub "args"))
-                (t (viper-check-sub "append"))))
-         ((looking-at "h") (viper-check-sub "help"))
-         ((looking-at "c")
-          (cond ((looking-at "cd") (viper-check-sub "cd"))
-                ((looking-at "ch") (viper-check-sub "chdir"))
-                ((looking-at "co") (viper-check-sub "copy"))
-                ((looking-at "cu") (viper-check-sub "customize"))
-                (t (viper-check-sub "change"))))
-         ((looking-at "d") (viper-check-sub "delete"))
-         ((looking-at "b") (viper-check-sub "buffer"))
-         ((looking-at "B") (viper-check-sub "Buffer"))
-         ((looking-at "e")
-          (if (looking-at "ex") (viper-check-sub "ex")
-            (viper-check-sub "edit")))
-         ((looking-at "f") (viper-check-sub "file"))
-         ((looking-at "g") (viper-check-sub "global"))
-         ((looking-at "i") (viper-check-sub "insert"))
-         ((looking-at "j") (viper-check-sub "join"))
-         ((looking-at "l") (viper-check-sub "list"))
-         ((looking-at "m")
-          (cond ((looking-at "map") (viper-check-sub "map"))
-                ((looking-at "mar") (viper-check-sub "mark"))
-                (t (viper-check-sub "move"))))
-         ((looking-at "k[a-z][^a-z]")
-          (setq ex-token "kmark")
-          (forward-char 1)
-          (exchange-point-and-mark))   ; this is canceled out by another
-                                       ; exchange-point-and-mark at the end
-         ((looking-at "k") (viper-check-sub "kmark"))
-         ((looking-at "n") (if (looking-at "nu")
-                               (viper-check-sub "number")
-                             (viper-check-sub "next")))
-         ((looking-at "N") (viper-check-sub "Next"))
-         ((looking-at "o") (viper-check-sub "open"))
-         ((looking-at "p")
-          (cond ((looking-at "pre") (viper-check-sub "preserve"))
-                ((looking-at "pu") (viper-check-sub "put"))
-                ((looking-at "pw") (viper-check-sub "pwd"))
-                (t (viper-check-sub "print"))))
-         ((looking-at "P") (viper-check-sub "PreviousRelatedFile"))
-         ((looking-at "R") (viper-check-sub "RelatedFile"))
-         ((looking-at "q") (viper-check-sub "quit"))
-         ((looking-at "r")
-          (cond ((looking-at "rec") (viper-check-sub "recover"))
-                ((looking-at "rew") (viper-check-sub "rewind"))
-                (t (viper-check-sub "read"))))
-         ((looking-at "s")
-          (cond ((looking-at "se") (viper-check-sub "set"))
-                ((looking-at "sh") (viper-check-sub "shell"))
-                ((looking-at "so") (viper-check-sub "source"))
-                ((looking-at "sr") (viper-check-sub "sr"))
-                ((looking-at "st") (viper-check-sub "stop"))
-                ((looking-at "sus") (viper-check-sub "suspend"))
-                ((looking-at "subm") (viper-check-sub "submitReport"))
-                (t (viper-check-sub "substitute"))))
-         ((looking-at "t")
-          (if (looking-at "ta") (viper-check-sub "tag")
-            (viper-check-sub "transfer")))
-         ((looking-at "u")
-          (cond ((looking-at "una") (viper-check-sub "unabbreviate"))
-                ((looking-at "unm") (viper-check-sub "unmap"))
-                (t (viper-check-sub "undo"))))
-         ((looking-at "v")
-          (cond ((looking-at "ve") (viper-check-sub "version"))
-                ((looking-at "vi") (viper-check-sub "visual"))
-                (t (viper-check-sub "vglobal"))))
-         ((looking-at "w")
-          (if (looking-at "wq") (viper-check-sub "wq")
-            (viper-check-sub "write")))
-         ((looking-at "W")
-          (if (looking-at "WW") 
-              (viper-check-sub "WWrite")
-            (viper-check-sub "Write")))
-         ((looking-at "x") (viper-check-sub "xit"))
-         ((looking-at "y") (viper-check-sub "yank"))
-         ((looking-at "z") (viper-check-sub "z")))
-    (exchange-point-and-mark)
-    ))
+       (setq cmd (viper-cmd-assoc ex-token ex-token-alist))
+       (if cmd (setq ex-token (car cmd)) (setq ex-token-type 'non-command))
+       ))
 
 ;; Get an ex-token which is either an address or a command.
 ;; A token has a type, \(command, address, end-mark\), and a value
@@ -597,14 +626,13 @@
       (viper-get-ex-token)
       (cond ((memq ex-token-type '(command end-mark))
             (if address (setq ex-addresses (cons address ex-addresses)))
-            (cond ((string= ex-token "global")
-                   (ex-global nil)
-                   (setq cont nil))
-                  ((string= ex-token "vglobal")
-                   (ex-global t)
-                   (setq cont nil))
-                  (t
-                   (viper-execute-ex-command)
+                (viper-deactivate-mark)
+                (let ((cmd (viper-cmd-assoc ex-token ex-token-alist)))
+                       (if (null cmd) (error "`%s': %s" ex-token 
viper-BadExCommand))
+                       (ex-cmd-execute cmd)
+                       (if (or (ex-cmd-is-mashed-with-args cmd)
+                                       (ex-cmd-is-one-letter cmd))
+                               (setq cont nil)
                    (save-excursion
                      (save-window-excursion
                        (setq viper-ex-work-buf
@@ -701,22 +729,6 @@
        (setq ex-token nil))
       c)))
 
-;; get an ex command
-(defun viper-get-ex-command ()
-  (save-window-excursion
-    (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name)) 
-    (set-buffer viper-ex-work-buf)
-    (if (looking-at "/") (forward-char 1))
-    (skip-chars-forward " \t")
-    (cond ((looking-at "[a-z]")
-          (viper-get-ex-com-subr)
-          (if (eq ex-token-type 'non-command)
-              (error "`%s': %s" ex-token viper-BadExCommand)))
-         ((looking-at "[!=><&~]")
-          (setq ex-token (char-to-string (following-char)))
-          (forward-char 1))
-         (t (error viper-BadExCommand)))))
-
 ;; Get an Ex option g or c
 (defun viper-get-ex-opt-gc (c)
   (save-window-excursion
@@ -1067,83 +1079,6 @@
                      (concat viper-last-ex-prompt " !")))))
     (substring str (or beg 0) end)))
 
-;; Execute ex command using the value of addresses
-(defun viper-execute-ex-command ()
-  (viper-deactivate-mark)
-  (cond ((string= ex-token "args") (ex-args))
-       ((string= ex-token "copy") (ex-copy nil))
-       ((string= ex-token "cd") (ex-cd))
-       ((string= ex-token "customize") (customize-group "viper"))
-       ((string= ex-token "chdir") (ex-cd))
-       ((string= ex-token "delete") (ex-delete))
-       ((string= ex-token "edit") (ex-edit))
-       ((string= ex-token "file") (viper-info-on-file))
-       ((string= ex-token "goto") (ex-goto))
-       ((string= ex-token "help") (ex-help))
-       ((string= ex-token "join") (ex-line "join"))
-       ((string= ex-token "kmark") (ex-mark))
-       ((string= ex-token "mark") (ex-mark))
-       ((string= ex-token "map") (ex-map))
-       ((string= ex-token "move") (ex-copy t))
-       ((string= ex-token "next") (ex-next ex-cycle-other-window))
-       ((string= ex-token "Next") (ex-next (not ex-cycle-other-window)))
-       ((string= ex-token "RelatedFile") (ex-next-related-buffer 1))
-       ((string= ex-token "put") (ex-put))
-       ((string= ex-token "pwd") (ex-pwd))
-       ((string= ex-token "preserve") (ex-preserve))
-       ((string= ex-token "PreviousRelatedFile") (ex-next-related-buffer -1))
-       ((string= ex-token "quit") (ex-quit))
-       ((string= ex-token "read") (ex-read))
-       ((string= ex-token "recover") (ex-recover))
-       ((string= ex-token "rewind") (ex-rewind))
-       ((string= ex-token "submitReport") (viper-submit-report))
-       ((string= ex-token "set") (ex-set))
-       ((string= ex-token "shell") (ex-shell))
-       ((string= ex-token "source") (ex-source))
-       ((string= ex-token "sr") (ex-substitute t t))
-       ((string= ex-token "substitute") (ex-substitute))
-       ((string= ex-token "suspend") (suspend-emacs))
-       ((string= ex-token "stop") (suspend-emacs))
-       ((string= ex-token "transfer") (ex-copy nil))
-       ((string= ex-token "buffer") (if ex-cycle-other-window
-                                        (viper-switch-to-buffer-other-window)
-                                      (viper-switch-to-buffer)))
-       ((string= ex-token "Buffer") (if ex-cycle-other-window
-                                        (viper-switch-to-buffer)
-                                      (viper-switch-to-buffer-other-window)))
-       ((string= ex-token "tag") (ex-tag))
-       ((string= ex-token "undo") (viper-undo))
-       ((string= ex-token "unmap") (ex-unmap))
-       ((string= ex-token "version") (viper-version))
-       ((string= ex-token "visual") (ex-edit))
-       ((string= ex-token "write") (ex-write nil))
-       ((string= ex-token "Write") (save-some-buffers))
-       ((string= ex-token "wq") (ex-write t))
-       ((string= ex-token "WWrite") (save-some-buffers t)) ; don't ask
-       ((string= ex-token "xit") (ex-write t))
-       ((string= ex-token "yank") (ex-yank))
-       ((string= ex-token "!") (ex-command))
-       ((string= ex-token "=") (ex-line-no))
-       ((string= ex-token ">") (ex-line "right"))
-       ((string= ex-token "<") (ex-line "left"))
-       ((string= ex-token "&") (ex-substitute t))
-       ((string= ex-token "~") (ex-substitute t t))
-       ((or (string= ex-token "append")
-            (string= ex-token "change")
-            (string= ex-token "insert")
-            (string= ex-token "open"))
-        (error "`%s': Obsolete command, not supported by Viper" ex-token))
-       ((or (string= ex-token "abbreviate")
-            (string= ex-token "unabbreviate"))
-        (error
-         "`%s': Vi abbrevs are obsolete.  Use the more powerful Emacs abbrevs"
-         ex-token))
-       ((or (string= ex-token "list")
-            (string= ex-token "print")
-            (string= ex-token "z")
-            (string= ex-token "#"))
-        (error "`%s': Command not implemented in Viper" ex-token))
-       (t (error "`%s': %s" ex-token viper-BadExCommand))))
 
 (defun viper-undisplayed-files ()
   (mapcar
@@ -1457,11 +1392,16 @@
 
 
 ;; Ex mark command
-(defun ex-mark ()
+(defun ex-mark (&optional name)
+       "Sets the mark to the current point.
+       If name is omitted, get the name straight from the work buffer."
   (let (char)
     (if (null ex-addresses)
        (setq ex-addresses
              (cons (point) nil)))
+       (if name (if (eq 1 (length name)) (setq char (string-to-char name))
+               (error "`%s': Spurious text \"%s\" after mark name."
+                       name (substring name 1) viper-SpuriousText))
     (save-window-excursion
       (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name)) 
       (set-buffer viper-ex-work-buf)
@@ -1473,7 +1413,7 @@
            (skip-chars-forward " \t")
            (if (not (looking-at "[\n|]"))
                (error "`%s': %s" ex-token viper-SpuriousText)))
-       (error "`%s' requires a following letter" ex-token)))
+       (error "`%s' requires a following letter" ex-token))))
     (save-excursion
       (goto-char (car ex-addresses))
       (point-to-register (1+ (- char ?a))))))
Index: viper-util.el
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs-packages/wp/viper/viper-util.el,v
retrieving revision 1.12
diff -u -r1.12 viper-util.el
--- viper-util.el       2000/11/24 08:19:56     1.12
+++ viper-util.el       2001/02/27 19:14:55
@@ -344,6 +344,33 @@
     
     (nconc lis1 lis2)))
 
+; If this is a one-letter magic command, splice in args.
+(defun viper-cmd-one-letter (key list)
+       (let ((onelet (ex-cmd-is-one-letter (assoc (substring key 0 1) list))))
+               (if onelet (list key
+                       (append (cadr onelet) (if (< 1 (length key)) (list 
(substring key 1))))
+                       (caddr onelet)))
+       ))
+
+;; Returns the alist entry for the appropriate key.
+;; If there is no appropriate key (no match or dupe matches) return nil
+(defun viper-cmd-assoc (key list)
+"Return the appropriate entry from list, possibly modified to match key.
+Return nil if key doesn't match any entry."
+  (let (result onelet (entry (try-completion key list)))
+    (setq result (cond
+               ((eq entry t)     (assoc key list))
+        ((stringp entry)  (or (viper-cmd-one-letter key list) (assoc entry 
list)))
+               ((eq entry nil)   (viper-cmd-one-letter key list))
+        (t nil)
+      ))
+    ; If we end up with an alias, look up the alias...
+    (if (stringp (cadr result))
+       (setq result (viper-cmd-assoc (cadr result) list)))
+       ; and return the corresponding alist entry
+    result
+  ))
+
 
 ;;; Support for :e, :r, :w file globbing
 
Index: viper.el
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs-packages/wp/viper/viper.el,v
retrieving revision 1.16
diff -u -r1.16 viper.el
--- viper.el    2001/02/12 08:31:34     1.16
+++ viper.el    2001/02/27 19:14:55
@@ -8,7 +8,7 @@
 
 ;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000 Free Software Foundation, Inc.
 
-(defconst viper-version "3.09 of January 19, 2001"
+(defconst viper-version "3.09+ of 26 Feb 2001"
   "The current version of Viper")
 
 ;; This file is part of GNU Emacs.




reply via email to

[Prev in Thread] Current Thread [Next in Thread]