branch: elpa/doc-show-inline
commit 1f4c13ce7d0416b9bfaffb5db0e7c882b11a3a3f
Author: Campbell Barton <ideasma...@gmail.com>
Commit: Campbell Barton <ideasma...@gmail.com>
Cleanup: emacs native format
---
doc-show-inline.el | 829 ++++++++++++++++++++++++++---------------------------
1 file changed, 399 insertions(+), 430 deletions(-)
diff --git a/doc-show-inline.el b/doc-show-inline.el
index 1d5323c030..453453178f 100644
--- a/doc-show-inline.el
+++ b/doc-show-inline.el
@@ -82,9 +82,9 @@ Note that the `background' is initialized using
;; TODO, document and make public.
(defvar doc-show-inline-mode-defaults
(list
- (cons 'c-mode (list :filter 'doc-show-inline-filter-for-cc-mode))
- (cons 'cc-mode (list :filter 'doc-show-inline-filter-for-cc-mode))
- (cons 'objc-mode (list :filter 'doc-show-inline-filter-for-cc-mode)))
+ (cons 'c-mode (list :filter 'doc-show-inline-filter-for-cc-mode))
+ (cons 'cc-mode (list :filter 'doc-show-inline-filter-for-cc-mode))
+ (cons 'objc-mode (list :filter 'doc-show-inline-filter-for-cc-mode)))
"An association-list of default functions.")
(defcustom doc-show-inline-use-logging nil
@@ -167,49 +167,45 @@ When unset, the :filter property from
`doc-show-inline-mode-defaults' is used.")
(defmacro doc-show-inline--with-advice (fn-orig where fn-advice &rest body)
"Execute BODY with WHERE advice on FN-ORIG temporarily enabled."
(declare (indent 3))
- `
- (let ((fn-advice-var ,fn-advice))
- (unwind-protect
- (progn
- (advice-add ,fn-orig ,where fn-advice-var)
- ,@body)
- (advice-remove ,fn-orig fn-advice-var))))
+ `(let ((fn-advice-var ,fn-advice))
+ (unwind-protect
+ (progn
+ (advice-add ,fn-orig ,where fn-advice-var)
+ ,@body)
+ (advice-remove ,fn-orig fn-advice-var))))
(defun doc-show-inline--color-highlight (color factor)
"Tint between COLOR by FACTOR in (-1..1).
Where positive brighten and negative numbers darken."
- (let
- (
- (value (color-values color))
- (factor-int (truncate (* 65535 factor))))
+ (let ((value (color-values color))
+ (factor-int (truncate (* 65535 factor))))
(apply #'format
- (cons
- "#%02x%02x%02x"
- (mapcar
- #'
- (lambda (n)
- ;; Shift by -8 to map the value returned by `color values':
- ;; 0..65535 to 0..255 for `#RRGGBB` string formatting.
- (ash (min 65535 (max 0 (truncate (+ (nth n value) factor-int))))
-8))
- (number-sequence 0 2))))))
+ (cons
+ "#%02x%02x%02x"
+ (mapcar
+ #'(lambda (n)
+ ;; Shift by -8 to map the value returned by `color values':
+ ;; 0..65535 to 0..255 for `#RRGGBB` string formatting.
+ (ash (min 65535 (max 0 (truncate (+ (nth n value)
factor-int)))) -8))
+ (number-sequence 0 2))))))
(defun doc-show-inline--buffer-substring-with-overlay-props (pos-beg pos-end)
"Return text between POS-BEG and POS-END including overlay properties."
(let
- ( ;; Extract text and possible overlays.
- (text (buffer-substring pos-beg pos-end))
- (text-length (- pos-end pos-beg))
- (overlays (overlays-in pos-beg pos-end)))
+ ( ;; Extract text and possible overlays.
+ (text (buffer-substring pos-beg pos-end))
+ (text-length (- pos-end pos-beg))
+ (overlays (overlays-in pos-beg pos-end)))
(while overlays
(let ((ov (pop overlays)))
(let ((face-prop (overlay-get ov 'face)))
(when face-prop
(add-face-text-property
- (max (- (overlay-start ov) pos-beg) 0)
- (min (- (overlay-end ov) pos-beg) text-length)
- face-prop
- t
- text)))))
+ (max (- (overlay-start ov) pos-beg) 0)
+ (min (- (overlay-end ov) pos-beg) text-length)
+ face-prop
+ t
+ text)))))
text))
@@ -229,15 +225,13 @@ Where positive brighten and negative numbers darken."
(defmacro doc-show-inline--log-fail (&rest args)
"Log failure messages formatted with ARGS."
- `
- (when doc-show-inline-use-logging
- (doc-show-inline--log-type-impl "Fail: " (format ,@args))))
+ `(when doc-show-inline-use-logging
+ (doc-show-inline--log-type-impl "Fail: " (format ,@args))))
(defmacro doc-show-inline--log-info (&rest args)
"Log info messages formatted with ARGS."
- `
- (when doc-show-inline-use-logging
- (doc-show-inline--log-type-impl "Info: " (format ,@args))))
+ `(when doc-show-inline-use-logging
+ (doc-show-inline--log-type-impl "Info: " (format ,@args))))
;; ---------------------------------------------------------------------------
@@ -253,33 +247,32 @@ The point will be located over the symbol (typically at
it's beginning),
the point should not be moved by this function."
(let ((prefix (buffer-substring-no-properties (line-beginning-position)
(point))))
(cond
- ;; Ignore defines, they never have external docs.
- ;; Removing will work, it just performs an unnecessary lookup.
- ((string-match-p "[ \t]*#[ \t]*define[ \t]+" prefix)
- nil)
- ;; Ignore static function doc-strings.
- ;; Removing will work, it just performs an unnecessary lookup.
- ((string-match-p "\\_<static\\_>" prefix)
- nil)
- ;; Forward declaring structs shouldn't show documentation, e.g:
- ;; struct SomeStruct;
- ;; while this is in some sense a personal preference,
- ;; forward declarations are mostly used to prevent warnings when these
- ;; structs are used as parameters.
- ;; So it makes sense to ignore them.
- ( ;; Match: struct sym;
- (and
- (string-match-p "^\\_<struct\\_>" prefix)
- (equal ?\; (char-after (+ (point) (length sym)))))
- nil)
- ;; Including `typedef' rarely gains anything from in-lining doc-string
- ;; Similar to `struct':
- ;; - This is already the declaration so the doc-string is already
available.
- ;; - This forward declares an opaque type.
- ((string-match-p "^\\_<typedef\\_>" prefix)
- nil)
- (t
- t))))
+ ;; Ignore defines, they never have external docs.
+ ;; Removing will work, it just performs an unnecessary lookup.
+ ((string-match-p "[ \t]*#[ \t]*define[ \t]+" prefix)
+ nil)
+ ;; Ignore static function doc-strings.
+ ;; Removing will work, it just performs an unnecessary lookup.
+ ((string-match-p "\\_<static\\_>" prefix)
+ nil)
+ ;; Forward declaring structs shouldn't show documentation, e.g:
+ ;; struct SomeStruct;
+ ;; while this is in some sense a personal preference,
+ ;; forward declarations are mostly used to prevent warnings when these
+ ;; structs are used as parameters.
+ ;; So it makes sense to ignore them.
+ ( ;; Match: struct sym;
+ (and (string-match-p "^\\_<struct\\_>" prefix)
+ (equal ?\; (char-after (+ (point) (length sym)))))
+ nil)
+ ;; Including `typedef' rarely gains anything from in-lining doc-string
+ ;; Similar to `struct':
+ ;; - This is already the declaration so the doc-string is already
available.
+ ;; - This forward declares an opaque type.
+ ((string-match-p "^\\_<typedef\\_>" prefix)
+ nil)
+ (t
+ t))))
(defun doc-show-inline-extract-doc-default (sym)
"Extract doc-string for SYM."
@@ -291,86 +284,80 @@ the point should not be moved by this function."
;; Move one character into the comment.
(goto-char pos-end)
(cond
- ((forward-comment -1)
- (let
- (
- (pos-beg (point))
+ ((forward-comment -1)
+ (let ((pos-beg (point))
(pos-beg-of-line (line-beginning-position)))
- (cond
- (
- ;; Ensure the comment is not a trailing comment of a previous
line.
- (not
- (eq
- pos-beg-of-line
- (save-excursion
- (skip-chars-backward " \t" pos-beg-of-line)
- (point))))
- (doc-show-inline--log-info
- "symbol \"%s\" in %S at point %d is previous lines trailing
comment"
- sym
- (current-buffer)
- (point))
- ;; Skip this comment.
- nil)
-
- ;; Optionally exclude blank lines between the comment and the
function definition.
- (
- (and
- ;; Checking blank lines?
- (not (zerop doc-show-inline-exclude-blank-lines))
- (let ((blank-lines 0))
- (save-excursion
- (goto-char pos-end)
- ;; It's important the point is at the beginning of the line
- ;; so `looking-at-p' works as expected.
- (beginning-of-line)
- (while
- (and
- (looking-at-p "[[:blank:]]*$")
- (< (setq blank-lines (1+ blank-lines))
doc-show-inline-exclude-blank-lines)
- (zerop (forward-line -1)))))
- (eq blank-lines doc-show-inline-exclude-blank-lines)))
+ (cond
+ (
+ ;; Ensure the comment is not a trailing comment of a previous line.
+ (not
+ (eq
+ pos-beg-of-line
+ (save-excursion
+ (skip-chars-backward " \t" pos-beg-of-line)
+ (point))))
+ (doc-show-inline--log-info
+ "symbol \"%s\" in %S at point %d is previous lines trailing comment"
+ sym
+ (current-buffer)
+ (point))
+ ;; Skip this comment.
+ nil)
+
+ ;; Optionally exclude blank lines between the comment and the
function definition.
+ ((and
+ ;; Checking blank lines?
+ (not (zerop doc-show-inline-exclude-blank-lines))
+ (let ((blank-lines 0))
+ (save-excursion
+ (goto-char pos-end)
+ ;; It's important the point is at the beginning of the line
+ ;; so `looking-at-p' works as expected.
+ (beginning-of-line)
+ (while (and (looking-at-p "[[:blank:]]*$")
+ (< (setq blank-lines (1+ blank-lines))
+ doc-show-inline-exclude-blank-lines)
+ (zerop (forward-line -1)))))
+ (eq blank-lines doc-show-inline-exclude-blank-lines)))
- (doc-show-inline--log-info
- "comment \"%s\" in %S at point %d was skipped because of at
least %d blank lines"
- sym
- (current-buffer)
- pos-beg
- doc-show-inline-exclude-blank-lines)
-
- ;; Found at least `doc-show-inline-exclude-blank-lines'
blank-lines, skipping.
- nil)
-
- ;; Optionally exclude a regexp.
- (
- (and
- doc-show-inline-exclude-regexp
- (save-match-data
- (goto-char pos-beg)
- (search-forward-regexp doc-show-inline-exclude-regexp
pos-end t)))
+ (doc-show-inline--log-info
+ "comment \"%s\" in %S at point %d was skipped because of at least
%d blank lines"
+ sym
+ (current-buffer)
+ pos-beg
+ doc-show-inline-exclude-blank-lines)
- (doc-show-inline--log-info
- "comment \"%s\" in %S at point %d was skipped because of regex
match with %S"
- sym
- (current-buffer)
- pos-beg
- doc-show-inline-exclude-regexp)
-
- ;; Skip this comment.
- nil)
-
- (t
- ;; Success.
- (cons pos-beg-of-line pos-end)))))
- (t
- (doc-show-inline--log-info
- "symbol \"%s\" in %S at point %d has no comment before it"
- sym
- (current-buffer)
- (point))
- ;; Failure.
- nil))))
+ ;; Found at least `doc-show-inline-exclude-blank-lines' blank-lines,
skipping.
+ nil)
+
+ ;; Optionally exclude a regexp.
+ ((and doc-show-inline-exclude-regexp
+ (save-match-data
+ (goto-char pos-beg)
+ (search-forward-regexp doc-show-inline-exclude-regexp pos-end
t)))
+
+ (doc-show-inline--log-info
+ "comment \"%s\" in %S at point %d was skipped because of regex
match with %S"
+ sym
+ (current-buffer)
+ pos-beg
+ doc-show-inline-exclude-regexp)
+
+ ;; Skip this comment.
+ nil)
+
+ (t
+ ;; Success.
+ (cons pos-beg-of-line pos-end)))))
+ (t
+ (doc-show-inline--log-info
+ "symbol \"%s\" in %S at point %d has no comment before it"
+ sym
+ (current-buffer)
+ (point))
+ ;; Failure.
+ nil))))
;; ---------------------------------------------------------------------------
@@ -380,38 +367,37 @@ the point should not be moved by this function."
"Ensure `doc-show-inline-face' has a background color."
(when (eq 'unspecified (face-attribute 'doc-show-inline-face :background))
(let*
- ( ;; Tint the color.
- (default-color (face-attribute 'default :background))
- (default-tint
+ ( ;; Tint the color.
+ (default-color (face-attribute 'default :background))
+ (default-tint
(doc-show-inline--color-highlight
- default-color
- doc-show-inline-face-background-highlight)))
+ default-color
+ doc-show-inline-face-background-highlight)))
;; Ensure there is some change, otherwise tint in the opposite direction.
(when (equal default-color default-tint)
(setq default-tint
- (doc-show-inline--color-highlight
- default-color
- (- doc-show-inline-face-background-highlight))))
+ (doc-show-inline--color-highlight
+ default-color
+ (- doc-show-inline-face-background-highlight))))
(set-face-attribute 'doc-show-inline-face nil :background
default-tint))))
(defun doc-show-inline--overlays-remove (&optional pos-beg pos-end)
"Remove overlays between POS-BEG & POS-END."
(cond
- ;; When logging remove overlays one at a time.
- (doc-show-inline-use-logging
- (let ((overlays-in-view (overlays-in (or pos-beg (point-min)) (or
pos-end (point-max)))))
- (when overlays-in-view
- (while overlays-in-view
- (let ((ov (pop overlays-in-view)))
- (when (and (overlay-get ov 'doc-show-inline) (overlay-buffer ov))
- (doc-show-inline--log-info
- "removing overlay in %S at point %d"
- (current-buffer)
- ;; Start & end are the same.
- (overlay-start ov))
- (delete-overlay ov)))))))
- (t
- (remove-overlays pos-beg pos-end 'doc-show-inline t))))
+ ;; When logging remove overlays one at a time.
+ (doc-show-inline-use-logging
+ (let ((overlays-in-view (overlays-in (or pos-beg (point-min)) (or pos-end
(point-max)))))
+ (when overlays-in-view
+ (while overlays-in-view
+ (let ((ov (pop overlays-in-view)))
+ (when (and (overlay-get ov 'doc-show-inline) (overlay-buffer ov))
+ (doc-show-inline--log-info
+ "removing overlay in %S at point %d" (current-buffer)
+ ;; Start & end are the same.
+ (overlay-start ov))
+ (delete-overlay ov)))))))
+ (t
+ (remove-overlays pos-beg pos-end 'doc-show-inline t))))
(defun doc-show-inline--pos-in-overlays (pos overlays)
"Return non-nil when POS is within OVERLAYS."
@@ -431,73 +417,69 @@ the point should not be moved by this function."
;; Ensure `imenu--index-alist' is populated.
(unless imenu--index-alist
(condition-case-unless-debug err
- ;; Note that in some cases a file will fail to parse,
- ;; typically when the file is intended for another platform (for
example).
- (imenu--make-index-alist)
+ ;; Note that in some cases a file will fail to parse,
+ ;; typically when the file is intended for another platform (for
example).
+ (imenu--make-index-alist)
(error
- (doc-show-inline--log-fail
- "IMENU couldn't access symbols (failed to parse?): %s"
- (error-message-string err)))))
- (let
- (
- (alist imenu--index-alist)
- (pair nil)
- (mark nil)
- (imstack nil)
- (result nil)
-
- ;; As the results differ between back-ends, some custom handling is
needed.
- (xref-backend (xref-find-backend)))
+ (doc-show-inline--log-fail
+ "IMENU couldn't access symbols (failed to parse?): %s"
+ (error-message-string err)))))
+ (let ((alist imenu--index-alist)
+ (pair nil)
+ (mark nil)
+ (imstack nil)
+ (result nil)
+
+ ;; As the results differ between back-ends, some custom handling is
needed.
+ (xref-backend (xref-find-backend)))
;; Elements of alist are either ("name" . marker), or
;; ("submenu" ("name" . marker) ... ). The list can be
;; Arbitrarily nested.
(while (or alist imstack)
(cond
- (alist
- (setq pair (car-safe alist))
- (setq alist (cdr-safe alist))
- (cond
- ((atom pair)) ;; Skip anything not a cons.
-
- ((imenu--subalist-p pair)
- (setq imstack (cons alist imstack))
- (setq alist (cdr pair)))
-
- ((number-or-marker-p (setq mark (cdr pair)))
- (let
- (
- (pos
- (cond
- ((markerp mark)
- (marker-position mark))
- (t ;; Integer.
- mark))))
-
- (unless (or (and pos-beg (<= pos pos-beg)) (and pos-end (>=
pos pos-end)))
- (goto-char pos)
- (let ((sym nil))
- (cond
- ((eq xref-backend 'eglot)
- ;; EGLOT mode has some differences.
- ;; - `xref-backend-identifier-at-point' isn't
functional.
- ;; - The point is at the beginning of the line.
- ;; For this reason, it's necessary to search for `sym'
& set the
- ;; position to this.
- (setq sym (car pair))
- (unless (looking-at-p (regexp-quote sym))
- ;; In most cases limiting by `line-end-position' is
sufficient.
- (save-match-data
- (when (search-forward sym pos-end t)
- (setq pos (- (point) (length sym)))))))
- (t
- ;; This works for `xref-lsp'.
- (setq sym (xref-backend-identifier-at-point
xref-backend))))
-
- (push (cons sym pos) result)))))))
- (t
- (setq alist (car imstack))
- (setq imstack (cdr imstack)))))
+ (alist
+ (setq pair (car-safe alist))
+ (setq alist (cdr-safe alist))
+ (cond
+ ((atom pair)) ;; Skip anything not a cons.
+
+ ((imenu--subalist-p pair)
+ (setq imstack (cons alist imstack))
+ (setq alist (cdr pair)))
+
+ ((number-or-marker-p (setq mark (cdr pair)))
+ (let ((pos
+ (cond
+ ((markerp mark)
+ (marker-position mark))
+ (t ;; Integer.
+ mark))))
+
+ (unless (or (and pos-beg (<= pos pos-beg)) (and pos-end (>= pos
pos-end)))
+ (goto-char pos)
+ (let ((sym nil))
+ (cond
+ ((eq xref-backend 'eglot)
+ ;; EGLOT mode has some differences.
+ ;; - `xref-backend-identifier-at-point' isn't functional.
+ ;; - The point is at the beginning of the line.
+ ;; For this reason, it's necessary to search for `sym' & set
the
+ ;; position to this.
+ (setq sym (car pair))
+ (unless (looking-at-p (regexp-quote sym))
+ ;; In most cases limiting by `line-end-position' is
sufficient.
+ (save-match-data
+ (when (search-forward sym pos-end t)
+ (setq pos (- (point) (length sym)))))))
+ (t
+ ;; This works for `xref-lsp'.
+ (setq sym (xref-backend-identifier-at-point xref-backend))))
+
+ (push (cons sym pos) result)))))))
+ (t
+ (setq alist (car imstack))
+ (setq imstack (cdr imstack)))))
result))
@@ -509,17 +491,19 @@ Argument XREF-BACKEND is used to avoid multiple calls to
`xref-find-backend'."
(let ((xref-list nil))
(doc-show-inline--with-advice #'xref--not-found-error :override (lambda
(_kind _input) nil)
(doc-show-inline--with-advice #'xref--show-defs :override
- (lambda (fetcher _display-action) (setq xref-list (funcall fetcher)))
+ (lambda (fetcher _display-action)
+ (setq xref-list (funcall fetcher)))
(let ((xref-prompt-for-identifier nil))
;; Needed to suppress `etags' from requesting a file.
(doc-show-inline--with-advice #'read-file-name :override
- (lambda (&rest _args)
- (doc-show-inline--log-info
- "XREF lookup %S requested a file name for backend %S"
- (current-buffer)
- xref-backend)
- ;; File that doesn't exist.
- (user-error "Doc-show-inline: ignoring request for file read"))
+ (lambda (&rest _args)
+ (doc-show-inline--log-info
+ "XREF lookup %S requested a file
name for backend %S"
+ (current-buffer)
+ xref-backend)
+ ;; File that doesn't exist.
+ (user-error
+ "Doc-show-inline: ignoring request
for file read"))
(with-demoted-errors "%S"
(xref-find-definitions sym))))))
xref-list))
@@ -529,25 +513,23 @@ Argument XREF-BACKEND is used to avoid multiple calls to
`xref-find-backend'."
;; Build a list of comments from the `xref' list (which may find multiple
sources).
;; In most cases only a single item is found.
;; Nevertheless, best combine all so a doc-string will be extracted from at
least one.
- (let
- (
- (text-results nil)
- (current-buf (current-buffer)))
+ (let ((text-results nil)
+ (current-buf (current-buffer)))
;; Don't enable additional features when loading files
;; only for the purpose of reading their comments.
;; `doc-show-inline-fontify-hook' can be used to enable features needed
for comment extraction.
(save-excursion
(doc-show-inline--with-advice #'run-mode-hooks :override
- (lambda (_hooks)
- (with-demoted-errors "doc-show-inline-buffer-hook: %S"
- (run-hooks 'doc-show-inline-buffer-hook)))
+ (lambda (_hooks)
+ (with-demoted-errors
"doc-show-inline-buffer-hook: %S"
+ (run-hooks
'doc-show-inline-buffer-hook)))
(dolist (item xref-list)
(let*
- ( ;; This sets '(point)' which is OK in this case.
- (marker (xref-location-marker (xref-item-location item)))
- (buf (marker-buffer marker)))
+ ( ;; This sets '(point)' which is OK in this case.
+ (marker (xref-location-marker (xref-item-location item)))
+ (buf (marker-buffer marker)))
;; Ignore matches in the same buffer.
;; While it's possible doc-strings could be at another location
within this buffer,
;; in practice, this is almost never done.
@@ -567,27 +549,25 @@ Argument XREF-BACKEND is used to avoid multiple calls to
`xref-find-backend'."
(with-demoted-errors "doc-show-inline-fontify-hook: %S"
(run-hook-with-args 'doc-show-inline-fontify-hook
pos-beg pos-end))
- (let
- (
- (text
-
(doc-show-inline--buffer-substring-with-overlay-props pos-beg pos-end)))
+ (let ((text
+
(doc-show-inline--buffer-substring-with-overlay-props pos-beg pos-end)))
(push text text-results))))))))))
(cond
- (text-results ;; Add a blank item so there is a trailing newline when
joining.
- (let ((text (string-join (reverse (cons "" text-results)) "\n")))
- (add-face-text-property 0 (length text) 'doc-show-inline-face t text)
- text))
- (t
- nil))))
+ (text-results ;; Add a blank item so there is a trailing newline when
joining.
+ (let ((text (string-join (reverse (cons "" text-results)) "\n")))
+ (add-face-text-property 0 (length text) 'doc-show-inline-face t text)
+ text))
+ (t
+ nil))))
(defun doc-show-inline--show-text (pos text)
"Add an overlay from TEXT at POS."
(doc-show-inline--log-info
- "adding overlay in %S at point %d has %d length text"
- (current-buffer)
- pos
- (length (or text "")))
+ "adding overlay in %S at point %d has %d length text"
+ (current-buffer)
+ pos
+ (length (or text "")))
(let ((ov (make-overlay pos pos)))
;; Handy for debugging pending regions to be checked.
@@ -618,73 +598,69 @@ Otherwise remove all overlays."
"Add text for the overlay at POS for SYM.
XREF-BACKEND is the back-end used to find this symbol."
(cond
- ;; Check if the symbol should be considered for doc-strings,
- ;; some symbols might not make sense such as: '#define FOO' in C
- ;; which can't have been declared elsewhere.
- ((null (funcall doc-show-inline-filter sym))
- (doc-show-inline--log-info
- "symbol \"%s\" in %S at point %d has been ignored by filter %S"
- sym
- (current-buffer)
- pos
- doc-show-inline-filter))
- (t ;; Symbol is valid and not filtered out.
-
- (let ((text t))
+ ;; Check if the symbol should be considered for doc-strings,
+ ;; some symbols might not make sense such as: '#define FOO' in C
+ ;; which can't have been declared elsewhere.
+ ((null (funcall doc-show-inline-filter sym))
+ (doc-show-inline--log-info
+ "symbol \"%s\" in %S at point %d has been ignored by filter %S"
+ sym
+ (current-buffer)
+ pos
+ doc-show-inline-filter))
+ (t ;; Symbol is valid and not filtered out.
+
+ (let ((text t))
+ (when doc-show-inline--use-lookup-cache
+ (setq text (gethash sym doc-show-inline--lookup-cache t)))
+
+ ;; When true, the value doesn't exist in cache.
+ (cond
+ ((eq text t)
+ (setq text nil)
+ (let ((xref-list (doc-show-inline--xref-list-from-definitions sym
xref-backend)))
+ (doc-show-inline--log-info
+ "symbol \"%s\" in %S at point %d has %d reference(s)"
+ sym
+ (current-buffer)
+ pos
+ (length xref-list))
+ ;; Loads a buffer.
+ (when xref-list
+ (setq text (doc-show-inline--doc-from-xref sym xref-list))))
+
+ ;; Cache, even when nil (to avoid future lookups to establish it's
nil).
(when doc-show-inline--use-lookup-cache
- (setq text (gethash sym doc-show-inline--lookup-cache t)))
+ (puthash sym text doc-show-inline--lookup-cache))
- ;; When true, the value doesn't exist in cache.
- (cond
- ((eq text t)
- (setq text nil)
- (let ((xref-list (doc-show-inline--xref-list-from-definitions sym
xref-backend)))
- (doc-show-inline--log-info
- "symbol \"%s\" in %S at point %d has %d reference(s)"
- sym
- (current-buffer)
- pos
- (length xref-list))
- ;; Loads a buffer.
- (when xref-list
- (setq text (doc-show-inline--doc-from-xref sym xref-list))))
-
- ;; Cache, even when nil (to avoid future lookups to establish it's
nil).
- (when doc-show-inline--use-lookup-cache
- (puthash sym text doc-show-inline--lookup-cache))
-
- (doc-show-inline--log-info
- "symbol \"%s\" in %S at point %d has %d length text"
- sym
- (current-buffer)
- pos
- (length (or text ""))))
- ;; Otherwise cache is used, text is either nil or a string.
- (t
- (doc-show-inline--log-info
- "symbol \"%s\" in %S at point %d has %d length text (cached)"
- sym
- (current-buffer)
- pos
- (length (or text "")))))
-
- (when text
- (doc-show-inline--show-text (line-beginning-position) text))))))
+ (doc-show-inline--log-info
+ "symbol \"%s\" in %S at point %d has %d length text"
+ sym
+ (current-buffer)
+ pos
+ (length (or text ""))))
+ ;; Otherwise cache is used, text is either nil or a string.
+ (t
+ (doc-show-inline--log-info
+ "symbol \"%s\" in %S at point %d has %d length text (cached)"
+ sym
+ (current-buffer)
+ pos
+ (length (or text "")))))
+
+ (when text
+ (doc-show-inline--show-text (line-beginning-position) text))))))
(defun doc-show-inline--idle-handle-pending-ranges ()
"Handle all queued ranges."
;; First remove any overlays.
(when-let ((overlays-in-view (doc-show-inline--idle-overlays (point-min)
(point-max))))
- (let
- (
- (overlays-beg (point-max))
- (overlays-end (point-min)))
+ (let ((overlays-beg (point-max))
+ (overlays-end (point-min)))
(dolist (ov overlays-in-view)
- (let
- (
- (ov-beg (overlay-start ov))
- (ov-end (overlay-end ov)))
+ (let ((ov-beg (overlay-start ov))
+ (ov-end (overlay-end ov)))
(doc-show-inline--overlays-remove ov-beg ov-end)
;; Calculate the range while removing overlays.
@@ -695,39 +671,39 @@ XREF-BACKEND is the back-end used to find this symbol."
;; There is something to do, postpone accessing `points'.
(let ((points (funcall doc-show-inline-locations (point-min)
(point-max))))
(doc-show-inline--log-info
- "found %d identifier(s) in %S"
- (length points)
- (current-buffer))
+ "found %d identifier(s) in %S"
+ (length points)
+ (current-buffer))
(when points
(let
- ( ;; When loading buffers for introspection,
- ;; there is no need to add `doc-show-inline' there (harmless
but not necessary).
- (doc-show-inline--inhibit-mode t)
+ ( ;; When loading buffers for introspection,
+ ;; there is no need to add `doc-show-inline' there (harmless
but not necessary).
+ (doc-show-inline--inhibit-mode t)
- (temporary-buffers (list))
+ (temporary-buffers (list))
- (xref-backend (xref-find-backend)))
+ (xref-backend (xref-find-backend)))
;; Track buffers loaded.
(doc-show-inline--with-advice #'create-file-buffer :around
- (lambda (fn-orig filename)
- (let ((buf (funcall fn-orig filename)))
- (when buf
- (push buf temporary-buffers))
- buf))
+ (lambda (fn-orig filename)
+ (let ((buf (funcall fn-orig
filename)))
+ (when buf
+ (push buf temporary-buffers))
+ buf))
(while points
(pcase-let ((`(,sym . ,pos) (pop points)))
(cond
- ((null (doc-show-inline--pos-in-overlays pos
overlays-in-view))
- (doc-show-inline--log-info
- "symbol \"%s\" in %S at point %d is not in the
overlay list"
- sym
- (current-buffer)
- pos))
- (t
- (goto-char pos)
- (doc-show-inline--idle-handle-pos pos sym
xref-backend))))))
+ ((null (doc-show-inline--pos-in-overlays pos
overlays-in-view))
+ (doc-show-inline--log-info
+ "symbol \"%s\" in %S at point %d is not in the overlay
list"
+ sym
+ (current-buffer)
+ pos))
+ (t
+ (goto-char pos)
+ (doc-show-inline--idle-handle-pos pos sym
xref-backend))))))
;; Close any buffers loaded only for the purpose of extracting
text.
(mapc 'kill-buffer temporary-buffers)))))
@@ -753,85 +729,80 @@ XREF-BACKEND is the back-end used to find this symbol."
;; Debug only, disabled by default.
(when doc-show-inline--idle-overlays-debug
(setq doc-show-inline--idle-overlays-debug-index
- (1+ doc-show-inline--idle-overlays-debug-index))
- (when
- (>= doc-show-inline--idle-overlays-debug-index
- (length doc-show-inline--idle-overlays-debug-colors))
+ (1+ doc-show-inline--idle-overlays-debug-index))
+ (when (>= doc-show-inline--idle-overlays-debug-index
+ (length doc-show-inline--idle-overlays-debug-colors))
(setq doc-show-inline--idle-overlays-debug-index 0))
(let ((ov (make-overlay pos-beg pos-end)))
(overlay-put ov 'doc-show-inline-idle-overlay-debug t)
(overlay-put
- ov 'face
- (list
- :background
- (nth
- doc-show-inline--idle-overlays-debug-index
- doc-show-inline--idle-overlays-debug-colors)
- :extend t)))))
+ ov 'face
+ (list
+ :background
+ (nth
+ doc-show-inline--idle-overlays-debug-index
+ doc-show-inline--idle-overlays-debug-colors)
+ :extend t)))))
(defun doc-show-inline--timer-callback-or-disable (this-timer buf)
"Callback run from the idle timer THIS-TIMER for BUF."
;; Ensure all other buffers are highlighted on request.
(cond
- ((null (buffer-name buf))
- (doc-show-inline--log-info "idle timer ignored for invalid buffer %S"
buf)
- ;; The buffer has been deleted, so cancel the timer directly.
- (cancel-timer this-timer))
- (t
- ;; Needed since the initial time might have been 0.0.
- ;; Ideally this wouldn't need to be set every time.
- (when doc-show-inline--idle-timer
- (timer-set-idle-time doc-show-inline--idle-timer
doc-show-inline-idle-delay t))
-
- (with-current-buffer buf
- (cond
- ((null (get-buffer-window buf t))
- (doc-show-inline--log-info "idle timer ignored for buffer %S
without a window" buf))
- ((null (bound-and-true-p doc-show-inline-mode))
- (doc-show-inline--log-info
- "idle timer ignored for buffer %S without `doc-show-inline-mode'
set"
- buf))
- (t
- (doc-show-inline--log-info "idle timer for buffer %S callback
running..." buf)
- ;; In the unlikely event of an error, run the timer again.
- (doc-show-inline--idle-handle-pending-ranges)))
+ ((null (buffer-name buf))
+ (doc-show-inline--log-info "idle timer ignored for invalid buffer %S" buf)
+ ;; The buffer has been deleted, so cancel the timer directly.
+ (cancel-timer this-timer))
+ (t
+ ;; Needed since the initial time might have been 0.0.
+ ;; Ideally this wouldn't need to be set every time.
+ (when doc-show-inline--idle-timer
+ (timer-set-idle-time doc-show-inline--idle-timer
doc-show-inline-idle-delay t))
+
+ (with-current-buffer buf
+ (cond
+ ((null (get-buffer-window buf t))
+ (doc-show-inline--log-info "idle timer ignored for buffer %S without a
window" buf))
+ ((null (bound-and-true-p doc-show-inline-mode))
+ (doc-show-inline--log-info
+ "idle timer ignored for buffer %S without `doc-show-inline-mode' set"
+ buf))
+ (t
+ (doc-show-inline--log-info "idle timer for buffer %S callback
running..." buf)
+ ;; In the unlikely event of an error, run the timer again.
+ (doc-show-inline--idle-handle-pending-ranges)))
- (doc-show-inline--timer-ensure nil)))))
+ (doc-show-inline--timer-ensure nil)))))
(defun doc-show-inline--timer-ensure (state)
"Ensure the timer is enabled when STATE is non-nil, otherwise disable."
(cond
- (state
- (cond
- (doc-show-inline--idle-timer
- (doc-show-inline--log-info
- "idle timer ensure t, already enabled for %S"
- (current-buffer)))
- (t
- (doc-show-inline--log-info "idle timer ensure t, enabling for %S"
(current-buffer))
- (setq doc-show-inline--idle-timer
+ (state
+ (cond
+ (doc-show-inline--idle-timer
+ (doc-show-inline--log-info "idle timer ensure t, already enabled for %S"
(current-buffer)))
+ (t
+ (doc-show-inline--log-info "idle timer ensure t, enabling for %S"
(current-buffer))
+ (setq doc-show-inline--idle-timer
;; One off, set repeat so the timer can be manually disabled,
;; ensuring it is only disabled on successful completion.
;; Pass a nil function here, set the function & arguments below.
(run-with-idle-timer
- doc-show-inline-idle-delay
- t
- #'doc-show-inline--timer-callback-or-disable))
-
- (timer-set-function
- doc-show-inline--idle-timer
- #'doc-show-inline--timer-callback-or-disable
- (list
- ;; Pass the timer, to allow cancellation from the timer.
- doc-show-inline--idle-timer
- ;; Pass the buffer (check the buffer is still active).
- (current-buffer))))))
-
- (t
- (when doc-show-inline--idle-timer
- (cancel-timer doc-show-inline--idle-timer))
- (kill-local-variable 'doc-show-inline--idle-timer))))
+ doc-show-inline-idle-delay
+ t
+ #'doc-show-inline--timer-callback-or-disable))
+
+ (timer-set-function doc-show-inline--idle-timer
#'doc-show-inline--timer-callback-or-disable
+ (list
+ ;; Pass the timer, to allow cancellation from the
timer.
+ doc-show-inline--idle-timer
+ ;; Pass the buffer (check the buffer is still
active).
+ (current-buffer))))))
+
+ (t
+ (when doc-show-inline--idle-timer
+ (cancel-timer doc-show-inline--idle-timer))
+ (kill-local-variable 'doc-show-inline--idle-timer))))
(defun doc-show-inline--timer-reset ()
"Run this when the buffer was changed."
@@ -871,10 +842,8 @@ XREF-BACKEND is the back-end used to find this symbol."
(let ((buffers (buffer-list)))
(while buffers
(let ((buf (pop buffers)))
- (when
- (and
- (buffer-local-value 'doc-show-inline-mode buf)
- (memq (buffer-local-value 'major-mode buf)
doc-show-inline--cc-modes))
+ (when (and (buffer-local-value 'doc-show-inline-mode buf)
+ (memq (buffer-local-value 'major-mode buf)
doc-show-inline--cc-modes))
;; Break.
(setq buffers nil)
(setq result t)))))
@@ -884,24 +853,24 @@ XREF-BACKEND is the back-end used to find this symbol."
"Setup the callback for tracking ranges that need to be handled.
Use STATE to enable/disable."
(cond
- ((memq major-mode doc-show-inline--cc-modes)
- (cond
- (state
- ;; Needed so existing regions that are highlighted will be
- ;; calculated again with the callback installed.
- (font-lock-flush)
- (advice-add 'c-context-expand-fl-region :around
#'doc-show-inline--cc-gapless-hack-fn))
- (t
- ;; Only remove when no other buffers use this mode.
- (unless (doc-show-inline--jit-or-gapless-hack-is-needed)
- (advice-remove 'c-context-expand-fl-region
#'doc-show-inline--cc-gapless-hack-fn)))))
-
- (t
- (cond
- (state
- (jit-lock-register #'doc-show-inline--idle-font-lock-region-pending))
- (t
- (jit-lock-unregister
#'doc-show-inline--idle-font-lock-region-pending))))))
+ ((memq major-mode doc-show-inline--cc-modes)
+ (cond
+ (state
+ ;; Needed so existing regions that are highlighted will be
+ ;; calculated again with the callback installed.
+ (font-lock-flush)
+ (advice-add 'c-context-expand-fl-region :around
#'doc-show-inline--cc-gapless-hack-fn))
+ (t
+ ;; Only remove when no other buffers use this mode.
+ (unless (doc-show-inline--jit-or-gapless-hack-is-needed)
+ (advice-remove 'c-context-expand-fl-region
#'doc-show-inline--cc-gapless-hack-fn)))))
+
+ (t
+ (cond
+ (state
+ (jit-lock-register #'doc-show-inline--idle-font-lock-region-pending))
+ (t
+ (jit-lock-unregister
#'doc-show-inline--idle-font-lock-region-pending))))))
;; ---------------------------------------------------------------------------
@@ -971,13 +940,13 @@ When IS-INTERACTIVE is true, use
`doc-show-inline-idle-delay-init'."
;; since `lsp-mode' may take some time to initialize.
;; Otherwise this can run immediately when started on an existing buffer.
(timer-set-idle-time doc-show-inline--idle-timer
- (cond
- (is-interactive
- 0.0)
- (t
- doc-show-inline-idle-delay-init))
- ;; Repeat.
- t)))
+ (cond
+ (is-interactive
+ 0.0)
+ (t
+ doc-show-inline-idle-delay-init))
+ ;; Repeat.
+ t)))
(defun doc-show-inline--mode-disable ()
"Turn off option `doc-show-inline-mode' for the current buffer."
@@ -993,11 +962,11 @@ When IS-INTERACTIVE is true, use
`doc-show-inline-idle-delay-init'."
:global nil
(cond
- (doc-show-inline-mode
- (unless doc-show-inline--inhibit-mode
- (doc-show-inline--mode-enable (called-interactively-p 'interactive))))
- (t
- (doc-show-inline--mode-disable))))
+ (doc-show-inline-mode
+ (unless doc-show-inline--inhibit-mode
+ (doc-show-inline--mode-enable (called-interactively-p 'interactive))))
+ (t
+ (doc-show-inline--mode-disable))))
(provide 'doc-show-inline)
;;; doc-show-inline.el ends here
