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 |