From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Paul Pogonyshev Newsgroups: gmane.emacs.devel Subject: Re: highlight current argument in Eldoc for Elisp Date: Mon, 2 Jul 2007 15:24:27 +0300 Message-ID: <200707021524.27632.pogonyshev@gmx.net> References: <200706301813.24815.pogonyshev@gmx.net> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset="iso-8859-1" Content-Transfer-Encoding: 7bit X-Trace: sea.gmane.org 1183378228 4281 80.91.229.12 (2 Jul 2007 12:10:28 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Mon, 2 Jul 2007 12:10:28 +0000 (UTC) Cc: rms@gnu.org To: emacs-devel@gnu.org, tromey@redhat.com Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Jul 02 14:10:25 2007 connect(): Connection refused Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1I5KjX-00040A-TP for ged-emacs-devel@m.gmane.org; Mon, 02 Jul 2007 14:10:24 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1I5KjW-0001sy-Vj for ged-emacs-devel@m.gmane.org; Mon, 02 Jul 2007 08:10:23 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1I5KjS-0001st-La for emacs-devel@gnu.org; Mon, 02 Jul 2007 08:10:18 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1I5KjR-0001sh-L2 for emacs-devel@gnu.org; Mon, 02 Jul 2007 08:10:17 -0400 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1I5KjR-0001se-H3 for emacs-devel@gnu.org; Mon, 02 Jul 2007 08:10:17 -0400 Original-Received: from mail.gmx.net ([213.165.64.20]) by monty-python.gnu.org with smtp (Exim 4.60) (envelope-from ) id 1I5KjQ-0007tb-PN for emacs-devel@gnu.org; Mon, 02 Jul 2007 08:10:17 -0400 Original-Received: (qmail invoked by alias); 02 Jul 2007 12:10:14 -0000 Original-Received: from unknown (EHLO [80.94.230.97]) [80.94.230.97] by mail.gmx.net (mp019) with SMTP; 02 Jul 2007 14:10:14 +0200 X-Authenticated: #16844820 X-Provags-ID: V01U2FsdGVkX18QFFZVvVEQ5FjJ9luuyngvF9GIT1IhFHC7qaRuWI DJ6dbojNIggOCa User-Agent: KMail/1.7.2 In-Reply-To: Content-Disposition: inline X-Y-GMX-Trusted: 0 X-detected-kernel: Linux 2.6, seldom 2.4 (older, 4) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:74179 Archived-At: Tom Tromey wrote: > >>>>> "rms" == Richard Stallman writes: > > rms> Thanks for posting the patch. Would people please try it > rms> and report any problems? > > I get this error occasionally: Fixed in the new version of the patch below. Paul 2007-07-02 Paul Pogonyshev * emacs-lisp/eldoc.el (eldoc-last-data): Revise documentation. (eldoc-print-current-symbol-info): Adjust for changed helper function signatures. (eldoc-get-fnsym-args-string): Add `args' argument. Use new `eldoc-highlight-function-argument'. (eldoc-highlight-function-argument): New function. (eldoc-get-var-docstring): Format documentation with `font-lock-variable-name-face'. (eldoc-docstring-format-sym-doc): Add `face' argument and apply it where suited. (eldoc-fnsym-in-current-sexp): Return a list with argument index. (eldoc-beginning-of-sexp): Return number of skipped sexps. Index: lisp/emacs-lisp/eldoc.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/emacs-lisp/eldoc.el,v retrieving revision 1.42 diff -c -r1.42 eldoc.el *** lisp/emacs-lisp/eldoc.el 7 May 2007 01:09:35 -0000 1.42 --- lisp/emacs-lisp/eldoc.el 2 Jul 2007 12:07:32 -0000 *************** *** 124,131 **** (defconst eldoc-last-data (make-vector 3 nil) "Bookkeeping; elements are as follows: 0 - contains the last symbol read from the buffer. ! 1 - contains the string last displayed in the echo area for that ! symbol, so it can be printed again if necessary without reconsing. 2 - 'function if function args, 'variable if variable documentation.") (defvar eldoc-last-message nil) --- 124,131 ---- (defconst eldoc-last-data (make-vector 3 nil) "Bookkeeping; elements are as follows: 0 - contains the last symbol read from the buffer. ! 1 - contains the string last displayed in the echo area for variables, ! or argument string for functions. 2 - 'function if function args, 'variable if variable documentation.") (defvar eldoc-last-message nil) *************** *** 249,260 **** (let* ((current-symbol (eldoc-current-symbol)) (current-fnsym (eldoc-fnsym-in-current-sexp)) (doc (cond ! ((eq current-symbol current-fnsym) ! (or (eldoc-get-fnsym-args-string current-fnsym) (eldoc-get-var-docstring current-symbol))) (t (or (eldoc-get-var-docstring current-symbol) ! (eldoc-get-fnsym-args-string current-fnsym)))))) (eldoc-message doc)))) ;; This is run from post-command-hook or some idle timer thing, ;; so we need to be careful that errors aren't ignored. --- 249,264 ---- (let* ((current-symbol (eldoc-current-symbol)) (current-fnsym (eldoc-fnsym-in-current-sexp)) (doc (cond ! ((null current-fnsym) ! nil) ! ((eq current-symbol (car current-fnsym)) ! (or (apply 'eldoc-get-fnsym-args-string ! current-fnsym) (eldoc-get-var-docstring current-symbol))) (t (or (eldoc-get-var-docstring current-symbol) ! (apply 'eldoc-get-fnsym-args-string ! current-fnsym)))))) (eldoc-message doc)))) ;; This is run from post-command-hook or some idle timer thing, ;; so we need to be careful that errors aren't ignored. *************** *** 263,286 **** ;; Return a string containing the function parameter list, or 1-line ;; docstring if function is a subr and no arglist is obtainable from the ;; docstring or elsewhere. ! (defun eldoc-get-fnsym-args-string (sym) (let ((args nil) (doc nil)) (cond ((not (and sym (symbolp sym) (fboundp sym)))) ((and (eq sym (aref eldoc-last-data 0)) (eq 'function (aref eldoc-last-data 2))) ! (setq doc (aref eldoc-last-data 1))) ((setq doc (help-split-fundoc (documentation sym t) sym)) (setq args (car doc)) (string-match "\\`[^ )]* ?" args) ! (setq args (concat "(" (substring args (match-end 0))))) (t (setq args (eldoc-function-argstring sym)))) ! (cond (args ! (setq doc (eldoc-docstring-format-sym-doc sym args)) ! (eldoc-last-data-store sym doc 'function))) doc)) ;; Return a string containing a brief (one-line) documentation string for ;; the variable. (defun eldoc-get-var-docstring (sym) --- 267,328 ---- ;; Return a string containing the function parameter list, or 1-line ;; docstring if function is a subr and no arglist is obtainable from the ;; docstring or elsewhere. ! (defun eldoc-get-fnsym-args-string (sym argument-index) (let ((args nil) (doc nil)) (cond ((not (and sym (symbolp sym) (fboundp sym)))) ((and (eq sym (aref eldoc-last-data 0)) (eq 'function (aref eldoc-last-data 2))) ! (setq args (aref eldoc-last-data 1))) ((setq doc (help-split-fundoc (documentation sym t) sym)) (setq args (car doc)) (string-match "\\`[^ )]* ?" args) ! (setq args (concat "(" (substring args (match-end 0)))) ! (eldoc-last-data-store sym args 'function)) (t (setq args (eldoc-function-argstring sym)))) ! (when args ! (setq doc (eldoc-highlight-function-argument sym args argument-index))) doc)) + ;; Highlight argument INDEX in ARGS list for SYM. + (defun eldoc-highlight-function-argument (sym args index) + (let ((start nil) + (end 0) + (argument-face 'bold)) + ;; Find the current argument in the argument string. We need to + ;; handle `&rest' and informal `...' properly. + ;; + ;; FIXME: What to do with optional arguments, like in + ;; (defun NAME ARGLIST [DOCSTRING] BODY...) case? + ;; The problem is there is no robust way to determine if + ;; the current argument is indeed a docstring. + (while (>= index 1) + (if (string-match "[^ ()]+" args end) + (progn + (setq start (match-beginning 0) + end (match-end 0)) + (let ((argument (match-string 0 args))) + (cond ((string= argument "&rest") + ;; All the rest arguments are the same. + (setq index 1)) + ((string= argument "&optional")) + ((string-match "\\.\\.\\.$" argument) + (setq index 0)) + (t + (setq index (1- index)))))) + (setq end (length args) + start (1- end) + argument-face 'font-lock-warning-face + index 0))) + (let ((doc args)) + (when start + (setq doc (copy-sequence args)) + (add-text-properties start end (list 'face argument-face) doc)) + (setq doc (eldoc-docstring-format-sym-doc + sym doc 'font-lock-function-name-face)) + doc))) + ;; Return a string containing a brief (one-line) documentation string for ;; the variable. (defun eldoc-get-var-docstring (sym) *************** *** 292,298 **** (let ((doc (documentation-property sym 'variable-documentation t))) (cond (doc (setq doc (eldoc-docstring-format-sym-doc ! sym (eldoc-docstring-first-line doc))) (eldoc-last-data-store sym doc 'variable))) doc))))) --- 334,341 ---- (let ((doc (documentation-property sym 'variable-documentation t))) (cond (doc (setq doc (eldoc-docstring-format-sym-doc ! sym (eldoc-docstring-first-line doc) ! 'font-lock-variable-name-face)) (eldoc-last-data-store sym doc 'variable))) doc))))) *************** *** 316,322 **** ;; If the entire line cannot fit in the echo area, the symbol name may be ;; truncated or eliminated entirely from the output to make room for the ;; description. ! (defun eldoc-docstring-format-sym-doc (sym doc) (save-match-data (let* ((name (symbol-name sym)) (ea-multi eldoc-echo-area-use-multiline-p) --- 359,365 ---- ;; If the entire line cannot fit in the echo area, the symbol name may be ;; truncated or eliminated entirely from the output to make room for the ;; description. ! (defun eldoc-docstring-format-sym-doc (sym doc face) (save-match-data (let* ((name (symbol-name sym)) (ea-multi eldoc-echo-area-use-multiline-p) *************** *** 328,334 **** (cond ((or (<= strip 0) (eq ea-multi t) (and ea-multi (> (length doc) ea-width))) ! (format "%s: %s" sym doc)) ((> (length doc) ea-width) (substring (format "%s" doc) 0 ea-width)) ((>= strip (length name)) --- 371,377 ---- (cond ((or (<= strip 0) (eq ea-multi t) (and ea-multi (> (length doc) ea-width))) ! (format "%s: %s" (propertize name 'face face) doc)) ((> (length doc) ea-width) (substring (format "%s" doc) 0 ea-width)) ((>= strip (length name)) *************** *** 338,364 **** ;; than the beginning, since the former is more likely ;; to be unique given package namespace conventions. (setq name (substring name strip)) ! (format "%s: %s" name doc)))))) (defun eldoc-fnsym-in-current-sexp () ! (let ((p (point))) ! (eldoc-beginning-of-sexp) ! (prog1 ! ;; Don't do anything if current word is inside a string. ! (if (= (or (char-after (1- (point))) 0) ?\") ! nil ! (eldoc-current-symbol)) ! (goto-char p)))) (defun eldoc-beginning-of-sexp () ! (let ((parse-sexp-ignore-comments t)) (condition-case err ! (while (progn ! (forward-sexp -1) ! (or (= (char-before) ?\") ! (> (point) (point-min))))) ! (error nil)))) ;; returns nil unless current word is an interned symbol. (defun eldoc-current-symbol () --- 381,424 ---- ;; than the beginning, since the former is more likely ;; to be unique given package namespace conventions. (setq name (substring name strip)) ! (format "%s: %s" (propertize name 'face face) doc)))))) + ;; Return a list of current function name and argument index. (defun eldoc-fnsym-in-current-sexp () ! (save-excursion ! (let ((argument-index (1- (eldoc-beginning-of-sexp)))) ! ;; If we are at the beginning of function name, this will be -1. ! (when (< argument-index 0) ! (setq argument-index 0)) ! ;; Don't do anything if current word is inside a string. ! (if (= (or (char-after (1- (point))) 0) ?\") ! nil ! (list (eldoc-current-symbol) argument-index))))) + ;; Move to the beginnig of current sexp. Return the number of nested + ;; sexp the point was over or after. (defun eldoc-beginning-of-sexp () ! (let ((parse-sexp-ignore-comments t) ! (num-skipped-sexps 0)) (condition-case err ! (progn ! ;; First account for the case the point is directly over a ! ;; beginning of a nested sexp. ! (condition-case err ! (let ((p (point))) ! (forward-sexp -1) ! (forward-sexp 1) ! (when (< (point) p) ! (setq num-skipped-sexps 1))) ! (error)) ! (while ! (let ((p (point))) ! (forward-sexp -1) ! (when (< (point) p) ! (setq num-skipped-sexps (1+ num-skipped-sexps)))))) ! (error)) ! num-skipped-sexps)) ;; returns nil unless current word is an interned symbol. (defun eldoc-current-symbol ()