/[emacs]/emacs/lisp/subr.el
ViewVC logotype

Diff of /emacs/lisp/subr.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.475 by rms, Sat Aug 20 21:48:51 2005 UTC revision 1.476 by viniciusjl, Thu Aug 25 01:37:47 2005 UTC
# Line 2851  convenience wrapper around `make-progres Line 2851  convenience wrapper around `make-progres
2851                                     (setq ,(car spec) (1+ ,(car spec)))))                                     (setq ,(car spec) (1+ ,(car spec)))))
2852         (progress-reporter-done ,temp2)         (progress-reporter-done ,temp2)
2853         nil ,@(cdr (cdr spec)))))         nil ,@(cdr (cdr spec)))))
2854    
2855    ;;;; Integer list & Version funs.
2856    
2857    (defvar version-separator "."
2858      "*Specify the string used to separate the version elements.
2859    
2860    Usually the separator is \".\", but it can be any other string.")
2861    
2862    
2863    (defvar version-regexp-alist
2864      '(("^a\\(lpha\\)?$"   . -3)
2865        ("^b\\(eta\\)?$"    . -2)
2866        ("^\\(pre\\|rc\\)$" . -1))
2867      "*Specify association between non-numeric version part and a priority.
2868    
2869    This association is used to handle version string like \"1.0pre2\",
2870    \"0.9alpha1\", etc.  It's used by `version-to-list' (which see) to convert the
2871    non-numeric part to an integer.  For example:
2872    
2873       String Version    Integer List Version
2874       \"1.0pre2\"         (1  0 -1 2)
2875       \"1.0PRE2\"         (1  0 -1 2)
2876       \"22.8beta3\"       (22 8 -2 3)
2877       \"22.8Beta3\"       (22 8 -2 3)
2878       \"0.9alpha1\"       (0  9 -3 1)
2879       \"0.9AlphA1\"       (0  9 -3 1)
2880       \"0.9alpha\"        (0  9 -3)
2881    
2882    Each element has the following form:
2883    
2884       (REGEXP . PRIORITY)
2885    
2886    Where:
2887    
2888    REGEXP          regexp used to match non-numeric part of a version string.
2889    
2890    PRIORITY        negative integer which indicate the non-numeric priority.")
2891    
2892    
2893    (defun version-to-list (ver)
2894      "Convert version string VER into an integer list.
2895    
2896    The version syntax is given by the following EBNF:
2897    
2898       VERSION ::= NUMBER ( SEPARATOR NUMBER )*.
2899    
2900       NUMBER ::= (0|1|2|3|4|5|6|7|8|9)+.
2901    
2902       SEPARATOR ::= `version-separator' (which see)
2903                   | `version-regexp-alist' (which see).
2904    
2905    As an example of valid version syntax:
2906    
2907       1.0pre2   1.0.7.5   22.8beta3   0.9alpha1
2908    
2909    As an example of invalid version syntax:
2910    
2911       1.0prepre2   1.0..7.5   22.8X3   alpha3.2   .5
2912    
2913    As an example of version convertion:
2914    
2915       String Version    Integer List Version
2916       \"1.0.7.5\"         (1  0  7 5)
2917       \"1.0pre2\"         (1  0 -1 2)
2918       \"1.0PRE2\"         (1  0 -1 2)
2919       \"22.8beta3\"       (22 8 -2 3)
2920       \"22.8Beta3\"       (22 8 -2 3)
2921       \"0.9alpha1\"       (0  9 -3 1)
2922       \"0.9AlphA1\"       (0  9 -3 1)
2923       \"0.9alpha\"        (0  9 -3)
2924    
2925    See documentation for `version-separator' and `version-regexp-alist'."
2926      (or (and (stringp ver) (not (string= ver "")))
2927          (error "Invalid version string: '%s'" ver))
2928      (save-match-data
2929        (let ((i 0)
2930              case-fold-search              ; ignore case in matching
2931              lst s al)
2932          (while (and (setq s (string-match "[0-9]+" ver i))
2933                      (= s i))
2934            ;; handle numeric part
2935            (setq lst (cons (string-to-number (substring ver i (match-end 0)))
2936                            lst)
2937                  i   (match-end 0))
2938            ;; handle non-numeric part
2939            (when (and (setq s (string-match "[^0-9]+" ver i))
2940                       (= s i))
2941              (setq s (substring ver i (match-end 0))
2942                    i (match-end 0))
2943              ;; handle alpha, beta, pre, etc. separator
2944              (unless (string= s version-separator)
2945                (setq al version-regexp-alist)
2946                (while (and al (not (string-match (caar al) s)))
2947                  (setq al (cdr al)))
2948                (or al (error "Invalid version syntax: '%s'" ver))
2949                (setq lst (cons (cdar al) lst)))))
2950          (if (null lst)
2951              (error "Invalid version syntax: '%s'" ver)
2952            (nreverse lst)))))
2953    
2954    
2955    (defun integer-list-< (l1 l2)
2956      "Return t if integer list L1 is lesser than L2.
2957    
2958    Note that integer list (1) is equal to (1 0), (1 0 0), (1 0 0 0),
2959    etc.  That is, the trailing zeroes are irrelevant.  Also, integer
2960    list (1) is greater than (1 -1) which is greater than (1 -2)
2961    which is greater than (1 -3)."
2962      (while (and l1 l2 (= (car l1) (car l2)))
2963        (setq l1 (cdr l1)
2964              l2 (cdr l2)))
2965      (cond
2966       ;; l1 not null and l2 not null
2967       ((and l1 l2) (< (car l1) (car l2)))
2968       ;; l1 null and l2 null         ==> l1 length = l2 length
2969       ((and (null l1) (null l2)) nil)
2970       ;; l1 not null and l2 null     ==> l1 length > l2 length
2971       (l1 (< (integer-list-not-zero l1) 0))
2972       ;; l1 null and l2 not null     ==> l2 length > l1 length
2973       (t  (< 0 (integer-list-not-zero l2)))))
2974    
2975    
2976    (defun integer-list-= (l1 l2)
2977      "Return t if integer list L1 is equal to L2.
2978    
2979    Note that integer list (1) is equal to (1 0), (1 0 0), (1 0 0 0),
2980    etc.  That is, the trailing zeroes are irrelevant.  Also, integer
2981    list (1) is greater than (1 -1) which is greater than (1 -2)
2982    which is greater than (1 -3)."
2983      (while (and l1 l2 (= (car l1) (car l2)))
2984        (setq l1 (cdr l1)
2985              l2 (cdr l2)))
2986      (cond
2987       ;; l1 not null and l2 not null
2988       ((and l1 l2) nil)
2989       ;; l1 null and l2 null     ==> l1 length = l2 length
2990       ((and (null l1) (null l2)))
2991       ;; l1 not null and l2 null ==> l1 length > l2 length
2992       (l1 (zerop (integer-list-not-zero l1)))
2993       ;; l1 null and l2 not null ==> l2 length > l1 length
2994       (t  (zerop (integer-list-not-zero l2)))))
2995    
2996    
2997    (defun integer-list-<= (l1 l2)
2998      "Return t if integer list L1 is lesser than or equal to L2.
2999    
3000    Note that integer list (1) is equal to (1 0), (1 0 0), (1 0 0 0),
3001    etc.  That is, the trailing zeroes are irrelevant.  Also, integer
3002    list (1) is greater than (1 -1) which is greater than (1 -2)
3003    which is greater than (1 -3)."
3004      (while (and l1 l2 (= (car l1) (car l2)))
3005        (setq l1 (cdr l1)
3006              l2 (cdr l2)))
3007      (cond
3008       ;; l1 not null and l2 not null
3009       ((and l1 l2) (< (car l1) (car l2)))
3010       ;; l1 null and l2 null     ==> l1 length = l2 length
3011       ((and (null l1) (null l2)))
3012       ;; l1 not null and l2 null ==> l1 length > l2 length
3013       (l1 (<= (integer-list-not-zero l1) 0))
3014       ;; l1 null and l2 not null ==> l2 length > l1 length
3015       (t  (<= 0 (integer-list-not-zero l2)))))
3016    
3017    
3018    (defalias 'version= 'string-equal
3019      "Return t if version V1 is equal to V2.
3020    
3021    Compare version string using `string-equal'.")
3022    
3023    
3024    (defun version< (v1 v2)
3025      "Return t if version V1 is lesser than V2.
3026    
3027    Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
3028    etc.  That is, the trailing \".0\"s are irrelevant.  Also, version string \"1\"
3029    is greater than \"1pre\" which is greater than \"1beta\" which is greater than
3030    \"1alpha\"."
3031      (integer-list-< (version-to-list v1) (version-to-list v2)))
3032    
3033    
3034    (defun version<= (v1 v2)
3035      "Return t if version V1 is lesser than or equal to V2.
3036    
3037    Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
3038    etc.  That is, the trailing \".0\"s are irrelevant.  Also, version string \"1\"
3039    is greater than \"1pre\" which is greater than \"1beta\" which is greater than
3040    \"1alpha\"."
3041      (integer-list-<= (version-to-list v1) (version-to-list v2)))
3042    
3043    
3044    (defun integer-list-not-zero (lst)
3045      "Return the first non-zero element of integer list LST.
3046    
3047    If all LST elements are zeroes or LST is nil, return zero."
3048      (while (zerop (car lst))
3049        (setq lst (cdr lst)))
3050      (if lst
3051          (car lst)
3052        ;; there is no element different of zero
3053        0))
3054    
3055    
3056  ;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc  ;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc
3057  ;;; subr.el ends here  ;;; subr.el ends here

Legend:
Removed from v.1.475  
changed lines
  Added in v.1.476

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26