bug-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

bug#6644: `describe-variable' misses on certain permanent-locals [PATCH]


From: MON KEY
Subject: bug#6644: `describe-variable' misses on certain permanent-locals [PATCH] (putative)
Date: Thu, 15 Jul 2010 20:14:09 -0400

As currently written `describe-variable' will, for certain variables,
only inform if a variable is permanently local when it is set to have
a local value in current-buffer.

This happens for example with `kill-buffer-hook' which _is_ a
permanent-local. And in thes situations, `describe-variable' (and by
proxy "*Help*") can not tell us if a variable is permanent-local
unless the docstring explicitly states as such.

At first blush it would appear that `describe-variable's binding of
`locus' happens at the buffer level and therfor _should_ identify a
permanent-local per:

,----
| (with-current-buffer buffer
|   (setq val (symbol-value variable)
|         locus (variable-binding-locus variable)))
`----

This is because the following heuristics won't always recognize the
permanent-local property where a `locus' pivots on a `bufferp' check:

,----
|  (if valvoid
|      nil
|    (with-current-buffer standard-output
|      (setq val-start-pos (point))
|      (princ "value is ")
|      (terpri)
|      (let ((from (point)))
|        (pp val)
|        (if (< (point) (+ from 20))
|            (delete-region (1- from) from)))))
|           (terpri)
|  (when locus
|    (if (bufferp locus) ;<- A permanent-local's locus is elsewhere!
|        (princ (format "%socal in buffer %s; "
|                       (if (get variable 'permanent-local)
|                           "Permanently l" "L")
|                       (buffer-name)))
|      (princ (format "It is a frame-local variable; ")))
|    (if (not (default-boundp variable))
|        (princ "globally void")
|      (let ((val (default-value variable)))
|        (with-current-buffer standard-output
|          (princ "global value is ")
|          (terpri)
|          (let ((from (point)))
|            (pp val)
|            (if (< (point) (+ from 20))
|                (delete-region (1- from) from))))))
|    (terpri))
`----

W/re `describe-variable's current behavior around permanent-local it
does not serve its purpose well.

When a user asks that for the description of a variable variable that
variable has a permanent-local property it is important that a user be
informed as such.

Specifically that:

- a variable _is_ permanent-local;

- that though currently null, _if_ set it would be permanent-local in
  current-buffer;

- that if non-nil the value is permanent-local in current-buffer and
  will persist across invocations of `kill-all-local-variables' unless
  explicitly removed.

IOW, knowing that a variable is:

 "Local in buffer <SOME-BUFFER>;"

Is not the same as saying that a variable is;

 "Permanently local in <SOME-BUFFER>;"

Which isn't the same as saying either of following about a variable;

 "This variable is a permanent-local.
  It satisfies the predicate `local-variable-p' in <SOME-BUFFER>.
  This value will persist in current-buffer until explicitly removed;"

 "This variable is a permanent-local.
  Its current value is null in <SOME-BUFFER>.
  This variable satisfies the predicate `local-variable-if-set-p'.
  When set with `make-local-variable' the value will persist in
  current-buffer until explicitly removed;"

Following fncn `%describe-variable-miss-permanent-local-example'
illustrates what I perceive to be the "problem":

;;; ==============================
(defun %describe-variable-miss-permanent-local-example ()
  "Illustrate `describe-variable' not identifying permanent-local variables.
Display results in buffer \"*BUFFER-W-OUT-LOCAL-KB-HOOK*\"."
  (interactive)
  (let ((dvdr (concat "\n" (make-string 80 59) "\n"))
        (w-lcl "*BUFFER-W-LOCAL-KB-HOOK*")
        (w/o-lcl "*BUFFER-W-OUT-LOCAL-KB-HOOK*")
        kbh tmp-fncn)
    (with-current-buffer (get-buffer-create w-lcl)
      (fset 'tmp-fncn #'(lambda () "does nothing." nil))
      (add-hook 'kill-buffer-hook 'tmp-fncn nil t)
      (setq kbh (buffer-local-value 'kill-buffer-hook (current-buffer)))
      (with-current-buffer (get-buffer-create w/o-lcl)
        (erase-buffer)
        (save-excursion
          (insert (substring dvdr 1)
                  ";; Local value of `kill-buffer-hook' in buffer: "
w-lcl "\n;;\n"
                  (format "%S" kbh) dvdr)
          (setq kbh (buffer-local-value 'kill-buffer-hook (current-buffer)))
          (insert dvdr ";; Local value of `kill-buffer-hook' in
buffer: " w/o-lcl "\n;;\n"
                  (format "%S" kbh) dvdr dvdr
                  ";; Evaluating `describe-variable' for
`kill-buffer-hook' with buffer: "
                  w/o-lcl "\n;; NOTE, with `current-buffer' there is
no indication "
                  "of `kill-buffer-hook' being permanent-local" dvdr "\n"
                  (describe-variable 'kill-buffer-hook
(current-buffer)) "\n" dvdr
                  ";; Evaluating `describe-variable' for
`kill-buffer-hook' with buffer: "
                  w-lcl "\n;; NOTE, contrasted with above, now there
_is_ indication "
                  "of `kill-buffer-hook' as permanent-local.\n"
                  ";; Additionally, there is also indication that the "
                  "varaible's global value differs from the local." dvdr "\n"
                  (describe-variable 'kill-buffer-hook (get-buffer
w-lcl)) "\n" dvdr)))
      (prog1
          (unintern 'tmp-fncn)
        (kill-buffer (current-buffer))))
    (pop-to-buffer (get-buffer w/o-lcl))))
;;
;; (%describe-variable-miss-permanent-local-example)
;;
;; (unintern '%describe-variable-miss-permanent-local-example)

;;; ==============================
Following is a lightly tested modified version of `describe-variable'
tweaked to report more intelligently when variables are buffer-local
and/or permanent-local.  Following that is a patch to lisp/help-fns.el
current through Bzr-1000827:


;;;###autoload
(defun describe-variable (variable &optional buffer frame)
  "Display the full documentation of VARIABLE (a symbol).
Returns the documentation as a string, also.
If VARIABLE has a buffer-local value in BUFFER or FRAME
\(default to the current buffer and current frame),
it is displayed along with the global value."
  (interactive
   (let ((v (variable-at-point))
         (enable-recursive-minibuffers t)
         val)
     (setq val (completing-read (if (symbolp v)
                                    (format
                                     "Describe variable (default %s): " v)
                                  "Describe variable: ")
                                obarray
                                '(lambda (vv)
                                   (or (boundp vv)
                                       (get vv 'variable-documentation)))
                                t nil nil
                                (if (symbolp v) (symbol-name v))))
     (list (if (equal val "")
               v (intern val)))))
  (let (file-name
        (ploc (get variable 'permanent-local)))
    (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
    (unless (frame-live-p frame) (setq frame (selected-frame)))
    (if (not (symbolp variable))
        (message "You did not specify a variable")
      (save-excursion
        (let ((valvoid (not (with-current-buffer buffer (boundp variable))))
              val val-start-pos locus)
          ;; Extract the value before setting up the output buffer,
          ;; in case `buffer' *is* the output buffer.
          (unless valvoid
            (with-selected-frame frame
              (with-current-buffer buffer
                (setq val (symbol-value variable)
                      locus (variable-binding-locus variable)))))
          (help-setup-xref (list #'describe-variable variable buffer)
                           (called-interactively-p 'interactive))
          (with-help-window (help-buffer)
            (with-current-buffer buffer
              (prin1 variable)
              (setq file-name (find-lisp-object-file-name variable 'defvar))

              (if file-name
                  (progn
                    (princ " is a variable defined in `")
                    (princ (if (eq file-name 'C-source)
                               "C source code"
                             (file-name-nondirectory file-name)))
                    (princ "'.\n")
                    (with-current-buffer standard-output
                      (save-excursion
                        (re-search-backward "`\\([^`']+\\)'" nil t)
                        (help-xref-button 1 'help-variable-def
                                          variable file-name)))
                    (unless ploc
                      (if valvoid
                          (princ "It is void as a variable.")
                        (princ "Its "))))
                (unless ploc
                  (if valvoid
                      (princ " is void as a variable.")
                    (if (bufferp locus)
                        (when (null (buffer-local-value variable
(get-buffer buffer)))
                          (terpri))
                      (princ "'s "))))))

            (with-current-buffer standard-output
              (if valvoid
                  nil
                (progn
                  (setq val-start-pos (point))
                  (if (bufferp locus)
                      (if ploc
                          (if (buffer-local-value variable (get-buffer buffer))
                              (princ "Its local value is ")
                            (princ "Its default local value is "))
                        (princ "Its non-local global value is "))
                    (if ploc
                        (princ "Its value is ")
                      (princ "value is ")))
                  (terpri)
                  (let ((from (point)))
                    (pp val)
                    ;; Hyperlinks in variable's value are quite frequently
                    ;; inappropriate e.g C-h v <RET> features <RET>
                    ;; (help-xref-on-pp from (point))
                    (if (< (point)
                           (if ploc
                               (+ from 20)
                             (+ from 20)))
                        (delete-region (1- from) from)))))
              (when (and ploc (not (bufferp locus)))
                (terpri)
                (princ "It has a non-nil permanent-local property;")))
            (terpri)

            (progn
              (cond ((bufferp locus)
                     (princ (format "It is a %slocal variable in buffer %s;\n"
                                    (if ploc
                                        "permanent-" "buffer-")
                                    (buffer-name))))
                    ((framep locus)
                     (princ (format "It is a frame-local variable;")))
                    ((null locus)
                     "It is a global variable;"))
              (when (or (framep locus) (bufferp locus) ploc)
                (if (not (default-boundp variable))
                    (princ "Value as global: void")
                  (unless (null (buffer-local-value variable
(get-buffer buffer)))
                    (let ((val (default-value variable)))
                      (with-current-buffer standard-output
                        (princ "Value as global: ")
                        (terpri)
                        ;; Fixme: pp can take an age if you happen to
                        ;; ask for a very large expression.  We should
                        ;; probably print it raw once and check it's a
                        ;; sensible size before prettyprinting.  -- fx
                        (let ((from (point)))
                          (pp val)
                          ;; See previous comment for this function.
                          ;; (help-xref-on-pp from (point))
                          (if (< (point) (+ from 20))
                              (delete-region (1- from) from))))))))
              (terpri))

            ;; If the value is large, move it to the end.
            (with-current-buffer standard-output
              (when (> (count-lines (point-min) (point-max)) 10)
                ;; Note that setting the syntax table like below
                ;; makes forward-sexp move over a `'s' at the end
                ;; of a symbol.
                (set-syntax-table emacs-lisp-mode-syntax-table)
                (goto-char val-start-pos)
                ;; The line below previously read as
                ;; (delete-region (point) (progn (end-of-line) (point)))
                ;; which suppressed display of the buffer local value for
                ;; large values.
                (when (looking-at "value is") (replace-match ""))
                (save-excursion
                  (insert "\n\nValue:")
                  (set (make-local-variable 'help-button-cache)
                       (point-marker)))
                (insert "value is shown ")
                (insert-button "below"
                               'action help-button-cache
                               'follow-link t
                               'help-echo "mouse-2, RET: show value")
                (insert ".\n")))
            (terpri)

            (let* ((alias (condition-case nil
                              (indirect-variable variable)
                            (error variable)))
                   (obsolete (get variable 'byte-obsolete-variable))
                   (use (car obsolete))
                   (safe-var (get variable 'safe-local-variable))
                   (doc (or (documentation-property variable
'variable-documentation)
                            (documentation-property alias
'variable-documentation)))
                   (extra-line nil))
              ;; Add a note for variables that have been make-var-buffer-local.
              (when (and (local-variable-if-set-p variable)
                         (or (not (local-variable-p variable))
                             (with-temp-buffer
                               (local-variable-if-set-p variable))))
                (setq extra-line t)
                (princ "  Automatically becomes buffer-local when set
in any fashion.\n"))

              ;; Mention if it's an alias
              (unless (eq alias variable)
                (setq extra-line t)
                (princ (format "  This variable is an alias for
`%s'.\n" alias)))

              (when obsolete
                (setq extra-line t)
                (princ "  This variable is obsolete")
                (if (cdr obsolete) (princ (format " since %s" (cdr obsolete))))
                (princ (cond ((stringp use) (concat ";\n  " use))
                             (use (format ";\n  use `%s' instead." (car 
obsolete)))
                             (t ".")))
                (terpri))

              (when (member (cons variable val) file-local-variables-alist)
                (setq extra-line t)
                (if (member (cons variable val) dir-local-variables-alist)
                    (let ((file (and (buffer-file-name)
                                     (not (file-remote-p (buffer-file-name)))
                                     (dir-locals-find-file 
(buffer-file-name)))))
                      (princ "  This variable is a directory local variable")
                      (when file
                        (princ (concat "\n  from the file \""
                                       (if (consp file)
                                           (car file)
                                         file)
                                       "\"")))
                      (princ ".\n"))
                  (princ "  This variable is a file local variable.\n")))

              (when (memq variable ignored-local-variables)
                (setq extra-line t)
                (princ "  This variable is ignored when used as a file local \
variable.\n"))

              ;; Can be both risky and safe, eg auto-fill-function.
              (when (risky-local-variable-p variable)
                (setq extra-line t)
                (princ "  This variable is potentially risky when used as a \
file local variable.\n")
                (when (assq variable safe-local-variable-values)
                  (princ "  However, you have added it to \
`safe-local-variable-values'.\n")))

              (when safe-var
                (setq extra-line t)
                (princ "  This variable is safe as a file local variable ")
                (princ "if its value\n  satisfies the predicate ")
                (princ (if (byte-code-function-p safe-var)
                           "which is byte-compiled expression.\n"
                         (format "`%s'.\n" safe-var))))

              (if extra-line (terpri))
              (princ "Documentation:\n")
              (with-current-buffer standard-output
                (insert (or doc "Not documented as a variable."))))

            ;; Make a link to customize if this variable can be customized.
            (when (custom-variable-p variable)
              (let ((customize-label "customize"))
                (terpri)
                (terpri)
                (princ (concat "You can " customize-label " this variable."))
                (with-current-buffer standard-output
                  (save-excursion
                    (re-search-backward
                     (concat "\\(" customize-label "\\)") nil t)
                    (help-xref-button 1 'help-customize-variable variable))))
              ;; Note variable's version or package version
              (let ((output (describe-variable-custom-version-info variable)))
                (when output
                  (terpri)
                  (terpri)
                  (princ output))))

            (with-current-buffer standard-output
              ;; Return the text we displayed.
              (buffer-string))))))))

;;; ==============================
;;; PATCH to describe-variable as provided above in full

*** ediff7517N_J        2010-07-15 19:06:56.253304353 -0400
--- help-fns.el Bzr-100827      2010-07-15 19:06:56.304504327 -0400
***************
*** 20,27 ****
                                (if (symbolp v) (symbol-name v))))
       (list (if (equal val "")
               v (intern val)))))
!   (let (file-name
!         (ploc (get variable 'permanent-local)))
      (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
      (unless (frame-live-p frame) (setq frame (selected-frame)))
      (if (not (symbolp variable))
--- 20,26 ----
                                (if (symbolp v) (symbol-name v))))
       (list (if (equal val "")
               v (intern val)))))
!   (let (file-name)
      (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
      (unless (frame-live-p frame) (setq frame (selected-frame)))
      (if (not (symbolp variable))
***************
*** 55,87 ****
                        (re-search-backward "`\\([^`']+\\)'" nil t)
                        (help-xref-button 1 'help-variable-def
                                          variable file-name)))
!                   (unless ploc
!                       (if valvoid
!                           (princ "It is void as a variable.")
!                         (princ "Its "))))
!                 (unless ploc
!                   (if valvoid
!                       (princ " is void as a variable.")
!                     (if (bufferp locus)
!                         (when (null (buffer-local-value variable
(get-buffer buffer)))
!                           (terpri))
!                       (princ "'s "))))))
!
!             (with-current-buffer standard-output
!               (if valvoid
!                   nil
!                 (progn
!                   (setq val-start-pos (point))
!                   (if (bufferp locus)
!                       (if ploc
!                           (if (buffer-local-value variable
(get-buffer buffer))
!                               (princ "Its local value is ")
!                             (princ "Its default local value is "))
!                         (princ "Its non-local global value is "))
!                     (if ploc
!                         (princ "Its value is ")
!                       (princ "value is ")))
!                   (terpri)
!                   (let ((from (point)))
!                     (pp val)
!                     ;; Hyperlinks in variable's value are quite frequently
--- 54,222 ----
                        (re-search-backward "`\\([^`']+\\)'" nil t)
                        (help-xref-button 1 'help-variable-def
                                          variable file-name)))
!                   (if valvoid
!                       (princ "It is void as a variable.")
!                     (princ "Its ")))
!               (if valvoid
!                   (princ " is void as a variable.")
!                 (princ "'s "))))
!           (if valvoid
!               nil
!             (with-current-buffer standard-output
!               (setq val-start-pos (point))
!               (princ "value is ")
!               (terpri)
!               (let ((from (point)))
!                 (pp val)
!                 ;; Hyperlinks in variable's value are quite frequently
!                 ;; inappropriate e.g C-h v <RET> features <RET>
!                 ;; (help-xref-on-pp from (point))
!                 (if (< (point) (+ from 20))
!                     (delete-region (1- from) from)))))
!           (terpri)
!
!           (when locus
!             (if (bufferp locus)
!                 (princ (format "%socal in buffer %s; "
!                                (if (get variable 'permanent-local)
!                                    "Permanently l" "L")
!                                (buffer-name)))
!               (princ (format "It is a frame-local variable; ")))
!             (if (not (default-boundp variable))
!                 (princ "globally void")
!               (let ((val (default-value variable)))
!                 (with-current-buffer standard-output
!                   (princ "global value is ")
!                   (terpri)
!                   ;; Fixme: pp can take an age if you happen to
!                   ;; ask for a very large expression.  We should
!                   ;; probably print it raw once and check it's a
!                   ;; sensible size before prettyprinting.  -- fx
!                   (let ((from (point)))
!                     (pp val)
!                     ;; See previous comment for this function.
!                     ;; (help-xref-on-pp from (point))
!                     (if (< (point) (+ from 20))
!                         (delete-region (1- from) from))))))
!               (terpri))
!
!           ;; If the value is large, move it to the end.
!           (with-current-buffer standard-output
!             (when (> (count-lines (point-min) (point-max)) 10)
!               ;; Note that setting the syntax table like below
!               ;; makes forward-sexp move over a `'s' at the end
!               ;; of a symbol.
!               (set-syntax-table emacs-lisp-mode-syntax-table)
!               (goto-char val-start-pos)
!               ;; The line below previously read as
!               ;; (delete-region (point) (progn (end-of-line) (point)))
!               ;; which suppressed display of the buffer local value for
!               ;; large values.
!               (when (looking-at "value is") (replace-match ""))
!               (save-excursion
!                 (insert "\n\nValue:")
!                 (set (make-local-variable 'help-button-cache)
!                      (point-marker)))
!               (insert "value is shown ")
!               (insert-button "below"
!                              'action help-button-cache
!                              'follow-link t
!                              'help-echo "mouse-2, RET: show value")
!               (insert ".\n")))
!             (terpri)
!
!             (let* ((alias (condition-case nil
!                               (indirect-variable variable)
!                             (error variable)))
!                    (obsolete (get variable 'byte-obsolete-variable))
!                  (use (car obsolete))
!                  (safe-var (get variable 'safe-local-variable))
!                    (doc (or (documentation-property variable
'variable-documentation)
!                             (documentation-property alias
'variable-documentation)))
!                    (extra-line nil))
!               ;; Add a note for variables that have been
make-var-buffer-local.
!               (when (and (local-variable-if-set-p variable)
!                          (or (not (local-variable-p variable))
!                              (with-temp-buffer
!                                (local-variable-if-set-p variable))))
!                 (setq extra-line t)
!                 (princ "  Automatically becomes buffer-local when
set in any fashion.\n"))
!
!               ;; Mention if it's an alias
!               (unless (eq alias variable)
!                 (setq extra-line t)
!                 (princ (format "  This variable is an alias for
`%s'.\n" alias)))
!
!               (when obsolete
!                 (setq extra-line t)
!                 (princ "  This variable is obsolete")
!                 (if (cdr obsolete) (princ (format " since %s" (cdr
obsolete))))
!               (princ (cond ((stringp use) (concat ";\n  " use))
!                            (use (format ";\n  use `%s' instead." (car 
obsolete)))
!                            (t ".")))
!                 (terpri))
!
!             (when (member (cons variable val) file-local-variables-alist)
!               (setq extra-line t)
!               (if (member (cons variable val) dir-local-variables-alist)
!                   (let ((file (and (buffer-file-name)
!                                    (not (file-remote-p (buffer-file-name)))
!                                    (dir-locals-find-file 
(buffer-file-name)))))
!                     (princ "  This variable is a directory local variable")
!                     (when file
!                       (princ (concat "\n  from the file \""
!                                      (if (consp file)
!                                          (car file)
!                                        file)
!                                      "\"")))
!                     (princ ".\n"))
!                 (princ "  This variable is a file local variable.\n")))
!
!             (when (memq variable ignored-local-variables)
!               (setq extra-line t)
!               (princ "  This variable is ignored when used as a file local \
! variable.\n"))
!
!             ;; Can be both risky and safe, eg auto-fill-function.
!             (when (risky-local-variable-p variable)
!               (setq extra-line t)
!               (princ "  This variable is potentially risky when used as a \
! file local variable.\n")
!               (when (assq variable safe-local-variable-values)
!                 (princ "  However, you have added it to \
! `safe-local-variable-values'.\n")))
!
!             (when safe-var
!                 (setq extra-line t)
!               (princ "  This variable is safe as a file local variable ")
!               (princ "if its value\n  satisfies the predicate ")
!               (princ (if (byte-code-function-p safe-var)
!                          "which is byte-compiled expression.\n"
!                        (format "`%s'.\n" safe-var))))
!
!               (if extra-line (terpri))
!             (princ "Documentation:\n")
!             (with-current-buffer standard-output
!               (insert (or doc "Not documented as a variable."))))
!
!           ;; Make a link to customize if this variable can be customized.
!           (when (custom-variable-p variable)
!             (let ((customize-label "customize"))
!               (terpri)
!               (terpri)
!               (princ (concat "You can " customize-label " this variable."))
!               (with-current-buffer standard-output
!                 (save-excursion
!                   (re-search-backward
!                    (concat "\\(" customize-label "\\)") nil t)
!                   (help-xref-button 1 'help-customize-variable variable))))
!             ;; Note variable's version or package version
!             (let ((output (describe-variable-custom-version-info variable)))
!               (when output
!                 (terpri)
!                 (terpri)
!                 (princ output))))
!
!           (with-current-buffer standard-output
!             ;; Return the text we displayed.
!             (buffer-string))))))))

Attachment: describe-variable-mods-2010-07-15.el
Description: Binary data


reply via email to

[Prev in Thread] Current Thread [Next in Thread]