main.lisp 4.68 KB
Newer Older
1
;;;; Generic code to interface a Lisp script to the shell command-line.
Robert Goldman's avatar
Robert Goldman committed
2 3 4 5 6 7
;;;; How does it work:
;;;; We get our command line from make.
;;;; the MAIN function first initializes the environment for the system,
;;;;  then processes the arguments
;;;; A key part of the argument processing is to decode the command name from
;;;;  make strings to CL function names.
8 9 10
(in-package :asdf-tools)

(defun re (arg)
11 12
  "Read-Eval function (the RE of REPL)
(the Print and Loop parts are not here)"
13 14
  (eval (read-from-string arg)))

15 16 17
(defun find-command (name &optional earlyp)
  "Given a string NAME, find the symbol for the function that implements the command, or else NIL.
Unless EARLYP is true, return NIL if the symbol is not fbound."
18 19 20
  (block nil
    (flet ((try (x)
             (multiple-value-bind (sym foundp)
21
                 (find-standard-case-symbol x :asdf-tools nil)
22
               (when (and sym (or earlyp (and foundp (fboundp sym))))
23
                 (return sym)))))
24 25
      (try (strcat "%" (string name))) ;; so that you may use load, t, etc., as targets
      (try name))))
26

27
(defun command-name (x &optional earlyp)
Robert Goldman's avatar
Robert Goldman committed
28 29
  "Given a command designator as per FIND-COMMAND, return the unix-y name for it, as a string.
The UNIX-y name will be downcased, and any % prefix will be dropped."
30
  (let ((c (find-command x earlyp)))
31 32 33 34 35 36 37 38 39 40 41 42
    (when c
      (let ((s (string-downcase c)))
        (if (eql (first-char s) #\%) (subseq s 1) s)))))

(defun short-function-description (x)
  "Short function description for x"
  (when (stringp x) (setf x (find-command x)))
  (if-let ((doc (and x (documentation x 'function))))
    (let* ((first-line (with-input (s doc) (read-line s)))
           (len (length first-line)))
      (if (>= len 50) (strcat (subseq first-line 0 49) "…") first-line))))

43
(defun public-commands ()
44 45
  ;;(loop :for x :being :the :external-symbols :of :asdf-tools
  ;; :when (and (eq x (find-command x)) (documentation x 'function)) :collect x)
46
  '(build-asdf build-asdf-tools doc website wc ;; build
47
    clean %push merge-master-into-release fix-local-git-tags fix-remote-git-tags ;; git
48
    ext-init ext-clear ext-reset ext-update ;; extension
49 50
    git-all-committed-p
    bump-version bump ;; version
51
    test-load-systems test-clean-load test-basic test-ascii %load install-asdf show-version ;; test-basic
52
    test %t test-scripts ;; test-scripts
53
    test-upgrade u extract-tagged-asdf extract-all-tagged-asdf extract ;; test-upgrade
54
    test-all-basic test-all-clean-load test-all-scripts test-all-no-upgrade test-all-upgrade ;; test-all
55
    test-all test-all-scripts-no-stop test-all-upgrade-no-stop
56 57
    test-all-no-upgrade-no-stop test-all-no-stop
    check-all-scripts-results check-all-upgrade-results check-all-results
58
    make-archive make-and-publish-archive publish-archive link-archive archive install ;; release
59
    debian-package publish-debian-package
60
    re help show-commands makefile-targets)) ;; main
61

62 63 64 65
(defun public-command-strings ()
  (sort (mapcar 'command-name (public-commands)) 'string<))

(defun show-commands ()
66
  "print the (sorted list of) names of all the public commands of asdf-tools."
67
  (format t "~{~A~^ ~}~%" (public-command-strings))
68
  (success))
69 70

(defun makefile-targets ()
71 72 73
  "print declaration for the public commands of asdf-tools as as many Makefile targets
so that, when included in the Makefile, they will enable shell completion
based on a list of targets"
74
  (let ((c (public-command-strings)))
75
    (format t ".PHONY: ~{~A~^ ~}~%~%~{~A~^ ~}: force
76
~C${MAKE_SCRIPT} l='$l' L='$L' u='$u' U='$u' v='$v' s='$s' t='$t' $@~%" c c #\tab))
77
  (success))
78 79

(defun help (&optional x)
80
  "help about a command, or list of commands"
81 82
  (cond
    ((null x)
83
     (loop :for x :in (public-command-strings)
84
           :do (format t "~(~27A~)~@[  ~A~]~%"
85
                       x (short-function-description x)))
86
     (success))
87 88 89 90 91 92
    (t
     (let ((x (find-command x)))
       (when x
         (format t "~A~@[ ~A~]~%~@[~A~]~&"
                 (command-name x)
                 (or ()) ;; TODO: remember the arguments to deftestcmd, translate to v=, etc
93
                 (documentation x 'function))
94
         (success))))))
95

96 97
;;; Main entry point.
;;; NB: For access control, you could check that only exported symbols are used as entry points.
98
(defun process-arguments (args)
99
  (if-let ((fun (and args (find-command (first args)))))
100
    (apply 'run-command fun (rest args))
101 102 103 104 105
    (progn
      (if args
        (format t "Command ~A not found~%" (first args))
        (format t "No command provided~%"))
      nil)))
106

107 108 109 110
;;; For a multi-call binary, use these cl-launch or buildapp arguments: --dispatch-entry asdf-tools/asdf-tools::main
(defun main (argv)
  (initialize-environment)
  (process-arguments argv))
111 112

(defun entry-point ()
113
  (main *command-line-arguments*))