r7834: remove getopt from package

diff --git a/getopt.lisp b/getopt.lisp
deleted file mode 100644 (file)
index 96e5f6f..0000000
--- a/getopt.lisp
+++ /dev/null
@@ -1,119 +0,0 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          getopt.lisp
-;;;; Purpose:       Command line option processing a la GNU getopt_long
-;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Sep 2003
-;;;;
-;;;; $Id: package.lisp 7814 2003-09-10 12:56:02Z kevin $
-;;;;
-;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; KMRCL users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
-;;;; *************************************************************************
-
-(in-package #:kmrcl)
-
-
-(defun is-short-option (arg)
-  (and (>= (length arg) 2)
-       (char= #\- (schar arg 0))
-       (char/= #\- (schar arg 1))))
-
-(defun is-option-terminator (arg)
-  (and (= 2 (length arg))
-       (char= #\- (schar arg 0))
-       (char= #\- (schar arg 1))))
-
-(defun is-long-option (arg)
-  (and (> (length arg) 2)
-       (char= #\- (schar arg 0))
-       (char= #\- (schar arg 1))
-       (char/= #\- (schar arg 3))))
-
-(defun arg->base-name (arg option-type)
-  "returns base-name,argument"
-  (let ((start (ecase option-type
-                (:long 2)
-                (:short 1)))
-       (name-end (position #\= arg)))
-
-    (values (subseq arg start name-end)
-           (when name-end (subseq arg (1+ name-end))))))
-
-(defun analyze-arg (arg)
-  "Analyzes an argument. Returns option-type,base-name,argument"
-  (let* ((option-type (cond ((is-short-option arg) :short)
-                           ((is-long-option arg) :long)
-                           (t :arg))))
-    (if (or (eq option-type :short) (eq option-type :long))
-       (multiple-value-bind (base arg) (arg->base-name arg option-type)
-         (values option-type base arg))
-       (values :arg arg nil))))
-
-
-(defun find-option (name options)
-  "Find an option in option list. Handles using unique abbreviations"
-  (let* ((option-names (mapcar #'car options))
-        (pos (match-unique-abbreviation name option-names)))
-    (when pos
-      (nth pos options))))
-
-(defun match-option (arg options)
-  "Matches an argument to an option. Returns option-list,option-type,base-name,argument"
-  (multiple-value-bind (option-type base-name argument) (analyze-arg arg)
-    (let ((match (find-option base-name options)))
-      (values match option-type (when match (car match)) argument))))
-
-(defun getopt (args options)
-  "Processes a list of arguments and options. Returns filtered argument
-list and alist of options.
-opts is a list of option lists. The fields of the list are
- - NAME name of the long option
- - HAS-ARG with legal values of :NONE, :REQUIRED, :OPTIONAL
- - VAL value to return for a option with no arguments
-"
-  (do ((pos args (cdr pos))
-       (finished-options)
-       (out-opts)
-       (out-args)
-       (errors))
-      ((null pos) (values (nreverse out-args) (nreverse out-opts) errors))
-    (cond
-     (finished-options
-      (push (car pos) out-args))
-     ((is-option-terminator (car pos))
-      (setq finished-options t))
-     (t
-      (let ((arg (car pos)))
-       (multiple-value-bind (option-list option-type base-name argument)
-           (match-option (car pos) options)
-         (cond
-           (option-list
-            (cond
-              (argument
-               (case (second option-list)
-                 (:none
-                  (push base-name errors))
-                 (t
-                  (push (cons base-name argument) out-opts))))
-              ((null argument)
-               (if (and (eq :required (second option-list)) (null (cdr pos)))
-                   (push base-name errors)
-                   (if (or (is-short-option (second pos))
-                           (is-long-option (second pos)))
-                       (if (eq :required (second option-list))
-                           (push base-name errors)
-                           (push (cons base-name (third option-list)) out-args))
-                       (progn
-                         (push (cons base-name (second pos)) out-opts)
-                         (setq pos (cdr pos))))))))
-           (t
-            (if (in option-type :long :short)
-                (push (nth-value 0 (arg->base-name arg option-type)) errors)
-                (push arg out-args))))))))))
-

diff --git a/kmrcl.asd b/kmrcl.asd
index 96f862b67756081fbba0e229fa86c0b5e5622330..fa298022bf550da93778fbab489ef246df0b9bd2 100644 (file)
--- a/kmrcl.asd
+++ b/kmrcl.asd
@@ -58,7 +58,6 @@
      (:file "listener" :depends-on ("sockets" "processes" "console"))
      (:file "repl" :depends-on ("listener" "strings"))
      (:file "os" :depends-on ("macros"))
-     (:file "getopt" :depends-on ("macros"))
      ))
 
 (defmethod perform ((o test-op) (c (eql (find-system 'kmrcl))))

diff --git a/package.lisp b/package.lisp
index 4146122e8adf15343538b0725a3bf8ff1035e5bd..fb555be72e8ca721a8f7c50e06163928eaf905cb 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -67,7 +67,6 @@
    #:string-strip-ending
    #:string-maybe-shorten
    #:shrink-vector
-   #:match-unique-abbreviation
 
    ;; io.lisp
    #:indent-spaces
@@ -244,9 +243,6 @@
    ;; os.lisp
    #:run-shell-command
 
-   ;; getopt.lisp
-   #:getopt
-   
    ))
 
 

diff --git a/strings.lisp b/strings.lisp
index 1832ff2a5dfa58f94564ee87f7b59587527c7b6e..fd2f37ca071e8dc6a7f8f7b1a849cbf849d19738 100644 (file)
--- a/strings.lisp
+++ b/strings.lisp
@@ -602,20 +602,4 @@ for characters in a string"
         (push (subseq string token-start token-end) tokens)))))
 
 
-(defun match-unique-abbreviation (abbr strings)
-  "Returns position of ABBR in STRINGS. ABBR may be a unique abbreviation.
-Returns NIL if no match found."
-  (let ((len (length abbr))
-       (matches nil))
-    (dotimes (i (length strings))
-      (let* ((s (nth i strings))
-            (l (length s)))
-       (cond
-         ((= len l)
-          (when (string= abbr s)
-            (push (cons s i) matches)))
-         ((< len l)
-          (when (string= abbr (subseq s 0 len))
-            (push (cons s i) matches))))))
-    (when (= 1 (length matches))
-      (cdr (first matches)))))
+

diff --git a/tests.lisp b/tests.lisp
index 275b9ba0bff9680c4b9f1401e10f68ef36dca07d..fc950e47ddf2a17d3b1ef979d29061332de9ad8f 100644 (file)
--- a/tests.lisp
+++ b/tests.lisp
@@ -186,31 +186,6 @@
 (deftest sse.4 (string-strip-ending "abc" '("ab")) "abc")
 (deftest sse.5 (string-strip-ending "abcd" '("a" "cd")) "ab")
 
-(deftest mua.1 (match-unique-abbreviation "abc" nil) nil)
-(deftest mua.2 (match-unique-abbreviation "abc" '("ab")) nil)
-(deftest mua.3 (match-unique-abbreviation "ab" '("ab")) 0)
-(deftest mua.4 (match-unique-abbreviation "a" '("ab")) 0)
-(deftest mua.5 (match-unique-abbreviation "b" '("ab")) nil)
-(deftest mua.6 (match-unique-abbreviation "ab" '("ab" "abc")) nil)
-(deftest mua.7 (match-unique-abbreviation "ac" '("ab" "ac")) 1)
-(deftest mua.8 (match-unique-abbreviation "ac" '("ab" "acb")) 1)
-
-(deftest gopt.1 (getopt '("argv") nil) ("argv") nil nil)
-(deftest gopt.2 (getopt '("argv" "2") nil) ("argv" "2") nil nil)
-(deftest gopt.3 (getopt '("argv" "-c") '(("c" :none))) ("argv") (("c")) nil)
-(deftest gopt.4 (getopt '("argv" "-c" "val") '(("c" :optional))) ("argv") (("c" . "val")) nil)
-(deftest gopt.5 (getopt '("argv" "-c" "val" "v1") '(("c" :optional))) ("argv" "v1") (("c" . "val")) nil)
-(deftest gopt.6 (getopt '("--colon" "val" "v1") '(("colon" :optional))) ( "v1") (("colon" . "val")) nil)
-(deftest gopt.7 (getopt '("ab" "--colon" "val" "--" "-c") '(("colon" :optional) ("-c" :none))) ("ab" "-c") (("colon" . "val")) nil)
-(deftest gopt.8 (getopt '("argv" "-c" "cd") '(("c" :required))) ("argv") (("c" . "cd")) nil)
-(deftest gopt.9 (getopt '("argv" "-c") '(("c" :required))) ("argv") nil ("c"))
-(deftest gopt.10 (getopt '("argv" "-c=10") '(("c" :required))) ("argv") (("c" . "10")) nil)
-(deftest gopt.11 (getopt '("argv" "-c=10") '(("c" :none))) ("argv") nil ("c"))
-(deftest gopt.12 (getopt '("--along=10") '(("along" :optional))) nil (("along" . "10")) nil)
-(deftest gopt.13 (getopt '("--along=10") '(("along" :none))) nil nil ("along")) 
-(deftest gopt.14 (getopt '("--a=10") '(("along" :optional))) nil (("along" . "10")) nil) 
-(deftest gopt.15 (getopt '("--a=10") '(("along" :optional) ("aboot" :optional))) nil nil ("a"))
-        
   
 ;;; MOP Testing