Mercurial > emacs
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 |