unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Jari Aalto <jari.aalto@cante.net>
To: 8439@debbugs.gnu.org
Subject: bug#8439: [PATCH] ffap.el -- detect paths with spaces (v2)
Date: Fri, 19 Oct 2012 11:35:17 +0300	[thread overview]
Message-ID: <87zk3i7tbu.fsf@picasso.cante.net> (raw)
In-Reply-To: <87pqoyaxu0.fsf@blue.sea.net>

[-- Attachment #1: Type: text/plain, Size: 65 bytes --]


Patch for http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8439#13


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-lisp-ffap.el-ffap-string-at-point-v2-support-spaces.patch --]
[-- Type: text/x-diff, Size: 5035 bytes --]

From 9d912ef5fe082c81917cf65bbacbf4d23e1cd9f3 Mon Sep 17 00:00:00 2001
From: Jari Aalto <jari.aalto@cante.net>
Date: Fri, 19 Oct 2012 10:15:50 +0300
Subject: [PATCH] lisp/ffap.el: (ffap-string-at-point): v2 support spaces
Organization: Private
Content-Type: text/plain; charset="utf-8"
Content-Transfer-Encoding: 8bit

Signed-off-by: Jari Aalto <jari.aalto@cante.net>
---
 lisp/ffap.el |   87 +++++++++++++++++++++++++++++++++++++++++++++-------------
 1 file changed, 68 insertions(+), 19 deletions(-)

diff --git a/lisp/ffap.el b/lisp/ffap.el
index 4c75609..a74f85b 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -1036,6 +1036,17 @@ possibly a major-mode name, or one of the symbol
   ;; Added at suggestion of RHOGEE (for ff-paths), 7/24/95.
   "Last string returned by `ffap-string-at-point'.")
 
