+;; Standardized progress reporting
+
+;; Progress reporter has the following structure:
+;;
+;; (NEXT-UPDATE-VALUE . [NEXT-UPDATE-TIME
+;; MIN-VALUE
+;; MAX-VALUE
+;; MESSAGE
+;; MIN-CHANGE
+;; MIN-TIME])
+;;
+;; This weirdeness is for optimization reasons: we want
+;; `progress-reporter-update' to be as fast as possible, so
+;; `(car reporter)' is better than `(aref reporter 0)'.
+;;
+;; NEXT-UPDATE-TIME is a float. While `float-time' loses a couple
+;; digits of precision, it doesn't really matter here. On the other
+;; hand, it greatly simplifies the code.
+
+(defsubst progress-reporter-update (reporter value)
+ "Report progress of an operation in the echo area.
+However, if the change since last echo area update is too small
+or not enough time has passed, then do nothing (see
+`make-progress-reporter' for details).
+
+First parameter, REPORTER, should be the result of a call to
+`make-progress-reporter'. Second, VALUE, determines the actual
+progress of operation; it must be between MIN-VALUE and MAX-VALUE
+as passed to `make-progress-reporter'.
+
+This function is very inexpensive, you may not bother how often
+you call it."
+ (when (>= value (car reporter))
+ (progress-reporter-do-update reporter value)))
+
+(defun make-progress-reporter (message min-value max-value
+ &optional current-value
+ min-change min-time)
+ "Return progress reporter object to be used with `progress-reporter-update'.
+
+MESSAGE is shown in the echo area. When at least 1% of operation
+is complete, the exact percentage will be appended to the
+MESSAGE. When you call `progress-reporter-done', word \"done\"
+is printed after the MESSAGE. You can change MESSAGE of an
+existing progress reporter with `progress-reporter-force-update'.
+
+MIN-VALUE and MAX-VALUE designate starting (0% complete) and
+final (100% complete) states of operation. The latter should be
+larger; if this is not the case, then simply negate all values.
+Optional CURRENT-VALUE specifies the progress by the moment you
+call this function. You should omit it or set it to nil in most
+cases since it defaults to MIN-VALUE.
+
+Optional MIN-CHANGE determines the minimal change in percents to
+report (default is 1%.) Optional MIN-TIME specifies the minimal
+time before echo area updates (default is 0.2 seconds.) If
+`float-time' function is not present, then time is not tracked
+at all. If OS is not capable of measuring fractions of seconds,
+then this parameter is effectively rounded up."
+
+ (unless min-time
+ (setq min-time 0.2))
+ (let ((reporter
+ (cons min-value ;; Force a call to `message' now
+ (vector (if (and (fboundp 'float-time)
+ (>= min-time 0.02))
+ (float-time) nil)
+ min-value
+ max-value
+ message
+ (if min-change (max (min min-change 50) 1) 1)
+ min-time))))
+ (progress-reporter-update reporter (or current-value min-value))
+ reporter))
+
+(defun progress-reporter-force-update (reporter value &optional new-message)
+ "Report progress of an operation in the echo area unconditionally.
+
+First two parameters are the same as for
+`progress-reporter-update'. Optional NEW-MESSAGE allows you to
+change the displayed message."
+ (let ((parameters (cdr reporter)))
+ (when new-message
+ (aset parameters 3 new-message))
+ (when (aref parameters 0)
+ (aset parameters 0 (float-time)))
+ (progress-reporter-do-update reporter value)))
+
+(defun progress-reporter-do-update (reporter value)
+ (let* ((parameters (cdr reporter))
+ (min-value (aref parameters 1))
+ (max-value (aref parameters 2))
+ (one-percent (/ (- max-value min-value) 100.0))
+ (percentage (if (= max-value min-value)
+ 0
+ (truncate (/ (- value min-value) one-percent))))
+ (update-time (aref parameters 0))
+ (current-time (float-time))
+ (enough-time-passed
+ ;; See if enough time has passed since the last update.
+ (or (not update-time)
+ (when (>= current-time update-time)
+ ;; Calculate time for the next update
+ (aset parameters 0 (+ update-time (aref parameters 5)))))))
+ ;;
+ ;; Calculate NEXT-UPDATE-VALUE. If we are not going to print
+ ;; message this time because not enough time has passed, then use
+ ;; 1 instead of MIN-CHANGE. This makes delays between echo area
+ ;; updates closer to MIN-TIME.
+ (setcar reporter
+ (min (+ min-value (* (+ percentage
+ (if enough-time-passed
+ (aref parameters 4) ;; MIN-CHANGE
+ 1))
+ one-percent))
+ max-value))
+ (when (integerp value)
+ (setcar reporter (ceiling (car reporter))))
+ ;;
+ ;; Only print message if enough time has passed
+ (when enough-time-passed
+ (if (> percentage 0)
+ (message "%s%d%%" (aref parameters 3) percentage)
+ (message "%s" (aref parameters 3))))))
+
+(defun progress-reporter-done (reporter)
+ "Print reporter's message followed by word \"done\" in echo area."
+ (message "%sdone" (aref (cdr reporter) 3)))
+
+(defmacro dotimes-with-progress-reporter (spec message &rest body)
+ "Loop a certain number of times and report progress in the echo area.
+Evaluate BODY with VAR bound to successive integers running from
+0, inclusive, to COUNT, exclusive. Then evaluate RESULT to get
+the return value (nil if RESULT is omitted).
+
+At each iteration MESSAGE followed by progress percentage is
+printed in the echo area. After the loop is finished, MESSAGE
+followed by word \"done\" is printed. This macro is a
+convenience wrapper around `make-progress-reporter' and friends.
+
+\(fn (VAR COUNT [RESULT]) MESSAGE BODY...)"
+ (declare (indent 2) (debug ((symbolp form &optional form) form body)))
+ (let ((temp (make-symbol "--dotimes-temp--"))
+ (temp2 (make-symbol "--dotimes-temp2--"))
+ (start 0)
+ (end (nth 1 spec)))
+ `(let ((,temp ,end)
+ (,(car spec) ,start)
+ (,temp2 (make-progress-reporter ,message ,start ,end)))
+ (while (< ,(car spec) ,temp)
+ ,@body
+ (progress-reporter-update ,temp2
+ (setq ,(car spec) (1+ ,(car spec)))))
+ (progress-reporter-done ,temp2)
+ nil ,@(cdr (cdr spec)))))
+
+\f
+;;;; Compare Version Strings
+
+(defvar version-separator "."
+ "*Specify the string used to separate the version elements.
+
+Usually the separator is \".\", but it can be any other string.")
+
+
+(defvar version-regexp-alist
+ '(("^a\\(lpha\\)?$" . -3)
+ ("^b\\(eta\\)?$" . -2)
+ ("^\\(pre\\|rc\\)$" . -1))
+ "*Specify association between non-numeric version part and a priority.
+
+This association is used to handle version string like \"1.0pre2\",
+\"0.9alpha1\", etc. It's used by `version-to-list' (which see) to convert the
+non-numeric part to an integer. For example:
+
+ String Version Integer List Version
+ \"1.0pre2\" (1 0 -1 2)
+ \"1.0PRE2\" (1 0 -1 2)
+ \"22.8beta3\" (22 8 -2 3)
+ \"22.8Beta3\" (22 8 -2 3)
+ \"0.9alpha1\" (0 9 -3 1)
+ \"0.9AlphA1\" (0 9 -3 1)
+ \"0.9alpha\" (0 9 -3)
+
+Each element has the following form:
+
+ (REGEXP . PRIORITY)
+
+Where:
+
+REGEXP regexp used to match non-numeric part of a version string.
+
+PRIORITY negative integer which indicate the non-numeric priority.")
+
+
+(defun version-to-list (ver)
+ "Convert version string VER into an integer list.
+
+The version syntax is given by the following EBNF:
+
+ VERSION ::= NUMBER ( SEPARATOR NUMBER )*.
+
+ NUMBER ::= (0|1|2|3|4|5|6|7|8|9)+.
+
+ SEPARATOR ::= `version-separator' (which see)
+ | `version-regexp-alist' (which see).
+
+As an example of valid version syntax:
+
+ 1.0pre2 1.0.7.5 22.8beta3 0.9alpha1
+
+As an example of invalid version syntax:
+
+ 1.0prepre2 1.0..7.5 22.8X3 alpha3.2 .5
+
+As an example of version convertion:
+
+ String Version Integer List Version
+ \"1.0.7.5\" (1 0 7 5)
+ \"1.0pre2\" (1 0 -1 2)
+ \"1.0PRE2\" (1 0 -1 2)
+ \"22.8beta3\" (22 8 -2 3)
+ \"22.8Beta3\" (22 8 -2 3)
+ \"0.9alpha1\" (0 9 -3 1)
+ \"0.9AlphA1\" (0 9 -3 1)
+ \"0.9alpha\" (0 9 -3)
+
+See documentation for `version-separator' and `version-regexp-alist'."
+ (or (and (stringp ver) (not (string= ver "")))
+ (error "Invalid version string: '%s'" ver))
+ (save-match-data
+ (let ((i 0)
+ case-fold-search ; ignore case in matching
+ lst s al)
+ (while (and (setq s (string-match "[0-9]+" ver i))
+ (= s i))
+ ;; handle numeric part
+ (setq lst (cons (string-to-number (substring ver i (match-end 0)))
+ lst)
+ i (match-end 0))
+ ;; handle non-numeric part
+ (when (and (setq s (string-match "[^0-9]+" ver i))
+ (= s i))
+ (setq s (substring ver i (match-end 0))
+ i (match-end 0))
+ ;; handle alpha, beta, pre, etc. separator
+ (unless (string= s version-separator)
+ (setq al version-regexp-alist)
+ (while (and al (not (string-match (caar al) s)))
+ (setq al (cdr al)))
+ (or al (error "Invalid version syntax: '%s'" ver))
+ (setq lst (cons (cdar al) lst)))))
+ (if (null lst)
+ (error "Invalid version syntax: '%s'" ver)
+ (nreverse lst)))))
+
+
+(defun version-list-< (l1 l2)
+ "Return t if integer list L1 is lesser than L2.
+
+Note that integer list (1) is equal to (1 0), (1 0 0), (1 0 0 0),
+etc. That is, the trailing zeroes are irrelevant. Also, integer
+list (1) is greater than (1 -1) which is greater than (1 -2)
+which is greater than (1 -3)."
+ (while (and l1 l2 (= (car l1) (car l2)))
+ (setq l1 (cdr l1)
+ l2 (cdr l2)))
+ (cond
+ ;; l1 not null and l2 not null
+ ((and l1 l2) (< (car l1) (car l2)))
+ ;; l1 null and l2 null ==> l1 length = l2 length
+ ((and (null l1) (null l2)) nil)
+ ;; l1 not null and l2 null ==> l1 length > l2 length
+ (l1 (< (version-list-not-zero l1) 0))
+ ;; l1 null and l2 not null ==> l2 length > l1 length
+ (t (< 0 (version-list-not-zero l2)))))
+
+
+(defun version-list-= (l1 l2)
+ "Return t if integer list L1 is equal to L2.
+
+Note that integer list (1) is equal to (1 0), (1 0 0), (1 0 0 0),
+etc. That is, the trailing zeroes are irrelevant. Also, integer
+list (1) is greater than (1 -1) which is greater than (1 -2)
+which is greater than (1 -3)."
+ (while (and l1 l2 (= (car l1) (car l2)))
+ (setq l1 (cdr l1)
+ l2 (cdr l2)))
+ (cond
+ ;; l1 not null and l2 not null
+ ((and l1 l2) nil)
+ ;; l1 null and l2 null ==> l1 length = l2 length
+ ((and (null l1) (null l2)))
+ ;; l1 not null and l2 null ==> l1 length > l2 length
+ (l1 (zerop (version-list-not-zero l1)))
+ ;; l1 null and l2 not null ==> l2 length > l1 length
+ (t (zerop (version-list-not-zero l2)))))
+
+
+(defun version-list-<= (l1 l2)
+ "Return t if integer list L1 is lesser than or equal to L2.
+
+Note that integer list (1) is equal to (1 0), (1 0 0), (1 0 0 0),
+etc. That is, the trailing zeroes are irrelevant. Also, integer
+list (1) is greater than (1 -1) which is greater than (1 -2)
+which is greater than (1 -3)."
+ (while (and l1 l2 (= (car l1) (car l2)))
+ (setq l1 (cdr l1)
+ l2 (cdr l2)))
+ (cond
+ ;; l1 not null and l2 not null
+ ((and l1 l2) (< (car l1) (car l2)))
+ ;; l1 null and l2 null ==> l1 length = l2 length
+ ((and (null l1) (null l2)))
+ ;; l1 not null and l2 null ==> l1 length > l2 length
+ (l1 (<= (version-list-not-zero l1) 0))
+ ;; l1 null and l2 not null ==> l2 length > l1 length
+ (t (<= 0 (version-list-not-zero l2)))))
+
+(defun version-list-not-zero (lst)
+ "Return the first non-zero element of integer list LST.
+
+If all LST elements are zeroes or LST is nil, return zero."
+ (while (and lst (zerop (car lst)))
+ (setq lst (cdr lst)))
+ (if lst
+ (car lst)
+ ;; there is no element different of zero
+ 0))
+
+
+(defun version< (v1 v2)
+ "Return t if version V1 is lesser than V2.
+
+Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
+etc. That is, the trailing \".0\"s are irrelevant. Also, version string \"1\"
+is greater than \"1pre\" which is greater than \"1beta\" which is greater than
+\"1alpha\"."
+ (version-list-< (version-to-list v1) (version-to-list v2)))
+
+
+(defun version<= (v1 v2)
+ "Return t if version V1 is lesser than or equal to V2.
+
+Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
+etc. That is, the trailing \".0\"s are irrelevant. Also, version string \"1\"
+is greater than \"1pre\" which is greater than \"1beta\" which is greater than
+\"1alpha\"."
+ (version-list-<= (version-to-list v1) (version-to-list v2)))
+
+(defun version= (v1 v2)
+ "Return t if version V1 is equal to V2.
+
+Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
+etc. That is, the trailing \".0\"s are irrelevant. Also, version string \"1\"
+is greater than \"1pre\" which is greater than \"1beta\" which is greater than
+\"1alpha\"."
+ (version-list-= (version-to-list v1) (version-to-list v2)))
+
+
+
+;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc