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 " "")
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
(defun apropos-documentation (pattern &optional do-all)
"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 any two (or more) of those words.
Note that by default this command only searches in the file specified by
`internal-doc-file-name'; i.e., the etc/DOC file. With \\[universal-argument] prefix,
or if `apropos-do-all' is non-nil, it searches all currently defined
documentation strings.
Note that by default this command only searches in the functions predefined
at Emacs startup, i.e., the primitives implemented in C or preloaded in the
Emacs dump image.
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."
;; 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)
f v sf sv)
(apropos-documentation-check-doc-file)
(if do-all
(mapatoms
(funcall
(if do-all #'mapatoms #'apropos--map-preloaded-atoms)
(lambda (symbol)
(setq f (apropos-safe-documentation symbol)
v (get symbol 'variable-documentation))
@ -939,7 +960,7 @@ Returns list of symbols and documentation found."
(cons (list symbol
(+ (apropos-score-symbol symbol 2) sf sv)
f v)
apropos-accumulator)))))))
apropos-accumulator))))))
(apropos-print nil "\n----------------\n" nil t))))
@ -1064,10 +1085,12 @@ non-nil."
(setq apropos-files-scanned (cons file apropos-files-scanned))
(erase-buffer)
(insert-file-contents file)
(while (search-forward "\n#@" nil t)
(while (search-forward "#@" nil t)
;; Read the comment length, and advance over it.
(setq end (read)
beg (1+ (point))
;; This #@ may be a false positive, so don't get upset if
;; 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))
(forward-char)
(if (save-restriction
@ -1110,7 +1133,7 @@ non-nil."
'face apropos-match-face doc)))
(setcar (nthcdr (if this-is-a-variable 3 2)
apropos-item)
doc))))))))))
doc)))))))))))