+;; Test cases:
+;;
+;; c:/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program here.txt
+;; c:/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program Files/Hummingbird/
+;;
+(defvar ffap-paths-with-spaces
+  (or (memq system-type '(ms-dos windows-nt))
+      (string-match "cygwin" (emacs-version)))
+  "If non-nil, look for paths with spaces in `ffap-string-at-point'.
+Enabled in W32 and Cygwin by default.")
+
 (defun ffap-string-at-point (&optional mode)
   "Return a string of characters from around point.
 MODE (defaults to value of `major-mode') is a symbol used to look up string
@@ -1043,25 +1054,63 @@ syntax parameters in `ffap-string-at-point-mode-alist'.
 If MODE is not found, we use `file' instead of MODE.
 If the region is active, return a string from the region.
 Sets `ffap-string-at-point' and `ffap-string-at-point-region'."
-  (let* ((args
-	  (cdr
-	   (or (assq (or mode major-mode) ffap-string-at-point-mode-alist)
-	       (assq 'file ffap-string-at-point-mode-alist))))
-	 (pt (point))
-	 (str
-	  (if (and transient-mark-mode mark-active)
-	      (buffer-substring
-	       (setcar ffap-string-at-point-region (region-beginning))
-	       (setcar (cdr ffap-string-at-point-region) (region-end)))
-	    (buffer-substring
-	     (save-excursion
-	       (skip-chars-backward (car args))
-	       (skip-chars-forward (nth 1 args) pt)
-	       (setcar ffap-string-at-point-region (point)))
-	     (save-excursion
-	       (skip-chars-forward (car args))
-	       (skip-chars-backward (nth 2 args) pt)
-	       (setcar (cdr ffap-string-at-point-region) (point)))))))
+  (let* ((cygwin-p (string-match "cygwin" (emacs-version)))
+	 (args
+          (cdr
+           (or (assq (or mode major-mode) ffap-string-at-point-mode-alist)
+               (assq 'file ffap-string-at-point-mode-alist))))
+         (pt (point))
+	  space-p
+	   end
+         (str
+          (if (and transient-mark-mode mark-active)
+              (buffer-substring
+               (setcar ffap-string-at-point-region (region-beginning))
+               (setcar (cdr ffap-string-at-point-region) (region-end)))
+            (buffer-substring
+             (save-excursion
+	       (if (and ffap-paths-with-spaces
+			(memq mode '(nil file)))
+		   (if (string-match "^[ \t]*$"
+				     (buffer-substring (line-beginning-position)
+						       (point)))
+		       ;; Nothing interesting before point. Move to the first character
+		       (skip-chars-forward " \t" (line-end-position))
+		     ;; If at colon, move a little forward so that next
+		     ;; `re-search-backward' can position at drive letter.
+		     (if (looking-at ":/")
+			 (forward-char 1))
+		     ;; Skip until drive path start or patch start letter
+		     (while (re-search-backward "[a-zA-Z]:[\\\\/]\\|[/\\\\]"
+						     (line-beginning-position) t)
+		       (goto-char (match-beginning 0)))))
+               (skip-chars-backward (car args))
+               (skip-chars-forward (nth 1 args) pt)
+	       (when (and ffap-paths-with-spaces
+			  (memq mode '(nil file)))
+		 ;; Paths may contains spaces, allow those
+		 (if (looking-at
+		      "[^\t\r\n]*[/\\\\][^][<>()\"';:|\t\r\n]*[^][<>()\"';:|\r\n[:space:]]")
+		     (setq space-p (match-end 0))))
+               (setcar ffap-string-at-point-region (point)))
+             (save-excursion
+               (skip-chars-forward (car args))
+               (skip-chars-backward (nth 2 args) pt)
+	              (setq end (point))
+		             (if (and space-p
+				      (> space-p end)
+				      (memq mode '(file nil)))
+				    (setq end space-p))
+               (setcar (cdr ffap-string-at-point-region) end))))))
+    ;; Under Cygwin, convert drive letters in paths.
+    (when (and cygwin-p
+               (memq mode '(nil file))
+               (string-match "^\\([a-zA-Z]\\):[/\\\\]\\(.*\\)" str))
+      (let ((drive (downcase (match-string 1 str)))
+            (path (match-string 2 str)))
+        (setq str (format "/cygdrive/%s/%s"
+                          drive
+                          (replace-regexp-in-string "[\\\\]" "/" path)))))
     (set-text-properties 0 (length str) nil str)
     (setq ffap-string-at-point str)))
 
-- 
1.7.10.4


  parent reply	other threads:[~2012-10-19  8:35 UTC|newest]

Thread overview: 29+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2011-04-07 15:24 bug#8439: [PATCH] ffap.el -- detect paths with spaces Jari Aalto
2011-07-03 23:29 ` Lars Magne Ingebrigtsen
2012-10-19  7:39 ` bug#8439: [PATCH] ffap.el -- detect paths with spaces (v2) Jari Aalto
2012-10-19  9:49   ` Eli Zaretskii
2012-10-19 10:05     ` jari
2012-10-19 11:15       ` Yigal Hochberg
2012-10-19 11:22       ` Eli Zaretskii
2012-10-19 12:15       ` Nicolas Richard
2012-10-19 21:47     ` Andrew W. Nosenko
2012-10-19 22:23       ` Eli Zaretskii
2012-10-19 22:36       ` Yigal Hochberg
2012-10-19 22:57         ` Andrew W. Nosenko
2012-10-19 23:24         ` Yigal Hochberg
2012-10-20  1:45       ` Stefan Monnier
2012-10-20 11:01       ` Juri Linkov
2012-10-19  8:35 ` Jari Aalto [this message]
2012-10-20  1:44   ` Stefan Monnier
2012-10-20  1:49     ` Daniel Colascione
2012-10-20  7:56     ` bug#8439: [PATCH] ffap.el -- detect paths with spaces (v3) jari
2012-10-20  8:45       ` bug#8439: [PATCH] ffap.el -- detect paths with spaces (v4) jari
2012-10-20 10:20         ` Eli Zaretskii
2012-10-21  0:18         ` Stefan Monnier
2012-10-21  8:07           ` Jari Aalto
2019-11-23 13:31         ` bug#6695: " Lars Ingebrigtsen
2020-08-14 13:08           ` Lars Ingebrigtsen
2020-08-15  9:07             ` Eli Zaretskii
2020-08-15 10:13               ` Lars Ingebrigtsen
2012-10-20  8:11     ` bug#8439: [PATCH] ffap.el -- detect paths with spaces (v2) Eli Zaretskii
2012-10-21  0:16       ` Stefan Monnier

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87zk3i7tbu.fsf@picasso.cante.net \
    --to=jari.aalto@cante.net \
    --cc=8439@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
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).