From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Wolfgang Jenkner Newsgroups: gmane.emacs.bugs Subject: bug#13575: 24.1; dired-mark-sexp misparses directory contents Date: Fri, 26 Jun 2015 14:54:10 +0200 Message-ID: <85381elj7m.fsf@iznogoud.viz> References: <85k3qxxg7v.fsf@iznogoud.viz> <85wquw8ruy.fsf@iznogoud.viz> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: ger.gmane.org 1435323629 32450 80.91.229.3 (26 Jun 2015 13:00:29 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Fri, 26 Jun 2015 13:00:29 +0000 (UTC) Cc: 13575@debbugs.gnu.org To: Sean McAfee Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Fri Jun 26 15:00:18 2015 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1Z8TEw-0001wn-98 for geb-bug-gnu-emacs@m.gmane.org; Fri, 26 Jun 2015 15:00:18 +0200 Original-Received: from localhost ([::1]:59891 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Z8TEv-0002np-AT for geb-bug-gnu-emacs@m.gmane.org; Fri, 26 Jun 2015 09:00:17 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:46027) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Z8TEp-0002k7-6n for bug-gnu-emacs@gnu.org; Fri, 26 Jun 2015 09:00:12 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Z8TEm-00029L-Aq for bug-gnu-emacs@gnu.org; Fri, 26 Jun 2015 09:00:11 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:56358) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Z8TEm-000297-8C for bug-gnu-emacs@gnu.org; Fri, 26 Jun 2015 09:00:08 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1Z8TEl-0008ED-JE for bug-gnu-emacs@gnu.org; Fri, 26 Jun 2015 09:00:07 -0400 X-Loop: help-debbugs@gnu.org In-Reply-To: Resent-From: Wolfgang Jenkner Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 26 Jun 2015 13:00:07 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 13575 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 13575-submit@debbugs.gnu.org id=B13575.143532354931518 (code B ref 13575); Fri, 26 Jun 2015 13:00:07 +0000 Original-Received: (at 13575) by debbugs.gnu.org; 26 Jun 2015 12:59:09 +0000 Original-Received: from localhost ([127.0.0.1]:57804 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1Z8TDo-0008CH-Nx for submit@debbugs.gnu.org; Fri, 26 Jun 2015 08:59:09 -0400 Original-Received: from b2bqsv11.mx.upcmail.net ([62.179.121.55]:46745) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1Z8TDl-0008Bg-EY for 13575@debbugs.gnu.org; Fri, 26 Jun 2015 08:59:07 -0400 Original-Received: from edge12.upcmail.net ([192.168.13.82]) by b2bfep16.mx.upcmail.net (InterMail vM.8.01.05.05 201-2260-151-110-20120111) with ESMTP id <20150626125812.OEVT8608.b2bfep16-int.chello.at@edge12.upcmail.net> for <13575@debbugs.gnu.org>; Fri, 26 Jun 2015 14:58:12 +0200 Original-Received: from iznogoud.viz ([91.119.136.147]) by edge12.upcmail.net with edge id l0ye1q00B3AzDwj0C0ye2N; Fri, 26 Jun 2015 14:58:38 +0200 X-SourceIP: 91.119.136.147 Original-Received: from wolfgang by iznogoud.viz with local (Exim 4.85 (FreeBSD)) (envelope-from ) id 1Z8TDJ-0000WW-SI; Fri, 26 Jun 2015 14:58:37 +0200 User-Agent: Gnus/5.130014 (Ma Gnus v0.14) Emacs/25.0.50 (berkeley-unix) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:104368 Archived-At: Since I haven't quite been able to just totally forget about this bug, here's an updated patch instead. -- >8 -- Subject: [PATCH] Fix parsing glitches in dired-mark-sexp (bug#13575) * lisp/dired-x.el (dired-x--string-to-number): New function. (dired-mark-sexp): Use it. Tweak dired-re-inode-size. Fix usage of directory-listing-before-filename-regexp. Consider forward-word harmful and replace it. Add more verbiage in comments and doc string. --- lisp/dired-x.el | 139 ++++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 96 insertions(+), 43 deletions(-) diff --git a/lisp/dired-x.el b/lisp/dired-x.el index eebfa91..93e32e0 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -1396,6 +1396,20 @@ Considers buffers closer to the car of `buffer-list' to be more recent." ;; result)) +(defun dired-x--string-to-number (str) + "Like `string-to-number' but recognize trailing unit prefixes (for ls -h). +The caller should make sure that STR is valid." + (let* ((val (string-to-number str)) + (u (unless (zerop val) + (aref str (1- (length str)))))) + (when (and u (> u ?9)) + (when (= u ?k) + (setq u ?K)) + (let ((units '(?B ?K ?M ?G ?T ?P ?E ?Z ?Y))) + (while (and units (/= (pop units) u)) + (setq val (* 1024.0 val))))) + val)) + ;; Does anyone use this? - lrd 6/29/93. ;; Apparently people do use it. - lrd 12/22/97. @@ -1422,7 +1436,19 @@ For example, use (equal 0 size) -to mark all zero length files." +to mark all zero length files. + +There's an ambiguity when a single integer not followed by a unit +prefix precedes the file mode: It is then parsed as inode number +and not as block size (this always works for GNU coreutils ls). + +Another limitation is that the uid field is needed for the +function to work correctly. In particular, the field is not +present for some values of `ls-lisp-emulation'. + +This function operates only on the buffer content and does not +refer at all to the underlying file system. Contrast this with +`find-dired', which might be preferable for the task at hand." ;; Using sym="" instead of nil avoids the trap of ;; (string-match "foo" sym) into which a user would soon fall. ;; Give `equal' instead of `=' in the example, as this works on @@ -1442,23 +1468,23 @@ to mark all zero length files." ;; to nil or the appropriate value, so they need not be initialized. ;; Moves point within the current line. (dired-move-to-filename) - (let (pos - (mode-len 10) ; length of mode string - ;; like in dired.el, but with subexpressions \1=inode, \2=s: - (dired-re-inode-size "\\s *\\([0-9]*\\)\\s *\\([0-9]*\\) ?")) - (beginning-of-line) - (forward-char 2) - (if (looking-at dired-re-inode-size) - (progn - (goto-char (match-end 0)) - (setq inode (string-to-number - (buffer-substring (match-beginning 1) - (match-end 1))) - s (string-to-number - (buffer-substring (match-beginning 2) - (match-end 2))))) - (setq inode nil - s nil)) + (let ((mode-len 10) ; length of mode string + ;; like in dired.el, but with subexpressions \1=inode, \2=s: + ;; GNU ls -hs suffixes the block count with a unit and + ;; prints it as a float, FreeBSD does neither. + (dired-re-inode-size "\\=\\s *\\([0-9]+\\s +\\)?\ +\\(?:\\([0-9]+\\(?:\\.[0-9]*\\)?[BkKMGTPEZY]?\\)? ?\\)")) + (beginning-of-line) + (forward-char 2) + (search-forward-regexp dired-re-inode-size nil t) + ;; XXX Might be a size not followed by a unit prefix. + ;; We could set s to inode if it were otherwise nil, + ;; with a similar reasoning as below for setting gid to uid, + ;; but it would be even more whimsical. + (setq inode (when (match-string 1) + (string-to-number (match-string 1)))) + (setq s (when (match-string 2) + (dired-x--string-to-number (match-string 2)))) (setq mode (buffer-substring (point) (+ mode-len (point)))) (forward-char mode-len) ;; Skip any extended attributes marker ("." or "+"). @@ -1466,33 +1492,60 @@ to mark all zero length files." (forward-char 1)) (setq nlink (read (current-buffer))) ;; Karsten Wenger fixed uid. - (setq uid (buffer-substring (1+ (point)) - (progn (forward-word 1) (point)))) - (re-search-forward directory-listing-before-filename-regexp) - (goto-char (match-beginning 1)) - (forward-char -1) - (setq size (string-to-number - (buffer-substring (save-excursion - (backward-word 1) - (setq pos (point))) + ;; Another issue is that GNU ls -n right-justifies numerical + ;; UIDs and GIDs, while FreeBSD left-justifies them, so + ;; don't rely on a specific whitespace layout. Both of them + ;; right-justify all other numbers, though. + ;; XXX Return a number if the uid or gid seems to be + ;; numerical? + (setq uid (buffer-substring (progn + (skip-chars-forward " \t") + (point)) + (progn + (skip-chars-forward "^ \t") (point)))) - (goto-char pos) - (backward-word 1) - ;; if no gid is displayed, gid will be set to uid - ;; but user will then not reference it anyway in PREDICATE. - (setq gid (buffer-substring (save-excursion - (forward-word 1) (point)) + (dired-move-to-filename) + (save-excursion + (setq time + ;; The regexp below tries to match from the last + ;; digit of the size field through a space after the + ;; date. Also, dates may have different formats + ;; depending on file age, so the date column need + ;; not be aligned to the right. + (buffer-substring (save-excursion + (skip-chars-backward " \t") (point)) - time (buffer-substring (match-beginning 1) - (1- (dired-move-to-filename))) - name (buffer-substring (point) - (or - (dired-move-to-end-of-filename t) - (point))) - sym (if (looking-at-p " -> ") - (buffer-substring (progn (forward-char 4) (point)) - (line-end-position)) - "")) + (progn + (re-search-backward + directory-listing-before-filename-regexp) + (skip-chars-forward "^ \t") + (1+ (point)))) + size (dired-x--string-to-number + ;; We know that there's some kind of number + ;; before point because the regexp search + ;; above succeeded. I don't think it's worth + ;; doing an extra check for leading garbage. + (buffer-substring (point) + (progn + (skip-chars-backward "^ \t") + (point)))) + ;; If no gid is displayed, gid will be set to uid + ;; but the user will then not reference it anyway in + ;; PREDICATE. + gid (buffer-substring (progn + (skip-chars-backward " \t") + (point)) + (progn + (skip-chars-backward "^ \t") + (point))))) + (setq name (buffer-substring (point) + (or + (dired-move-to-end-of-filename t) + (point))) + sym (if (looking-at " -> ") + (buffer-substring (progn (forward-char 4) (point)) + (line-end-position)) + "")) t) (eval predicate `((inode . ,inode) -- 2.4.2