Mercurial > emacs
comparison lisp/ffap.el @ 54183:b91c8ab75b81
(dired-at-point): Additional writability test for relative directory names.
(dired-at-point-prompter): Treat directories as a directory,
get the directory component from files.
(ffap-string-at-point): Return string from region if region is active.
(ffap-file-at-point): Remove redundant code.
author | Juri Linkov <juri@jurta.org> |
---|---|
date | Sat, 28 Feb 2004 05:00:19 +0000 |
parents | 9aa83ff74ef0 |
children | 73c87f418eba |
comparison
equal
deleted
inserted
replaced
54182:39ae79d0177a | 54183:b91c8ab75b81 |
---|---|
1 ;; ffap.el --- find file (or url) at point | 1 ;;; ffap.el --- find file (or url) at point |
2 ;; | 2 |
3 ;; Copyright (C) 1995, 96, 97, 2000 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1995, 96, 97, 2000, 2004 Free Software Foundation, Inc. |
4 ;; | 4 |
5 ;; Author: Michelangelo Grigni <mic@mathcs.emory.edu> | 5 ;; Author: Michelangelo Grigni <mic@mathcs.emory.edu> |
6 ;; Maintainer: Rajesh Vaidheeswarran <rv@gnu.org> | 6 ;; Maintainer: Rajesh Vaidheeswarran <rv@gnu.org> |
7 ;; Created: 29 Mar 1993 | 7 ;; Created: 29 Mar 1993 |
8 ;; Keywords: files, hypermedia, matching, mouse, convenience | 8 ;; Keywords: files, hypermedia, matching, mouse, convenience |
9 ;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/ | 9 ;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/ |
699 (list dir)))) | 699 (list dir)))) |
700 path))) | 700 path))) |
701 | 701 |
702 (defun ffap-locate-file (file &optional nosuffix path dir-ok) | 702 (defun ffap-locate-file (file &optional nosuffix path dir-ok) |
703 ;; The Emacs 20 version of locate-library could almost replace this, | 703 ;; The Emacs 20 version of locate-library could almost replace this, |
704 ;; except it does not let us overrride the suffix list. The | 704 ;; except it does not let us override the suffix list. The |
705 ;; compression-suffixes search moved to ffap-file-exists-string. | 705 ;; compression-suffixes search moved to ffap-file-exists-string. |
706 "A generic path-searching function, mimics `load' by default. | 706 "A generic path-searching function, mimics `load' by default. |
707 Returns path to file that \(load FILE\) would load, or nil. | 707 Returns path to file that \(load FILE\) would load, or nil. |
708 Optional NOSUFFIX, if nil or t, is like the fourth argument | 708 Optional NOSUFFIX, if nil or t, is like the fourth argument |
709 for load: whether to try the suffixes (\".elc\" \".el\" \"\"). | 709 for load: whether to try the suffixes (\".elc\" \".el\" \"\"). |
964 (defun ffap-string-at-point (&optional mode) | 964 (defun ffap-string-at-point (&optional mode) |
965 "Return a string of characters from around point. | 965 "Return a string of characters from around point. |
966 MODE (defaults to value of `major-mode') is a symbol used to look up string | 966 MODE (defaults to value of `major-mode') is a symbol used to look up string |
967 syntax parameters in `ffap-string-at-point-mode-alist'. | 967 syntax parameters in `ffap-string-at-point-mode-alist'. |
968 If MODE is not found, we use `file' instead of MODE. | 968 If MODE is not found, we use `file' instead of MODE. |
969 If the region is active, return a string from the region. | |
969 Sets `ffap-string-at-point' and `ffap-string-at-point-region'." | 970 Sets `ffap-string-at-point' and `ffap-string-at-point-region'." |
970 (let* ((args | 971 (let* ((args |
971 (cdr | 972 (cdr |
972 (or (assq (or mode major-mode) ffap-string-at-point-mode-alist) | 973 (or (assq (or mode major-mode) ffap-string-at-point-mode-alist) |
973 (assq 'file ffap-string-at-point-mode-alist)))) | 974 (assq 'file ffap-string-at-point-mode-alist)))) |
974 (pt (point)) | 975 (pt (point)) |
975 (str | 976 (str |
976 (buffer-substring | 977 (if (and transient-mark-mode mark-active) |
977 (save-excursion | 978 (buffer-substring |
978 (skip-chars-backward (car args)) | 979 (setcar ffap-string-at-point-region (region-beginning)) |
979 (skip-chars-forward (nth 1 args) pt) | 980 (setcar (cdr ffap-string-at-point-region) (region-end))) |
980 (setcar ffap-string-at-point-region (point))) | 981 (buffer-substring |
981 (save-excursion | 982 (save-excursion |
982 (skip-chars-forward (car args)) | 983 (skip-chars-backward (car args)) |
983 (skip-chars-backward (nth 2 args) pt) | 984 (skip-chars-forward (nth 1 args) pt) |
984 (setcar (cdr ffap-string-at-point-region) (point)))))) | 985 (setcar ffap-string-at-point-region (point))) |
986 (save-excursion | |
987 (skip-chars-forward (car args)) | |
988 (skip-chars-backward (nth 2 args) pt) | |
989 (setcar (cdr ffap-string-at-point-region) (point))))))) | |
985 (set-text-properties 0 (length str) nil str) | 990 (set-text-properties 0 (length str) nil str) |
986 (setq ffap-string-at-point str))) | 991 (setq ffap-string-at-point str))) |
987 | 992 |
988 (defun ffap-string-around nil | 993 (defun ffap-string-around nil |
989 ;; Sometimes useful to decide how to treat a string. | 994 ;; Sometimes useful to decide how to treat a string. |
1126 ;; Try stripping off prominent (non-root - #) shell prompts | 1131 ;; Try stripping off prominent (non-root - #) shell prompts |
1127 ;; if the ffap-shell-prompt-regexp is non-nil. | 1132 ;; if the ffap-shell-prompt-regexp is non-nil. |
1128 ((and ffap-shell-prompt-regexp | 1133 ((and ffap-shell-prompt-regexp |
1129 (not abs) (string-match ffap-shell-prompt-regexp name) | 1134 (not abs) (string-match ffap-shell-prompt-regexp name) |
1130 (ffap-file-exists-string (substring name (match-end 0))))) | 1135 (ffap-file-exists-string (substring name (match-end 0))))) |
1131 ;; Immediately test local filenames. If default-directory is | |
1132 ;; remote, you probably already have a connection. | |
1133 ((and (not abs) (ffap-file-exists-string name))) | |
1134 ;; Accept remote names without actual checking (too slow): | 1136 ;; Accept remote names without actual checking (too slow): |
1135 ((if abs | 1137 ((if abs |
1136 (ffap-file-remote-p name) | 1138 (ffap-file-remote-p name) |
1137 ;; Try adding a leading "/" (common omission in ftp file names): | 1139 ;; Try adding a leading "/" (common omission in ftp file names): |
1138 (and | 1140 (and |
1673 (dired filename)) | 1675 (dired filename)) |
1674 ((file-exists-p filename) | 1676 ((file-exists-p filename) |
1675 (if (file-directory-p filename) | 1677 (if (file-directory-p filename) |
1676 (dired (expand-file-name filename)) | 1678 (dired (expand-file-name filename)) |
1677 (dired (concat (expand-file-name filename) "*")))) | 1679 (dired (concat (expand-file-name filename) "*")))) |
1678 ((and (file-writable-p (file-name-directory filename)) | 1680 ((and (file-writable-p |
1681 (or (file-name-directory (directory-file-name filename)) | |
1682 filename)) | |
1679 (y-or-n-p "Directory does not exist, create it? ")) | 1683 (y-or-n-p "Directory does not exist, create it? ")) |
1680 (make-directory filename) | 1684 (make-directory filename) |
1681 (dired filename)) | 1685 (dired filename)) |
1682 ((error "No such file or directory `%s'" filename))))) | 1686 ((error "No such file or directory `%s'" filename))))) |
1683 | 1687 |
1686 ;; Extra complication for the temporary highlighting. | 1690 ;; Extra complication for the temporary highlighting. |
1687 (unwind-protect | 1691 (unwind-protect |
1688 (ffap-read-file-or-url | 1692 (ffap-read-file-or-url |
1689 (if ffap-url-regexp "Dired file or URL: " "Dired file: ") | 1693 (if ffap-url-regexp "Dired file or URL: " "Dired file: ") |
1690 (prog1 | 1694 (prog1 |
1691 (setq guess (or guess (ffap-guesser))) | 1695 (setq guess (or guess |
1692 (and guess (ffap-highlight)) | 1696 (let ((guess (ffap-guesser))) |
1693 )) | 1697 (if (or (not guess) |
1698 (ffap-url-p guess) | |
1699 (ffap-file-remote-p guess)) | |
1700 guess | |
1701 (setq guess (abbreviate-file-name | |
1702 (expand-file-name guess))) | |
1703 (cond | |
1704 ;; Interpret local directory as a directory. | |
1705 ((file-directory-p guess) | |
1706 (file-name-as-directory guess)) | |
1707 ;; Get directory component from local files. | |
1708 ((file-regular-p guess) | |
1709 (file-name-directory guess)) | |
1710 (guess)))) | |
1711 )) | |
1712 (and guess (ffap-highlight)))) | |
1694 (ffap-highlight t))) | 1713 (ffap-highlight t))) |
1695 | 1714 |
1696 ;;; Offer default global bindings (`ffap-bindings'): | 1715 ;;; Offer default global bindings (`ffap-bindings'): |
1697 | 1716 |
1698 (defvar ffap-bindings | 1717 (defvar ffap-bindings |