Changeset 9004


Ignore:
Timestamp:
Apr 4, 2008, 5:59:25 AM (11 years ago)
Author:
gb
Message:

svn-version hacking.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lib/misc.lisp

    r8418 r9004  
    709709(%fhave 'df #'disassemble)
    710710
     711(defun svn-info-component (component)
     712  (let* ((component-length (length component)))
     713  (with-output-to-string (s)
     714    (multiple-value-bind (status exit-code)
     715        (external-process-status
     716         (run-program "svn"  (list "info" (native-translated-namestring "ccl:")):output s))
     717      (when (and (eq :exited status) (zerop exit-code))
     718        (with-input-from-string (output (get-output-stream-string s))
     719            (do* ((line (read-line output nil nil) (read-line output nil nil)))
     720                 ((null line))
     721              (when (and (>= (length line) component-length)
     722                         (string= component line :end2 component-length))
     723                (return-from svn-info-component
     724                  (string-trim " " (subseq line component-length)))))))))))
     725
     726(defun svn-url () (svn-info-component "URL:"))
     727(defun svn-repository () (svn-info-component "Repository Root:"))
     728
     729;;; Try to say something about what tree (trunk, a branch, a release)
     730;;; we were built from. If the URL (relative to the repository)
     731;;; starts with "branches", return the second component of the
     732;;; relative URL, otherwise return the first component.
     733(defun svn-tree ()
     734  (let* ((repo (svn-repository))
     735         (url (svn-url)))
     736    (or
     737     (if (and repo url)
     738       (let* ((repo-len (length repo)))
     739         (when (and (> (length url) repo-len)
     740                    (string= repo url :end2 repo-len))
     741           ;; Cheat: do pathname parsing here.
     742           (let* ((path (pathname (ensure-directory-namestring (subseq url repo-len))))
     743                  (dir (cdr (pathname-directory path))))
     744             (when (string= "ccl" (car (last dir)))
     745               (if (string= (car dir) "branches")
     746                 (cadr dir)
     747                 (car dir))))))))))
     748
     749
     750
     751       
     752                         
    711753(defun local-svn-revision ()
    712754  (or
     
    718760    (multiple-value-bind (status exit-code)
    719761        (external-process-status
    720          (run-program "svnversion"  (list  (native-translated-namestring "ccl:") "/trunk/ccl"):output s))
     762         (run-program "svnversion"  (list  (native-translated-namestring "ccl:") (or (svn-url) "")):output s))
    721763      (when (and (eq :exited status) (zerop exit-code))
    722764        (with-input-from-string (output (get-output-stream-string s))
Note: See TracChangeset for help on using the changeset viewer.