;;; 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 ;; 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 . ;;; 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) ; `' (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 "[,]") nil t)) (elinfo-find-tag-other-window (concat "^@node " tag "[,]") 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))))