[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: find-name-dired exits when s is pressed (for sorting)
|
From: |
Ehud Karni |
|
Subject: |
Re: find-name-dired exits when s is pressed (for sorting) |
|
Date: |
Wed, 16 Jan 2002 23:57:28 +0200 |
On Sun, 13 Jan 2002 21:29:09 -0700 (MST), Richard Stallman <address@hidden>
wrote:
>
> Writing code to sort the Dired buffer by time or by name internally,
> handling subdirectories properly, is not trivial, but it should not be
> terribly hard either. Does someone want to try?
I wrote code for that exact purpose. It works in Emacs 20 & 21. It
supports sorting modes not supported by the OS (e.g by extension or
owner, also sorting directories and symbolic links before regular
files). This code also works with MULE (it support Hebrew names).
However, it is written in Emacs-lisp and for really large directories
(more than 1500 files) it is VERY noticeable. I'm sure it can be
improved both in structure and performance. I'm open to any suggestion
or if anybody want s/he can use it and rewrite it's own code.
Ehud.
;; -------------------- sort dired buffer code --------------------
(defvar dired-sort-number 0 "sort requested for this buffer (see help for
'dired-sort-set)")
(make-variable-buffer-local 'dired-sort-number)
(setq-default dired-sort-number 0) ;; initial value
(add-hook 'dired-after-readin-hook 'dired-sort-after-revert) ;check for sort
after revert
(defun dired-get-file-extension (file-name)
"In dired, return extension of FILE-NAME. Extension is defined as the
substring from the rightmost `.' to the end, if no dot return \"\"."
(if (string-match "\\." file-name)
(let* ((lng (length file-name))
(ix lng)
(ch 0)
(ext ""))
(while (not (= ch ?.))
(setq ix (1- ix))
(setq ch (aref file-name ix))
(setq ext (concat (list ch) ext)))
ext)
""))
(defun dired-get-file-length ()
"In dired, return length of file mentioned on this line.
Return 0 if there is no file on this line."
(string-to-int (dired-get-file-length-string)))
(defun dired-get-file-length-string ()
"In dired, return length of file mentioned on this line.
Return "0" if there is no file on this line."
(let ((length "0") bol pos)
(save-excursion
(beginning-of-line)
(setq bol (point))
(end-of-line)
(if (re-search-backward
(concat "[ ]" dired-months-regexp) bol t)
(progn
(setq pos (point))
(skip-chars-backward "^ " bol)
(setq length (buffer-substring (point) pos))))
length)))
(defun dired-get-file-owner ()
"In dired, return owner (1st field after number of links)
Return "" if there is no file on this line."
(let ((owner " ")
(pos (point))
(eol (progn (end-of-line) (point))))
(beginning-of-line)
(and (re-search-forward "[ ][^ ]*[-stx][ ]" eol t)
(re-search-forward "[0-9][ ]" eol t)
(setq owner (buffer-substring (point) (search-forward " "))))
(goto-char pos)
owner))
(defun dired-get-file-time (&optional arg)
"In dired, return file time as exactly 10 character string
optional ARG specify what time: 1-modify (def), 2-access, 3-control."
(or arg (setq arg 1)) ; def value
(let ((ftst " ") ;10 spaces
(tp (cond
((= arg 2) 4)
((= arg 3) 6)
(t 5)))
(fn (dired-get-filename t t))) ;file name/time
(and fn
(if (or (member system-type '(windows-nt dos))
(and (boundp 'ftp-on) ftp-on))
(save-excursion
(beginning-of-line)
(re-search-forward
(concat dired-months-regexp "[ ]+[0-9]+") nil t)
(let* ((beg (match-beginning 0))
(end (match-end 0))
(ymf (+ 0.032786885 (/ (float (car
(current-time))) 40.12756))) ; Year & month in float
(YR (format "%3d" (+ 170 (truncate (/ ymf
12))))) ; curent year 1xx/2xx
(HM "0000")
; def hou.minute
(MNT (cdr-safe (assoc (upcase (buffer-substring
beg (+ 3 beg)))
timezone-months-assoc)))
; month number or nil (unknown)
(DAY (string-to-number (buffer-substring (- end
2) end) 10)) ; day (number)
)
(or MNT (setq MNT 0)) ; convert unknown
month to 0
(setq ymf (1+ (% (truncate ymf) 12))) ; current
month 1-12
(skip-chars-forward " ") ; start of YEAR or
HH:MM
(setq beg (point))
(skip-chars-forward "^ ") ; end of YEAR or
HH:MM
(setq end (point))
(if (= (- end beg) 4) ; 4 digits - YEAR
19xx/20xx
(setq YR (concat
(buffer-substring beg (1+ beg))
(buffer-substring (- end 2) end)))
(setq HM (concat
(buffer-substring beg (+ beg 2))
(buffer-substring (- end 2) end))
YR (if (<= MNT ymf) YR
;leave year as is if month <= current
(format "%d" (1- (string-to-number
YR))))));decrease 1 otherwise
(setq DAY (format "%d" (+ 100 (* MNT 50) DAY))) ;
month*50 + day + 100 (3 digits)
(setq ftst (concat YR DAY HM)))) ;
3d-3d-4d (10 chars)
(progn
(setq fn (nth tp (file-attributes fn))) ;
get file time as (hi16bit lo16bit)
(setq ftst (format "%d%d" (+ 10000 (or (car fn) 0)) ;
convert each to exactly 5
(+ 10000 (or (nth 1 fn) 0))))))) ;
decimal digits
ftst))
(defun dired-restore-8bit-chars ()
"Replace \[23]xx (4 chars) with their real value (1 char) in the whole buffer"
(let ((pos (point-marker))
buffer-read-only
rplc
)
(goto-char (point-min))
(while (re-search-forward "\\\\[23][0-7][0-7]" nil t)
(setq rplc (read (concat "\""
(buffer-substring (match-beginning 0)
(match-end 0))
"\"")))
(and (eq 'w32 window-system) ;; Windows NT/95 system (20.x)
(string-lessp rplc "\233")
(aset rplc 0 (+ 96 (aref rplc 0)))) ;;windows erorr in
handling Hebrew names
(replace-match rplc t t))
(goto-char (point-min))
(while (search-forward "\\ " nil t)
(replace-match " " t t))
(goto-char pos)))
(defun dired-sort-after-revert () "sort the buffer each time its re-read or
inserted"
(let* ((bdir (< dired-sort-number 0)) ;begin with dirs
(rvrs (>= (mod (abs dired-sort-number) 100) 10)) ;revers switch
(o-s (mod (abs dired-sort-number) 10)) ;0-6 sort
requested
(ftp-on (string-match "@.*:" ;ange-ftp on
switch
(if (listp dired-directory)
(car dired-directory)
dired-directory))))
(dired-restore-8bit-chars) ; convert Hebrew to 8bit
(if bdir ; special dirs
(dired-sort-ek rvrs o-s bdir) ; Yes, use my sort
(and (or
(and (member system-type '(windows-nt dos))
(>= o-s 1)) ; sort of any type in
MSDOS
;;;; U N I X - (with ange ftp) ==============================
(>= o-s 4) ; sort by owner / size /
extension (unix)
ftp-on) ; any (ange-ftp)
(dired-sort-ek rvrs o-s)))); sort by any needed sort (0-6)
(set-buffer-modified-p nil)) ; ignore modification done by
sort
(defun dired-sort-ek (reverse sub-sort &optional bdir)
"sort the buffer (REVERSED) according to SUB-SORT:
0-name, 1,2,3-sort by time/name, 4-size/name, 5-owner/name, 6-extension/name.
Optional BDIR - sort directories at beging by name."
(let ((sv-fn (dired-get-filename 'no-dir t))
(sv-fn-ful (dired-get-filename t t))
(sv-pos (point-marker))
(sv-col (column-no))
(sbul buffer-undo-list) ;; undo list
buffer-read-only
(fsdch "531") ;; file/symbolic/dir char
(diron 0) ;; sub type - file/symbolic/dir -
0/1/2
ds-chk ;; dir/symbolic check
fn beg end sv-end)
(and (> sub-sort 0)
(< sub-sort 4)
(setq reverse (not reverse)))
(and bdir
reverse
(setq fsdch "579"))
(goto-char (point-min))
(while (not (eobp))
(while (and (not (eobp)) (not (dired-get-filename 'no-dir t)))
(forward-line 1)) ;;search 1st line of
directory to sort
(beginning-of-line)
(setq beg (point))
(while (and (not (eobp))
(setq fn (dired-get-filename 'no-dir t)))
(beginning-of-line)
(and bdir fn
(setq diron 0
ds-chk (if (member system-type '(windows-nt dos))
;; on W9x/DOS use the bash attributes
(cond
((looking-at ". d") t)
;;directory
((looking-at ". l") "symlink")
;;symbolic link
(t nil))
(nth 0 (file-attributes fn)))) ;
exit from and for regular files
(setq diron
(if (or (eq ds-chk t)
(string-equal fn "..")
(string-equal fn "."))
2 1)))
(insert (aref fsdch diron)
(cond
((> diron 0)
(and reverse
(setq diron (length fn))
(setq fn (concat fn "��"))
(while (> diron 0)
(setq diron (1- diron))
(setq ds-chk (- 287 (% (aref fn
diron) 256)))
(if (> ds-chk 255) (setq ds-chk 255))
(aset fn diron ds-chk)))
"") ;; ensure
add nothing
((= sub-sort 0) "") ;; we realy
need only the name
((< sub-sort 4) ;; 1, 2 or 3
(all the same on pc)
(dired-get-file-time sub-sort))
((= sub-sort 4)
(dired-get-file-owner))
((= sub-sort 5)
(substring (concat " "
(dired-get-file-length-string)) -10))
((= sub-sort 6)
(dired-get-file-extension fn))
(t ""))
" "
fn
" ��‗")
(forward-line 1))
(setq sv-end (point-marker))
(setq end (point))
(sort-lines reverse beg end)
(goto-char beg)
(while (< (point-marker) sv-end)
(delete-region (point)
(search-forward " ��‗"))
(forward-line 1))
(goto-char sv-end))
(setq buffer-undo-list sbul) ;; restore undo
(goto-char sv-pos)
(if sv-fn
(progn
(goto-char (point-min))
(while (not (string-equal sv-fn-ful (dired-get-filename t
t)))
(search-forward sv-fn)
(end-of-line))
(goto-col sv-col)))))
(defun dired-sort-set (&optional arg)
"Sort current dired buffer (and reread),
and change dired-listing-switches according to argument:
0/9 -sort by name (normal) - al
1 - sort by modification time - alt PC:-al
2 - sort by access time - altu PC:-al
3 - sort by control (chmod ..) time - altc PC:-al
4 - sort by owner / name - al
5 - sort by size / name - al
6 - sort by extension / name - al
Add 10 for reverse sorting (r switch to ls)
Add 100 for subdirectory inclusion (R switch to ls)
Use negative value (e.g. -101) for listing directories
and symbolic links at the beginning by name"
(interactive "P")
(or arg
(save-window-excursion
(describe-function 'dired-sort-set)
(setq arg (string-to-int (read-string
"Enter new sort value for this Dired: " (format "%s"
dired-sort-number))))
(kill-buffer "*Help*")))
(let* ((a-arg (abs arg))
(Subdir (if (< a-arg 100) "" "R"))
(revers (if (< (mod a-arg 100) 10) "" "r"))
(switch (mod a-arg 10))
(d-l-s ""))
(cond
((member system-type '(windows-nt dos))
(setq d-l-s "-al")) ;; it always "-al" in
MSDOS/windows
((or (= switch 0) ;; by name
(= switch 9)) ;; 0 / 9
(setq d-l-s "-al"))
((= switch 1)
(setq d-l-s "-alt"))
((= switch 2)
(setq d-l-s "-altu"))
((= switch 3)
(setq d-l-s "-altc"))
((<= switch 6)
(setq d-l-s "-al"))
(t
(error "arg to dired-sort-set is %d - must be [01][01][0-6]"
arg)))
(setq-default dired-sort-number arg) ;; make it default for new
dirs
(setq dired-sort-number arg)
(setq dired-actual-switches (setq dired-listing-switches (concat
d-l-s revers Subdir)))
(dired-sort-set-modeline)
(revert-buffer)))
(define-key dired-mode-map "z" 'dired-sort-set)
(defun dired-sort-set-modeline () "Dired sub mode (sort & Subdirectory options)"
(let ((modec "Dired by ")
(dsn (abs dired-sort-number))
(case-fold-search))
(if (string-match "t" dired-actual-switches)
(progn
(cond
((string-match "u" dired-actual-switches)
(setq modec (concat modec "access")))
((string-match "c" dired-actual-switches)
(setq modec (concat modec "control")))
(t (setq modec (concat modec "modify"))))
(setq modec (concat modec " time")))
(progn
(cond
((= (mod dsn 10) 4)
(setq modec (concat modec "owner/")))
((= (mod dsn 10) 5)
(setq modec (concat modec "size/")))
((= (mod dsn 10) 6)
(setq modec (concat modec "ext/"))))
(setq modec (concat modec "name"))))
(and (string-match "r" dired-actual-switches)
(setq modec (concat modec " reversed")))
(and (string-match "R" dired-actual-switches)
(setq modec (concat modec " (SubDir)")))
(setq mode-name modec))
(force-mode-line-update))
(define-key dired-mode-map [menu-bar sort] (cons "Sort" (make-sparse-keymap
"Sort")))
(let (typ kot nnn lsw
(srt-opts '(
(ext "6" "extens/name" "-alb")
(size "5" "size/name " "-alb")
(owner "4" "owner/name " "-alb")
(ctrl "3" "chmod time " "-albtc")
(acct "2" "access time" "-albtu")
(modt "1" "mod time " "-albt")
(name "0" "name " "-alb"))))
(while srt-opts
(setq kot (car srt-opts))
(setq srt-opts (cdr srt-opts))
(setq typ (vector 'menu-bar 'sort (car kot)))
(setq nnn (nth 1 kot))
(setq lsw (nth 3 kot))
(setq kot (concat "sort by " (nth 2 kot)))
(define-key dired-mode-map typ (cons (concat kot " " lsw)
(make-sparse-keymap kot)))
(setq typ (vector (aref typ 0) (aref typ 1) (aref typ 2) 'no-rvrs))
(define-key dired-mode-map typ (cons " -NO- subdirs/reverse"
(concat "1" nnn "z")))
(aset typ 3 'no-nrml)
(define-key dired-mode-map typ (cons " -NO- subdirs/normal"
(concat nnn "z")))
(aset typ 3 'inc-rvrs)
(define-key dired-mode-map typ (cons "include subdirs/reverse"
(concat "11" nnn "z")))
(aset typ 3 'inc-nrml)
(define-key dired-mode-map typ (cons "include subdirs/normal"
(concat "10" nnn "z")))))
(defun dired-sort-set-menu (event)
"Pop up a menu of sort-options for this dired buffer
This switches buffers in the window that you clicked on,
and selects that window."
(interactive "e")
(let (rsb ; reverse & sub dir
option
(srt (x-popup-menu t '("type select"
("dired sort options"
("normal (sort by name) " . 0)
("sort by modification time " . 1)
("sort by access time " . 2)
("sort by control (chmod ..) time" . 3)
("sort by owner / name " . 4)
("sort by size / name " . 5)
("sort by extension / name " . 6)))))) ;;major
sort option
(and srt
(setq rsb (x-popup-menu t '("rsb"
("sort order / subdirectory"
("ls order, NO sub directories" . 0)
("-r order, NO sub directories" . 10)
("ls order, + sub directories " . 100)
("-r order, + sub directories " . 110)))))
(setq srt (+ srt rsb))
(dired-sort-set srt))))
(define-key dired-mode-map [drag-mouse-3] 'dired-sort-set-menu) ;; sort dired
;; --------------- sort dired buffer code ends here ---------------
--
Ehud Karni Tel: +972-3-7966-561 /"\
Mivtach - Simon Fax: +972-3-7966-667 \ / ASCII Ribbon Campaign
Insurance agencies (USA) voice mail and X Against HTML Mail
http://www.mvs.co.il FAX: 1-815-5509341 / \
mailto:address@hidden Better Safe Than Sorry