comparison lisp/subr.el @ 65105:aad2616355a4

version string comparison
author Vinicius Jose Latorre <viniciusjl@ig.com.br>
date Thu, 25 Aug 2005 01:37:47 +0000
parents de7df04c6d6b
children fcb6fe79c532
comparison
equal deleted inserted replaced
65104:99b859795eb0 65105:aad2616355a4
2849 ,@body 2849 ,@body
2850 (progress-reporter-update ,temp2 2850 (progress-reporter-update ,temp2
2851 (setq ,(car spec) (1+ ,(car spec))))) 2851 (setq ,(car spec) (1+ ,(car spec)))))
2852 (progress-reporter-done ,temp2) 2852 (progress-reporter-done ,temp2)
2853 nil ,@(cdr (cdr spec))))) 2853 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
2854 3055
2855 ;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc 3056 ;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc
2856 ;;; subr.el ends here 3057 ;;; subr.el ends here