unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#65726: 29.1.50; Crash in regexp engine
@ 2023-09-04  7:46 martin rudalics
  2023-09-04  8:44 ` Mattias Engdegård
                   ` (2 more replies)
  0 siblings, 3 replies; 36+ messages in thread
From: martin rudalics @ 2023-09-04  7:46 UTC (permalink / raw)
  To: 65726

[-- Attachment #1: Type: text/plain, Size: 4687 bytes --]

With emacs -Q load the attached file elinfo.el.  Now type

C-h S split-window RET

C-x o

C-c C-g

This crashes Emacs here with

Thread 1 "emacs" received signal SIGSEGV, Segmentation fault.
0x000000000068810a in skip_noops (p=<error reading variable: Cannot access memory at address 0x7fffff66fff8>, pend=<error reading variable: Cannot access memory at address 0x7fffff66fff0>) at ../../src/regex-emacs.c:3556
3556	{

and an infinite backtrace starting with

Python Exception <class 'gdb.MemoryError'> Cannot access memory at address 0x7fffff66fff8:
#0  0x000000000068810a in skip_noops (p=#1  0x0000000000688823 in mutually_exclusive_p (bufp=0xec9c30 <searchbufs+752>, p1=0x1fcee74 "\004\005", p2=0x1fcee81 "\016\063") at ../../src/regex-emacs.c:3665
#2  0x0000000000688e19 in mutually_exclusive_p (bufp=0xec9c30 <searchbufs+752>, p1=0x1fcee74 "\004\005", p2=0x1fcee81 "\016\063") at ../../src/regex-emacs.c:3838
#3  0x0000000000688e3c in mutually_exclusive_p (bufp=0xec9c30 <searchbufs+752>, p1=0x1fcee74 "\004\005", p2=0x1fceeba "\004\020") at ../../src/regex-emacs.c:3839
#4  0x0000000000688e3c in mutually_exclusive_p (bufp=0xec9c30 <searchbufs+752>, p1=0x1fcee74 "\004\005", p2=0x1fcee84 "\002\001@\004\020") at ../../src/regex-emacs.c:3839
#5  0x0000000000688e19 in mutually_exclusive_p (bufp=0xec9c30 <searchbufs+752>, p1=0x1fcee74 "\004\005", p2=0x1fcee81 "\016\063") at ../../src/regex-emacs.c:3838
...

The same scenario worked well with Emacs 22 through 28.

martin


In GNU Emacs 29.1.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.24.5,
  cairo version 1.16.0) of 2023-09-03 built on restno
Repository revision: f1e4cbe72aa4da9351cbbcd209d9233c68dd9fbb
Repository branch: emacs-29
Windowing system distributor 'The X.Org Foundation', version 11.0.12004000
System Description: Debian GNU/Linux 10 (buster)

Configured using:
  'configure --with-gif=ifavailable --with-tiff=ifavailable
  --with-gnutls=no --without-pop --enable-gcc-warnings=warn-only
  --enable-checking=yes,glyphs --enable-check-lisp-object-type=yes
  'CFLAGS=-O0 -g3 -no-pie -Wno-missing-braces''

Configured features:
CAIRO DBUS FREETYPE GIF GLIB GSETTINGS HARFBUZZ JPEG LIBSELINUX MODULES
NOTIFY INOTIFY PDUMPER PNG SECCOMP SOUND THREADS TOOLKIT_SCROLL_BARS X11
XDBE XIM XINPUT2 XPM GTK3 ZLIB

Important settings:
   value of $LANG: de_AT.utf8
   value of $XMODIFIERS: @im=ibus
   locale-coding-system: utf-8-unix

Major mode: Lisp Interaction

Minor modes in effect:
   tooltip-mode: t
   global-eldoc-mode: t
   eldoc-mode: t
   show-paren-mode: t
   electric-indent-mode: t
   mouse-wheel-mode: t
   tool-bar-mode: t
   menu-bar-mode: t
   file-name-shadow-mode: t
   global-font-lock-mode: t
   font-lock-mode: t
   blink-cursor-mode: t
   line-number-mode: t
   indent-tabs-mode: t
   transient-mark-mode: t
   auto-composition-mode: t
   auto-encryption-mode: t
   auto-compression-mode: t

Load-path shadows:
None found.

Features:
(shadow sort mail-extr emacsbug message mailcap yank-media puny dired
dired-loaddefs rfc822 mml mml-sec password-cache epa derived epg rfc6068
epg-config gnus-util text-property-search time-date subr-x mm-decode
mm-bodies mm-encode mail-parse rfc2231 mailabbrev gmm-utils mailheader
cl-loaddefs cl-lib sendmail rfc2047 rfc2045 ietf-drums mm-util
mail-prsvr mail-utils elinfo texinfo texinfo-loaddefs info rmc
iso-transl tooltip cconv eldoc paren electric uniquify ediff-hook
vc-hooks lisp-float-type elisp-mode mwheel term/x-win x-win
term/common-win x-dnd tool-bar dnd fontset image regexp-opt fringe
tabulated-list replace newcomment text-mode lisp-mode prog-mode register
page tab-bar menu-bar rfn-eshadow isearch easymenu timer select
scroll-bar mouse jit-lock font-lock syntax font-core term/tty-colors
frame minibuffer nadvice seq simple cl-generic indonesian philippine
cham georgian utf-8-lang misc-lang vietnamese tibetan thai tai-viet lao
korean japanese eucjp-ms cp51932 hebrew greek romanian slovak czech
european ethiopic indian cyrillic chinese composite emoji-zwj charscript
charprop case-table epa-hook jka-cmpr-hook help abbrev obarray oclosure
cl-preloaded button loaddefs theme-loaddefs faces cus-face macroexp
files window text-properties overlay sha1 md5 base64 format env
code-pages mule custom widget keymap hashtable-print-readable backquote
threads dbusbind inotify dynamic-setting system-font-setting
font-render-setting cairo move-toolbar gtk x-toolkit xinput2 x multi-tty
make-network-process emacs)

Memory information:
((conses 16 45758 8352)
  (symbols 48 5682 0)
  (strings 32 15622 2110)
  (string-bytes 1 431024)
  (vectors 16 10081)
  (vector-slots 8 157669 13073)
  (floats 8 26 23)
  (intervals 56 218 0)
  (buffers 976 10))

[-- Attachment #2: elinfo.el --]
[-- Type: text/x-emacs-lisp, Size: 51929 bytes --]

;;; elinfo.el --- Elisp Info and Texinfo support routines

;; Copyright (C) 2009 Martin Rudalics

;; Time-stamp: "2021-06-09 18:45:29 martin"
;; Author: Martin Rudalics <rudalics@gmx.at>

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This file provides functions for checking the validity of Emacs' Info
;; files, navigating between Emacs' Info files and corresponding Texinfo
;; buffers, and for creating Texinfo entries from documentation strings.

(require 'info)
(require 'texinfo)

(defgroup elinfo nil
  "Elinfo."
  :version "23.2"
  :group 'lisp)

;; _____________________________________________________________________________
;;
;;;			  Utility Functions
;; _____________________________________________________________________________
;;

;; Move to and return start of first non-whitespace char after `point'.
(defun elinfo--move-to-next ()
  (forward-comment (buffer-size))
  (point))

;; Move to end of and return next name.
(defun elinfo--get-next ()
  (let ((from (elinfo--move-to-next)))
    (skip-chars-forward "^ \t\n")
    (buffer-substring-no-properties from (point))))

;; Like `elinfo--get-next' but don't leave current line.
(defun elinfo--get-next-arg ()
  (save-restriction
    (narrow-to-region (point) (line-end-position))
    (elinfo--get-next)))

;; _____________________________________________________________________________
;;
;;;		  Checking and Elinfo Log Utilities
;; _____________________________________________________________________________
;;

(defcustom elinfo-log-warnings nil
  "Non-nil means log warnings in Elinfo Log buffer."
  :group 'elinfo
  :type 'boolean
  :version "23.2")

(defcustom elinfo-show-definition t
  "Non-nil means show definitions when browsing Elinfo Logs."
  :group 'elinfo
  :type 'boolean
  :version "23.2")

(defcustom elinfo-balance-windows t
  "Non-nil means balance windows when browsing Elinfo Logs."
  :group 'elinfo
  :type 'boolean
  :version "23.2")

(defcustom elinfo-reuse-windows t
  "Non-nil means reuse windows when browsing Elinfo Logs."
  :group 'elinfo
  :type 'boolean
  :version "23.2")

(defcustom elinfo-log-location-face 'underline
  "Face name for highlighting locations in Elinfo Logs."
  :group 'elinfo
  :type 'face
  :version "23.2")

(defcustom elinfo-log-def-face font-lock-constant-face
  "Face name for highlighting things in Elinfo Logs."
  :group 'elinfo
  :type 'face
  :version "23.2")

;; Window navigation.
(defvar elinfo-source-window nil
  "The window where the Texinfo source buffer was displayed.")
(defvar elinfo-def-window nil
  "The window where the definition of some symbol was displayed.")

(defun elinfo-show-definition (symbol &optional type)
  "Show definition of SYMBOL in a suitable window.
For compatibility with `find-definition-noselect' TYPE must be
omitted or nil for functions and `defvar' for variables."
  ;; `find-definition-noselect' is autoloaded in find-func.el and should
  ;; return a cons whose car is the buffer containing the definition
  ;; while its cdr contains the position within the buffer.
  (let ((buffer-position-pair (save-excursion
				(find-definition-noselect symbol type))))
    (when buffer-position-pair
      (let ((buffer (car buffer-position-pair))
	    (position (cdr buffer-position-pair)))
	(if (and elinfo-reuse-windows (window-live-p elinfo-def-window))
	    (set-window-buffer elinfo-def-window buffer)
	  (setq elinfo-def-window (display-buffer buffer)))
	;; Record window/buffer relationship.
	(set-window-point elinfo-def-window position)
	(with-selected-window elinfo-def-window
	  ;; Put the definition at the top of the window.
	  (recenter 1))))))

(defun elinfo-show-source (&optional log-pos)
  "Show Texinfo source corresponding to Elinfo Log entry at LOG-POS.
LOG-POS nil or omitted means consider the entry located at
`point'.

This function may also display a corresponding definition in case
`elinfo-show-definition' is non-nil and balance the respective
windows provided `elinfo-balance-windows' is non-nil."
  (save-excursion
    (let* ((log-pos (or log-pos (point)))
	   (file-name (get-text-property log-pos 'elinfo-file-name))
	   (position (get-text-property log-pos 'elinfo-position))
	   (buffer (find-file-noselect file-name))
	   balance)
      ;; Display Texinfo source.
      (if (and elinfo-reuse-windows (window-live-p elinfo-source-window))
	  (set-window-buffer elinfo-source-window buffer)
	(setq elinfo-source-window (display-buffer buffer)))
      ;; Set window/buffer relationship.
      (set-window-point elinfo-source-window position)
      (with-selected-window elinfo-source-window
	;; We could make the "1" customizable.
	(recenter 1))
      ;; Display definition if possible.
      (cond
       ((not elinfo-show-definition))
       ((memq (get-text-property log-pos 'elinfo-type)
	      '(command no-command arg-mismatch))
	(elinfo-show-definition
	 (intern (get-text-property log-pos 'elinfo-name)))
	(setq balance t))
       ((memq (get-text-property log-pos 'elinfo-type)
	      '(option no-option))
	(elinfo-show-definition
	 (intern (get-text-property log-pos 'elinfo-name)) 'defvar)
	(setq balance t)))
      ;; Balance windows if possible.
      (when (and elinfo-balance-windows balance
		 (eq (window-frame elinfo-source-window)
		     (window-frame elinfo-def-window)))
	;; `balance-windows' should balance siblings of the
	;; source-window only.
	(balance-windows elinfo-source-window)))))

;; The next-/previous-error functions have been copied from compile.el
;; and slightly adapted for our needs.  For UI and keybindings stick to
;; those used by compile and related modes.  Also retain the -error
;; postfix for all entries and don't modify the doc strings to make this
;; look familiar.
(defun elinfo-next-error (n &optional other-file)
  "Show Texinfo source for next entry in Elinfo Log.
Prefix arg N says how many entries to move forwards \(backwards,
if negative).

Optional arg OTHER-FILE, if non-nil, means find entry for a file
that is different from the current one.  In that case, N
specifies the number of files whose entries shall be skipped.

This function may also display a corresponding definition in case
`elinfo-show-definition' is non-nil and balance the respective
windows provided `elinfo-balance-windows' is non-nil."
  (interactive "p")
  (if other-file
      (let ((last-file (get-text-property (point) 'elinfo-file-name))
	    (current-file ""))
	(if (> n 0)
	    (while (and (not (eobp))
			(setq current-file
			      (get-text-property (point) 'elinfo-file-name))
			(or (string-equal current-file last-file)
			    (and (setq last-file current-file)
				 (> (setq n (1- n)) 0))))
	      (forward-line))
	  (while (and (not (bobp))
		      (setq current-file
			    (get-text-property (point) 'elinfo-file-name))
		      (or (string-equal current-file last-file)
			  (and (setq last-file current-file)
			       (< (setq n (1+ n)) 0))))
	      (forward-line -1))))
    (forward-line n))

  (elinfo-show-source))

(defun elinfo-next-error-function (n &optional reset)
  "Move to next entry in Elinfo Log and show corresponding Texinfo source.
Optional argument RESET non-nil means go to first Elinfo Log
entry.  See also `elinfo-next-error'.

This function provides the value of `next-error-function' in
Elinfo Log buffers."
  (interactive "p")
  (when reset (goto-char (point-min)))
  (elinfo-next-error n))

(defun elinfo-previous-error (n)
  "Show Texinfo source corresponding to previous entry in Elinfo Log.
Prefix arg N says how many entries to move backwards \(forwards,
if negative).  See also `elinfo-next-error'."
  (interactive "p")
  (elinfo-next-error (- n)))

(defun elinfo-next-file (n)
  "Show Texinfo source of next Elinfo Log entry naming another file.
Prefix arg N says how many files to move forwards \(or backwards,
if negative).  See also `elinfo-next-error'."
  (interactive "p")
  (elinfo-next-error n t))

(defun elinfo-previous-file (n)
  "Show Texinfo source of previous Elinfo Log entry naming another file.
Prefix arg N says how many files to move backwards \(or forwards,
if negative).  See also `elinfo-next-error'."
  (interactive "p")
  (elinfo-next-file (- n)))

(defun elinfo-goto-error (&optional event)
  "Show Texinfo source for Elinfo Log entry at `point'.
See also `elinfo-next-error'."
  (interactive (list last-input-event))
  (when event (posn-set-point (event-end event)))
  (next-error-internal))

(defvar elinfo-log-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [mouse-2] 'elinfo-goto-error)
    (define-key map [follow-link] 'mouse-face)
    (define-key map "\C-c\C-c" 'elinfo-goto-error)
    ;; Elinfo goto compatibility.
    (define-key map "\C-c\C-g" 'elinfo-goto-error)
    (define-key map "\C-m" 'elinfo-goto-error)
    (define-key map "\M-n" 'elinfo-next-error)
    (define-key map "\M-p" 'elinfo-previous-error)
    (define-key map "\M-{" 'elinfo-previous-file)
    (define-key map "\M-}" 'elinfo-next-file)
    (define-key map "\t" 'elinfo-next-error)
    (define-key map [backtab] 'elinfo-previous-error)
    (define-key map "q" 'quit-window)
    (define-key map " " 'scroll-up)
    (define-key map "\^?" 'scroll-down)
    (define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
    map)
  "Keymap for Elinfo Logs.")

(defun elinfo-log-mode ()
  "Major mode for browsing Elinfo Logs.
\\{elinfo-log-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (use-local-map elinfo-log-mode-map)
  (setq major-mode 'elinfo-log-mode)
  (setq mode-name "Elinfo")
  (setq next-error-function 'elinfo-next-error-function)
  (setq buffer-read-only t))

(defvar elinfo-log-button-map
  (let ((map (make-sparse-keymap)))
    (define-key map [mouse-2] 'elinfo-goto-error)
    (define-key map [follow-link] 'mouse-face)
    (define-key map "\C-m" 'elinfo-goto-error)
    map)
  "Keymap for Elinfo Log buttons.")
(fset 'elinfo-log-button-map elinfo-log-button-map)

;; Two utility functions for getting properties of functions and
;; variables.  These are used for checking properties described by
;; Texinfo text.
(defun elinfo--fun-properties (function)
  "Return properties of FUNCTION.
Return value is a list of three elements: The first element, when
non-nil, tells that FUNCTION is a command.  The second element,
when non-nil, specifies the function FUNCTION is aliased to.  The
third element specifies the argument list of FUNCTION (and is t
when that argument list is not available)."
  (let (def command alias arglist doc)
    (setq def (if (symbolp function)
		  (symbol-function function)
		function))
    (setq command (commandp def))
    (when (symbolp def)
      (while (and (fboundp def) (symbolp (symbol-function def)))
	(setq def (indirect-function def)))
      (setq alias def))
    (setq arglist
	  (if (and (setq doc (documentation function))
		   (string-match "\n\n(fn[ \]*\\(.*\\))[ \t\n]*\\'" doc))
	      (mapcar 'downcase (split-string (match-string 1 doc)))
	    ;; Handle symbols aliased to other symbols.
	    (when (and (symbolp def) (fboundp def))
	      (setq def (indirect-function def)))
	    ;; If definition is a macro, find the function inside it.
	    (when (eq (car-safe def) 'macro)
	      (setq def (cdr def)))
	    (cond
	     ((byte-code-function-p def) (aref def 0))
	     ((eq (car-safe def) 'lambda) (nth 1 def))
	     (t t))))
    (list command alias (if (listp arglist) arglist t))))

(defun elinfo--is-option (variable)
  "Return t if VARIABLE is an option."
  (let* ((file-name (find-lisp-object-file-name variable 'defvar))
	 (alias (condition-case nil
		    (indirect-variable variable)
		  (error variable)))
	 (doc
	  (condition-case nil
	      (or (documentation-property variable 'variable-documentation)
		  (documentation-property alias 'variable-documentation))
	    (error nil)))
	 (option (or (custom-variable-p variable)
		     (and (stringp doc)
			  (string-equal
			   "*" (substring-no-properties doc 0 1))))))
    option))

;; Some counters.
(defvar elinfo-files-count nil)
(defvar elinfo-errors-count 0)
(defvar elinfo-warnings-count 0)

(defun elinfo-clear-log ()
  "Clear Elinfo Log buffer and reset error counts."
  ;; Maybe we should make clearing customizable.
  (with-current-buffer (get-buffer-create "*Elinfo-Log*")
    (let ((inhibit-read-only t))
      (delete-region (point-min) (point-max))))
  ;; We could insert some header, but who'd care anyway?
  (setq elinfo-errors-count 0)
  (setq elinfo-warnings-count 0))

(defun elinfo-display-log (&optional file-name)
  "Display Elinfo Log.
If there were no errors just write a message.  Optional argument
FILE-NAME must name the file whose contents were checked."
  (if (and (zerop elinfo-errors-count) (zerop elinfo-warnings-count))
      (let ((text
	     (concat
	      "No errors found"
	      (cond
	       (file-name
		(format " in file %s" file-name))
	       (elinfo-files-count
		(format " in %s checked file(s)" elinfo-files-count))))))
	(message text))
    (let* ((buffer (get-buffer "*Elinfo-Log*"))
	   (window (when buffer
		     (display-buffer buffer)))
	   (text (concat
		  (format "%s error(s)" elinfo-errors-count)
		  (when elinfo-log-warnings
		    (format " and %s warning(s)" elinfo-warnings-count))
		  (cond
		   (file-name
		    (format " in file %s" file-name))
		   (elinfo-files-count
		    (format " in %s checked file(s)" elinfo-files-count))))))
      ;; We really should have an option which lets users select
      ;; Log/Help windows.
      (when window
	(set-window-point window (point-min)))
      (message text))))

(defun elinfo-log-string (type name file-name position string &optional warning)
  "Log STRING in Elinfo Log buffer.
STRING is propertized with TYPE \(the type of the error), NAME
\(usually the name of some function or variable), FILE-NAME \(the
name of a file), POSITION \(a position valid in a buffer visiting
FILE-NAME).  Optional argument WARNING non-nil means no logging
occurs unless `elinfo-log-warnings' is non-nil."
  (when (or (not warning) elinfo-log-warnings)
    (if warning
	(setq elinfo-warnings-count (1+ elinfo-warnings-count))
      (setq elinfo-errors-count (1+ elinfo-errors-count)))
    (let ((line (count-lines (point-min) position))
	  (column (save-excursion
		    (goto-char position)
		    (current-column))))
      (with-current-buffer (get-buffer-create "*Elinfo-Log*")
	(unless (eq major-mode 'elinfo-log-mode)
	  (elinfo-log-mode))
	(let ((inhibit-read-only t)
	      from to)
	  (goto-char (setq from (point-max)))
	  (insert
	   ;; Propertized information.
	   (propertize
	    (concat
	     (propertize
	      (concat
	       (when file-name
		 (concat (file-name-nondirectory file-name) ":"))
	       (format "%s:%s" line column))
	      'face elinfo-log-location-face)
	     " " string)
	    'elinfo-type type 'elinfo-name name
	    'elinfo-file-name file-name 'elinfo-position position
	    'mouse-face 'highlight 'follow-link 'elinfo-follow-link)
	   ;; STRING itself followed by a newline.
	   "\n"))))))

(defsubst elinfo--symbol-name (arg)
  "If ARG is a symbol return its name, else return ARG."
  (if (symbolp arg) (symbol-name arg) arg))

(defun elinfo-check (file-name)
  "Check current buffer.
FILE-NAME must specify the name of the file whose contents are in
the current buffer."
  (interactive)
  (save-excursion
    (save-restriction
      (widen)
      ;; Make sure `case-fold-search' is nil to catch the "C-" and "M-"
      ;; entries only and not the C-mode "c-..." stuff.
      (let (case-fold-search
	    texi-name texi-pd-name texi-arg-name texi-command texi-option
	    position properties arg-list arg-name is-option)
	(goto-char (point-min))
	;; We probably won't ever bother to optimize the regexp below.
	(while (re-search-forward
		;; REGEXP MNEMNONICS: 1..defun/deffn, 4..defvar/defopt,
		;; 8..text we ignore, 9..C-/M- prefixed string in @code,
		;; 10..SPC/RET/etc. in @code, 11..SPC/RET/etc. in @kbd,
		;; 13..non-nil.
		"^@\\(?:\\(\\(defunx?\\|defmac\\|defspec\\)\\|\\(deffn Command\\)\\)\
\\|\\(\\(defvarx?\\)\\|\\(defoptx?\\)\\)\
\\|\\(small\\)?\\(example\\|lisp\\|verbatim\\|ignore\\)\\)\
\\|@code{\\([CM]-[^}]+\\)\\|@\\(?:\\(code\\)\
\\|\\(kbd\\)\\){\\(SPC\\|RET\\|LFD\\|TAB\\|BS\\|ESC\\|DEL\\|SHIFT\\|CTRL\\|META\\|F[0-9]+\\)}\
\\|\\(non-nil\\)" nil t)
	  (cond
	   ((match-beginning 1)
	    (setq texi-command (match-beginning 3))
	    (setq position (elinfo--move-to-next))
	    (setq texi-name (elinfo--get-next))
	    (setq texi-pd-name (propertize texi-name 'face elinfo-log-def-face))
	    (if (not (fboundp (intern texi-name)))
		(progn
		  (elinfo-log-string
		   'fun-unbound texi-name file-name position
		   (concat "Unbound function `" texi-pd-name "'") t)
		  (forward-line))
	      (setq properties (elinfo--fun-properties (intern texi-name)))
	      (if (and (eq (nth 1 properties) 'ignore)
		       (not (string-equal texi-name "ignore")))
		  ;; When the function is remapped to `ignore' we can't
		  ;; do anything reasonable on the current platform.
		  (progn
		    (elinfo-log-string
		     'remapped-to-ignore texi-name file-name position
		     (concat "`" texi-pd-name "' remapped to `ignore' on this platform") t)
		    (forward-line))
		;; Check command property.
		(cond
		 ((and texi-command (not (nth 0 properties)))
		  (elinfo-log-string
		   'command texi-name file-name position
		   (concat "`" texi-pd-name "' is not a command")))
		 ((and (not texi-command) (nth 0 properties))
		  (elinfo-log-string
		   'no-command texi-name file-name position
		   (concat "`" texi-pd-name "' is a command"))))
		;; Check arguments.
		(setq arg-list (nth 2 properties))
		(cond
		 ((not arg-list)
		  (unless (string-equal (elinfo--get-next-arg) "")
		    ;; The function doesn't have arguments.
		    (elinfo-log-string
		     'arg-mismatch texi-name file-name position
		     (concat "`" texi-pd-name "' has no arguments"))))
		 ((not (listp arg-list))
		  ;; Usually this is an "Arglist not available ..." problem.
		  (elinfo-log-string
		   'arg-not-available texi-name file-name position
		   (concat "Arguments of `" texi-pd-name "' not available") t))
		 (t
		  (catch 'bug
		    (dolist (arg arg-list)
		      (setq arg-name (elinfo--symbol-name arg))
		      (setq texi-arg-name (elinfo--get-next-arg))
		      (cond
		       ((string-equal arg-name texi-arg-name)) ; :-)
		       ((string-equal texi-arg-name "")
			;; The function has more arguments than described.
			(or (and (string-match "&optional\\|&rest" arg-name)
				 ;; Maybe the manual just wants us to
				 ;; ignore the arguments.
				 (let ((last-name (car (last arg-list))))
				   (string-match
				    "ignored?" (elinfo--symbol-name last-name))))
			    (elinfo-log-string
			     'arg-mismatch texi-name file-name position
			     (concat
			      "`" texi-pd-name "' lacks description of "
			      (cond
			       ((string-equal arg-name "&optional")
				"optional argument(s).")
			       ((string-equal arg-name "%rest")
				"rest of arguments.")
			       (t (concat "argument `" arg-name "'"))))))
			(throw 'bug t))
		       ((or (string-match "&optional\\|&rest" arg-name)
			    (string-match "&optional\\|&rest" texi-arg-name))
			(or (and (string-match "&optional\\|&rest" texi-arg-name)
				 ;; Maybe we don't want to know all
				 ;; arguments?  Let's get heuristical
				 ;; once more.
				 (let ((next-name (elinfo--get-next-arg)))
				   (string-match
				    "elements\\|arguments\\|args" next-name 0)))
			    ;; The following idiom is popular within
			    ;; macros and special forms.
			    (and (string-match "&rest" arg-name)
				 (or (string-match "@dots{}$" texi-arg-name)
				     (re-search-forward
				      "@dots{}$" (line-end-position) t)))
			    (elinfo-log-string
			     'arg-mismatch texi-name file-name position
			     (concat
			      "`" texi-pd-name
			      "' has mismatching optional or rest of arguments")))
			(throw 'bug t))
		       (t
			(elinfo-log-string
			 'arg-mismatch texi-name file-name position
			 (concat "'" texi-pd-name "' uses `" texi-arg-name
				 "' for argument `" arg-name "'") t))
		       (throw 'bug t)))))))))
	   ((match-beginning 4)
	    (setq texi-option (match-beginning 6))
	    (setq position (elinfo--move-to-next))
	    (setq texi-name (elinfo--get-next))
	    (setq texi-pd-name (propertize texi-name 'face elinfo-log-def-face))
	    (if (not (boundp (intern texi-name)))
		(progn
		  (elinfo-log-string
		   'var-unbound texi-name file-name position
		   (concat "Unbound variable `" texi-pd-name "'") t)
		  (forward-line))
	      ;; Check option property.
	      (setq is-option (elinfo--is-option (intern texi-name)))
	      (cond
	       ((and texi-option (not is-option))
		(elinfo-log-string
		 'no-option texi-name file-name position
		 (concat "`" texi-pd-name "' is not an option")))
	       ((and (not texi-option) is-option)
		(elinfo-log-string
		 'option texi-name file-name position
		 (concat "`" texi-pd-name "' is an option"))))))
	   ((match-beginning 8)
	    (setq position (line-beginning-position))
	    ;; An example-verbatim-lisp group, skip it.
	    (unless (re-search-forward
		     (concat "^@end " (match-string-no-properties 7)
			     (match-string-no-properties 8)) nil t)
	      (elinfo-log-string
	       'no-end nil file-name position
	       (concat "Unterminated " (match-string-no-properties 7)
		       (match-string-no-properties 8)))))
	   ((match-beginning 9)
	    (elinfo-log-string
	     'code-kbd nil file-name (match-beginning 9)
	     (concat "Use @kbd for @code{"
		     (replace-regexp-in-string
		      "\n" " " (match-string-no-properties 9)) "}")))
	   ((match-beginning 10)
	    (elinfo-log-string
	     'code-key nil file-name (match-beginning 10)
	     (concat "Use @key for @code{"
		     (replace-regexp-in-string
		      "\n" " " (match-string-no-properties 12)) "}")))
	   ((match-beginning 11)
	    (elinfo-log-string
	     'kbd-key nil file-name (match-beginning 11)
	     (concat "Use @key for @kbd{"
		     (replace-regexp-in-string
		      "\n" " " (match-string-no-properties 12)) "}")))
	   ((match-beginning 13)
	    ;; Currently we don't cater for @code{nil} miswritten as nil
	    ;; and probably never will.
	    (elinfo-log-string
	     'kbd-key nil file-name (match-beginning 13)
	     (concat "Use non-@code{nil} instead of non-nil")))
	   ;; Additional cases added here.
	   ))))))

(defun elinfo-check-buffer ()
  "Check validity of current Texinfo buffer.
The buffer must be visiting a file."
  (interactive)
  (elinfo-clear-log)
  (cond
   ((not buffer-file-name)
    (error "The current buffer does not visit a file"))
   ((and (buffer-modified-p)
	 (y-or-n-p (format "Save buffer %s first? " (buffer-name))))
    (save-buffer)))
  (setq elinfo-files-count nil)
  (goto-char (point-min))
  (elinfo-check buffer-file-name)
  (elinfo-display-log buffer-file-name))

(defun elinfo-check-file (file-name)
  "Check validity of Texinfo file FILE-NAME."
  (interactive "fCheck Texinfo file ")
  (elinfo-clear-log)
  (setq elinfo-files-count nil)
  (with-temp-buffer
    (insert-file-contents file-name)
    (elinfo-check file-name))
  (elinfo-display-log file-name))

(defun elinfo-check-directory (directory)
  "Check validity of Texinfo files in DIRECTORY."
  (interactive "DCheck all texinfo files in ")
  (let ((files (directory-files directory 'full)))
    (elinfo-clear-log)
    (setq elinfo-files-count 0)
    (dolist (file files)
      (when (and (string-equal (file-name-extension file) "texi")
		 (not (backup-file-name-p file)))
	(with-temp-buffer
	  (insert-file-contents file)
	  (elinfo-check file)
	  (setq elinfo-files-count (1+ elinfo-files-count))
	  (let (message-log-max)
	    (message "%s files checked" elinfo-files-count)))))
    (elinfo-display-log)))

;; _____________________________________________________________________________
;;
;;;			Navigation Utilities
;; _____________________________________________________________________________
;;

(defcustom elinfo-names-alist
  '(("elisp" . "lispref") ("emacs" . "emacs"))
  "Alist of (info-file-name texi-subdirectory) associations.
If elinfo can't find an association it will look in the \"misc\"
subdirectory."
  :type '(repeat (group (string :tag "info-file" :format "  %t: %v" :size 15)
			(string :tag "texi-subdir" :format "  %t: %v\n" :size 15)))
  :group 'elinfo)

(defcustom elinfo-texi-directory (concat source-directory "doc/")
  "Directory where doc files reside."
  :type 'file
  :group 'elinfo)

(defun elinfo--default-tag ()
  "Return cons holding start and name of tag near `point'."
  (let (from to bound)
    (when (or (progn
		;; Look at text around `point'.
		(save-excursion
		  (skip-chars-backward "a-z0-9") (setq from (point)))
		(save-excursion
		  (skip-chars-forward "a-z0-9") (setq to (point)))
		(> to from))
	      ;; Look between `line-beginning-position' and `point'.
	      (save-excursion
		(and (setq bound (line-beginning-position))
		     (skip-chars-backward "^a-z0-9" bound)
		     (> (setq to (point)) bound)
		     (skip-chars-backward "a-z0-9")
		     (setq from (point))))
	      ;; Look between `point' and `line-end-position'.
	      (save-excursion
		(and (setq bound (line-end-position))
		     (skip-chars-forward "^a-z0-9" bound)
		     (< (setq from (point)) bound)
		     (skip-chars-forward "a-z0-9")
		     (setq to (point)))))
      (cons from (buffer-substring-no-properties from to)))))

(defconst elinfo-at-regexp "\\(?:\\(?:@[a-z]+{\\|[}`'\"_:]*\\)*[ \t\n]*\\)"
  "Regexp supposed to match Texinfo constructs that separate items.")

;; Two globals, initialized in `elinfo-goto-texi' and updated by
;; `elinfo--update-regexp'.
(defvar elinfo-from nil)
(defvar elinfo-regexp nil)

(defun elinfo--make-regexp (from to)
  "Return buffer text from FROM to TO as regexp."
  (replace-regexp-in-string
   "[ \t]+" "[ \t\n]+"
    (regexp-quote
     (downcase
      (buffer-substring-no-properties from to))) nil t))

(defun elinfo--make-regexp-2 (from to)
  "Return buffer text from FROM to TO as Texinfoish regexp."
  (replace-regexp-in-string
   "@\\([@{}]\\)" (lambda (string) (match-string-no-properties 1 string))
   (elinfo--make-regexp from to)))

(defun elinfo--update-regexp (&optional rest)
  (setq elinfo-regexp
	(concat
	 elinfo-regexp
	 (elinfo--make-regexp elinfo-from (match-beginning 0))
	 (unless (= elinfo-from (match-beginning 0))
	   elinfo-at-regexp)
	 (when rest
	   (concat rest elinfo-at-regexp)))))

(defun elinfo--update-regexp-810 (&optional rest)
  (setq elinfo-regexp
	(concat
	 elinfo-regexp
	 (elinfo--make-regexp elinfo-from (match-beginning 0))
	 (unless (= elinfo-from (match-beginning 0))
	   elinfo-at-regexp)
	 (when rest
	   (concat rest elinfo-at-regexp)))))

(defconst elinfo-info-regexp
  "\\(-- \\(?:Function\\|Command\\|Variable\\|Macro\\|Special Form\\|User Option\\|Syntax class\\): \\)\
\\|\\(?:\\(\\*Note\\)\\|\\(::\\)\\|\\*\\(Warning:\\)\\*\\)[ ]*\\|[‘]*<\\([^>]+\\)>[’]*\
\\|\\(\\(?:La\\)?TeX\\|([CR])\\|Euro\\)\\|\\(‘\\([^’]+\\)’\\)\\|\\([‘]*\\([A-Z0-9*-]+\\)[’]*\\)\
\\|\\([ \t\n]+\\)\\|\\(['\"_]+\\)\\|\\(-+\\)\\|\\(\\.[.]+\\)\
\\|\\(\\(?:error\\)?[-.!=>|*#][-.!=>|*#]+\\)\\|\\([{}]\\)"
  "The basic regexp used by `elinfo-goto-texi'.")

;; Used for testing only so REMOVE it.
(defvar elinfo-test-texi-window nil)

(defun elinfo-find-tag-other-window (tagname &optional next-p regexp-p)
  "Our version of `find-tag-other-window'."
  (let* ((window-point (window-point))
	 (tagbuf (find-tag-noselect tagname next-p regexp-p))
	 (tagpoint (progn (set-buffer tagbuf) (point))))
    (set-window-point (prog1
			  (selected-window)
			(select-window
			 (or (get-buffer-window tagbuf)
			     (let ((window (split-window nil nil 'left)))
			       (set-window-buffer window tagbuf)
			       window)))
			(set-window-point (selected-window) tagpoint))
		      window-point)))

(defun elinfo-windows-synch (&optional source target)
  "Synch `window-point' of window TARGET with that of window SOURCE."
  (let* ((source (or source (selected-window)))
	 (target (or target
		     (window-in-direction 'left source)
		     (window-in-direction 'right source)))
	 (line
	  (with-current-buffer (window-buffer source)
	    (count-screen-lines (window-start source) (window-point source))))
	 ;; Experimentally OK ...
	 (source-head (/ (+ (window-header-line-height source)
			    (window-tab-line-height source))
			 (frame-char-height (window-frame source))))
	 (target-head (/ (+ (window-header-line-height target)
			    (window-tab-line-height target))
			 (frame-char-height (window-frame target)))))
    (setq line (+ line (- source-head target-head)))
    (with-selected-window target
      (recenter (1- line)))))

(defun elinfo-goto-texi ()
  "In `Info-mode' display corresponding Texinfo text in other window.
If invoking this command doesn't get you to the desired position
in the Texinfo buffer, you might try to invoke it from a position
one line above or below the current one in the Info buffer."
  (interactive)
  (unless (eq major-mode 'Info-mode)
    (error "This function can be invoked in Info-mode only"))
  (let* ((info-window (selected-window))
	 (window-point (window-point))
	 (info-file-name
	  (when (boundp 'Info-current-file)
	    (file-name-nondirectory Info-current-file)))
	 (tag
	  (when (boundp 'Info-current-node)
	    Info-current-node))
	 (texi-subdir
	  (when info-file-name
	    (let ((cell (assoc info-file-name elinfo-names-alist)))
	      (if cell (cdr cell) "misc"))))
	 (at (point))
	 (offset 0)
	 texi-dir texi-file tags-file-name
	 default-tag anchor repeat from to
	 case-fold-search tagbuf)
    (cond
     ((not texi-subdir)
      (error "Can't identify texinfo subdirectory"))
     ((file-exists-p
       (setq texi-dir (concat elinfo-texi-directory texi-subdir "/"))))
     (t
      (error "Can't find texinfo subdirectory")))

    ;; Sigh ...
    (save-excursion
      ;; Move away from empty lines.
      (save-excursion
	(beginning-of-line)
	(when (looking-at "[ \t]*$")
	  (let ((prev-at
		 (progn
		   (skip-chars-backward " \t\n")
		   (unless (bobp)
		     (point))))
		(next-at
		 (progn
		   (skip-chars-forward " \t\n")
		   (unless (eobp)
		     (point)))))
	    (setq at
		  (cond
		   ((and prev-at next-at)
		    (if (> (- at prev-at) (- next-at at)) next-at prev-at))
		   (prev-at prev-at)
		   (next-at next-at))))))
      (goto-char at)
      (setq from (progn
		   (beginning-of-line)
		   (skip-chars-forward " \t")
		   (point)))
      (setq to (progn
		 (end-of-line)
		 (skip-chars-backward " \t")
		 (point)))
      ;; Try to handle an xref that spans the beginning of this line.
      ;; This will put us after the reference in the texi buffer, but
      ;; that's still better than getting to the head of the section.
      (when (save-excursion
	      (goto-char from)
	      (and (re-search-backward
		    "\\*[Nn]ote" (line-beginning-position 0) t)
		   (not (re-search-forward "[.,]\\|::" from t))))
	(goto-char from)
	(re-search-forward "::\\|\\([.,])?\\)" to t)
	(when (match-beginning 1)
	  ;; Found a closing `.' or `,' so relocate `from'.
	  (setq from (point))
	  (setq at (max from at))))

      (goto-char at)
      (when (setq default-tag (elinfo--default-tag))
	(setq offset (- at (car default-tag)))
	(setq anchor (cdr default-tag))
	(save-excursion
	  (goto-char from)
	  (catch 'done
	    (let ((case-fold-search t))
	      (while (re-search-forward anchor nil t)
		(if (= (match-beginning 0) (car default-tag))
		    (throw 'done t)
		  (setq repeat
			(if repeat (1+ repeat) 2))))))))

      (goto-char (setq elinfo-from from))
      (setq elinfo-regexp nil)
      ;; Scan line.
      (while (re-search-forward elinfo-info-regexp to t)
	(cond
	 ((match-beginning 1))			; -- Function: ...
	 ((match-beginning 2)			; *Note
	  (elinfo--update-regexp)
	  (let ((from-1 (point))
		to-1)
	    (if (re-search-forward ":" to t)
		(progn
		  (setq to-1 (match-beginning 0))
		  (if (looking-at-p ":")
		      ;; :: is handled by main loop, rescan.
		      (goto-char from-1)
		    ;; A complex xref, handle it here.
		    (setq elinfo-regexp
			  (concat elinfo-regexp ; Force a `{' here?
				  "[a-zA-Z, \t\n]*"
				  (elinfo--make-regexp from-1 to-1)
				  "[a-zA-Z, \t\n]*}"))
		    ;; Quit loop.
		    (setq from to)
		    (goto-char to)))
	      (setq elinfo-regexp
		    (concat elinfo-regexp	; Force a `{' here?
			    "[a-zA-Z, \t\n]*"
			    (elinfo--make-regexp from-1 to)
			    "[a-zA-Z, \t\n]*}"))
	      ;; Quit loop.
	      (setq from to)
	      (goto-char to))))
	 ((match-beginning 3)			; ::
	  (elinfo--update-regexp))
	 ((match-beginning 4)			; *Warning:*
	  (elinfo--update-regexp))
	 ((match-beginning 5)			; `<KEY>'
	  (elinfo--update-regexp
	   (elinfo--make-regexp (match-beginning 5) (match-end 5))))
	 ((match-beginning 6)
	  (elinfo--update-regexp
	   (concat "@?" (match-string-no-properties 6) "\\(?:[{}]+\\)?")))
	 ((match-beginning 7)			; Quoted string
	  (elinfo--update-regexp-810
	   (elinfo--make-regexp (match-beginning 8) (match-end 8))))
	 ((match-beginning 9)			; Upper-case string.
	  (elinfo--update-regexp-810
	   (elinfo--make-regexp (match-beginning 10) (match-end 10))))
	 ((match-beginning 11)			; Whitespace
	  (elinfo--update-regexp "[ \t\n]+"))
	 ((match-beginning 12)			; `'"
	  (elinfo--update-regexp))
	 ((match-beginning 13)			; --
	  (elinfo--update-regexp "[-]+"))
	 ((match-beginning 14)			; ..
	  (elinfo--update-regexp "\\(?:\\.[.]+\\|@dots{}\\)"))
	 ((match-beginning 15)			; =>
	  (elinfo--update-regexp
	   (concat
	    "\\(?:@[a-z]+{}\\)\\|"
	    (elinfo--make-regexp (match-beginning 15) (match-end 15)))))
	 ((match-beginning 16)			; { or }
	  (elinfo--update-regexp
	   (concat "@?" (match-string-no-properties 16) elinfo-at-regexp)))
	 ;; Future additions go here.
	 )
	(setq elinfo-from (point)))
      (setq elinfo-regexp
	    (concat elinfo-regexp (elinfo--make-regexp elinfo-from to))))

    (if (not (file-exists-p
	      (setq tags-file-name (concat texi-dir "TAGS"))))
	(error "No tags file found")
      (setq tagbuf (find-tag-noselect (concat "^@node " tag "[\x7f,]") nil t))
      (elinfo-find-tag-other-window (concat "^@node " tag "[\x7f,]") nil t)

      ;; Used for testing only so REMOVE it.
      (setq elinfo-test-texi-window (selected-window))

      (let ((case-fold-search t))
	(when elinfo-regexp
	  (with-current-buffer (get-buffer-create "*test*")
	    (delete-region (point-min) (point-max))
	    (insert elinfo-regexp))
	  (let ((at (point)))
	    (cond
	     ((and (re-search-forward (concat "\\(" elinfo-regexp "\\)\\|^node") nil t)
		   (match-beginning 1))
	      (goto-char (match-beginning 1))
	      (save-restriction
		(widen)
		(narrow-to-region (match-beginning 1) (match-end 1))
		(when (and anchor (re-search-forward anchor nil t repeat))
		  (goto-char (+ (match-beginning 0) offset)))))
	     (t
	      (goto-char at)))))))

    (set-window-point info-window window-point)
    (elinfo-windows-synch info-window (get-buffer-window tagbuf))
    ;; The following might get removed.
    (select-window info-window)
    ))

(defconst elinfo-texi-glyph-regexp
  (regexp-opt
   '("dots" "enddots" "bullet" "minus" "result" "expansion"
     "print" "error" "equiv" "point" "copyright"
     "registeredsymbol" "euro" "pounds" "LaTeX" "TeX"))
  "Regular expression for glyphs in texi buffers.")

(defconst elinfo-texi-regexp
  (concat
   "@def\\(un\\|fn Command\\|var\\|macro\\|spec\\|opt\\)[ \t]+\
\\|\\(?:@p?xref{\\([^}]+\\)\\(?:}\\|$\\)\\)\\|@\\(?:strong\\|emph\\){\\([^}]+\\)}\
\\|\\(@" elinfo-texi-glyph-regexp "{}\\)\\|\\(?:@dfn{\\([^}]+\\)}\\)\
\\|\\(@[a-z]+{\\)\\|\\(}\\)\\|\\([ \t]+\\)\\|\\([`'\"][`'\"]+\\)")
  "The basic regexp used by `elinfo-goto-info'.")

(defun elinfo-goto-info ()
  "In `texinfo-mode' display corresponding Info node in other window.
If invoking this command doesn't get you to the desired position
in the Info buffer, you might try to invoke it from a position
one line above or below the current one in the Texinfo buffer."
  (interactive)
  (unless (eq major-mode 'texinfo-mode)
    (error "This function can be invoked in texinfo-mode only"))
  (let* ((texi-window (selected-window))
	 (window-point (window-point))
	 (info-node-3
	  (save-excursion
	    (when (re-search-backward "^@node \\([-a-zA-Z ]+\\)" nil t)
	      (match-string-no-properties 1))))
	 (info-node-2
	  (save-excursion
	    (goto-char (point-min))
	    (when (re-search-forward "^@node \\([-a-zA-Z ]+\\)" nil t)
	      (match-string-no-properties 1))))
	 (info-node-1
	  ;; If we can't find an association, `info-other-window' will
	  ;; start at the top node.
	  (car (rassoc
		(file-name-nondirectory
		 (directory-file-name
		  (file-name-directory buffer-file-name)))
		elinfo-names-alist)))
	 (offset 0)
	 regexp default-tag anchor repeat
	 case-fold-search)

    (save-excursion
      ;; Use brute force.
      (while (save-excursion
	       (beginning-of-line)
	       (or (looking-at "[ \t]*\n\\|@anchor{")
		   (and (looking-at "@[a-z]+\\(?: \\|$\\)")
			(not (looking-at "@def\\(un\\|fn Command\\|var\\|macro\\|spec\\|opt\\)")))))
	(forward-line))
      (let ((at (point))
	     (from (progn
		     (beginning-of-line)
		     (skip-chars-forward " \t")
		     (point)))
	     (to (progn
		   (end-of-line)
		   (skip-chars-backward " \t")
		   (point))))

	;; Get out of any reference at BOL, we can't trace it anyway.
	(condition-case nil
	    (and (progn
		   (goto-char from)
		   (up-list -1)
		   (looking-at "{"))
		 (looking-back "xref" (line-beginning-position))
		 (progn
		   (forward-sexp)
		   (setq from (point))
		   (setq at (max at from))))
	  (error nil))

	(goto-char (max at from))
	(when (setq default-tag (elinfo--default-tag))
	  (setq offset (- at (car default-tag)))
	  (setq anchor (cdr default-tag))
	  (save-excursion
	    (goto-char from)
	    (catch 'done
	      (let ((case-fold-search t))
		(while (re-search-forward anchor nil t)
		  (if (= (match-beginning 0) (car default-tag))
		      (throw 'done t)
		    (setq repeat
			  (if repeat (1+ repeat) 2))))))))

	(goto-char from)
	;; Scan line.
	(while (re-search-forward elinfo-texi-regexp to t)
	  (cond
	   ((match-beginning 1))
	   ((match-beginning 2)			; @p?xref
	    (or (and (save-excursion
		       (goto-char (match-end 2))
		       (and (save-match-data
			      ;; A comma within the braces stands for a
			      ;; complex reference.
			      (re-search-backward "," (match-beginning 2) t))
			    (skip-chars-forward " \t\n,")
			    (setq regexp
				  (concat
				   regexp
				   (elinfo--make-regexp-2 from (match-beginning 0))
				   "\\*note[ \t\n]*"
				   (elinfo--make-regexp-2 (point) (match-end 2))))))
		     ;; Leave main loop.
		     (setq from to)
		     (goto-char to))
		(setq regexp
		      (concat
		       regexp (elinfo--make-regexp-2 from (match-beginning 0))
		       "\\*note[ \t\n]*"
		       (elinfo--make-regexp-2 (match-beginning 2) (match-end 2))
		       "::[ \t\n]*"))))
	   ((match-beginning 3)			; @strong or @emph
	    (setq regexp
		  (concat
		   regexp (elinfo--make-regexp-2 from (match-beginning 0))
		   "[*_]" (elinfo--make-regexp-2 (match-beginning 3) (match-end 3))
		   "[*_][ \t\n]*")))
	   ((match-beginning 4)			; Some sort of glyph
	    (setq regexp
		  (concat
		   regexp (elinfo--make-regexp-2 from (match-beginning 0))
		   "\\(?:\\(?:error\\)?[-.!=>|*][-.!=>|*]+\\|\\(?:La\\)?TeX\\|([CR])\\|Euro\\|#\\)[ \t\n]*")))
	   ((match-beginning 5)			; @dfn
	    (setq regexp
		  (concat
		   regexp (elinfo--make-regexp-2 from (match-beginning 0))
		   "\"" (elinfo--make-regexp-2 (match-beginning 5) (match-end 5))
		   "\"")))
	   ((match-beginning 6)			; @...{
	    (setq regexp
		  (concat
		   regexp (elinfo--make-regexp-2 from (match-beginning 0))
		   "‘?")))
	   ((match-beginning 7)			; }
	    (setq regexp
		  (concat
		   regexp (elinfo--make-regexp-2 from (match-beginning 0))
		   "’?")))
	   ((match-beginning 8)			; whitespace
	    (setq regexp
		  (concat
		   regexp (elinfo--make-regexp-2 from (match-beginning 0))
		   "[ \t\n]*")))
	   ((match-beginning 9)		; quotes like ``...''
	    (setq regexp
		  (concat
		   regexp (elinfo--make-regexp-2 from (match-beginning 0))
		   "[‘’\"]+")))
	   )				     ; Future additions go here.
	  (setq from (point)))
	(setq regexp
	      (concat regexp (elinfo--make-regexp-2 from to)))))

    (info-other-window info-node-1)
    (Info-goto-node info-node-2)
    (when info-node-3
      (Info-goto-node info-node-3))

    (let ((case-fold-search t))
      (when regexp
	(with-current-buffer (get-buffer-create "*test*")
	  (delete-region (point-min) (point-max))
	  (insert regexp))
	(let ((at (point)))
	  (cond
	   ;; We could add name after File: below.
	   ((and (re-search-forward (concat "\\(" regexp "\\)\\|^File: ") nil t)
		 (match-beginning 1))
	    (goto-char (match-beginning 1))
	    (save-restriction
	      (widen)
	      (narrow-to-region (match-beginning 1) (match-end 1))
	      (when (and anchor (re-search-forward anchor nil t repeat))
		(goto-char (+ (match-beginning 0) offset)))))
	   (t
	    (goto-char at))))))

    (set-window-point texi-window window-point)
    (elinfo-windows-synch texi-window (get-buffer-window "*info*"))
    (select-window texi-window)			; remove this evtly
    ))

;; Unless people object ...
(define-key Info-mode-map "\C-c\C-g" 'elinfo-goto-texi)
(define-key texinfo-mode-map "\C-c\C-g" 'elinfo-goto-info)
(define-key texinfo-mode-map "\M-o" 'elinfo-goto-info)

;; _____________________________________________________________________________
;;
;;;		   Grabbing Documentation Dtrings
;; _____________________________________________________________________________
;;

(defun elinfo-get-definition ()
  "Add doc string of object at `point' to kill ring.
The doc string is suitable for insertion into Elisp Texinfo
buffers."
  (interactive)
  (save-excursion
    (let ((at (point))
	  limit from to
	  type name arg-list init-value doc open-paren-at)
      (cond
       ((eq major-mode 'emacs-lisp-mode)
	(beginning-of-defun)
	(when (looking-at "(\\(?:\\(def\\(?:un\\|subst\\)\\)\\|\\(defvar\\)\\|\\(defcustom\\)\\|\\(defmacro\\)\\)[ \t]+")
	  (setq type
		(cond
		 ((match-beginning 1) 'function)
		 ((match-beginning 2) 'variable)
		 ((match-beginning 3) 'option)
		 ((match-beginning 4) 'macro)))
	  (goto-char (match-end 0))
	  (setq name (elinfo--get-next))
	  (cond
	   ((memq type '(function command macro))
	    (skip-chars-forward " \t\n(")
	    (while (not (looking-at ")"))
	      (setq arg-list
		    (cons (buffer-substring-no-properties
			   (point)
			   (progn
			     (skip-chars-forward "^ \t\n)")
			     (point)))
			  arg-list))
	      (skip-chars-forward " \t\n"))
	    (setq arg-list (nreverse arg-list)))
	   ((memq type '(variable option))
	    (skip-chars-forward " \t\n")
	    (setq init-value
		  (buffer-substring-no-properties
		   (point)
		   (progn
		     (forward-sexp)
		     (point))))))
	  (skip-chars-forward " \t\n)")
	  ;; We must be before the doc-string now.
	  (setq doc (buffer-substring-no-properties
		     (progn
		       (skip-chars-forward " \t\n")
		       (1+ (point)))
		     (progn
		       (forward-sexp)
		       (1- (point)))))
	  (when (eq type 'function)
	    ;; Check for interactive property.
	    (forward-comment (buffer-size))
	    (when (looking-at "(interactive")
	      (setq type 'command)))))
       ((eq major-mode 'c-mode)
	(beginning-of-defun)
	(cond
	 ((looking-at "void[ \t\n]*syms_of")
	  (setq limit (point))
	  (goto-char at)
	  (when (or (save-excursion
		      (beginning-of-line)
		      (looking-at
		       "[ \t]*DEFVAR_\\(?:LISP\\|BOOL\\|INT\\|PER_BUFFER\\)[ \t]+(\"\\([^\" \t\n]+\\)"))
		    (re-search-backward
		     "DEFVAR_\\(?:LISP\\|BOOL\\|INT\\|PER_BUFFER\\)[ \t]+(\"\\([^\" \t\n]+\\)" limit t))
	    (setq type 'variable)
	    (setq name (match-string-no-properties 1))))
	 ;; The following must be decided.
	 ;; (when (eq type 'variable) (custom-variable-p (intern name)))
	 ;; (setq type 'option))
	 ((looking-at "\\(?:DEFUN\\)[ \t]+(\"\\([^\" \t\n]+\\)")
	  (setq type 'function)
	  (setq name (match-string-no-properties 1))))
	(cond
	 ((eq type 'function)
	  (let ((index 0)
		from to min-args)
	    (re-search-forward ",[ \t]*" nil nil 3)
	    ;; Must be before MIN now.
	    (setq min-args
		  (string-to-number
		   (buffer-substring-no-properties
		    (point)
		    (progn (skip-chars-forward "0-9") (point)))))
	    (re-search-forward ",[ \t\n]*" nil t 2)
	    (unless (looking-at "0")
	      ;; Command.
	      (setq type 'command))
	    (re-search-forward "^[ \t]*doc:[ \]*\\(/\\*[ \t]*\\)" nil t)
	    (setq from (match-end 0))
	    (goto-char (match-beginning 1))
	    (forward-comment 1)
	    (save-excursion
	      (skip-chars-backward "*/ \t")
	      (setq to (point)))
	    (setq doc (buffer-substring-no-properties from to))
	    (unless arg-list
	      (skip-chars-forward ") \t\n(")
	      (unless (looking-at "void")
		(while (not (looking-at "[ \t\n]*)"))
		  (when (looking-at "\\(?:register[ \t]+Lisp_Object[ \t]*\\)\\|\\(?:Lisp_Object[ \t]*\\)")
		    (goto-char (match-end 0)))
		  (skip-chars-forward " \t\n,")
		  (cond
		   ((< index min-args)
		    (setq index (1+ index)))
		   ((= index min-args)
		    (setq arg-list (cons "&optional" arg-list))
		    (setq index (1+ index))))
		  (when (looking-at "Lisp_Object[ \t]*")
		    (goto-char (match-end 0)))
		  (setq arg-list
			(cons (buffer-substring-no-properties
			       (point)
			       (progn
				 (skip-chars-forward "^, \t\n)")
				 (point)))
			      arg-list)))
		(setq arg-list (nreverse arg-list))))))
	 ((eq type 'variable)
	  (re-search-forward "^[ \t]*doc:[ \]*\\(/\\*[ \t]*\\)" nil t)
	  (setq from (match-end 0))
	  (goto-char (match-beginning 1))
	  (forward-comment 1)
	  (save-excursion
	    (skip-chars-backward "*/ \t")
	    (setq to (point)))
	  ;; Remove leading asterisk.
	  (goto-char from)
	  (when (looking-at "\\*")
	    (setq from (1+ from)))
	  (setq doc (buffer-substring-no-properties from to))))))

      (when doc
	(with-current-buffer (get-buffer-create "*Elinfo-Temp*")
	  (delete-region (point-min) (point-max))
	  (insert doc)
	  ;; Handle usage information.
	  (when (memq type '(function command))
	    (when (re-search-backward "^usage:[ \t]*(" from t)
	      (setq from (point))
	      (goto-char (match-end 0))
	      (save-excursion
		(goto-char (match-beginning 0))
		(skip-chars-backward " \t\n")
		(setq to (point)))
	      (skip-chars-forward "^ \t\n")
	      (skip-chars-forward " \t\n")
	      (setq arg-list nil)
	      (while (not (or (looking-at ")") (eobp)))
		(setq arg-list
		      (cons
		       (downcase
			(buffer-substring-no-properties
			 (point)
			 (progn
			   (skip-chars-forward "^ \t\n)")
			   (point))))
		       arg-list))
		(skip-chars-forward " \t\n"))
	      (setq arg-list (nreverse arg-list))
	      (delete-region (point) (point-max))))

	  (when arg-list
	    ;; Handle args within doc.  This case could be merged with
	    ;; the remaining ones but hardly seems worth the effort.
	    (goto-char (point-min))
	    (let ((regexp (mapconcat
			   'regexp-quote
			   (mapcar 'upcase arg-list) "\\|"))
		  (to (make-marker))
		  case-fold-search)
	      (while (re-search-forward regexp nil t)
		(let ((string (downcase (match-string-no-properties 0)))
		      (from (match-beginning 0)))
		  (set-marker to (match-end 0))
		  (catch 'found
		    (dolist (arg arg-list)
		      ;; We assume that all args are downcase.
		      (when (string-equal string arg)
			(replace-match (concat "@var{" string "}") t)
			(throw 'found t))))))
	      (set-marker to nil)))

	  ;; Look for quotes, double-quotes, nil and other funny things.
	  (goto-char (point-min))
	  (let (quoted)
	    (while (re-search-forward "\\(`\\)\\(?:[^ \t\n']+\\)\\('\\)\
\\|\\(?:^\\|[ \t\n(*`]\\)\\(\\(?:[Nn]on-\\)?\\(nil\\)\\|t\\|\\(\\(?:[CM]-\\)+\\(?:[a-zA-Z]+\\|[^ a-zA-Z\t\n]+\\)\\)\
\\|\\(SPC\\|RET\\|LFD\\|TAB\\|BS\\|ESC\\|DEL\\|SHIFT\\|CTRL\\|META\\|F[0-9]+\\)\\)\\(?:$\\|[ \t\n,.;:?!')]\\)\
\\|\\(\\\\?\"\\)\\|\\(?:\\(\\\\\\\\[[{]\\)[^]}]+\\([]}]\\)\\|\\(<[^>]+>\\)\\)\
\\|\\\\\\([([{]\\)\\|\\(\\\\$\\)" nil t)
	      (cond
	       ((match-beginning 1)
		;; `...'
		(replace-match "@code{" nil nil nil 1)
		(replace-match "}" nil nil nil 2))
	       ((match-beginning 3)
		;; `nil', `non-nil' and `t'.
		(cond
		 ((match-beginning 4)
		  (replace-match (concat "@code{nil}") t nil nil 4))
		 ((match-beginning 5)
		  (replace-match (concat "@kbd{" (match-string-no-properties 5) "}")
				 t nil nil 5))
		 ((match-beginning 6)
		  (replace-match (concat "@key{" (match-string-no-properties 6) "}")
				 t nil nil 6))
		 (t
		  (replace-match (concat "@code{" (match-string-no-properties 3) "}")
				 t nil nil 3))))
	       ((match-beginning 7)
		;; \"
		(replace-match (if quoted "''" "``"))
		(setq quoted (not quoted )))
	       ((match-beginning 8)
		;; \\[...], \\{...}
		(replace-match "@code{" nil t nil 8)
		(replace-match "}" nil t nil 9))
	       ((match-beginning 10)
		;; \\<...>
		(replace-match ""))
	       ((match-beginning 11)
		;; An escaped paren (this must follow case 2).
		(replace-match (match-string-no-properties 11)))
	       ((match-beginning 12)
		;; A backslash at EOL.
		(replace-match ""))
	       )))
	  ;; Fill.
	  (let ((fill-column 70))
	    (fill-region (point-min) (point-max)))
	  ;; Handle key-bindings, manual references and URLs, maybe.
	  (setq doc (buffer-substring-no-properties (point-min) (point-max)))))

      (let (at-string arg-list-string)
	(cond
	 ((eq type 'command)
	  (setq at-string (cons "@deffn Command" "@end deffn")))
	 ((eq type 'function)
	  (setq at-string (cons "@defun" "@end defun")))
	 ((eq type 'variable)
	  (setq at-string (cons "@defvar" "@end defvar")))
	 ((eq type 'option)
	  (setq at-string (cons "@defopt" "@end defopt")))
	 ((eq type 'macro)
	  (setq at-string (cons "@defmac" "@end defmac"))))

	(dolist (arg arg-list)
	  (setq arg-list-string (concat arg-list-string " " arg)))

	;; Hardly anyone wants to see this so REMOVE it.
	(with-selected-window (display-buffer (get-buffer-create "*Elinfo-show"))
	  (delete-region (point-min) (point-max))
	  (insert (concat (car at-string) " " name arg-list-string "\n"
			  doc "\n" (cdr at-string) "\n\n")))

	(kill-new (concat (car at-string) " " name arg-list-string "\n"
			  doc "\n" (cdr at-string) "\n\n"))))))

;; TODO: define-mode and define-derived-mode are not handled.

;; TODO: Special forms are written in C and have UNEVALLED set.

(provide 'elinfo)

;; Below this line are monsters.

;; Used for testing only, so REMOVE it.
(defun elinfo-test ()
  (interactive)
  (with-current-buffer (get-buffer-create "*elinfo-test*")
    (delete-region (point-min) (point-max)))
  (let ((old-point (point))
	new-point node split-height-threshold split-width-threshold)
    (while t
      (Info-forward-node nil nil t)
      (forward-line (random 43))
      (setq old-point (point))
      (setq node Info-current-node)
      (elinfo-goto-texi)
      (with-selected-window elinfo-test-texi-window
	(elinfo-goto-info)
	(sit-for 0.1))
      (setq new-point (point))
      (with-current-buffer (get-buffer-create "*elinfo-test*")
	(goto-char (point-max))
	(insert
	 (format "node: %s   old: %s   new: %s   diff: %s \n"
		 node old-point new-point (- old-point new-point))))
      (goto-char old-point))))

^ permalink raw reply	[flat|nested] 36+ messages in thread

end of thread, other threads:[~2023-09-23 11:56 UTC | newest]

Thread overview: 36+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2023-09-04  7:46 bug#65726: 29.1.50; Crash in regexp engine martin rudalics
2023-09-04  8:44 ` Mattias Engdegård
2023-09-04 12:12   ` Eli Zaretskii
2023-09-04 13:18     ` Mattias Engdegård
2023-09-04 13:26       ` Mattias Engdegård
2023-09-04 13:28       ` Eli Zaretskii
2023-09-04 15:47         ` Mattias Engdegård
2023-09-05 12:23           ` Mattias Engdegård
2023-09-05 13:08             ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-09-05 13:50               ` Mattias Engdegård
2023-09-05 15:33                 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-09-06 12:03                   ` Mattias Engdegård
2023-09-09 15:55                     ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-09-09 16:34                       ` Mattias Engdegård
2023-09-14 14:41                         ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-09-15 20:03                           ` Mattias Engdegård
2023-09-15 22:20                             ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-09-16  3:45                           ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-09-16 10:49                             ` Mattias Engdegård
2023-09-16 15:48                               ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-09-18  2:14                                 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-09-18  3:59                                   ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-09-18 12:32                                     ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-09-21 17:23                                       ` Mattias Engdegård
2023-09-21 18:08                                         ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-09-23 11:56                                           ` Mattias Engdegård
2023-09-04 14:32 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-09-04 15:57   ` Eli Zaretskii
2023-09-04 17:12     ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-09-10  7:50       ` Stefan Kangas
2023-09-10  7:55         ` Eli Zaretskii
2023-09-10 23:09           ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-09-11 14:46             ` Stefan Kangas
2023-09-05  7:14   ` martin rudalics
2023-09-11  8:10 ` Mattias Engdegård
2023-09-11 13:41   ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).