emacs_el/tiny-tools/other/dired-sort.el

   1 ;;; dired-sort.el --- Sort by by size, date, field, name and type
   2
   3 ;; This file is not part of Emacs
   4
   5 ;; {{{ Id
   6
   7 ;; Maintainer:      Jari Aalto
   8 ;; Created:         1989-03
   9 ;; Keywords:        extensions
  10 ;;
  11 ;; This program is free software; you can redistribute it and/or modify it
  12 ;; under the terms of the GNU General Public License as published by the Free
  13 ;; Software Foundation; either version 2 of the License, or (at your option)
  14 ;; any later version.
  15 ;;
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  18 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  19 ;; for more details.
  20 ;;
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with program; see the file COPYING. If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25 ;;
  26 ;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
  27
  28 ;; }}}
  29 ;; {{{ Install
  30
  31 ;;; Install:
  32
  33 ;;  Put this file on your Emacs-Lisp load path, add following into your
  34 ;;  ~/.emacs startup file.
  35 ;;
  36 ;;      (add-hook 'dired-mode-hook '(lambda () (require 'dired-sort)))
  37 ;;
  38 ;;  NOTE: ls-lisp.el, which dired.el uses, by default inserts month names
  39 ;;  in national format. If the setting is anything other than English,
  40 ;;  this module *cannot* parse the dired lines. Please add this setting
  41 ;;  to your Emacs (21.4+) to make dired listing use ISO 8601 date stamps:
  42 ;;
  43 ;;   (setq ls-lisp-format-time-list
  44 ;;       '("%Y-%m-%d %H:%M"
  45 ;;         "%Y-%m-%d      "))
  46
  47 ;; }}}
  48 ;; {{{
  49
  50 ;;; Commentary:
  51
  52 ;;
  53 ;;  Preface, Nov 1997
  54 ;;
  55 ;;      Not much to say. I have had this package lying in my lisp directory
  56 ;;      since Emacs 18.xx days. When I noticed that this package doesn't
  57 ;;      exist in the OHIO archive, neither did the ftpsearch locate it,
  58 ;;      I decided to clen it up and put publically available.
  59 ;;
  60 ;;      The original author is unknown And the only thing that was in the
  61 ;;      original documentation was this line:
  62 ;;
  63 ;;      $Header: /tmp_mnt/am/p7/utility/gmacs/f2/RCS/dired-resort.el,v
  64 ;;      1.1 88/11/03 13:22:08 fad Exp $
  65 ;;
  66 ;;  New bindings in dired
  67 ;;
  68 ;;      When you load this file, function `dired-sort-default-keys' is called.
  69 ;;      The following bindings to dired mode are defined.
  70 ;;
  71 ;;          S" "    dired-sort-resort    (that's an "s" + SPACE)
  72 ;;          Ss      dired-sort-by-size
  73 ;;          Sd      dired-sort-by-date
  74 ;;          Sf      dired-sort-by-field
  75 ;;          Sn      dired-sort-by-name
  76 ;;          St      dired-sort-by-type
  77 ;;
  78 ;; }}}
  79
  80 ;;; Change Log:
  81
  82 ;;; Code:
  83
  84 (require 'date-parse)
  85
  86 (eval-and-compile
  87   ;;  Silence Byte compiler
  88   (defvar revert-buffer-function)
  89   (defvar current-prefix-arg) ;; Elint.el
  90   ;; Not exported from sort.el
  91   (autoload 'sort-subr                "sort")
  92   (autoload 'sort-fields-1            "sort")
  93   (autoload 'dired-revert             "dired")
  94   (autoload 'dired-get-filename       "dired")
  95   (autoload 'dired-move-to-filename   "dired")
  96   (autoload 'sort-skip-fields         "sort"))
  97
  98 ;;; ....................................................... &variables ...
  99
 100 (defvar dired-sort-load-hook '(dired-sort-default-keys)
 101   "Hook run when file is loaded.")
 102
 103 ;; File property caching mechanism for dired
 104
 105 (defvar dired-sort-line-property-table nil
 106   "Buffer local obarray:
 107 Each symbol is a file name whose plist caches file properties,
 108 accessed by #'dired-line-property")
 109 (make-variable-buffer-local 'dired-sort-line-property-table)
 110
 111 (defvar dired-sort-resort-last-kind '(date)
 112   "What the last sort did to the buffer.")
 113 (make-variable-buffer-local 'dired-sort-resort-last-kind)
 114
 115 (defvar dired-sort-resort-alist
 116   '(("name" dired-sort-by-name nil "ascending order")
 117     (nil dired-sort-by-name t "descending order")
 118     ("date" dired-sort-by-date nil "most recent first")
 119     (nil dired-sort-by-date t "oldest first")
 120     ("size" dired-sort-by-size nil "biggest first")
 121     (nil dired-sort-by-size t "smallest first")
 122     ("type" dired-sort-by-type t "alphabetically")
 123     ("modes" dired-sort-by-field 1 "file modes")
 124     ("links" dired-sort-by-field 2 "number of links")
 125     ("owner" dired-sort-by-field 3 "file owner")
 126     ("field" dired-sort-by-field (1) "textual field")))
 127
 128 ;;; ............................................................ &code ...
 129
 130 (defvar dired-sort-last-sort  nil
 131   "Last sort indication.")
 132
 133 (defun dired-sort-revert-and-decache (&optional arg noconfirm)
 134   "Revert buffer using `dired-revert' ARG and NOCONFIRM."
 135   (if dired-sort-line-property-table
 136       (mapatoms (function (lambda (file) (setplist file nil)))
 137                 dired-sort-line-property-table))
 138   (dired-revert arg noconfirm))
 139
 140 (defun dired-sort-line-property (func)
 141   "Call FUNC with one argument:  The (absolute) file name of this dired line.
 142 Cache the result, and return it the next time without calling FUNC.
 143    The caches are cleared when the buffer is reverted.
 144    See dired-sort-line-property-table."
 145   (or dired-sort-line-property-table
 146       (progn
 147         (if (eq revert-buffer-function 'dired-revert)
 148             (setq revert-buffer-function 'dired-sort-revert-and-decache))
 149         (setq dired-sort-line-property-table (make-vector 31 0))))
 150   (let ((file (intern (dired-get-filename t) dired-sort-line-property-table)))
 151     (or (get file func)
 152         (put file func
 153              (funcall func (symbol-name file))))))
 154
 155 (defun dired-sort-move-word-backward ()
 156   "move one space dlimited word backward. Must already be on word."
 157   (skip-chars-backward "^ \t" (line-beginning-position))
 158   (skip-chars-backward " \t" (line-beginning-position))
 159   (skip-chars-backward "^ \t" (line-beginning-position)))
 160
 161 ;;   FIXME: It is unreliable to read words from dired buffer,
 162 ;;   because the Month name can be in national format.
 163 ;;   => There is no eas way, doing file stat() would be too
 164 ;;   expensive to find out the month name?
 165 ;;   => It is bets to configure Emacs to always use
 166 ;;   ISO dates only.
 167
 168 (defun dired-sort-move-to-date (&optional and-extract)
 169   "Details depend on the `dired-extract-size' AND-EXTRACT."
 170   ;;  Go two words backward
 171   ;;                         4694 Month 16   19:44 file
 172   ;; -rw-rw----   1 foo foo  2082 2004-10-14 17:23 .
 173   ;;                                               |
 174   ;;                                      start here
 175   (when (dired-move-to-filename)
 176     (let ((end (point)))
 177       (dired-sort-move-word-backward)
 178       (dired-sort-move-word-backward)
 179       ;;  Now, should we still take on leap due to Month name?
 180       (unless (looking-at "[0-9][0-9][0-9][0-9]-")
 181         (dired-sort-move-word-backward))
 182       (if and-extract
 183           (parse-date (buffer-substring (point) end) t)
 184         (point)))))
 185
 186 (defun dired-sort-extract-date ()
 187   "Call `dired-sort-move-to-date'."
 188   (dired-sort-move-to-date t))
 189
 190 (defun dired-sort-extract-size ()
 191   "Read size with regular expression."
 192   (let ((ret -1))
 193     (when (dired-sort-move-to-date)
 194       (skip-chars-backward " " (line-beginning-position))
 195       (skip-chars-backward "0-9" (line-beginning-position))
 196       (if (looking-at "[0-9]+ ")
 197           (setq ret (read (current-buffer)))))
 198     ret))
 199
 200 (defun dired-sort-header-line-p ()
 201   "Check `dired-sort-extract-size'."
 202   (save-excursion
 203     (minusp (dired-sort-extract-size))))
 204
 205 (defun dired-sort-first-file ()
 206   "Goto first file."
 207   (interactive)
 208   (goto-char (point-min))
 209   (while (and (dired-sort-header-line-p)
 210               (not (eobp)))
 211     (forward-line 1))
 212   (dired-move-to-filename))
 213
 214 (defun dired-sort-extract-date-key (&optional ignore)
 215   "Extract key with IGNORE."
 216   (let ((date (dired-sort-extract-date)))
 217     (if date
 218         (date-compare-key date 'integer))))
 219
 220 (defun dired-sort-by-size-key (&optional ignore)
 221   "Sort by zise or IGNORE."
 222   (dired-sort-by-size-key-1 nil))
 223
 224 (defun dired-sort-by-size-increasing-key (&optional ignore)
 225   "Sort by zise or IGNORE."
 226   (dired-sort-by-size-key-1 t))
 227
 228 (defun dired-sort-resort-menu-options ()
 229   "See `dired-sort-resort-alist'."
 230   (list "Help"
 231         (cons "Sort Dired listing by:"
 232               (mapcar
 233                (function(lambda (elt)
 234                           (cons
 235                            (format "%5s (%s)"
 236                                    (capitalize (or (nth 0 elt) " '' "))
 237                                    (nth 3 elt))
 238                            elt)))
 239                dired-sort-resort-alist))))
 240
 241 (defun dired-sort-by-size-key-1 (incr-p)
 242   "Sort possibly with INCR-P."
 243   (let ((size (dired-sort-extract-size))
 244         (char (save-excursion
 245                 (forward-line 0)
 246                 (skip-chars-forward " ")
 247                 (following-char))))
 248     (setq char (downcase char))
 249     (cond
 250      ((not incr-p))
 251      ((= char ?-) (setq char ?~))
 252      ((>= char ?a) (setq char (- (+ ?a ?z) char))))
 253     (format "%c%09d" char size)))
 254
 255 (defun dired-sort-read-resort-args (&optional res)
 256   "Produce a 1- or 2- list.
 257 Suitable for non-interactive calling of dired-sort-resort.
 258 Optional RES is a line from dired-sort-resort-alist."
 259   (or res
 260       (setq res
 261             (completing-read
 262              (format "Sort by: [%s] " (car dired-sort-resort-last-kind))
 263              dired-sort-resort-alist
 264              nil t)))
 265   (if (zerop (length res))
 266       dired-sort-resort-last-kind
 267     (if (atom res)
 268         (setq res (or (assoc res dired-sort-resort-alist)
 269                       (error "reading resort"))))
 270     (let ((type (nth 0 res))
 271           (func (nth 1 res))
 272           (arg (nth 2 res))
 273           (what (nth 3 res)))
 274       (let ((ptr dired-sort-resort-alist) elt)
 275         (while (and ptr (null type))
 276           (setq elt (car ptr) ptr (cdr ptr))
 277           (if (eq func (nth 1 elt))
 278               (setq type (nth 0 elt)))))
 279       (setq type (intern type))
 280       (cond
 281        ((atom arg))
 282        (current-prefix-arg
 283         (setq arg
 284               (if (integerp (car arg))
 285                   (prefix-numeric-value current-prefix-arg)
 286                 (and current-prefix-arg t))))
 287        ((integerp (car arg))
 288         (setq arg (read-string (format "What %s? " what))))
 289        (t (setq arg (y-or-n-p (format "%s? " what)))))
 290       (if (null arg)
 291           type
 292         (list type arg)))))
 293
 294 ;;; ..................................................... &interactive ...
 295
 296 (defun dired-sort-last-file ()
 297   "Go to last file."
 298   (interactive)
 299   (goto-char (point-max))
 300   (while (and (dired-sort-header-line-p)
 301               (not (bobp)))
 302     (forward-line -1))
 303   (dired-move-to-filename))
 304
 305 (defun dired-sort-narrow-to-files ()
 306   "Narrow to visible files."
 307   (interactive)
 308   (narrow-to-region
 309    (save-excursion
 310      (dired-sort-first-file)
 311      (forward-line 0)
 312      (point))
 313    (save-excursion
 314      (dired-sort-last-file)
 315      (forward-line 1)
 316      (point))))
 317
 318 ;;;###autoload
 319 (defun dired-sort-by-date (&optional arg)
 320   "In dired, sort the lines by date, newest first.
 321 With ARG, sorts oldest first."
 322   (interactive "P")
 323   (save-restriction
 324     (dired-sort-narrow-to-files)
 325     (let (buffer-read-only)
 326       (goto-char (point-min))
 327       (sort-subr
 328        (not arg) 'forward-line 'end-of-line
 329        (function
 330         (lambda ()
 331           (or (dired-sort-line-property 'dired-sort-extract-date-key)))))))
 332   ;; (throw key 'nil)
 333   (setq dired-sort-last-sort (if arg
 334                                  'oldest
 335                                'newest))
 336   (message "Dired-sort: Now sorted by date, %s first."
 337            (if arg
 338                "oldest"
 339              "newest")))
 340
 341 (defun dired-sort-by-name (&optional arg skip-to sort-by)
 342   "In dired, sort the lines by file name.
 343 With ARG, sorts in reverse order. SKIP-TO SORT-BY."
 344   (interactive "P")
 345   (or sort-by (setq sort-by 'name))
 346   (save-restriction
 347     (dired-sort-narrow-to-files)
 348     (let ((buffer-read-only nil)
 349           (reverse-sort-p arg))
 350       (goto-char (point-min))
 351       (sort-subr
 352        reverse-sort-p 'forward-line 'end-of-line
 353        (function(lambda ()
 354                   (dired-move-to-filename)
 355                   (cond
 356                    ((null skip-to))
 357                    (reverse-sort-p
 358                     (let ((here (point)))
 359                       (end-of-line)
 360                       (re-search-backward
 361                        skip-to here 'move)))
 362                    ((re-search-forward
 363                      skip-to
 364                      (save-excursion (end-of-line) (point))
 365                      'move)
 366                     (goto-char (match-beginning 0))))
 367                   nil)))))
 368   (setq dired-sort-last-sort sort-by)
 369   (message "Dired-sort: Now sorted by %s%s." sort-by
 370            (if arg
 371                ", in reverse order"
 372              "")))
 373
 374 ;;;###autoload
 375 (defun dired-sort-by-type (&optional arg)
 376   "Sort by type, ARG means reverse."
 377   (interactive "P")
 378   (dired-sort-by-name
 379    arg (if arg
 380            "[.#~]"
 381          "[.~0-9#]+")
 382    'type))
 383
 384 ;;;###autoload
 385 (defun dired-sort-by-field (field)
 386   "In dired, sort the lines by FIELD (defaults to the mode field)."
 387   (interactive "p")
 388   (save-restriction
 389     (dired-sort-narrow-to-files)
 390     (let ((buffer-read-only nil))
 391       (goto-char (point-min))
 392       (sort-fields-1
 393        field (point-min) (point-max)
 394        (function(lambda ()
 395                   (sort-skip-fields (1- field))
 396                   (skip-chars-backward " ")
 397                   nil))
 398        nil)))
 399   (setq dired-sort-last-sort 'fields)
 400   (message "Dired-sort: Now sorted by %s."
 401            (cond ((= field 1) "file mode")
 402                  ((= field 2) "number of links")
 403                  ((= field 3) "file owner")
 404                  (t (format "field #%d" field)))))
 405
 406 ;;;###autoload
 407 (defun dired-sort-by-size (&optional arg)
 408   "In dired, sort the lines by file size, largest first.
 409 With ARG, sorts in the reverse order (smallest first).
 410 All directories are grouped together at the head of the buffer,
 411 and other file types are also grouped."
 412   (interactive "P")
 413   (let ((buffer-read-only nil)
 414         (incr-p arg))
 415     (save-restriction
 416       (dired-sort-narrow-to-files)
 417       (goto-char (point-min))
 418       (sort-subr
 419        (not incr-p) 'forward-line 'end-of-line
 420        (if incr-p
 421            (function (lambda () (dired-sort-line-property
 422                                  'dired-sort-by-size-increasing-key)))
 423          (function (lambda () (dired-sort-line-property
 424                                'dired-sort-by-size-key))))))
 425     (setq dired-sort-last-sort (if incr-p
 426                                    'smallest
 427                                  'largest))
 428     (message "Dired-sort: Now sorted by type and size, %s first."
 429              (if incr-p
 430                  "smallest"
 431                "largest"))))
 432
 433 ;;;###autoload
 434 (defun dired-sort-resort (kind &optional args)
 435   "In dired, change the sorting of lines. Prompt for the KIND of sorting.
 436 Non-interactively, takes a sort-kind, and an optional argument for
 437 the associated function. To get a list of such arguments interactively,
 438 call dired-sort-read-resort-args. ARGS are passed to sort."
 439   (interactive (list (dired-sort-read-resort-args)))
 440   (if (null kind)
 441       (setq kind dired-sort-resort-last-kind))
 442   (if (consp kind)
 443       (setq args (cdr kind) kind (car kind)))
 444   (if (symbolp kind) (setq kind (symbol-name kind)))
 445   (apply
 446    (or (nth 1 (assoc kind dired-sort-resort-alist))
 447        (error "No such sorting method: %s" kind))
 448    args)
 449   (setq dired-sort-resort-last-kind (cons kind args)))
 450
 451 ;;;###autoload
 452 (defun dired-sort-default-keys-dired-mode-map ()
 453   "Define default bindings to dired map."
 454   (interactive)
 455   (let* ((map (symbol-value 'dired-mode-map)))
 456     (unless map
 457       (error "dired-sort.el: [ERROR] dired is not yet loaded."))
 458     (define-key map  "\C-cs"  nil)
 459     (define-key map  "\C-cs " 'dired-sort-resort)
 460     (define-key map  "\C-css" 'dired-sort-by-size)
 461     (define-key map  "\C-csd" 'dired-sort-by-date)
 462     (define-key map  "\C-csf" 'dired-sort-by-field)
 463     (define-key map  "\C-csn" 'dired-sort-by-name)
 464     (define-key map  "\C-cst" 'dired-sort-by-type)))
 465
 466 ;;;###autoload
 467 (defun dired-sort-default-keys ()
 468   "Define default bindings to dired map."
 469   (eval-after-load "dired"
 470     '(progn (dired-sort-default-keys-dired-mode-map))))
 471
 472 ;;;###autoload
 473 (add-hook  'dired-mode-hook 'dired-sort-default-keys 'end)
 474
 475 (run-hooks 'dired-sort-load-hook)
 476 (provide   'dired-sort)
 477
 478 ;;; dired-sort.el ends here