cgit.sxemacs.org Git - packages/blob - xemacs-packages/dired/dired-sex.el

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; File:          dired-sex.el
   4 ;; Dired Version: 7.17
   5 ;; RCS:
   6 ;; Description:   Marking files according to sexpressions.  Sorry.
   7 ;; Created:       Wed Sep 14 01:30:43 1994 by sandy on ibm550
   8 ;;
   9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10
  11 (provide 'dired-sex)
  12 (require 'dired)
  13
  14 (defvar dired-sexpr-history nil
  15   "History of sexpr used to mark files in dired.")
  16
  17 ;;; Marking files according to sexpr's
  18
  19 (defun dired-parse-ls ()
  20   ;; Sets vars
  21   ;;                inode s mode nlink uid gid size time name sym
  22   ;; (probably let-bound in caller) according to current file line.
  23   ;; Returns t for success, nil if this is no file line.
  24   ;; Upon success, all variables are set, either to nil or the
  25   ;; appropriate value, so they need not be initialized.
  26   ;; Moves point within the current line to the end of the file name.
  27   (let ((bol (progn (beginning-of-line) (point)))
  28         (eol (save-excursion (skip-chars-forward "^\n\r") (point))))
  29     (if (re-search-forward dired-re-before-filename eol t)
  30         (let ((mode-len 10)             ; length of mode string
  31               (tstart (progn (goto-char (match-beginning 1))
  32                              (skip-chars-forward " ")
  33                              (point)))
  34               (fstart (match-end 0))
  35               pos)
  36           (goto-char (1+ bol))
  37           (skip-chars-forward " \t")
  38           ;; This subdir had better have been created with the current
  39           ;; setting of actual switches. Otherwise, we can't parse.
  40           (cond
  41            ((and (or (memq ?k dired-internal-switches)
  42                      (memq ?s dired-internal-switches))
  43                  (memq ?i dired-internal-switches))
  44             (setq pos (point))
  45             (skip-chars-forward "0-9")
  46             (if (setq inode (and (/= pos (point)) (string-to-int
  47                                                    (buffer-substring
  48                                                     pos (point)))))
  49                 (progn
  50                   (skip-chars-forward " ")
  51                   (setq pos (point))
  52                   (skip-chars-forward "0-9")
  53                   (setq s (and (/= pos (point)) (string-to-int
  54                                                  (buffer-substring
  55                                                   pos (point))))))
  56               (setq s nil)))
  57            ((or (memq ?s dired-internal-switches)
  58                 (memq ?k dired-internal-switches))
  59             (setq pos (point))
  60             (skip-chars-forward "0-9")
  61             (setq s (and (/= pos (point)) (string-to-int
  62                                            (buffer-substring
  63                                             pos (point))))
  64                   inode nil))
  65            ((memq ?i dired-internal-switches)
  66             (setq pos (point))
  67             (skip-chars-forward "0-9")
  68             (setq inode (and (/= pos (point)) (string-to-int
  69                                                (buffer-substring
  70                                                 pos (point))))
  71                   s nil))
  72            (t
  73             (setq s nil
  74                   inode nil)))
  75           (skip-chars-forward " 0-9")   ; in case of junk
  76           (setq mode (buffer-substring (point) (+ mode-len (point))))
  77           (forward-char mode-len)
  78           (setq nlink (read (current-buffer)))
  79           (or (integerp nlink) (setq nlink nil))
  80           (skip-chars-forward " ")
  81           (setq uid (buffer-substring (point) (progn
  82                                                 (skip-chars-forward "^ ")
  83                                                 (point))))
  84           (goto-char tstart)
  85           (skip-chars-backward " ")
  86           (setq pos (point))
  87           (skip-chars-backward "0-9")
  88           (if (= pos (point))
  89               (setq size nil)
  90             (setq size (string-to-int (buffer-substring (point) pos))))
  91           (skip-chars-backward " ")
  92           ;; if no gid is displayed, gid will be set to uid
  93           ;; but user will then not reference it anyway in PREDICATE.
  94           (setq gid (buffer-substring (point) (progn
  95                                                 (skip-chars-backward "^ ")
  96                                                 (point)))
  97                 time (buffer-substring tstart
  98                                        (progn
  99                                          (goto-char fstart)
 100                                          (skip-chars-backward " ")
 101                                          (point)))
 102                 name (buffer-substring
 103                       (dired-move-to-filename nil bol eol)
 104                       (or (dired-move-to-end-of-filename t bol eol)
 105                           (point)))
 106                 sym  (and (looking-at "[/*@#=|]? -> ")
 107                           (buffer-substring (match-end 0)
 108                                             eol)))
 109           t))))                    ; return t if parsing was a success
 110
 111
 112 ;;;###autoload
 113 (defun dired-mark-sexp (predicate &optional unflag-p)
 114   "Mark files for which PREDICATE returns non-nil.
 115 With a prefix arg, unflag those files instead.
 116
 117 PREDICATE is a lisp expression that can refer to the following symbols:
 118
 119     inode  [integer] the inode of the file (only for ls -i output)
 120     s      [integer] the size of the file for ls -s output
 121                      (usually in blocks or, with -k, in KByte)
 122     mode   [string]  file permission bits, e.g. \"-rw-r--r--\"
 123     nlink  [integer] number of links to file
 124     uid    [string]  owner
 125     gid    [string]  group  (If the gid is not displayed by ls,
 126                      this will still be set (to the same as uid))
 127     size   [integer] file size in bytes
 128     time   [string]  the time that ls displays, e.g. \"Feb 12 14:17\"
 129     name   [string]  the name of the file
 130     sym    [string]  if file is a symbolic link, the linked-to name, else nil.
 131
 132 For example, use
 133
 134         (equal 0 size)
 135
 136 to mark all zero length files."
 137   ;; Using sym="" instead of nil avoids the trap of
 138   ;; (string-match "foo" sym) into which a user would soon fall.
 139   ;; No! Want to be able look for symlinks pointing to the empty string.
 140   ;; Can happen. Also, then I can do an (if sym ...) structure. --sandy
 141   ;; Give `equal' instead of `=' in the example, as this works on
 142   ;; integers and strings.
 143   (interactive
 144    (list
 145     (read
 146      (dired-read-with-history "Mark if (lisp expr): " nil
 147                               'dired-sexpr-history))
 148     current-prefix-arg))
 149   (message "%s" predicate)
 150   (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char))
 151         inode s mode nlink uid gid size time name sym)
 152     (dired-mark-if (save-excursion
 153                      (and (dired-parse-ls)
 154                           (eval predicate)))
 155                    (format "'%s file" predicate)))
 156   (dired-update-mode-line-modified t))
 157
 158 ;;; end of dired-sex.el