bug#6601: help-make-xref doesn't buttonize `help-variable-def' and per `help-xref-symbol-regexp'

[MON KEY]

The button `help-variable-def' and constant `help-xref-symbol-regexp'
do not find variables with symbol-names containing asterisks,
e.g. `*some-var*'. Presumably this applies equally as well to any
variable which contains a non-letter as the first character in the
variables symbol name.

It looks like `help-make-xrefs' inherits the
`emacs-lisp-mode-syntax-table' and odd stuff is happening around the
regexp and the syntax table though this seems odd as `*' is a symbol
constituent.

Following bit of code provides an example illustrating the problem:


(defvar check-xref-var-no-star 'xrefd-in-docstrings
  "A test for xref'ing non-star prefixed variables in docstrings.\n
Non-star prefixed variables have the form:\n
 <SOME-VAR-NAME>\n
These appear with xrefs in docstrings when preceded by either of the following
two tokens:\n
 { variable | option }\n
where the variables symbol-name is enclosed with a preceding grave char `
\(ASCII 96\), and followed by an apostrophe char ' (ASCII 39) e.g.:\n
 variable `<SOME-VAR-NAME>'
 option `<SOME-VAR-NAME>'\n
This is as contrasted with star prefixed variables which have the form:\n
 *<SOME-VAR-NAME>*\n
and do not appear with xrefs in docstrings.\n
For example, this variable `*check-xref-var-w-star*' is not xref'd.
Neither is it xref'd as an option `*check-xref-var-w-star*'.
However, the current variable `check-xref-var-no-star' is xref'd.
Likewise, it is also xref'd as the option `check-xref-var-no-star'.")

(defvar *check-xref-var-w-star* 'not-xrefd-in-docstrings
  "A test for xref'ing star prefixed variables in docstrings.\n
Star prefixed variables have the form:\n
 *<SOME-VAR-NAME>*\n
these do not appear with xrefs in docstrings.\n
This is as contrasted with non-star prefixed variables which have the form:\n
  <SOME-VAR-NAME>\n
and which do appear in xref'd in docstrings when preceded by either of the
follwing two tokens:\n
 { variable | option }\n
where the symbole-name of the variable is enclosed with a preceding grave char `
\(ASCII 96\) and followed by an apostrophe char ' (ASCII 39) e.g.:\n
 variable `<SOME-VAR-NAME>'
 option `<SOME-VAR-NAME>'\n
For example, this variable `check-xref-var-no-star' is xref'd.
Likewise, the option `check-xref-var-no-star' is also xref'd.
Whereas, the variable `*check-xref-var-w-star*' is not xref'd.
Neither is it xref'd as option `*check-xref-var-w-star*'.")

(defun check-xref-test-function ()
  "This is a docstring which tests xref'ing of two differently named
variables.\n
The current functions docstring illustrates the problem.\n
This symbol-name will be xref'd as variable `check-xref-var-no-star'.\n
It will also be xref'd as option `check-xref-var-no-star'.\n
Whereas following symbol-name is not xref'd as variable
`*check-xref-var-w-star*',
nor is it xref'd as option `*check-xref-var-w-star*'.\n
This behaviour constitutes a bug. For additional detailed illustration of the
problem see return value of `check-xrefs-w-help-variable-def'."
  (describe-function 'check-xref-test-function))

(defun check-xrefs-w-help-variable-def (&optional w-test-fncn cnt-var-name)
  "Find help-variable-button text-property values in *Help* buffer.\n
Return a list of text-properties and buffer locations when buffer has
a `category` text-property with a prop value `help-variable-button`.\n
List contains a count of the number of times the property `help-variable-button`
appears along with the count of the number of times a variable name appears in
the documentation.\n
When W-TEST-FNCN is non-nil it is a symol naming a documented function.
Default is `check-xref-test-function'.\n
When CNT-VAR-NAME is non-nil count the number of times symbol-name matches the
regexp \"`<CNT-VAR-NAME>'\".
Default is to count matches for the symbol `*check-xref-var-w-star*'.\n
Before returning pops-to-buffer named \"*Help*\" and then to buffer named
\"*CHECK-XREFS-W-HELP-VARIABLE-DEF*\".\n
:EXAMPLE\n\n\(check-xrefs-w-help-variable-def\)\n
\(check-xrefs-w-help-variable-def 'help-make-xrefs 'help-forward-label\)\n
\(check-xrefs-w-help-variable-def 'help-make-xrefs 'help-xref-symbol-regexp\)\n"
  (let ((gthr-props)
        (gthrng t))
    (if w-test-fncn
        (describe-function w-test-fncn)
      (check-xref-test-function))
    (with-current-buffer
        (get-buffer "*Help*")
      (goto-char (buffer-end 0))
      (while gthrng
        (when (eq (point) (buffer-end 0))
          (goto-char (next-single-property-change (point) 'button)))
        (unless (null (text-properties-at (point)))
          (let* ((props-here (text-properties-at (point)))
                 (chk-hvb (plist-get props-here 'category)))
            (when (equal (symbol-name chk-hvb) "help-variable-button")
              (push `(:button-found-at ,(point) :w-props ,props-here)
gthr-props))
            (if (eq (next-char-property-change (point)) (point))
                (setq gthrng)
              (progn (goto-char (next-char-property-change (point)))
                     (if (eq (next-char-property-change (point)) (point))
                         (setq gthrng)
                       (let ((chk-nxt (next-single-property-change
(point) 'button)))
                         (if chk-nxt
                             (goto-char (next-single-property-change
(point) 'button))
                           (setq gthrng)))))))))
      (when gthr-props (setq gthr-props (nreverse gthr-props)))
      (let ((cnt-fnd 0))
        (dolist (bfa gthr-props
                     (when (> cnt-fnd 0)
                       (setq gthr-props
                             (nconc `(:help-var-btn-fnd-n-tms
,cnt-fnd) gthr-props))))
          (when (equal (symbol-name (plist-get (plist-get bfa
:w-props) 'category))
                       "help-variable-button")
            (incf cnt-fnd)))
        (goto-char (buffer-end 0))
        (setq cnt-fnd 0)
        (let* ((chk-star-sym (or cnt-var-name '*check-xref-var-w-star*))
               (chk-star-str (format "`\%s\'" chk-star-sym)))
          (while (search-forward-regexp chk-star-str nil t)
            (incf cnt-fnd))
          (if (> cnt-fnd 0)
              (progn
                (setq gthrng 0)
                (dolist (bfa (if (eq (car gthr-props) :help-var-btn-fnd-n-tms)
                                 (cddr gthr-props)
                               gthr-props)
                             gthrng)
                  (when (equal (symbol-name (car (plist-get (plist-get
bfa :w-props) 'help-args)))
                               (symbol-name chk-star-sym))
                    (incf gthrng)))
                (setq gthr-props (nconc `(:help-var-star-seen-n-tms ,cnt-fnd
                                          :help-var-star-seen-n-tms
,gthrng) gthr-props)))
            (setq gthr-props (nconc '(:help-var-star-seen-n-tms 0
                                      :help-var-star-seen-n-tms 0)
gthr-props))))))
    (let ((pp-rtn-bfr "*CHECK-XREFS-W-HELP-VARIABLE-DEF*"))
      (with-current-buffer (get-buffer-create pp-rtn-bfr)
        (erase-buffer))
      (pp-display-expression (identity gthr-props) pp-rtn-bfr)
      (pop-to-buffer "*Help*" t)
      (pop-to-buffer pp-rtn-bfr t))
    gthr-props))

;; :CLEANUP
;; (dolist (unint '(check-xref-var-no-star
;;                  *check-xref-var-w-star*
;;                  check-xref-test-function
;;                  check-xrefs-w-help-variable-def))
;;   (message "The check-xref fncns and vars were uninterned"))
;;; ==============================

buttonize-help-make-xref.el
Description: Binary data