commit e5218df144203ff1b5da3d46b7579b6455008ee7 (HEAD, refs/remotes/origin/master) Author: Spencer Baugh Date: Thu May 1 14:27:30 2025 -0400 Add load-path-filter-function and use it to optimize loading When there are many directories on load-path, the part of load which searches load-path can become very slow. By filtering load-path up front to only contain directories which are likely to contain the searched-for file, load becomes much faster. This can be set in early-init.el for maximum effect. * lisp/startup.el (load-path-filter--cache) (load-path-filter-cache-directory-files): Add. * src/lread.c (Fload): Call load-path-filter-function. (syms_of_lread): Add load-path-filter-function. diff --git a/lisp/startup.el b/lisp/startup.el index 230b50311c6..c2c1d18338c 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1143,6 +1143,39 @@ the `--debug-init' option to view a complete error backtrace." (defvar lisp-directory nil "Directory where Emacs's own *.el and *.elc Lisp files are installed.") +(defvar load-path-filter--cache nil + "A cache used by `load-path-filter-cache-directory-files'. + +This is an alist. The car of each entry is a list of load suffixes, +such as returned by `get-load-suffixes'. The cdr of each entry is a +cons whose car is an optimized regex matching those suffixes at the end +of a string, and whose cdr is a hashtable mapping directories to files +in that directory which end with one of the suffixes.") + +(defun load-path-filter-cache-directory-files (path file suffixes) + "Filter PATH to only directories which might contain FILE with SUFFIXES. + +Doesn't filter if FILE is an absolute file name or if FILE is a relative +file name with more than one component. + +Caches directory contents in `load-path-filter--cache'." + (if (file-name-directory file) + ;; FILE has more than one component, don't bother filtering. + path + (seq-filter + (let ((rx-and-ht + (with-memoization (alist-get suffixes load-path-filter--cache nil nil #'equal) + (cons + (concat (regexp-opt suffixes) "\\'") + (make-hash-table :test #'equal))))) + (lambda (dir) + (when (file-directory-p dir) + (try-completion + file + (with-memoization (gethash dir (cdr rx-and-ht)) + (directory-files dir nil (car rx-and-ht) t)))))) + path))) + (defun command-line () "A subroutine of `normal-top-level'. Amongst another things, it parses the command-line arguments." diff --git a/src/lread.c b/src/lread.c index 98cda8316ac..ed481c19721 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1424,12 +1424,16 @@ Return t if the file exists and loads successfully. */) suffixes = CALLN (Fappend, suffixes, Vload_file_rep_suffixes); } + Lisp_Object load_path = Vload_path; + if (FUNCTIONP (Vload_path_filter_function)) + load_path = calln (Vload_path_filter_function, load_path, file, suffixes); + #if !defined USE_ANDROID_ASSETS - fd = openp (Vload_path, file, suffixes, &found, Qnil, + fd = openp (load_path, file, suffixes, &found, Qnil, load_prefer_newer, no_native, NULL); #else asset = NULL; - rc = openp (Vload_path, file, suffixes, &found, Qnil, + rc = openp (load_path, file, suffixes, &found, Qnil, load_prefer_newer, no_native, &asset); fd.fd = rc; fd.asset = asset; @@ -6107,6 +6111,18 @@ where FILE is the filename of the eln file, including the .eln extension. through `require'. */); load_no_native = false; + DEFVAR_LISP ("load-path-filter-function", + Vload_path_filter_function, + doc: /* Non-nil means to call this function to filter `load-path' for `load'. + +When load is called, this function is called with three arguments: the +current value of `load-path' (a list of directories), the FILE argument +to load, and the current load-suffixes. + +It should return a list of directories, which `load' will use instead of +`load-path'. */); + Vload_path_filter_function = Qnil; + /* Vsource_directory was initialized in init_lread. */ DEFSYM (Qcurrent_load_list, "current-load-list"); commit c8795767292caaaa3765ef6fffb12a7c0809d642 Author: Michael Albinus Date: Fri May 23 13:40:11 2025 +0200 * test/infra/Dockerfile.emba (emacs-tree-sitter): Cosmetic change. diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba index 96fe0440667..70bfb076c3c 100644 --- a/test/infra/Dockerfile.emba +++ b/test/infra/Dockerfile.emba @@ -129,6 +129,7 @@ RUN git config --global http.sslverify "false" RUN src/emacs -Q --batch \ --eval '(message "library ABI min version %d max version %d" \ (treesit-library-abi-version t) (treesit-library-abi-version))' \ + --eval '(message "\nInstalling grammars\n===================")' \ --eval '(setq treesit-extra-load-path (list "/root/.emacs.d/tree-sitter"))' \ --eval '(dolist (feature (quote (c-ts-mode cmake-ts-mode csharp-mode \ dockerfile-ts-mode elixir-ts-mode heex-ts-mode go-ts-mode java-ts-mode \ @@ -137,13 +138,21 @@ RUN src/emacs -Q --batch \ toml-ts-mode yaml-ts-mode treesit-x))) (require feature))' \ --eval '(dolist (lang (mapcar (quote car) treesit-language-source-alist)) \ (treesit-install-language-grammar lang "/root/.emacs.d/tree-sitter"))' \ - --eval '(message "treesit-language-source-alist\n%s" \ - (pp-to-string treesit-language-source-alist))' \ - --eval '(dolist (lang (sort (mapcar (quote car) treesit-language-source-alist))) \ - (message "%s ABI version %d" lang (treesit-language-abi-version lang)))' \ + --eval '(message "\ntreesit-language-source-alist")' \ + --eval '(message "=============================")' \ + --eval '(message "%s" (pp-to-string treesit-language-source-alist))' \ + --eval '(message "ABI versions\n===========")' \ + --eval \ + '(dolist (lang (sort (mapcar (quote car) treesit-language-source-alist))) \ + (message "%s ABI version %d" lang (treesit-language-abi-version lang)))' \ -l admin/tree-sitter/treesit-admin.el \ - --eval '(setq treesit-admin--builtin-language-sources treesit-language-source-alist)' \ + --eval '(setq treesit-admin--builtin-language-sources \ + treesit-language-source-alist)' \ + --eval '(message "\ntreesit-admin-check-manual-coverage")' \ + --eval '(message "===================================")' \ -f treesit-admin-check-manual-coverage \ + --eval '(message "\ntreesit-admin--generate-compatibility-report")' \ + --eval '(message "============================================")' \ --eval '(treesit-admin--generate-compatibility-report \ (list (expand-file-name "src/emacs")) treesit-admin--builtin-modes \ (expand-file-name "compatibility-report.html"))' commit 9f80363f8cbba078cc6e8c02501a4d25ef7b3a84 Author: Vincent Belaïche Date: Fri May 23 09:57:25 2025 +0200 Minor fix. * lisp/ses.el (ses--align): fix /Unused lexical variable 'half'/ warning. diff --git a/lisp/ses.el b/lisp/ses.el index 90ea4ad4b25..01d6e755eb3 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -4093,8 +4093,7 @@ WIDTH the additional width to be padded if >0, <= 0 if no padding is to be added. FILL the fill character to be padded." (setq printer (or printer (ses-col-printer ses--col) ses--default-printer)) - (let ((width (ses-col-width ses--col)) - half) + (let ((width (ses-col-width ses--col))) (or span (setq span 0)) (setq value (ses-call-printer printer value)) (dotimes (x span) commit ce08defd0a9a02a69edb781671047545baae14d7 Author: Vincent Belaïche Date: Fri May 23 09:28:56 2025 +0200 More SES printer functions. * lisp/ses.el (ses-standard-printer-functions): add 'ses-left' & 'ses-left-span' to the list. (ses--align): New helper function, takes most of the code previously in 'ses-center' (ses-center): Use 'ses--align'. (ses--span): New helper function, takes most of the code previously in 'ses-center-span. (ses-center-span): Use 'ses--span'.' (ses-left): New function. (ses-left-span): New function. diff --git a/lisp/ses.el b/lisp/ses.el index aa3eb1bad40..90ea4ad4b25 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -299,7 +299,10 @@ Used for listing local printers or renamed cells.") (defconst ses-standard-printer-functions '(ses-center - ses-center-span ses-dashfill ses-dashfill-span + ses-center-span + ses-left + ses-left-span + ses-dashfill ses-dashfill-span ses-tildefill-span ses-prin1) "List of print functions to be included in initial history of printer functions. @@ -4080,43 +4083,83 @@ either (ses-range BEG END) or (list ...). The TEST is evaluated." (put x 'side-effect-free t)) -;;---------------------------------------------------------------------------- -;; Standard print functions -;;---------------------------------------------------------------------------- - -(defun ses-center (value &optional span fill printer) - "Print VALUE, centered within column. -FILL is the fill character for centering (default = space). -SPAN indicates how many additional rightward columns to include -in width (default = 0). -PRINTER is the printer to use for printing the value, default is the -column printer if any, or the spreadsheet the spreadsheet default -printer otherwise." +(defun ses--align (value align-fn span fill printer) + "Helper fonction for \\{ses-center} and \\{ses-left}. Please refer to these functions help. +ALIGN-FN shall be a function to concatenate the padding, it shall have +parameters (VALUE WIDTH FILL) with: +VALUE a string already formatted by PRINTER to which padding is to be +concatenated. +WIDTH the additional width to be padded if >0, <= 0 if no padding is to +be added. +FILL the fill character to be padded." (setq printer (or printer (ses-col-printer ses--col) ses--default-printer)) (let ((width (ses-col-width ses--col)) half) - (or fill (setq fill ?\s)) (or span (setq span 0)) (setq value (ses-call-printer printer value)) (dotimes (x span) (setq width (+ width 1 (ses-col-width (+ ses--col span (- x)))))) ;; Set column width. (setq width (- width (string-width value))) - (if (<= width 0) - value ; Too large for field, anyway. - (setq half (make-string (/ width 2) fill)) - (concat half value half - (if (oddp width) (char-to-string fill)))))) + (funcall align-fn value width fill))) -(defun ses-center-span (value &optional fill printer) - "Print VALUE, centered within the span that starts in the current column -and continues until the next nonblank column. -FILL specifies the fill character (default = space)." +;;---------------------------------------------------------------------------- +;; Standard print functions +;;---------------------------------------------------------------------------- + +(defun ses-center (value &optional span fill printer) + "Print VALUE, centered within column. +FILL is the fill character for centering (default = space). +SPAN indicates how many additional rightward columns to include in +width (default = 0). +PRINTER is the printer to use for printing the value, default is the +column printer if any, or the spreadsheet default printer otherwise." + (ses--align value + (lambda (value width fill) + (if (<= width 0) + value ; Too large for field, anyway. + (let ((half (make-string (/ width 2) fill))) + (concat half value half + (if (oddp width) (char-to-string fill)))))) + span (or fill ?\s) printer)) + +(defun ses--span (align-fn value fill printer) + "Helper function for \\{ses-center-span} and \\{ses-left-span}. Please refer to these functions help. +ALIGN-FN shall be a function such as \\{ses-center} or \\{ses-left}." (let ((end (1+ ses--col))) (while (and (< end ses--numcols) (memq (ses-cell-value ses--row end) '(nil *skip*))) (setq end (1+ end))) - (ses-center value (- end ses--col 1) fill printer))) + (funcall align-fn value (- end ses--col 1) fill printer))) + + +(defun ses-center-span (value &optional fill printer) + "Print VALUE, centered within the span that starts in the current column +and continues until the next nonblank column. +FILL specifies the fill character (default = space)." + (ses--span #'ses-center value fill printer)) + +(defun ses-left (value &optional span fill printer) + "Print VALUE, left aligned within column. +FILL is the fill character for aligning (default = '-'). +SPAN indicates how many additional rightward columns to include +in width (default = 0). +PRINTER is the printer to use for printing the value, default is the +column printer if any, or the spreadsheet the spreadsheet default +printer otherwise." + (ses--align value + (lambda (value width fill) + (if (<= width 0) + value ; Too large for field, anyway. + (concat value (make-string width fill)))) + span (or fill ?-) printer)) + +(defun ses-left-span (value &optional fill printer) + "Print VALUE, aligned left within the span that starts in the current column +and continues until the next nonblank column. +FILL specifies the fill character (default = '-')." + (ses--span #'ses-left value fill printer)) + (defun ses-dashfill (value &optional span printer) "Print VALUE centered using dashes.