procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(internal--c-header-file-path): Move to ffap.el

Browse source 
This function is used so rarely that it's really best not to
preload it.

* lisp/ffap.el (ffap-url-regexp): Precompute.
(ffap-c-path): Use `ffap--c-path`.
(ffap--gcc-is-clang-p, ffap--c-path): Move and rename from subr.el's
* lisp/subr.el (internal--gcc-is-clang-p)
(internal--c-header-file-path): Move to ffap.el and rename.

* lisp/man.el (Man-header-file-path): Default to a new value that
delegates to ffap.
(Man-header-file-path): Obey that new value.

* lisp/emacs-lisp/ert-x.el (ert-gcc-is-clang-p): Use `ffap--gcc-is-clang-p`.

* test/lisp/ffap-tests.el (ffap-tests--c-path)
(ffap-tests--c-path/gcc-mocked, ffap-tests--c-path/clang-mocked):
Move and rename from `subr-tests.el`.
* test/lisp/subr-tests.el (subr-tests-internal--c-header-file-path)
(subr-tests-internal--c-header-file-path/gcc-mocked)
(subr-tests-internal--c-header-file-path/clang-mocked):
Move to `ffap-tests.el` and rename.
This commit is contained in:
Stefan Monnier 2025-02-28 17:03:21 -05:00
parent 678fdcc165
commit 5f165caf31
6 changed files with 151 additions and 143 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
lisp/emacs-lisp/ert-x.el
View file

@ -374,7 +374,9 @@ The same keyword arguments are supported as in
(defun ert-gcc-is-clang-p ()
"Return non-nil if the `gcc' command actually runs the Clang compiler."
(internal--gcc-is-clang-p))
(require 'ffap)
(declare-function ffap--gcc-is-clang-p "ffap" ())
(ffap--gcc-is-clang-p))
(defvar tramp-default-host-alist)
(defvar tramp-methods)

83
lisp/ffap.el
View file

