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

apropos.el: Fix bug#60628

Browse source 
* lisp/apropos.el (apropos--map-preloaded-atoms): New function.
(apropos-documentation): Use it.
(apropos-documentation-check-elc-file): Don't presume #@ is preceded by
a newline (since that's not the case any more since commit
900b09c023), but be more careful not to burp on false positives.
This commit is contained in:
Stefan Monnier 2023-01-14 09:06:10 -05:00
parent 10032f424c
commit 96601cd90b
1 changed files with 100 additions and 77 deletions
Download patch file Download diff file Expand all files Collapse all files

45
lisp/apropos.el
View file

@ -886,6 +886,26 @@ Optional arg BUFFER (default: current buffer) is the buffer to check."
(if (consp pattern) "keywords " "") (if (consp pattern) "keywords " "")
pattern)))) pattern))))
(defun apropos--map-preloaded-atoms (f)
"Like `mapatoms' but only enumerates functions&vars that are predefined."
(let ((preloaded-regexp
(concat "\\`"
(regexp-quote lisp-directory)
(regexp-opt preloaded-file-list)
"\\.elc?\\'")))
;; FIXME: I find this regexp approach brittle. Maybe a better
;; option would be find/record the nthcdr of `load-history' which
;; corresponds to the `load-history' state when we dumped.
;; (Then again, maybe an even better approach would be to record the
;; state of the `obarray' when we dumped, which we may also be able to
;; use in `bytecomp' to provide a clean initial environment?)
(dolist (x load-history)
(when (string-match preloaded-regexp (car x))
(dolist (def (cdr x))
(cond
((symbolp def) (funcall f def))
((eq 'defun (car-safe def)) (funcall f (cdr def)))))))))
;;;###autoload ;;;###autoload
(defun apropos-documentation (pattern &optional do-all) (defun apropos-documentation (pattern &optional do-all)
"Show symbols whose documentation contains matches for PATTERN. "Show symbols whose documentation contains matches for PATTERN.
@ -894,10 +914,11 @@ or a regexp (using some regexp special characters). If it is a word,
search for matches for that word as a substring. If it is a list of words, search for matches for that word as a substring. If it is a list of words,
search for matches for any two (or more) of those words. search for matches for any two (or more) of those words.
Note that by default this command only searches in the file specified by Note that by default this command only searches in the functions predefined
`internal-doc-file-name'; i.e., the etc/DOC file. With \\[universal-argument] prefix, at Emacs startup, i.e., the primitives implemented in C or preloaded in the
or if `apropos-do-all' is non-nil, it searches all currently defined Emacs dump image.
documentation strings. With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, it searches
all currently defined documentation strings.
Returns list of symbols and documentation found." Returns list of symbols and documentation found."
;; The doc used to say that DO-ALL includes key-bindings info in the ;; The doc used to say that DO-ALL includes key-bindings info in the
@ -913,8 +934,8 @@ Returns list of symbols and documentation found."
(apropos-sort-by-scores apropos-documentation-sort-by-scores) (apropos-sort-by-scores apropos-documentation-sort-by-scores)
f v sf sv) f v sf sv)
(apropos-documentation-check-doc-file) (apropos-documentation-check-doc-file)
(if do-all (funcall
(mapatoms (if do-all #'mapatoms #'apropos--map-preloaded-atoms)
(lambda (symbol) (lambda (symbol)
(setq f (apropos-safe-documentation symbol) (setq f (apropos-safe-documentation symbol)
v (get symbol 'variable-documentation)) v (get symbol 'variable-documentation))
@ -939,7 +960,7 @@ Returns list of symbols and documentation found."
(cons (list symbol (cons (list symbol
(+ (apropos-score-symbol symbol 2) sf sv) (+ (apropos-score-symbol symbol 2) sf sv)
f v) f v)
apropos-accumulator))))))) apropos-accumulator))))))
(apropos-print nil "\n----------------\n" nil t)))) (apropos-print nil "\n----------------\n" nil t))))
@ -1064,10 +1085,12 @@ non-nil."
(setq apropos-files-scanned (cons file apropos-files-scanned)) (setq apropos-files-scanned (cons file apropos-files-scanned))
(erase-buffer) (erase-buffer)
(insert-file-contents file) (insert-file-contents file)
(while (search-forward "\n#@" nil t) (while (search-forward "#@" nil t)
;; Read the comment length, and advance over it. ;; Read the comment length, and advance over it.
(setq end (read) ;; This #@ may be a false positive, so don't get upset if
beg (1+ (point)) ;; it's not followed by the expected number of bytes to skip.
(when (and (setq end (ignore-errors (read))) (natnump end))
(setq beg (1+ (point))
end (+ (point) end -1)) end (+ (point) end -1))
(forward-char) (forward-char)
(if (save-restriction (if (save-restriction
@ -1110,7 +1133,7 @@ non-nil."
'face apropos-match-face doc))) 'face apropos-match-face doc)))
(setcar (nthcdr (if this-is-a-variable 3 2) (setcar (nthcdr (if this-is-a-variable 3 2)
apropos-item) apropos-item)
doc)))))))))) doc)))))))))))