main.lisp 4.57 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 46 47 48 49 50
  ;;(loop :for x :being :the :external-symbols :of :asdf-tools
  ;; :when (and (eq x (find-command x)) (documentation x 'function)) :collect x)
  '(build-asdf doc website wc ;; build
    clean %push merge-master-into-release fix-local-git-tags fix-remote-git-tags ;; git
    git-all-committed-p
    bump-version bump ;; version
    test-load-systems test-clean-load test-basic %load install-asdf ;; test-basic
51
    test %t test-scripts ;; test-scripts
52
    test-upgrade u extract-tagged-asdf extract-all-tagged-asdf extract ;; test-upgrade
53 54
    test-all-clean-load test-all-scripts test-all-no-upgrade test-all-upgrade ;; test-all
    test-all test-all-scripts-no-stop test-all-upgrade-no-stop
55 56
    test-all-no-upgrade-no-stop test-all-no-stop
    check-all-scripts-results check-all-upgrade-results check-all-results
57
    make-archive make-and-publish-archive publish-archive link-archive archive install ;; release
58
    debian-package publish-debian-package
59
    re help show-commands makefile-targets)) ;; main
60

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

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

(defun makefile-targets ()
70 71 72
  "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"
73
  (let ((c (public-command-strings)))
74
    (format t ".PHONY: ~{~A~^ ~}~%~%~{~A~^ ~}: force
Robert Goldman's avatar
Robert Goldman committed
75
        ./tools/asdf-tools env l='$l' L='$L' u='$u' U='$u' v='$v' s='$s' t='$t' $@~%" c c))
76
  (success))
77 78

(defun help (&optional x)
79
  "help about a command, or list of commands"
80 81
  (cond
    ((null x)
82
     (loop :for x :in (public-command-strings)
83
           :do (format t "~(~27A~)~@[  ~A~]~%"
84
                       x (short-function-description x)))
85
     (success))
86 87 88 89 90 91
    (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
92
                 (documentation x 'function))
93
         (success))))))
94

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

106 107 108 109
;;; 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))
110 111

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