@ -179,12 +179,13 @@ Note this name may be omitted if it equals the default
:group 'ffap)
(defvar ffap-url-regexp
(concat
"\\("
"news\\(post\\)?:\\|mailto:\\|file:" ; no host ok
"\\|"
"\\(ftp\\|https?\\|telnet\\|gopher\\|gemini\\|www\\|wais\\)://" ; needs host
"\\)")
(eval-when-compile
(concat
"\\("
"news\\(post\\)?:\\|mailto:\\|file:" ; no host ok
"\\|"
"\\(ftp\\|https?\\|telnet\\|gopher\\|gemini\\|www\\|wais\\)://" ;Needs host
"\\)"))
"Regexp matching the beginning of a URI, for ffap.
If the value is nil, disable URL-matching features in ffap.")
@ -831,13 +832,79 @@ to extract substrings.")
(and (not (string-match "\\.el\\'" name))
(ffap-locate-file name '(".el") load-path)))
(defvar ffap-c-path (internal--c-header-file-path)
(defun ffap--gcc-is-clang-p ()
"Return non-nil if the `gcc' command actually runs the Clang compiler."
;; Recent macOS machines run llvm when you type gcc by default. (!)
;; We can't even check if it's a symlink; it's a binary placed in
;; "/usr/bin/gcc". So we need to check the output.
(when-let* ((out (ignore-errors
(with-temp-buffer
(call-process "gcc" nil t nil "--version")
(buffer-string)))))
(string-match "Apple \\(LLVM\\|[Cc]lang\\)\\|Xcode\\.app" out)))
(defun ffap--c-path ()
"Return search path for C header files (a list of strings)."
;; FIXME: It's not clear that this is a good place to put this, or
;; even that this should necessarily be internal.
;; See also (Bug#10702):
;; cc-search-directories, semantic-c-dependency-system-include-path,
;; semantic-gcc-setup
(delete-dups
;; We treat MS-Windows/MS-DOS specially, since there's no
;; widely-accepted canonical directory for C include files.
(let ((base (if (not (memq system-type '(windows-nt ms-dos)))
'("/usr/include" "/usr/local/include")))
(call-clang-p (or (ffap--gcc-is-clang-p)
(and (executable-find "clang")
(not (executable-find "gcc"))))))
(cond ((or call-clang-p
(memq system-type '(windows-nt ms-dos)))
;; This is either macOS, or MS-Windows/MS-DOS, or a system
;; with clang only.
(with-temp-buffer
(ignore-errors
(call-process (if call-clang-p "clang" "gcc")
nil t nil
"-v" "-E" "-"))
(goto-char (point-min))
(narrow-to-region
(save-excursion
(re-search-forward
"^#include <\\.\\.\\.> search starts here:\n" nil t)
(point))
(save-excursion
(re-search-forward "^End of search list.$" nil t)
(pos-bol)))
(while (search-forward "(framework directory)" nil t)
(delete-line))
;; "gcc -v" reports file names with many "..", so we
;; normalize it.
(or (mapcar #'expand-file-name
(append base
(split-string (buffer-substring-no-properties
(point-min) (point-max)))))
;; Fallback for whedn the compiler is not available.
(list (expand-file-name "/usr/include")
(expand-file-name "/usr/local/include")))))
;; Prefer GCC.
((let ((arch (with-temp-buffer
(when (eq 0 (ignore-errors
(call-process "gcc" nil '(t nil) nil
"-print-multiarch")))
(goto-char (point-min))
(buffer-substring (point) (line-end-position))))))
(if (zerop (length arch))
base
(append base (list (expand-file-name arch "/usr/include"))))))))))
(defvar ffap-c-path (ffap--c-path) ;FIXME: Delay initialization?
"List of directories to search for include files.")
(defun ffap-c-mode (name)
(ffap-locate-file name t ffap-c-path))
(defvar ffap-c++-path
(defvar ffap-c++-path ;FIXME: Delay initialization?
(let ((c++-include-dir (with-temp-buffer
(when (eq 0 (ignore-errors
(call-process "g++" nil t nil "-v")))

11
lisp/man.el
View file

@ -230,10 +230,11 @@ the associated section number."
:type '(repeat (cons (string :tag "Bogus Section")
(string :tag "Real Section"))))
(defcustom Man-header-file-path (internal--c-header-file-path)
(defcustom Man-header-file-path t
"C Header file search path used in Man."
:version "31.1"
:type '(repeat string))
:type '(choice (repeat string)
(const :tag "Use 'ffap-c-path'" t)))
(defcustom Man-name-local-regexp (concat "^" (regexp-opt '("NOM" "NAME")) "$")
"Regexp that matches the text that precedes the command's name.
@ -571,7 +572,11 @@ list of directories where the remote system has the C header files."
(let ((remote-id (file-remote-p default-directory)))
(if (null remote-id)
;; The local case.
Man-header-file-path
(if (not (eq t Man-header-file-path))
Man-header-file-path
(require 'ffap)
(defvar ffap-c-path)
ffap-c-path)
;; The remote case. Use connection-local variables.
(mapcar
(lambda (elt) (concat remote-id elt))

66
lisp/subr.el
View file

@ -7627,70 +7627,4 @@ and return the value found in PLACE instead."
,(funcall setter val)
,val)))))
(defun internal--gcc-is-clang-p ()
"Return non-nil if the `gcc' command actually runs the Clang compiler."
;; Recent macOS machines run llvm when you type gcc by default. (!)
;; We can't even check if it's a symlink; it's a binary placed in
;; "/usr/bin/gcc". So we need to check the output.
(when-let* ((out (ignore-errors
(with-temp-buffer
(call-process "gcc" nil t nil "--version")
(buffer-string)))))
(string-match "Apple \\(LLVM\\|[Cc]lang\\)\\|Xcode\\.app" out)))
(defun internal--c-header-file-path ()
"Return search path for C header files (a list of strings)."
;; FIXME: It's not clear that this is a good place to put this, or
;; even that this should necessarily be internal.
;; See also (Bug#10702):
;; cc-search-directories, semantic-c-dependency-system-include-path,
;; semantic-gcc-setup
(delete-dups
;; We treat MS-Windows/MS-DOS specially, since there's no
;; widely-accepted canonical directory for C include files.
(let ((base (if (not (memq system-type '(windows-nt ms-dos)))
'("/usr/include" "/usr/local/include")))
(call-clang-p (or (internal--gcc-is-clang-p)
(and (executable-find "clang")
(not (executable-find "gcc"))))))
(cond ((or call-clang-p
(memq system-type '(windows-nt ms-dos)))
;; This is either macOS, or MS-Windows/MS-DOS, or a system
;; with clang only.
(with-temp-buffer
(ignore-errors
(call-process (if call-clang-p "clang" "gcc")
nil t nil
"-v" "-E" "-"))
(goto-char (point-min))
(narrow-to-region
(save-excursion
(re-search-forward
"^#include <\\.\\.\\.> search starts here:\n" nil t)
(point))
(save-excursion
(re-search-forward "^End of search list.$" nil t)
(pos-bol)))
(while (search-forward "(framework directory)" nil t)
(delete-line))
;; "gcc -v" reports file names with many "..", so we
;; normalize it.
(or (mapcar #'expand-file-name
(append base
(split-string (buffer-substring-no-properties
(point-min) (point-max)))))
;; Fallback for whedn the compiler is not available.
(list (expand-file-name "/usr/include")
(expand-file-name "/usr/local/include")))))
;; Prefer GCC.
((let ((arch (with-temp-buffer
(when (eq 0 (ignore-errors
(call-process "gcc" nil '(t nil) nil
"-print-multiarch")))
(goto-char (point-min))
(buffer-substring (point) (line-end-position))))))
(if (zerop (length arch))
base
(append base (list (expand-file-name arch "/usr/include"))))))))))
;;; subr.el ends here

65
test/lisp/ffap-tests.el
View file

@ -182,6 +182,71 @@ left alone when opening a URL in an external browser."
(goto-char (point-min))
(should (equal (ffap-file-at-point) nil))))
(ert-deftest ffap-tests--c-path ()
(should (seq-every-p #'stringp (ffap--c-path)))
(should (locate-file "stdio.h" (ffap--c-path)))
(or (memq system-type '(windows-nt ms-dos))
(should (member "/usr/include" (ffap--c-path))))
(should (equal (ffap--c-path)
(delete-dups (ffap--c-path))))
;; Return a meaningful result even if calling some compiler fails.
(cl-letf (((symbol-function 'call-process)
(lambda (_program &optional _infile _destination _display &rest _args) 1)))
(should (seq-every-p #'stringp (ffap--c-path)))
(should (member (expand-file-name "/usr/include")
(ffap--c-path)))
(should (equal (ffap--c-path)
(delete-dups (ffap--c-path))))))
(ert-deftest ffap-tests--c-path/gcc-mocked ()
;; Handle empty values of "gcc -print-multiarch".
(cl-letf (((symbol-function 'call-process)
(lambda (_program &optional _infile _destination _display &rest args)
(when (equal (car args) "-print-multiarch")
(insert "\n") 0))))
(should (member (expand-file-name "/usr/include")
(ffap--c-path))))
;; Handle single values of "gcc -print-multiarch".
(cl-letf ((system-type 'foo)
((symbol-function 'call-process)
(lambda (_program &optional _infile _destination _display &rest args)
(when (equal (car args) "-print-multiarch")
(insert "x86_64-linux-gnu\n") 0))))
(should (member (expand-file-name "/usr/include/x86_64-linux-gnu")
(ffap--c-path)))))
(ert-deftest ffap-tests--c-path/clang-mocked ()
;; Handle clang 15.0.0 output on macOS 15.2.
(cl-letf (((symbol-function 'ffap--gcc-is-clang-p) (lambda () t))
((symbol-function 'call-process)
(lambda (_program &optional _infile _destination _display &rest _args)
(insert "\
Apple clang version 15.0.0 (clang-1500.3.9.4)
Target: arm64-apple-darwin24.2.0
Thread model: posix
InstalledDir: /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin
\"/Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin/clang\"
[[[...Emacs test omits some verbose junk from the output here...]]]
clang -cc1 version 15.0.0 (clang-1500.3.9.4) default target arm64-apple-darwin24.2.0
ignoring nonexistent directory \"/usr/local/include\"
#include \"...\" search starts here:
#include <...> search starts here:
/Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/lib/clang/15.0.0/include
/Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/usr/include
/Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/include
/Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/System/Library/Frameworks (framework directory)
End of search list.
# 1 \"<stdin>\"
# 1 \"<built-in>\" 1
# 1 \"<built-in>\" 3
# 418 \"<built-in>\" 3
# 1 \"<command line>\" 1
# 1 \"<built-in>\" 2
# 1 \"<stdin>\" 2")
0)))
(should (member (expand-file-name "/Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/lib/clang/15.0.0/include")
(ffap--c-path)))))
(provide 'ffap-tests)
;;; ffap-tests.el ends here

65
test/lisp/subr-tests.el
View file

@ -1463,70 +1463,5 @@ final or penultimate step during initialization."))
(props-out (object-intervals out)))
(should (equal props-out props-in))))))))
(ert-deftest subr-tests-internal--c-header-file-path ()
(should (seq-every-p #'stringp (internal--c-header-file-path)))
(should (locate-file "stdio.h" (internal--c-header-file-path)))
(or (memq system-type '(windows-nt ms-dos))
(should (member "/usr/include" (internal--c-header-file-path))))
(should (equal (internal--c-header-file-path)
(delete-dups (internal--c-header-file-path))))
;; Return a meaningful result even if calling some compiler fails.
(cl-letf (((symbol-function 'call-process)
(lambda (_program &optional _infile _destination _display &rest _args) 1)))
(should (seq-every-p #'stringp (internal--c-header-file-path)))
(should (member (expand-file-name "/usr/include")
(internal--c-header-file-path)))
(should (equal (internal--c-header-file-path)
(delete-dups (internal--c-header-file-path))))))
(ert-deftest subr-tests-internal--c-header-file-path/gcc-mocked ()
;; Handle empty values of "gcc -print-multiarch".
(cl-letf (((symbol-function 'call-process)
(lambda (_program &optional _infile _destination _display &rest args)
(when (equal (car args) "-print-multiarch")
(insert "\n") 0))))
(should (member (expand-file-name "/usr/include")
(internal--c-header-file-path))))
;; Handle single values of "gcc -print-multiarch".
(cl-letf ((system-type 'foo)
((symbol-function 'call-process)
(lambda (_program &optional _infile _destination _display &rest args)
(when (equal (car args) "-print-multiarch")
(insert "x86_64-linux-gnu\n") 0))))
(should (member (expand-file-name "/usr/include/x86_64-linux-gnu")
(internal--c-header-file-path)))))
(ert-deftest subr-tests-internal--c-header-file-path/clang-mocked ()
;; Handle clang 15.0.0 output on macOS 15.2.
(cl-letf (((symbol-function 'internal--gcc-is-clang-p) (lambda () t))
((symbol-function 'call-process)
(lambda (_program &optional _infile _destination _display &rest _args)
(insert "\
Apple clang version 15.0.0 (clang-1500.3.9.4)
Target: arm64-apple-darwin24.2.0
Thread model: posix
InstalledDir: /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin
\"/Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin/clang\"
[[[...Emacs test omits some verbose junk from the output here...]]]
clang -cc1 version 15.0.0 (clang-1500.3.9.4) default target arm64-apple-darwin24.2.0
ignoring nonexistent directory \"/usr/local/include\"
#include \"...\" search starts here:
#include <...> search starts here:
/Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/lib/clang/15.0.0/include
/Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/usr/include
/Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/include
/Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/System/Library/Frameworks (framework directory)
End of search list.
# 1 \"<stdin>\"
# 1 \"<built-in>\" 1
# 1 \"<built-in>\" 3
# 418 \"<built-in>\" 3
# 1 \"<command line>\" 1
# 1 \"<built-in>\" 2
# 1 \"<stdin>\" 2")
0)))
(should (member (expand-file-name "/Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/lib/clang/15.0.0/include")
(internal--c-header-file-path)))))
(provide 'subr-tests)
;;; subr-tests.el ends here