* enable sorting by version in `ls-lisp-handle-switches'
@ 2010-03-07 4:46 Toru TSUNEYOSHI
2010-03-07 14:49 ` Stefan Monnier
0 siblings, 1 reply; 5+ messages in thread
From: Toru TSUNEYOSHI @ 2010-03-07 4:46 UTC (permalink / raw)
To: emacs-devel
[-- Attachment #1: Type: Text/Plain, Size: 1568 bytes --]
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
[-- Attachment #2: strcmp.el --]
[-- Type: Text/Plain, Size: 7366 bytes --]
(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)
[-- Attachment #3: ls-lisp.el.diff --]
[-- Type: Text/X-Patch, Size: 1783 bytes --]
--- 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)
+
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -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
[-- Attachment #4: test.el --]
[-- Type: Text/Plain, Size: 1536 bytes --]
;; (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)
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: enable sorting by version in `ls-lisp-handle-switches'
2010-03-07 4:46 enable sorting by version in `ls-lisp-handle-switches' Toru TSUNEYOSHI
@ 2010-03-07 14:49 ` Stefan Monnier
[not found] ` <20100312.030317.128157175.tune@to.email.ne.jp>
0 siblings, 1 reply; 5+ messages in thread
From: Stefan Monnier @ 2010-03-07 14:49 UTC (permalink / raw)
To: Toru TSUNEYOSHI; +Cc: emacs-devel
> 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'.
You may also want to take a look at mpc-compare-strings which does
something similar, tho simpler (not specific to versions, just taking
care of numbers).
Stefan
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: enable sorting by version in `ls-lisp-handle-switches'
[not found] ` <20100312.030317.128157175.tune@to.email.ne.jp>
@ 2010-03-11 19:20 ` Stefan Monnier
2010-03-12 5:31 ` Toru TSUNEYOSHI
2010-03-12 7:00 ` Toru TSUNEYOSHI
1 sibling, 1 reply; 5+ messages in thread
From: Stefan Monnier @ 2010-03-11 19:20 UTC (permalink / raw)
To: Toru TSUNEYOSHI; +Cc: emacs-devel
>> You may also want to take a look at mpc-compare-strings which does
>> something similar, tho simpler (not specific to versions, just taking
>> care of numbers).
> I checked `mpc-compare-strings'.
> `mpc-compare-strings' and `string-logical-lessp' are different.
Indeed, I don't expect them to behave identically.
> (mpc-compare-strings "01-00001" "1-1") => 1
> (string-logical-lessp "01-00001" "1-1") => nil
> (mpc-compare-strings "1-1" "01-00001") => -1
> (string-logical-lessp "1-1" "01-00001") => nil
I remember having struggled over "correct" handling (meaning, making
sure that it's transitive) of leading zeroes in
mpc-compare-strings, so I'm not very surprised.
I don't really care whether "1-1" is considered larger, smaller or
equivalent to "01-00001". I don't think such issues show up much in
practice and I'm not sure as a user I'd prefer one over the other.
The implementation strategy is also very different, so I'd expect the
performance behavior to be quite different as well.
Stefan
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: enable sorting by version in `ls-lisp-handle-switches'
2010-03-11 19:20 ` Stefan Monnier
@ 2010-03-12 5:31 ` Toru TSUNEYOSHI
0 siblings, 0 replies; 5+ messages in thread
From: Toru TSUNEYOSHI @ 2010-03-12 5:31 UTC (permalink / raw)
To: monnier; +Cc: emacs-devel
> Indeed, I don't expect them to behave identically.
OK. I wanted to list just different points between those functions.
Those are not alternative, I think.
(I have still struggled to write English properly. :) )
> The implementation strategy is also very different, so I'd expect the
> performance behavior to be quite different as well.
Yes. That's right.
Originally, I wanted `ls-lisp-handle-switches' to sort by version. Then
I made the functions, `string-version-lessp' (based on Gnu) and
`string-logical-lessp' (based on Windows).
I think that users will select the favorite one.
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: enable sorting by version in `ls-lisp-handle-switches'
[not found] ` <20100312.030317.128157175.tune@to.email.ne.jp>
2010-03-11 19:20 ` Stefan Monnier
@ 2010-03-12 7:00 ` Toru TSUNEYOSHI
1 sibling, 0 replies; 5+ messages in thread
From: Toru TSUNEYOSHI @ 2010-03-12 7:00 UTC (permalink / raw)
To: monnier; +Cc: emacs-devel
[-- Attachment #1: Type: Text/Plain, Size: 499 bytes --]
I mistaked in the following.
> And, if you eval the following, `string-logical-lessp' emulates sorting
> style by Windows Explorer on Windows XP or later. (Windows Explorer
> seems to use function `StrCmpLogicalW')
>
> (put 'string-version-lessp 'strcmplogical t)
I should have written
(put 'string-logical-lessp 'strcmplogical t)
And for temporary change, I shoud have replaced symbol property with
variable.
(setq string-logical-lessp--strcmplogical t)
I fixed and attached it.
[-- Attachment #2: strcmp.el --]
[-- Type: Text/Plain, Size: 15240 bytes --]
;; `strcmplogical-trans-tbl-at-1st-char' and
;; `strcmplogical-trans-tbl-after-2nd-char' of `string-logical-lessp'
;; are results composed of only output by Window Explorer on Windows XP
;; and Windows API `StrCmpLogicalW'.
;;
;; It is arranged about some code (?\C-? ?' ?- and array using a case
;; sensitive of alphabet. (Enable case insensitive by `ls-lisp-ignore-case')
(put
'string-logical-lessp
'strcmplogical-trans-tbl-at-1st-char
'(
#x00 ; \C-@
#x01 ; \C-a
#x02 ; \C-b
#x03 ; \C-c
#x04 ; \C-d
#x05 ; \C-e
#x06 ; \C-f
#x07 ; \C-g
#x08 ; \C-h
#x0e ; \C-n
#x0f ; \C-o
#x10 ; \C-p
#x11 ; \C-q
#x12 ; \C-r
#x13 ; \C-s
#x14 ; \C-t
#x15 ; \C-u
#x16 ; \C-v
#x17 ; \C-w
#x18 ; \C-x
#x19 ; \C-y
#x1a ; \C-z
#x1b ; \C-[
#x1c ; \C-\\
#x1d ; \C-]
#x1e ; \C-^
#x1f ; \C-_
#x20 ; (SPC)
#x09 ; TAB
#x0a ; \C-j
#x0b ; \C-k
#x0c ; \C-l
#x0d ; \C-m
#x21 ; !
#x22 ; "
#x23 ; #
#x24 ; $
#x25 ; %
#x26 ; &
#x27 ; '
#x28 ; (
#x29 ; )
#x2a ; *
#x2c ; ,
#x2e ; .
#x2f ; /
#x3a ; :
#x3b ; ;
#x3f ; ?
#x40 ; @
#x5b ; [
#x5d ; ]
#x5e ; ^
#x5f ; _
#x60 ; `
#x7b ; {
#x7c ; |
#x7d ; }
#x7e ; ~
#x2b ; +
#x2d ; -
#x3c ; <
#x3d ; =
#x3e ; >
#x5c ; \
#x7f ; \C-?
#x30 ; 0
#x31 ; 1
#x32 ; 2
#x33 ; 3
#x34 ; 4
#x35 ; 5
#x36 ; 6
#x37 ; 7
#x38 ; 8
#x39 ; 9
#x41 ; A
#x42 ; B
#x43 ; C
#x44 ; D
#x45 ; E
#x46 ; F
#x47 ; G
#x48 ; H
#x49 ; I
#x4a ; J
#x4b ; K
#x4c ; L
#x4d ; M
#x4e ; N
#x4f ; O
#x50 ; P
#x51 ; Q
#x52 ; R
#x53 ; S
#x54 ; T
#x55 ; U
#x56 ; V
#x57 ; W
#x58 ; X
#x59 ; Y
#x5a ; Z
#x61 ; a
#x62 ; b
#x63 ; c
#x64 ; d
#x65 ; e
#x66 ; f
#x67 ; g
#x68 ; h
#x69 ; i
#x6a ; j
#x6b ; k
#x6c ; l
#x6d ; m
#x6e ; n
#x6f ; o
#x70 ; p
#x71 ; q
#x72 ; r
#x73 ; s
#x74 ; t
#x75 ; u
#x76 ; v
#x77 ; w
#x78 ; x
#x79 ; y
#x7a ; z
))
(put
'string-logical-lessp
'strcmplogical-trans-tbl-after-2nd-char
'(
#x00 ; \C-@
#x01 ; \C-a
#x02 ; \C-b
#x03 ; \C-c
#x04 ; \C-d
#x05 ; \C-e
#x06 ; \C-f
#x07 ; \C-g
#x08 ; \C-h
#x0e ; \C-n
#x0f ; \C-o
#x10 ; \C-p
#x11 ; \C-q
#x12 ; \C-r
#x13 ; \C-s
#x14 ; \C-t
#x15 ; \C-u
#x16 ; \C-v
#x17 ; \C-w
#x18 ; \C-x
#x19 ; \C-y
#x1a ; \C-z
#x1b ; \C-[
#x1c ; \C-\\
#x1d ; \C-]
#x1e ; \C-^
#x1f ; \C-_
#x30 ; 0
#x31 ; 1
#x32 ; 2
#x33 ; 3
#x34 ; 4
#x35 ; 5
#x36 ; 6
#x37 ; 7
#x38 ; 8
#x39 ; 9
#x20 ; (SPC)
#x09 ; TAB
#x0a ; \C-j
#x0b ; \C-k
#x0c ; \C-l
#x0d ; \C-m
#x21 ; !
#x22 ; "
#x23 ; #
#x24 ; $
#x25 ; %
#x26 ; &
#x27 ; '
#x28 ; (
#x29 ; )
#x2a ; *
#x2c ; ,
#x2e ; .
#x2f ; /
#x3a ; :
#x3b ; ;
#x3f ; ?
#x40 ; @
#x5b ; [
#x5d ; ]
#x5e ; ^
#x5f ; _
#x60 ; `
#x7b ; {
#x7c ; |
#x7d ; }
#x7e ; ~
#x2b ; +
#x2d ; -
#x3c ; <
#x3d ; =
#x3e ; >
#x5c ; \
#x7f ; \C-?
#x41 ; A
#x42 ; B
#x43 ; C
#x44 ; D
#x45 ; E
#x46 ; F
#x47 ; G
#x48 ; H
#x49 ; I
#x4a ; J
#x4b ; K
#x4c ; L
#x4d ; M
#x4e ; N
#x4f ; O
#x50 ; P
#x51 ; Q
#x52 ; R
#x53 ; S
#x54 ; T
#x55 ; U
#x56 ; V
#x57 ; W
#x58 ; X
#x59 ; Y
#x5a ; Z
#x61 ; a
#x62 ; b
#x63 ; c
#x64 ; d
#x65 ; e
#x66 ; f
#x67 ; g
#x68 ; h
#x69 ; i
#x6a ; j
#x6b ; k
#x6c ; l
#x6d ; m
#x6e ; n
#x6f ; o
#x70 ; p
#x71 ; q
#x72 ; r
#x73 ; s
#x74 ; t
#x75 ; u
#x76 ; v
#x77 ; w
#x78 ; x
#x79 ; y
#x7a ; z
))
;; Convert the above translation table to vector indexed by ascii code
(mapc
(lambda (x)
(unless (vectorp (get 'string-logical-lessp x))
;; make vector from list of cdr part
;;
;; '((#x00 . 0) (#x01 . 1) ... (#x7a . 127) ... (#x7f . 53))
;; => '(0 1 ... 127 ... 53)
;; => [0 1 ... 127 ... 53]
(put 'string-logical-lessp
x
(apply
'vector
(mapcar
'cdr
;; sort by car part
;;
;; '((#x00 . 0) (#x01 . 1) ... (#x7f . 53) ... (#x7a . 127))
;; => '((#x00 . 0) (#x01 . 1) ... (#x7a . 127) ... (#x7f . 53))
(sort
(let ((i 0))
;; make index on cdr part
;;
;; '(#x00 #x01 ... #x7a)
;; => '((#x00 . 0) (#x01 . 1) ... (#x7f . 53) ... (#x7a . 127))
(mapcar
(lambda (x)
(prog1
(cons x i)
(setq i (1+ i))))
(get 'string-logical-lessp x)))
(lambda (x y)
(< (car x) (car y)))))))))
'(strcmplogical-trans-tbl-at-1st-char
strcmplogical-trans-tbl-after-2nd-char))
;; Length
(put 'string-logical-lessp 'strcmplogical-trans-tbl-at-1st-char-len
(length (get 'string-logical-lessp 'strcmplogical-trans-tbl-at-1st-char)))
(put 'string-logical-lessp 'strcmplogical-trans-tbl-after-2nd-char-len
(length (get 'string-logical-lessp 'strcmplogical-trans-tbl-after-2nd-char)))
(defvar string-logical-lessp--strcmplogical nil
"If non-nil, emulate filename sorting style of Window Explorer on
Windows XP (or later) and Windows API `StrCmpLogicalW' easily.
See also `string-logical-lessp'.
Example:
(sort
'(\".emacs\"
\".emacs-places.~10~\"
\".emacs-places.~9~\"
\".emacs.~10~\"
\".emacs.~9~\")
'string-logical-lessp)
=>
;; string-logical-lessp--strcmplogical
;; =>
;; nil: t:
(\".emacs\" (\".emacs\"
\".emacs-places.~9~\" \".emacs.~9~\" ; <= just after \".emacs\"
\".emacs-places.~10~\" \".emacs.~10~\"
\".emacs.~9~\" \".emacs-places.~9~\"
\".emacs.~10~\") \".emacs-places.~10~\")")
\f
(defalias 'string-version< 'string-version-lessp)
(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'.
Policy of version order:
See `glibc-2.11.1/string/strverscmp.c' or it's manual.
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
(i 0) ; index of string s1, s2
c1 c2 ; character of string s1, s2 at index i
diff ; difference between c1 and c2
(dl '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) ; digit-list
(dl-except-0 '(?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) ; digit-list except 0
(state S_N)
(repeat t))
(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))
(while repeat
;; check limit
(if (<= l1 i)
(if (<= l2 i)
(throw 'end 0) ; s1 and s2 match.
(throw 'end -1)) ; s1 is less than s2.
(if (<= l2 i)
(throw 'end 1))) ; s1 is greater than s2.
(setq c1 (elt s1 i)
c2 (elt s2 i)
i (1+ i)
diff (- c1 c2)
state (+ state (cond ((eq c1 ?0) 2)
((memq c1 dl-except-0) 1)
(t 0))))
(if (= diff 0)
(setq state (aref next-state state))
(setq repeat nil)))
(setq state (aref result-type (+ (* state 3)
(cond ((eq c2 ?0) 2)
((memq c2 dl-except-0) 1)
(t 0)))))
(cond ((eq state CMP)
(setq ret diff))
((eq state LEN)
(while (progn
(setq c1 (if (< i l1) (elt s1 i) -1) ; -1: invalid code as character
c2 (if (< i l2) (elt s2 i) -1)
i (1+ i))
(memq c1 dl))
(unless (memq c2 dl)
(throw 'end 1)))
(setq ret (if (memq c2 dl) -1 diff)))
(t
(setq ret state)))
ret))
;; convert ret to the style of `string-lessp'
(< ret 0)))
(defalias 'string-logical< 'string-logical-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'.
Policy of Logical version order:
Sort by number whose leading 0 is skipped.
For example, \"1\", \"0001\" and \"0000001\" are equivalent.
And if `string-logical-lessp--strcmplogical' is non-nil, emulate
filename sorting style of Window Explorer on Windows XP (or later) and
Windows API `StrCmpLogicalW' easily. (The emulation is poor and
incomplete.)
1st character: sort by alphabetical order (not precisely ascii)
after 2nd character: digit takes first priority
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)
;; if `string-logical-lessp--strcmplogical' is non-nil
(sort
'(\"1#.txt\" => (\"##.txt\"
\"##.txt\") \"1#.txt\")
'string-logical-lessp)
(sort
'(\"#1.txt\" => (\"#1.txt\"
\"##.txt\") \"##.txt\")
'string-logical-lessp)"
(let (ret ; same style as return value of C language `strcmp'
l1 l2 ; length of string s1, s2
(i1 0) ; index of string s1, s2
(i2 0)
(c1 0) ; character of string s1, s2 at index n1, n2
(c2 0) ; (set dummy code as initial value)
d1 d2 ; digit flag
(dl '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))) ; digit-list
(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 t
;; check limit
(if (<= l1 i1)
(if (<= l2 i2)
(throw 'end 0) ; s1 and s2 match logically.
(throw 'end -1)) ; s1 is less than s2 logically.
(if (<= l2 i2)
(throw 'end 1))) ; s1 is greater than s2 logically.
(setq c1 (elt s1 i1)
c2 (elt s2 i2)
d1 (memq c1 dl)
d2 (memq c2 dl))
(cond ((and d1 d2) ; both c1 and c2 are digit.
(let (n1 n2 ; number
w1 w2) ; length (or width) of number
;; skip needless "0"
;;
;; example:
;; "0" => "0"
;; "00000" => "0"
;; "10" => "10"
;; "010" => "10"
;; "000010" => "10"
(string-match "0*\\([0-9]+\\)" s1 i1)
(setq n1 (match-string 1 s1)
w1 (length n1)
i1 (match-end 1)) ; next character index after number
(string-match "0*\\([0-9]+\\)" s2 i2)
(setq n2 (match-string 1 s2)
w2 (length n2)
i2 (match-end 1))
;; number whose length is shorter is less than another.
(cond ((< w1 w2) (throw 'end -1))
((> w1 w2) (throw 'end 1))
(t
;; as both lengths are equal,
;; we should use `compare-strings' instead of
;; `number-to-string' to avoid overflow.
(setq ret (compare-strings n1 nil nil
n2 nil nil))
(unless (eq ret t)
(throw 'end ret))))))
(t
(setq ret (- c1 c2))
(if (= ret 0)
;; next character index
(setq i1 (1+ i1)
i2 (1+ i2))
(when string-logical-lessp--strcmplogical
(let (tbl tbl-len)
(cond ((= i1 0) ; 1st character: sort by alphabetical order
(setq tbl (get 'string-logical-lessp
'strcmplogical-trans-tbl-at-1st-char)
tbl-len (get 'string-logical-lessp
'strcmplogical-trans-tbl-at-1st-char-len)))
(t ; after 2nd character: digit takes first priority
(setq tbl (get 'string-logical-lessp
'strcmplogical-trans-tbl-after-2nd-char)
tbl-len (get 'string-logical-lessp
'strcmplogical-trans-tbl-after-2nd-char-len))))
(if (< c1 tbl-len)
(setq c1 (aref tbl c1)))
(if (< c2 tbl-len)
(setq c2 (aref tbl c2))))
(setq ret (- c1 c2)))
(throw 'end ret)))))))
;; convert ret to the style of `string-lessp'
(< ret 0)))
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2010-03-12 7:00 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2010-03-07 4:46 enable sorting by version in `ls-lisp-handle-switches' Toru TSUNEYOSHI
2010-03-07 14:49 ` Stefan Monnier
[not found] ` <20100312.030317.128157175.tune@to.email.ne.jp>
2010-03-11 19:20 ` Stefan Monnier
2010-03-12 5:31 ` Toru TSUNEYOSHI
2010-03-12 7:00 ` Toru TSUNEYOSHI
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).