cgit.sxemacs.org Git - packages/blob - xemacs-packages/cedet-common/inversion.el

   1 ;;; inversion.el --- When you need something in version XX.XX
   2
   3 ;;; Copyright (C) 2002, 2003, 2005, 2006, 2007 Eric M. Ludlam
   4
   5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   6 ;; X-RCS: $Id: inversion.el,v 1.1 2007-11-26 15:06:41 michaels Exp $
   7
   8 ;;; Code:
   9 (defvar inversion-version "1.3"
  10   "Current version of InVersion.")
  11 (defvar inversion-incompatible-version "0.1alpha1"
  12   "An earlier release which is incompatible with this release.")
  13
  14 ;; InVersion is free software; you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation; either version 2, or (at your option)
  17 ;; any later version.
  18
  19 ;; This software is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  26 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  27 ;; Boston, MA 02110-1301, USA.
  28
  29 ;;; Commentary:
  30 ;;
  31 ;; Keeping track of rapidly developing software is a tough thing to
  32 ;; do, especially if you want to have co-dependent packages which all
  33 ;; move at different rates.
  34 ;;
  35 ;; This library provides a framework for specifying version numbers
  36 ;; and (as side effect) have a flexible way of getting a desired feature set.
  37 ;;
  38 ;; If you would like to use this package to satisfy dependency replace this:
  39 ;;
  40 ;; (require 'spiffy)
  41 ;;
  42 ;; with this:
  43 ;;
  44 ;; (require 'inversion)
  45 ;; (inversion-require 'spiffy "1.0")
  46 ;;
  47 ;; If you feel the need to not throw errors, you can do this instead:
  48 ;;
  49 ;; (let ((err (inversion-test 'spiffy "1.0")))
  50 ;;    (if err (your-stuff-here)))
  51 ;;
  52 ;; If you new package (2.0) needs to make sure a load file from your
  53 ;; package is compatible, use this test:
  54 ;;
  55 ;; (if (not (inversion-reverse-test 'spiffy version-from-file))
  56 ;;       ;; Everything ok
  57 ;;       (do stuff)
  58 ;;    ;; Out of date
  59 ;;    (import-old-code))
  60 ;;
  61 ;; If you would like to make inversion optional, do this:
  62 ;;
  63 ;; (or (require 'inversion nil t)
  64 ;;     (defun inversion-test (p v)
  65 ;;       (string= v (symbol-value
  66 ;;                (intern-soft (concat (symbol-string p) "-version"))))))
  67 ;;
  68 ;; Or modify to specify `inversion-require' instead.
  69 ;;
  70 ;; TODO:
  71 ;;  Offer to download newer versions of a package.
  72
  73 ;;; History:
  74 ;;
  75 ;; Sept 3, 2002:  First general publication.
  76
  77 (defconst inversion-decoders
  78   '(
  79     (alpha  "^\\([0-9]+\\)\\.\\([0-9]+\\)\\s-*alpha\\([0-9]+\\)?$" 3)
  80     (beta   "^\\([0-9]+\\)\\.\\([0-9]+\\)\\s-*beta\\([0-9]+\\)?$" 3)
  81     (prerelease "^\\([0-9]+\\)\\.\\([0-9]+\\)\\s-*pre\\([0-9]+\\)?$" 3)
  82     (full   "^\\([0-9]+\\)\\.\\([0-9]+\\)$" 2)
  83     (point  "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)$" 3)
  84     )
  85   "List of decoders for version strings.
  86 Each decoder is of the form:
  87
  88   ( RELEASE-TYPE REGEXP MAX )
  89
  90 RELEASE-TYPE is a symbol specifying something like `beta' or `alpha'.
  91 REGEXP is the regular expression to match a version string.
  92 MAX is the maximum number of match-numbers in the release number.
  93 Decoders must be ordered to decode least stable versions before the
  94 more stable ones.")
  95
  96 ;;; Version Checking
  97 ;;
  98 (defun inversion-decode-version (version-string)
  99   "Decode VERSION-STRING into an encoded list.
 100 Return value is of the form:
 101   (RELEASE MAJOR MINOR ...)
 102 where RELEASE is a symbol such as `full', or `beta'."
 103   (let ((decoders inversion-decoders)
 104         (result nil))
 105     (while (and decoders (not result))
 106       (if (string-match (nth 1 (car decoders)) version-string)
 107           (let ((ver nil)
 108                 (num-left (nth 2 (car decoders)))
 109                 (count 1))
 110             (while (<= count num-left)
 111               (setq ver (cons
 112                          (if (match-beginning count)
 113                              (string-to-number
 114                               (substring version-string
 115                                          (match-beginning count)
 116                                          (match-end count)))
 117                            1)
 118                          ver)
 119                     count (1+ count)))
 120             (setq result (cons (caar decoders) (nreverse ver))))
 121         (setq decoders (cdr decoders))))
 122     result))
 123
 124 (defun inversion-package-version (package)
 125   "Return the decoded version for PACKAGE."
 126   (let ((ver (symbol-value
 127               (intern-soft
 128                (concat (symbol-name package)
 129                        "-version"))))
 130         (code nil))
 131     (unless ver
 132       (error "Package %S does not define %S-version" package package))
 133     ;; Decode the code
 134     (setq code (inversion-decode-version ver))
 135     (unless code
 136       (error "%S-version value cannot be decoded" package))
 137     code))
 138
 139 (defun inversion-package-incompatibility-version (package)
 140   "Return the decoded incompatibility version for PACKAGE.
 141 The incompatibility version is specified by the programmer of
 142 a package when a package is not backward compatible.  It is
 143 not an indication of new features or bug fixes."
 144   (let ((ver (symbol-value
 145               (intern-soft
 146                (concat (symbol-name package)
 147                        "-incompatible-version")))))
 148     (if (not ver)
 149         nil
 150       ;; Decode the code
 151       (inversion-decode-version ver))))
 152
 153 (defun inversion-recode (code)
 154   "Convert CODE into a string."
 155   (let ((r (nth 0 code))                ; release-type
 156         (n (nth 1 code))                ; main number
 157         (i (nth 2 code))                ; first increment
 158         (p (nth 3 code)))               ; second increment
 159     (cond
 160      ((eq r 'full)
 161       (setq r "" p ""))
 162      ((eq r 'point)
 163       (setq r ".")))
 164     (format "%s.%s%s%s" n i r p)))
 165
 166 (defun inversion-release-to-number (release-symbol)
 167   "Convert RELEASE-SYMBOL into a number."
 168   (let* ((ra (assoc release-symbol inversion-decoders))
 169          (rn (- (length inversion-decoders)
 170                 (length (member ra inversion-decoders)))))
 171     rn))
 172
 173 (defun inversion-= (ver1 ver2)
 174   "Return non-nil if VER1 is equal to VER2."
 175   (equal ver1 ver2))
 176
 177 (defun inversion-< (ver1 ver2)
 178   "Return non-nil if VER1 is less than VER2."
 179   (let ((v1-0 (inversion-release-to-number (nth 0 ver1)))
 180         (v1-1 (nth 1 ver1))
 181         (v1-2 (nth 2 ver1))
 182         (v1-3 (nth 3 ver1))
 183         ;; v2
 184         (v2-0 (inversion-release-to-number (nth 0 ver2)))
 185         (v2-1 (nth 1 ver2))
 186         (v2-2 (nth 2 ver2))
 187         (v2-3 (nth 3 ver2)))
 188     (or (and (= v1-0 v2-0)
 189              (= v1-1 v2-1)
 190              (= v1-2 v2-2)
 191              v1-3 v2-3          ; all or nothin if elt - is =
 192              (< v1-3 v2-3))
 193         (and (= v1-1 v2-1)
 194              (< v1-2 v2-2))
 195         (and (< v1-1 v2-1))
 196         (and (< v1-0 v2-0)
 197              (= v1-1 v2-1)
 198              (= v1-2 v2-2)
 199              )
 200         )))
 201
 202 (defun inversion-check-version (version incompatible-version
 203                                         minimum &rest reserved)
 204   "Check that a given version meets the minimum requirement.
 205 VERSION, INCOMPATIBLE-VERSION and MINIMUM are of similar format to
 206 return entries of `inversion-decode-version', or a classic version
 207 string.  INCOMPATIBLE-VERSION can be nil.
 208 RESERVED arguments are kept for a later use.
 209 Return:
 210 - nil if everything is ok
 211 - 'outdated if VERSION is less than MINIMUM.
 212 - 'incompatible if VERSION is not backward compatible with MINIMUM.
 213 - t if the check failed."
 214   (let ((code (if (stringp version)
 215                   (inversion-decode-version version)
 216                 version))
 217         (req (if (stringp minimum)
 218                  (inversion-decode-version minimum)
 219                minimum))
 220         (count 0)
 221         )
 222     ;; Perform a test.
 223     (cond
 224      ((inversion-= code req)
 225       ;; Same version.. Yay!
 226       nil)
 227      ((inversion-< code req)
 228       ;; Version is too old!
 229       'outdated)
 230      ((inversion-< req code)
 231       ;; Newer is installed.  What to do?
 232       (let ((incompatible
 233              (if (stringp incompatible-version)
 234                  (inversion-decode-version incompatible-version)
 235                incompatible-version)))
 236         (cond
 237          ((not incompatible) nil)
 238          ((or (inversion-= req incompatible)
 239               (inversion-< req incompatible))
 240           ;; The requested version is = or < than what the package
 241           ;; maintainer says is incompatible.
 242           'incompatible)
 243          ;; Things are ok.
 244          (t nil))))
 245      ;; Check failed
 246      (t t))))
 247
 248 (defun inversion-test (package minimum &rest reserved)
 249   "Test that PACKAGE meets the MINIMUM version requirement.
 250 PACKAGE is a symbol, similar to what is passed to `require'.
 251 MINIMUM is of similar format to return entries of
 252 `inversion-decode-version', or a classic version string.
 253 RESERVED arguments are kept for a later user.
 254 This depends on the symbols `PACKAGE-version' and optionally
 255 `PACKAGE-incompatible-version' being defined in PACKAGE.
 256 Return nil if everything is ok.  Return an error string otherwise."
 257   (let ((check (inversion-check-version
 258                 (inversion-package-version package)
 259                 (inversion-package-incompatibility-version package)
 260                 minimum reserved)))
 261     (cond
 262      ((null check)
 263       ;; Same version.. Yay!
 264       nil)
 265      ((eq check 'outdated)
 266       ;; Version is too old!
 267       (format "You need to upgrade package %s to %s" package minimum))
 268      ((eq check 'incompatible)
 269       ;; Newer is installed but the requested version is = or < than
 270       ;; what the package maintainer says is incompatible, then throw
 271       ;; that error.
 272       (format "Package %s version is not backward compatible with %s"
 273               package minimum))
 274      ;; Check failed
 275      (t "Inversion version check failed."))))
 276
 277 (defun inversion-reverse-test (package oldversion &rest reserved)
 278   "Test that PACKAGE at OLDVERSION is still compatible.
 279 If something like a save file is loaded at OLDVERSION, this
 280 test will identify if OLDVERSION is compatible with the current version
 281 of PACKAGE.
 282 PACKAGE is a symbol, similar to what is passed to `require'.
 283 OLDVERSION is of similar format to return entries of
 284 `inversion-decode-version', or a classic version string.
 285 RESERVED arguments are kept for a later user.
 286 This depends on the symbols `PACKAGE-version' and optionally
 287 `PACKAGE-incompatible-version' being defined in PACKAGE.
 288 Return nil if everything is ok.  Return an error string otherwise."
 289   (let ((check (inversion-check-version
 290                 (inversion-package-version package)
 291                 (inversion-package-incompatibility-version package)
 292                 oldversion reserved)))
 293     (cond
 294      ((null check)
 295       ;; Same version.. Yay!
 296       nil)
 297      ((eq check 'outdated)
 298       ;; Version is too old!
 299       (format "Package %s version %s is not compatible with current version"
 300               package oldversion))
 301      ((eq check 'incompatible)
 302       ;; Newer is installed but the requested version is = or < than
 303       ;; what the package maintainer says is incompatible, then throw
 304       ;; that error.
 305       (format "Package %s version is not backward compatible with %s"
 306               package oldversion))
 307      ;; Check failed
 308      (t "Inversion version check failed."))))
 309
 310 ;;;###autoload
 311 (defun inversion-require (package version &optional file directory
 312                                   &rest reserved)
 313   "Declare that you need PACKAGE with at least VERSION.
 314 PACKAGE might be found in FILE.  (See `require'.)
 315 Throws an error if VERSION is incompatible with what is installed.
 316 Optional argument DIRECTORY is a location where new versions of
 317 this tool can be located.  If there is a versioning problem and
 318 DIRECTORY is provided, inversion will offer to download the file.
 319 Optional argument RESERVED is saved for later use."
 320   (require package file)
 321   (let ((err (inversion-test package version)))
 322     (when err
 323       (if directory
 324           (inversion-download-package-ask err package directory version)
 325         (error err)))))
 326
 327 (defconst inversion-find-data
 328   '("(def\\(var\\|const\\)\\s-+%s-%s\\s-+\"\\([^\"]+\\)" 2)
 329   "Regexp template and match data index of a version string.")
 330
 331 ;;;###autoload
 332 (defun inversion-find-version (package)
 333   "Search for the version and incompatible version of PACKAGE.
 334 Does not load PACKAGE nor requires that it has been previously loaded.
 335 Search in the directories in `load-path' for a PACKAGE.el library.
 336 Visit the file found and search for the declarations of variables or
 337 constants `PACKAGE-version' and `PACKAGE-incompatible-version'.  The
 338 value of these variables must be a version string.
 339
 340 Return a pair (VERSION-STRING . INCOMPATIBLE-VERSION-STRING) where
 341 INCOMPATIBLE-VERSION-STRING can be nil.
 342 Return nil when VERSION-STRING was not found."
 343   (let* ((file (locate-library (format "%s.el" package) t))
 344          (tag (car inversion-find-data))
 345          (idx (nth 1 inversion-find-data))
 346          version)
 347     (when file
 348       (with-temp-buffer
 349         ;; The 3000 is a bit arbitrary, but should cut down on
 350         ;; fileio as version info usually is at the very top
 351         ;; of a file.  AFter a long commentary could be bad.
 352         (insert-file-contents-literally file nil 0 3000)
 353         (goto-char (point-min))
 354         (when (re-search-forward (format tag package 'version) nil t)
 355           (setq version (list (match-string idx)))
 356           (goto-char (point-min))
 357           (when (re-search-forward
 358                  (format tag package 'incompatible-version) nil t)
 359             (setcdr version (match-string idx))))))
 360     version))
 361
 362 ;;;###autoload
 363 (defun inversion-add-to-load-path (package minimum
 364                                            &optional installdir
 365                                            &rest subdirs)
 366   "Add the PACKAGE path to `load-path' if necessary.
 367 MINIMUM is the minimum version requirement of PACKAGE.
 368 Optional argument INSTALLDIR is the base directory where PACKAGE is
 369 installed.  It defaults to `default-directory'/PACKAGE.
 370 SUBDIRS are sub-directories to add to `load-path', following the main
 371 INSTALLDIR path."
 372   (let ((ver (inversion-find-version package)))
 373     ;; If PACKAGE not found or a bad version already in `load-path',
 374     ;; prepend the new PACKAGE path, so it will be loaded first.
 375     (when (or (not ver)
 376               (and
 377                (inversion-check-version (car ver) (cdr ver) minimum)
 378                (message "Outdated %s %s shadowed to meet minimum version %s"
 379                         package (car ver) minimum)
 380                t))
 381       (let* ((default-directory
 382                (or installdir
 383                    (expand-file-name (format "./%s" package))))
 384              subdir)
 385         (when (file-directory-p default-directory)
 386           ;; Add SUBDIRS
 387           (while subdirs
 388             (setq subdir  (expand-file-name (car subdirs))
 389                   subdirs (cdr subdirs))
 390             (when (file-directory-p subdir)
 391               (message "%S added to `load-path'" subdir)
 392               (add-to-list 'load-path subdir)))
 393           ;; Add the main path
 394           (message "%S added to `load-path'" default-directory)
 395           (add-to-list 'load-path default-directory))
 396         ;; We get to this point iff we do not accept or there is no
 397         ;; system file.  Lets check the version of what we just
 398         ;; installed... just to be safe.
 399         (let ((newver (inversion-find-version package)))
 400           (if (not newver)
 401               (error "Failed to find version for newly installed %s"
 402                      package))
 403           (if (inversion-check-version (car newver) (cdr newver) minimum)
 404               (error "Outdated %s %s just installed" package (car newver)))
 405           )))))
 406
 407 ;;; Inversion tests
 408 ;;
 409 (defun inversion-unit-test ()
 410   "Test inversion to make sure it can identify different version strings."
 411   (interactive)
 412   (let ((c1 (inversion-package-version 'inversion))
 413         (c1i (inversion-package-incompatibility-version 'inversion))
 414         (c2 (inversion-decode-version "1.3alpha2"))
 415         (c3 (inversion-decode-version "1.3beta4"))
 416         (c4 (inversion-decode-version "1.3 beta5"))
 417         (c5 (inversion-decode-version "1.3.4"))
 418         (c6 (inversion-decode-version "2.3alpha"))
 419         (c7 (inversion-decode-version "1.3"))
 420         (c8 (inversion-decode-version "1.3pre1")))
 421     (if (not (and
 422               (inversion-= c1 c1)
 423               (inversion-< c1i c1)
 424               (inversion-< c2 c3)
 425               (inversion-< c3 c4)
 426               (inversion-< c4 c5)
 427               (inversion-< c5 c6)
 428               (inversion-< c2 c4)
 429               (inversion-< c2 c5)
 430               (inversion-< c2 c6)
 431               (inversion-< c3 c5)
 432               (inversion-< c3 c6)
 433               (inversion-< c7 c6)
 434               (inversion-< c4 c7)
 435               (inversion-< c2 c7)
 436               (inversion-< c8 c6)
 437               (inversion-< c8 c7)
 438               (inversion-< c4 c8)
 439               (inversion-< c2 c8)
 440               ;; Negatives
 441               (not (inversion-< c3 c2))
 442               (not (inversion-< c4 c3))
 443               (not (inversion-< c5 c4))
 444               (not (inversion-< c6 c5))
 445               (not (inversion-< c7 c2))
 446               (not (inversion-< c7 c8))
 447               ;; Test the tester on inversion
 448               (not (inversion-test 'inversion inversion-version))
 449               ;; Test that we throw an error
 450               (inversion-test 'inversion "0.0.0")
 451               (inversion-test 'inversion "1000.0")
 452               ))
 453         (error "Inversion tests failed")
 454       (message "Inversion tests passed."))))
 455
 456 ;;; URL and downloading code
 457 ;;
 458 (defun inversion-locate-package-files (package directory &optional version)
 459   "Get a list of distributions of PACKAGE from DIRECTORY.
 460 DIRECTORY can be an ange-ftp compatible filename, such as:
 461  \"/ftp@ftp1.sourceforge.net/pub/sourceforge/PACKAGE\"
 462 If it is a URL, wget will be used for download.
 463 Optional argument VERSION will restrict the list of available versions
 464 to the file matching VERSION exactly, or nil."
 465 ;;DIRECTORY should also allow a URL:
 466 ;; \"http://ftp1.sourceforge.net/PACKAGE\"
 467 ;; but then I can get file listings easily.
 468   (if (symbolp package) (setq package (symbol-name package)))
 469   (directory-files directory t
 470                    (if version
 471                        (concat "^" package "-" version "\\>")
 472                      package)))
 473
 474 (defvar inversion-package-common-tails '( ".tar.gz"
 475                                          ".tar"
 476                                          ".zip"
 477                                          ".gz"
 478                                          )
 479   "Common distribution mechanisms for Emacs Lisp packages.")
 480
 481 (defun inversion-locate-package-files-and-split (package directory &optional version)
 482   "Use `inversion-locate-package-files' to get a list of PACKAGE files.
 483 DIRECTORY is the location where distributions of PACKAGE are.
 484 VERSION is an optional argument specifying a version to restrict to.
 485 The return list is an alist with the version string in the CAR,
 486 and the full path name in the CDR."
 487   (if (symbolp package) (setq package (symbol-name package)))
 488   (let ((f (inversion-locate-package-files package directory version))
 489         (prefix (concat (file-name-as-directory directory)
 490                         package "-"))
 491         (out nil))
 492     (while f
 493       (let* ((file (car f))
 494              (dist (file-name-nondirectory file))
 495              (tails inversion-package-common-tails)
 496              (verstring nil))
 497         (while (and tails (not verstring))
 498           (when (string-match (concat (car tails) "$") dist)
 499             (setq verstring
 500                   (substring dist (1+ (length package)) (match-beginning 0))))
 501           (setq tails (cdr tails)))
 502         (if (not verstring)
 503             (error "Cannot decode version for %s" dist))
 504         (setq out
 505               (cons
 506                (cons verstring file)
 507                out))
 508         (setq f (cdr f))))
 509     out))
 510
 511 (defun inversion-download-package-ask (err package directory version)
 512   "Due to ERR, offer to download PACKAGE from DIRECTORY.
 513 The package should have VERSION available for download."
 514   (if (symbolp package) (setq package (symbol-name package)))
 515   (let ((files (inversion-locate-package-files-and-split
 516                 package directory version)))
 517     (if (not files)
 518         (error err)
 519       (if (not (y-or-n-p (concat err ": Download update? ")))
 520           (error err)
 521         (let ((dest (read-directory-name (format "Download %s to: "
 522                                                  package)
 523                                          t)))
 524           (if (> (length files) 1)
 525               (setq files
 526                     (list
 527                      "foo" ;; ignored
 528                      (read-file-name "Version to download: "
 529                                      directory
 530                                      files
 531                                      t
 532                                      (concat
 533                                       (file-name-as-directory directory)
 534                                       package)
 535                                      nil))))
 536
 537           (copy-file (cdr (car files)) dest))))))
 538
 539 ;;;###autoload
 540 (defun inversion-upgrade-package (package &optional directory)
 541   "Try to upgrade PACKAGE in DIRECTORY is available."
 542   (interactive "sPackage to upgrade: ")
 543   (if (stringp package) (setq package (intern package)))
 544   (if (not directory)
 545       ;; Hope that the package maintainer specified.
 546       (setq directory (symbol-value (or (intern-soft
 547                                          (concat (symbol-name package)
 548                                                  "-url"))
 549                                         (intern-soft
 550                                          (concat (symbol-name package)
 551                                                  "-directory"))))))
 552   (let ((files (inversion-locate-package-files-and-split
 553                 package directory))
 554         (cver (inversion-package-version package))
 555         (newer nil))
 556     (mapcar (lambda (f)
 557               (if (inversion-< cver (inversion-decode-version (car f)))
 558                   (setq newer (cons f newer))))
 559             files)
 560     newer
 561     ))
 562
 563 ;; (inversion-upgrade-package
 564 ;;  'semantic
 565 ;;  "/ftp@ftp1.sourceforge.net:/pub/sourceforge/cedet")
 566
 567 ;; "/ftp@ftp1.sourceforge.net:/pub/sourceforge/cedet"
 568 (provide 'inversion)
 569
 570 ;;; inversion.el ends here