ffap.el 4.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129
  1. (setq ffap-file-finder 'org-open-file)
  2. (defcustom ffap-info-finder 'info
  3. "The command called by `wi-info-at-point' to find an Info file."
  4. :type 'function
  5. :group 'ffap
  6. :risky t)
  7. (defun wi-info-at-point (&optional filename)
  8. "Start Info, defaulting to file at point. See `ffap'.
  9. Optional argument FILENAME opens the file instead."
  10. (interactive)
  11. (or filename (setq filename (thing-at-point 'filename t)))
  12. (cond
  13. ((and ffap-info-regexp
  14. (string-match ffap-info-regexp filename))
  15. (funcall ffap-info-finder filename))
  16. ((error "No such file or directory `%s'" filename))))
  17. (defun delete-file-at-point (&optional filename)
  18. "Remove file, defaulting to file at point.
  19. Optional argument FILENAME removes the file instead."
  20. (interactive)
  21. (or filename (setq filename (thing-at-point 'filename t)))
  22. (delete-file filename))
  23. (autoload 'browse-at-remote--remote-ref "browse-at-remote")
  24. (defun wi-github-issue-at-point (&optional issue)
  25. "Start `browse-url', defaulting to ISSUE at point. See `ffap'."
  26. (interactive)
  27. (or issue (setq issue (thing-at-point 'number t)))
  28. (if (numberp issue)
  29. (browse-url
  30. (concat (car (browse-at-remote--remote-ref default-directory))
  31. "/issues/" (number-to-string issue)))
  32. (error "No issue number at point `%s'" issue)))
  33. (defun ffap-info-p (filename)
  34. "If FILENAME is Info page, return it."
  35. (when (string-match-p (rx-to-string `(and ".info"
  36. (zero-or-more ".gz")
  37. line-end)
  38. t)
  39. filename)
  40. filename))
  41. (defun ffap-man-p (filename)
  42. "If FILENAME if Man page, return it."
  43. (when (string-match-p (rx "/man" (zero-or-more digit)
  44. "/" (one-or-more (or alphanumeric "." "-" "_"))
  45. (zero-or-more ".gz")
  46. line-end)
  47. filename)
  48. filename))
  49. (autoload 'guix-ffap-store-path-p "guix-ffap")
  50. (defcustom guix-profile-path-regexp
  51. (rx-to-string `(and line-start
  52. (or "~" ,(getenv "HOME")) "/.guix-profile/"))
  53. "Regexp matching Guix profile path."
  54. :type 'regexp
  55. :group 'guix)
  56. (defun guix-ffap-profile-path-p (filename)
  57. "Match FILENAME with `guix-profile-path-regexp' regexp and return it."
  58. (when (string-match-p guix-profile-path-regexp filename) filename))
  59. (defun wi-find-file-at-point (&optional filename)
  60. "Find FILENAME, guessing a default from text around point.
  61. If `ffap-url-regexp' is not nil, the FILENAME may also be an URL.
  62. With a prefix, this command behaves exactly like `ffap-file-finder'.
  63. If `ffap-require-prefix' is set, the prefix meaning is reversed.
  64. See also the variables `ffap-dired-wildcards', `ffap-newfile-prompt',
  65. and the functions `ffap-file-at-point' and `ffap-url-at-point'."
  66. (interactive)
  67. (if (and (called-interactively-p 'interactive)
  68. (if ffap-require-prefix (not current-prefix-arg)
  69. current-prefix-arg))
  70. ;; Do exactly the ffap-file-finder command, even the prompting:
  71. (let (current-prefix-arg) ; we already interpreted it
  72. (call-interactively ffap-file-finder))
  73. (or filename (setq filename (ffap-prompter)))
  74. (let ((url (ffap-url-p filename))
  75. (info-page (ffap-info-p filename))
  76. ;; (guix-profile-dir (guix-ffap-profile-path-p filename))
  77. (man-page (ffap-man-p filename)))
  78. (cond
  79. (url
  80. (let (current-prefix-arg)
  81. (funcall ffap-url-fetcher url)))
  82. (info-page
  83. (let (current-prefix-arg)
  84. (info info-page)))
  85. (man-page
  86. (let (current-prefix-arg)
  87. (man man-page)))
  88. ;; (guix-profile-dir
  89. ;; (let (current-prefix-arg)
  90. ;; (guix-run-in-shell (concat "readlink " filename))))
  91. ((and ffap-pass-wildcards-to-dired
  92. ffap-dired-wildcards
  93. (string-match ffap-dired-wildcards filename))
  94. (funcall ffap-directory-finder filename))
  95. ((and ffap-dired-wildcards
  96. (string-match ffap-dired-wildcards filename)
  97. find-file-wildcards
  98. ;; Check if it's find-file that supports wildcards arg
  99. (memq ffap-file-finder '(find-file find-alternate-file)))
  100. (funcall ffap-file-finder (expand-file-name filename) t))
  101. ((or (not ffap-newfile-prompt)
  102. (file-exists-p filename)
  103. (y-or-n-p "File does not exist, create buffer? "))
  104. (funcall ffap-file-finder
  105. ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR.
  106. (expand-file-name filename)))
  107. ;; User does not want to find a non-existent file:
  108. ((signal 'file-error (list "Opening file buffer"
  109. "No such file or directory"
  110. filename)))))))
  111. (with-eval-after-load 'ffap
  112. (add-to-list 'ffap-alist '("\\.patch" . guix-devel-ffap-patch)))
  113. (advice-add 'find-file-at-point :override #'wi-find-file-at-point)