Package: emacs;
Reported by: Toru TSUNEYOSHI <t_tuneyosi <at> hotmail.com>
Date: Mon, 24 May 2010 19:11:02 UTC
Severity: wishlist
Tags: patch
Done: Lars Ingebrigtsen <larsi <at> gnus.org>
Bug is archived. No further changes may be made.
Message #1 received at quiet <at> debbugs.gnu.org (full text, mbox):
From: Toru TSUNEYOSHI <t_tuneyosi <at> hotmail.com> To: quiet <at> debbugs.gnu.org Subject: enable sorting by version in `ls-lisp-handle-switches' Date: Sun, 07 Mar 2010 13:46:49 +0900
[Message part 1 (text/plain, inline)]
Package: emacs
Severity: wishlist
Tags: patch
[ resent from
http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg00206.html ]
Hello.
I made a function sorting by version in `ls-lisp-handle-switches', by
setting `dired-listing-switches' to "-alv".
At first, I made `string-version-lessp', by referring to
`glibc-2.11.1/string/strverscmp.c'.
But I was not satisfied with the spec.
So I made another function `string-logical-lessp'.
If no problems, please apply to `ls-lisp.el'.
Example:
(sort '(
"abc-1.0051.tgz"
"abc-1.00501.tgz"
"abc-1.007.tgz"
"abc-1.012b.tgz"
"abc-1.01a.tgz"
)
'string-logical-lessp)
=>
("abc-1.01a.tgz"
"abc-1.007.tgz"
"abc-1.012b.tgz"
"abc-1.0051.tgz"
"abc-1.00501.tgz")
(dired "d:/test/")
=>
d:/test:
total used in directory 0 available 20000000
drwxrwxrwx 1 Administrators none 0 Mar 7 12:03 .
dr-xr-xr-x 1 Administrators none 0 Mar 7 12:23 ..
-rw-rw-rw- 1 Administrators none 0 May 7 12:57 7
-rw-rw-rw- 1 Administrators none 0 May 7 12:57 8
-rw-rw-rw- 1 Administrators none 0 May 7 12:57 9
-rw-rw-rw- 1 Administrators none 0 May 7 12:57 10
-rw-rw-rw- 1 Administrators none 0 May 7 12:57 11
-rw-rw-rw- 1 Administrators none 0 May 7 12:57 12
-rw-rw-rw- 1 Administrators none 0 Mar 7 12:57 abc-1.01a.tgz
-rw-rw-rw- 1 Administrators none 0 Mar 7 12:57 abc-1.007.tgz
-rw-rw-rw- 1 Administrators none 0 Mar 7 12:57 abc-1.012b.tgz
-rw-rw-rw- 1 Administrators none 0 Mar 7 12:57 abc-1.0051.tgz
-rw-rw-rw- 1 Administrators none 0 Mar 7 12:57 abc-1.00501.tgz
[strcmp.el (text/plain, inline)]
(defun string-version-lessp (s1 s2 &optional ignore-case)
"Return t if first arg string is less than second in version order.
Case is significant in this comparison if IGNORE-CASE is nil.
Symbols are also allowed; their print names are used instead.
See also `string-logical-lessp'.
Example:
(sort
'(\"foo.zml-1.gz\" => (\"foo.zml-1.gz\"
\"foo.zml-100.gz\" \"foo.zml-2.gz\"
\"foo.zml-12.gz\" \"foo.zml-6.gz\"
\"foo.zml-13.gz\" \"foo.zml-12.gz\"
\"foo.zml-2.gz\" \"foo.zml-13.gz\"
\"foo.zml-25.gz\" \"foo.zml-25.gz\"
\"foo.zml-6.gz\") \"foo.zml-100.gz\")
'string-version-lessp)
(sort
'(\"abc-1.01a.tgz\" => (\"abc-1.007.tgz\"
\"abc-1.007.tgz\" \"abc-1.012b.tgz\"
\"abc-1.012b.tgz\") \"abc-1.01a.tgz\")
'string-version-lessp)
(sort
'(\"9.000001.10.tgz\" => (\"009.01.91.tgz\"
\"009.01.91.tgz\") \"9.000001.10.tgz\")
'string-version-lessp)
"
(let* (;; states
(S_N #x0) ; normal
(S_I #x3) ; comparing integral part
(S_F #x6) ; comparing fractionnal parts
(S_Z #x9) ; idem but with leading Zeroes only
;; Symbol(s) 0 [1-9] others
;; Transition (10) 0 (01) d (00) x
;;
;; x d 0 ; state
(next-state (vector S_N S_I S_Z ; S_N
S_N S_I S_I ; S_I
S_N S_F S_F ; S_F
S_N S_F S_Z)) ; S_Z
;; result-type
(CMP 2) ; return diff
(LEN 3) ; compare using len_diff/diff
;; `glibc-2.11.1/string/strverscmp.c'
;;
;; *p1 *p1 ; pair
;; *p2 *p2 ;
;; *p3 *p3 ;
;;
;; x/x x/d x/0 d/x d/d d/0 0/x 0/d 0/0 ; state
(result-type (vector CMP CMP CMP CMP LEN CMP CMP CMP CMP ; S_N
CMP -1 -1 +1 LEN LEN +1 LEN LEN ; S_I
CMP CMP CMP CMP CMP CMP CMP CMP CMP ; S_F
CMP +1 +1 -1 CMP CMP -1 CMP CMP)) ; S_Z
;;; ;; like `coreutils-6.12/lib/strverscmp.c'
;;; ;;
;;; ;; x/x x/d x/0 d/x d/d d/0 0/x 0/d 0/0 ; state
;;; (result-type (vector CMP CMP CMP CMP LEN CMP CMP CMP CMP ; S_N
;;; CMP -1 -1 +1 LEN LEN +1 LEN LEN ; S_I
;;; CMP CMP CMP CMP LEN CMP CMP CMP CMP ; S_F
;;; CMP +1 +1 -1 CMP CMP -1 CMP CMP)) ; S_Z
ret ; same style as return value of C language `strcmp'
l1 l2 ; length of string s1, s2
(n 0) ; index of string s1, s2
c1 c2 ; character of string s1, s2 at index n
state
diff)
(setq ret (catch 'end
(if (eq s1 s2)
(throw 'end 0))
(if (symbolp s1)
(setq s1 (symbol-name s1)))
(if (symbolp s2)
(setq s2 (symbol-name s2)))
(unless (stringp s1)
(signal 'wrong-type-argument `(stringp ,s1)))
(unless (stringp s2)
(signal 'wrong-type-argument `(stringp ,s2)))
(if ignore-case
(setq s1 (upcase s1)
s2 (upcase s2)))
(setq l1 (length s1)
l2 (length s2)
c1 (if (< n l1) (elt s1 n) ?\0) ; ?\0: null terminator
c2 (if (< n l2) (elt s2 n) ?\0)
n (1+ n)
;; Hint: '0' is a digit too.
state (+ S_N
(if (= c1 ?0) 1 0)
(if (and (<= ?0 c1) (<= c1 ?9)) 1 0))) ; (isdigit (c1) != 0)
(while (= (setq diff (- c1 c2)) 0)
(if (= c1 ?\0)
(throw 'end diff))
(setq state (aref next-state state)
c1 (if (< n l1) (elt s1 n) ?\0)
c2 (if (< n l2) (elt s2 n) ?\0)
n (1+ n)
state (+ state
(if (= c1 ?0) 1 0)
(if (and (<= ?0 c1) (<= c1 ?9)) 1 0))))
(setq state (aref result-type (+ (* state 3)
(if (= c2 ?0) 1 0)
(if (and (<= ?0 c2) (<= c2 ?9)) 1 0))))
(cond ((= state CMP)
(setq ret diff))
((= state LEN)
(while (progn
(setq c1 (if (< n l1) (elt s1 n) ?\0)
c2 (if (< n l2) (elt s2 n) ?\0)
n (1+ n))
(and (<= ?0 c1) (<= c1 ?9)))
(if (not (and (<= ?0 c2) (<= c2 ?9)))
(throw 'end 1)))
(setq ret (if (and (<= ?0 c2) (<= c2 ?9)) -1 diff)))
(t
(setq ret state)))
ret))
;; convert ret to the style of `string-lessp'
(< ret 0)))
(defalias 'string-version< 'string-version-lessp)
(defun string-logical-lessp (s1 s2 &optional ignore-case)
"Return t if first arg string is less than second in logical version order.
Case is significant in this comparison if IGNORE-CASE is nil.
Symbols are also allowed; their print names are used instead.
See also `string-version-lessp'.
Example:
(sort
'(\"foo.zml-1.gz\" => (\"foo.zml-1.gz\"
\"foo.zml-100.gz\" \"foo.zml-2.gz\"
\"foo.zml-12.gz\" \"foo.zml-6.gz\"
\"foo.zml-13.gz\" \"foo.zml-12.gz\"
\"foo.zml-2.gz\" \"foo.zml-13.gz\"
\"foo.zml-25.gz\" \"foo.zml-25.gz\"
\"foo.zml-6.gz\") \"foo.zml-100.gz\")
'string-logical-lessp)
(sort
'(\"abc-1.01a.tgz\" => (\"abc-1.01a.tgz\"
\"abc-1.007.tgz\" \"abc-1.007.tgz\"
\"abc-1.012b.tgz\") \"abc-1.012b.tgz\")
'string-logical-lessp)
(sort
'(\"9.000001.10.tgz\" => (\"9.000001.10.tgz\"
\"009.01.91.tgz\") \"009.01.91.tgz\")
'string-logical-lessp)
"
(let (ret ; same style as return value of C language `strcmp'
l1 l2 ; length of string s1, s2
(n1 0) ; index of string s1, s2
(n2 0)
(c1 -1) ; character of string s1, s2 at index n1, n2
(c2 -1) ; (set dummy code as initial (and invalid as character) value)
diff)
(if (symbolp s1)
(setq s1 (symbol-name s1)))
(if (symbolp s2)
(setq s2 (symbol-name s2)))
(unless (stringp s1)
(signal 'wrong-type-argument `(stringp ,s1)))
(unless (stringp s2)
(signal 'wrong-type-argument `(stringp ,s2)))
(if ignore-case
(setq s1 (upcase s1)
s2 (upcase s2)))
(setq l1 (length s1)
l2 (length s2))
(setq ret (catch 'end
(while (= (setq diff (- c1 c2)) 0)
(if (or (= c1 ?\0) (= c2 ?\0))
(throw 'end diff))
(setq c1 (if (< n1 l1) (elt s1 n1) ?\0) ; ?\0: null terminator
c2 (if (< n2 l2) (elt s2 n2) ?\0))
;; encounter numbers ?
(if (and (<= ?0 c1) (<= c1 ?9)
(<= ?0 c2) (<= c2 ?9))
(let (sub-s1 sub-s2
sub-l1 sub-l2)
;; skip needless "0"
;;
;; example:
;; "00...0" => "0"
;; "010" => "10"
;; "000305" => "305"
(string-match "0*\\([0-9]+\\)" s1 n1)
(setq sub-s1 (match-string 1 s1)
sub-l1 (length sub-s1)
n1 (match-end 1))
(string-match "0*\\([0-9]+\\)" s2 n2)
(setq sub-s2 (match-string 1 s2)
sub-l2 (length sub-s2)
n2 (match-end 1))
;; number whose length is shorter is smaller than another
(cond ((< sub-l1 sub-l2)
(throw 'end -1))
((> sub-l1 sub-l2)
(throw 'end 1))
(t
;; don't use `number-to-string' because of overflow
(setq ret (compare-strings sub-s1 0 nil
sub-s2 0 nil))
(unless (eq ret t)
(throw 'end ret))))
;; as both numbers are equal, prepare for next step
(setq c1 (if (< n1 l1) (elt s1 n1) ?\0)
c2 (if (< n2 l2) (elt s2 n2) ?\0))))
(setq n1 (1+ n1)
n2 (1+ n2)))
diff))
;; convert ret to the style of `string-lessp'
(< ret 0)))
(defalias 'string-logical< 'string-logical-lessp)
[ls-lisp.el.diff (text/x-patch, inline)]
--- ls-lisp.el.orig 2009-06-21 13:37:45.000000000 +0900
+++ ls-lisp.el 2010-03-07 11:09:33.595406400 +0900
@@ -196,6 +196,9 @@
(or (featurep 'ls-lisp) ; FJW: unless this file is being reloaded!
(setq original-insert-directory (symbol-function 'insert-directory)))
+;;(defalias 'ls-lisp-version-lessp 'string-version-lessp)
+(defalias 'ls-lisp-version-lessp 'string-logical-lessp)
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -493,6 +496,32 @@
(error (message "Unsorted (ls-lisp sorting error) - %s"
(error-message-string err))
(ding) (sit-for 2)))) ; to show user the message!
+ ;; Should execute `ls-lisp-version-lessp'
+ ;; after sorting by `ls-lisp-string-lessp' or others
+ ;;
+ ;; The reason:
+ ;; See the following numbers.
+ ;; "1.5"
+ ;; "1.05"
+ ;;
+ ;; `ls-lisp-string-lessp' *may* eval that both numbers are equal.
+ ;; So the function returns `nil'. In other words, the order is unchanged.
+ ;; But it is clear that these numbers shoud be sorted
+ ;; in lexicographic order before.
+ (if (and (not (memq ?U switches)) ; unsorted
+ (memq ?v switches))
+ ;; Catch and ignore unexpected sorting errors
+ (condition-case err
+ (setq file-alist
+ (let (index)
+ ;; Copy file-alist in case of error
+ (sort (copy-sequence file-alist) ; modifies its argument!
+ (lambda (x y) ; sorted on version
+ (ls-lisp-version-lessp (car x) (car y)
+ ls-lisp-ignore-case)))))
+ (error (message "Unsorted (ls-lisp sorting error) - %s"
+ (error-message-string err))
+ (ding) (sit-for 2)))) ; to show user the message!
(if (memq ?F switches) ; classify switch
(setq file-alist (mapcar 'ls-lisp-classify file-alist)))
(if ls-lisp-dirs-first
[test.el (text/plain, inline)]
;; (query-replace "string-version-lessp" "string-logical-lessp")
;; (query-replace "string-logical-lessp" "string-version-lessp")
(sort '(
"foo.zml-1.gz"
"foo.zml-100.gz"
"foo.zml-12.gz"
"foo.zml-13.gz"
"foo.zml-2.gz"
"foo.zml-25.gz"
"foo.zml-6.gz"
)
'string-version-lessp)
(sort '(
"foo.zml-1 gz"
"foo.zml-100 gz"
"foo.zml-12 gz"
"foo.zml-13 gz"
"foo.zml-2 gz"
"foo.zml-25 gz"
"foo.zml-6 gz"
)
'string-version-lessp)
(sort '(
"foo.zml-1~gz"
"foo.zml-100~gz"
"foo.zml-12~gz"
"foo.zml-13~gz"
"foo.zml-2~gz"
"foo.zml-25~gz"
"foo.zml-6~gz"
)
'string-version-lessp)
(sort '(
"abc-1.0051.tgz"
"abc-1.00501.tgz"
"abc-1.007.tgz"
"abc-1.012b.tgz"
"abc-1.01a.tgz"
)
'string-version-lessp)
(sort '(
"1.007.tgz"
"1.01a.tgz"
)
'string-version-lessp)
(sort '(
"012b.tgz"
"01a.tgz"
)
'string-version-lessp)
(sort '(
"01.012b.tgz"
"009.01a.tgz"
)
'string-version-lessp)
(sort '(
"9.011.tgz"
"009.01.tgz"
)
'string-version-lessp)
(sort '(
"9.000001.10tgz"
"009.01.91tgz"
;;"009.01.9tgz"
;;"009.01.50tgz"
)
'string-version-lessp)
(sort '(
"9,001.tgz"
"9000.tgz"
"9,000.tgz"
)
'string-version-lessp)
(sort '(
"0123.tgz"
"01012.tgz"
)
'string-version-lessp)
(sort '(
"1.05.txt"
"1.5.txt"
)
'string-version-lessp)
(sort '(
"a001b.txt"
"a0b.txt"
)
'string-version-lessp)
(sort '(
"a01b.txt"
"a0b.txt"
)
'string-version-lessp)
(sort '(
"abc001.txt"
"abc0a.txt"
)
'string-version-lessp)
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.