;;; acldoc.el --- fix markup in acl2 docstrings ;; Author: Noah Friedman ;; Maintainer: friedman@cli.com ;; Created: 1995-02-15 ;; $Id: acldoc.el,v 1.5 1995/03/22 18:15:51 friedman Exp $ ;;; Commentary: ;;; Code: ;; The following list was obtained by starting acl2 but exiting from the ;; acl2 loop (with `:q'), then evaluating the following: ;; ;; (progn ;; (compile ;; (defun print-topics () ;; (labels ((all-but-pc-package ;; (syms acc) ;; (cond ;; ((null syms) acc) ;; ((or (not (symbolp (car syms))) ;; (equal (symbol-package-name (car syms)) "ACL2-PC")) ;; (all-but-pc-package (cdr syms) acc)) ;; (t (all-but-pc-package (cdr syms) (cons (car syms) acc)))))) ;; (sort (mapcar #'(lambda (s) ;; (string-downcase (symbol-name s))) ;; (all-but-pc-package ;; (strip-cars (global-val 'documentation-alist ;; (w *the-live-state*))) ;; nil)) ;; #'string-lessp)))) ;; (print-topics)) ;; ;; Documented topics from ACL2 Version 1.8 built March 3, 1995 22:50:32. ;(makunbound 'acldoc-topics) (defvar acldoc-topics '("*" "*standard-ci*" "*standard-co*" "*standard-oi*" "*terminal-markup-table*" "+" "-" "/" "/=" "1+" "1-" "<" "<=" "=" ">" ">=" "@" "abs" "accumulated-persistence" "acknowledgements" "acl2-characterp" "acl2-complex-rationalp" "acl2-count" "acl2-customization" "acl2-defaults-table" "acl2-numberp" "acons" "add-macro-alias" "add-to-set-eq" "alistp" "alpha-char-p" "and" "append" "apropos" "aref1" "aref2" "args" "array1p" "array2p" "arrays" "aset1" "aset2" "ash" "assign" "assoc" "assoc-eq" "assoc-equal" "assoc-keyword" "assoc-string-equal" "atom" "atom-listp" "bibliography" "binary-*" "binary-+" "binary-append" "book-contents" "book-example" "book-name" "books" "booleanp" "break-lemma" "break-rewrite" "breaks" "brr" "brr-commands" "brr@" "built-in-clauses" "butlast" "caaaar" "caaadr" "caaar" "caadar" "caaddr" "caadr" "caar" "cadaar" "cadadr" "cadar" "caddar" "cadddr" "caddr" "cadr" "car" "case" "cbd" "cdaaar" "cdaadr" "cdaar" "cdadar" "cdaddr" "cdadr" "cdar" "cddaar" "cddadr" "cddar" "cdddar" "cddddr" "cdddr" "cddr" "cdr" "ceiling" "certificate" "certify-book" "certify-book!" "char" "char-code" "char-downcase" "char-equal" "char-upcase" "char<" "char<=" "char>" "char>=" "character-listp" "characters" "check-sum" "checkpoint-forced-goals" "code-char" "coerce" "command" "command-descriptor" "comp" "compilation" "complex" "complex-rationalp" "compound-recognizer" "compress1" "compress2" "concatenate" "cond" "congruence" "conjugate" "cons" "consp" "copyright" "corollary" "current-package" "current-theory" "declare" "default" "default-defun-mode" "default-print-prompt" "defaxiom" "defchoose" "defcong" "defconst" "defdoc" "defequiv" "defevaluator" "definition" "deflabel" "defmacro" "defpkg" "defrefinement" "defstub" "deftheory" "defthm" "defun" "defun-mode" "defun-mode-caveat" "defun-sk" "defun-sk-example" "defuns" "denominator" "digit-char-p" "digit-to-char" "dimensions" "disable" "disable-forcing" "disabledp" "doc" "doc!" "doc-string" "docs" "documentation" "e0-ord-<" "e0-ordinalp" "eighth" "elim" "embedded-event-form" "enable" "enable-forcing" "encapsulate" "endp" "enter-boot-strap-mode" "eq" "eql" "eqlable-alistp" "eqlable-listp" "eqlablep" "equal" "equivalence" "er-progn" "escape-to-common-lisp" "evenp" "events" "eviscerate-hide-terms" "examples" "executable-counterpart" "executable-counterpart-theory" "exists" "exit-boot-strap-mode" "explode-nonnegative-integer" "expt" "failed-forcing" "failure" "fifth" "file-reading-example" "find-rules-of-rune" "first" "fix" "fix-true-list" "floor" "fms" "fmt" "fmt1" "forall" "force" "forcing-round" "forward-chaining" "fourth" "full-book-name" "function-theory" "generalize" "goal-spec" "good-bye" "ground-zero" "guard" "guard-example" "guard-introduction" "guard-miscellany" "guard-quick-reference" "guards-and-evaluation" "guards-for-specification" "header" "help" "hide" "hints" "history" "i-am-here" "identity" "if" "iff" "ifix" "illegal" "imagpart" "immediate-force-modep" "implies" "improper-consp" "in-package" "in-theory" "include-book" "incompatible" "induction" "inhibit-output-lst" "initialization" "instructions" "int=" "integer-length" "integer-listp" "integerp" "intern" "intern-in-package-of-symbol" "intersection-theories" "intersectp-eq" "intersectp-equal" "invisible-fns-alist" "io" "irrelevant-formals" "keep" "keyword-commands" "keyword-value-listp" "keywordp" "last" "ld" "ld-error-action" "ld-error-triples" "ld-evisc-tuple" "ld-keyword-aliases" "ld-post-eval-print" "ld-pre-eval-filter" "ld-pre-eval-print" "ld-prompt" "ld-query-control-alist" "ld-redefinition-action" "ld-skip-proofsp" "ld-verbose" "lemma-instance" "length" "let" "let*" "linear" "linear-alias" "list" "list*" "listp" "local" "local-incompatibility" "logand" "logandc1" "logandc2" "logbitp" "logcount" "logeqv" "logic" "logical-name" "logior" "lognand" "lognor" "lognot" "logorc1" "logorc2" "logtest" "logxor" "loop-stopper" "lower-case-p" "lp" "macro-aliases-table" "macro-args" "macro-command" "make-character-list" "make-list" "markup" "max" "maximum-length" "member" "member-eq" "member-equal" "meta" "min" "minusp" "miscellaneous" "mod" "monitor" "monitored-runes" "more" "more!" "more-doc" "mutual-recursion" "mutual-recursion-proof-example" "mv" "mv-let" "mv-nth" ;; "name" is omitted for the first pass "nfix" "ninth" "no-duplicatesp" "nonnegative-integer-quotient" "not" "note1" "note2" "note3" "note4" "note5" "note6" "note7" "note8" "nqthm-to-acl2" "nth" "nthcdr" "null" "numerator" "oddp" "ok-if" "oops" "or" "otf-flg" "other" "package-reincarnation-import-restrictions" "pairlis" "pairlis$" "pathname" "pbt" "pc" "pcb" "pcb!" "pcs" "pe" "pe!" "pf" "pl" "plusp" "portcullis" "position" "position-eq" "position-equal" "pprogn" "pr" "pr!" "print-doc-start-column" "progn" "program" "programming" "prompt" "proof-checker" "proof-of-well-foundedness" "proof-tree" "proof-tree-details" "proof-tree-examples" "proofs-co" "proper-consp" "props" "pseudo-termp" "puff" "puff*" "put-assoc-eq" "q" "rassoc" "rational-listp" "rationalp" "realpart" "rebuild" "redef" "redef!" "redefined-names" "redundant-events" "refinement" "release-notes" "rem" "remove" "remove-duplicates" "remove-duplicates-equal" "remove-macro-alias" "reset-ld-specials" "rest" "retrieve" "revappend" "reverse" "rewrite" "rfix" "round" "rule-classes" "rule-names" "rune" "saving-and-restoring" "second" "set-cbd" "set-compile-fns" "set-difference-equal" "set-difference-theories" "set-guard-checking" "set-ignore-ok" "set-inhibit-warnings" "set-invisible-fns-alist" "set-irrelevant-formals-ok" "set-measure-function" "set-verify-guards-eagerness" "set-well-founded-relation" "seventh" "signature" "signum" "simple" "sixth" "skip-proofs" "slow-array-warning" "specious-simplification" "standard-char-listp" "standard-char-p" "standard-co" "standard-oi" "start-proof-tree" "startup" "state" "stop-proof-tree" "string" "string-alistp" "string-append" "string-downcase" "string-equal" "string-listp" "string-upcase" "string<" "string<=" "string>" "string>=" "stringp" "strip-cars" "strip-cdrs" "sublis" "subsetp" "subsetp-equal" "subst" "subversive-inductions" "symbol-<" "symbol-alistp" "symbol-listp" "symbol-name" "symbol-package-name" "symbolp" "syntax" "syntaxp" "table" "take" "tenth" ;; "term" is omitted for the first pass "term-order" "term-table" "the" "theories" "theory" "theory-functions" "theory-invariant" "third" "tidbits" "toggle-pc-macro" "trans" "trans1" "true-list-listp" "true-listp" "truncate" "tutorial" "type-prescription" "type-set" "type-set-inverter" "type-spec" ;; "u" is omitted for the first pass "ubt" "ubt!" "unary--" "unary-/" "uncertified-books" "union-eq" "union-equal" "union-theories" "universal-theory" "unmonitor" "unsave" "update-nth" "upper-case-p" "verify" "verify-guards" "verify-termination" "well-founded-relation" "why-brr" "world" "wormhole" "xargs" "zero-test-idioms" "zerop" "zip" "zp")) ;; These are words in ~c[] that are possibly not actually references to the ;; documented topic. `u', for instance, is sometimes used as a metavariable in ;; some examples. At one time we didn't consider these suspect when prefixed ;; by a colon or quote, but we have decided to play it safe. ;(makunbound 'acldoc-suspect-topics) (defvar acldoc-suspect-topics '("*" "args" "book-name" "default" ;; "doc" ; This used to be suspect, but I don't think it should be ;; "doc-string" ; This used to be suspect, but I don't think it should be "events" "guard" "hints" ;; "name" is totally omitted for the first pass "q" "rune" "table" ;; "term" is totally omitted for the first pass ;; "u" is totally omitted for the first pass )) ;; These are words without markup at all, that are the names of documented ;; topics, but are also used so often with informal meaning, that it's better ;; not to stop and query on them at all. ;; For instance, `and' is a documented topic, but is probably used more ;; often in common english form. ;; Said once more: many of the following are names of Common Lisp functions, ;; and they will be in ~c already if they should be linked. ;(makunbound 'acldoc-topics-common-words) (defvar acldoc-topics-common-words '("/" "=" ">" "1-" "and" "ash" "assign" "case" "ceiling" "complex" "default" "definition" "equal" "examples" "exists" "fix" "if" "iff" "illegal" "implies" "keep" "last" "length" "let" "list" "logic" "member" "mod" "more" "not" "or" "other" "position" "program" "remove" "rest" "retrieve" "rewrite" "round" "simple" "string" "syntax" "take" "the" "theory" "verify" "first" "second" "third" "fourth" "fifth" "sixth" "seventh" "eighth" "ninth" "tenth")) ;; If t, then ask about what to do with suspicious entries. ;(makunbound 'acldoc-suspect-topic-query-p) (defvar acldoc-suspect-topic-query-p t) ;; Function used to ask about what to do. ;; Normally y-or-n-p or yes-or-no-p; one is easier to answer, one is safer ;; since it requires a long answer and a newline. ;; But this variable could just as easily be bound to a function that ;; unreservedly returns t or nil if you have a global preference. ;(makunbound 'acldoc-query-function) ;(defvar acldoc-query-function (function (lambda (&rest ignored) nil))) (defvar acldoc-query-function 'y-or-n-p) ;;; Commands ;;; These are the actual interfaces to this program. (defun acldoc-update-marked () "Fix markup of all references to documented topics presently in ~c[]." (interactive) (acldoc-update-doc-section 'acldoc-update-marked-keywords)) (defun acldoc-update-unmarked () "Search for documented topic words in docstrings and query for markup." (interactive) (acldoc-update-doc-section 'acldoc-update-unmarked-keywords)) ;;; Subroutines (defun acldoc-update-doc-section (fn) (save-restriction (let (;; The first two are builtin emacs magic (case-fold-search t) (parse-sexp-ignore-comments t) ;(region-start (point-min)) ;; Note this moves point. (region-start (progn (forward-char 1) (beginning-of-defun) (point))) (region-end (set-marker (make-marker) (point-max))) top-sexp-begin (top-sexp-end (make-marker)) current-topic) (goto-char region-start) (while (/= (point) (progn (or (acldoc-forward-sexp) (progn (beep) (message "Please resume at top-level of file, %s" "not inside any sexp."))) ;; If this point is the same as point before moving ;; forward one sexp, it means there are no tokens left ;; in the buffer. ;; Note (mk): if there is whitespace after the last sexp, ;; then we may process it twice. But so what. Anyhow, I've ;; replaced forward-sexp above with acldoc-forward-sexp so ;; that we can re-start in the middle of (for example) a ;; mutual recursion form without getting to an error. (point))) ;; forward-sexp moved point to end of current sexp. This point ;; is saved as a marker so that the relevant fact about this ;; position (i.e. that it's the end of the sexp) won't become ;; worthless if text before it is inserted or deleted. (set-marker top-sexp-end (point)) (backward-sexp) (setq top-sexp-begin (point)) (widen) (narrow-to-region top-sexp-begin top-sexp-end) ;; Top level sexp might contain several defuns/deflabels/etc in ;; which doc sections are defined. They may be wrapped inside a ;; mutual-recursion form, for instance. So search for all ;; occurences of docstrings. (goto-char (1+ top-sexp-begin)) (while (re-search-forward "[ \t]\":doc-section " top-sexp-end t) ;; p should be the position of the double quote (let ((p (1+ (match-beginning 0)))) ;; back up until label for current form is found (goto-char p) (while (acldoc-backward-sexp)) ;; Normally to position point exactly on the next sexp, you ;; have to skip past it, then back up. But since we're going ;; to use the reader (which will ignore any leading ;; whitespace) don't bother here. (forward-sexp) (setq current-topic (read (current-buffer))) (and (symbolp current-topic) (setq current-topic (symbol-name current-topic))) (goto-char p) ;; Don't include end and start quotes in the narrowed doc region (let ((doc-beg (1+ (point))) (doc-end (progn (forward-sexp) (1- (point))))) (widen) (narrow-to-region doc-beg doc-end) (goto-char (point-min)) (and (funcall fn current-topic) current-topic (message "Updated %s" current-topic))) (widen) (narrow-to-region top-sexp-begin top-sexp-end) ;; Make sure to skip past doc just processed. (goto-char p) (forward-sexp))) (widen) (narrow-to-region region-start region-end) (goto-char top-sexp-end))))) ;; Find all keywords currently marked in courier font (~c[]) and make them ;; "invisibly linked" as well (~ilc[]). (defun acldoc-update-marked-keywords (&optional current-topic) (let ((case-fold-search t) (data (match-data)) (new-string nil) (start-pos 0) (markup-end-marker (make-marker)) markup-start-pos word word-start-pos (changep nil) (queried-user-p nil)) ;; skip first line in doc, since the documentation frobs dynamically ;; handle that case. (search-forward "\n" nil t) (while (re-search-forward "~c\\[" nil t) (setq markup-start-pos (match-beginning 0)) (setq word-start-pos (match-end 0)) (setq word nil) ;; Find end of marked up word, but skip tilde-quoted chars (goto-char word-start-pos) (while (and (null word) (re-search-forward "[]~]" nil t)) (let ((char (char-after (match-beginning 0)))) (cond ((eq char ?~) (goto-char (1+ (match-end 0)))) (t (set-marker markup-end-marker (1- (point))) (setq word (buffer-substring word-start-pos markup-end-marker)))))) (let ((p nil) (real-word word) (downcase-real-word word)) ;; separate word from prefixed chars like "'" and ":" (cond ((eq (aref word 0) ?') (if (and (> (length word) 1) (eq (aref word 1) ?:)) (setq p 2) (setq p 1))) ((eq (aref word 0) ?:) (setq p 1))) (and p (setq real-word (substring word p))) (setq downcase-real-word (downcase real-word)) ;; No trailing `]' because that is still in the ;; unprocessed part of string. ;; Leave the colon/quotes in ~c[] and put the ;; actual word name in ~ilc, since only that part ;; is name of the linked topic. (cond ((or (and current-topic (string= downcase-real-word current-topic)) (not (member downcase-real-word acldoc-topics))) (setq new-string nil)) ;; ((and (eq real-word word) ;; (member downcase-real-word acldoc-suspect-topics)) ;; (if (and acldoc-suspect-topic-query-p ;; (setq queried-user-p t) ;; (acldoc-query ;; (format "[%s] This use of \"%s\" is suspect; %s" ;; current-topic word "invisibly-link anyway? ") ;; markup-start-pos (1+ markup-end-marker))) ;; ;; We know there can be no prefix character : or ' in word ;; ;; here, because real-word and word are the same string. ;; ;; This is the only time there is any doubt. ;; (setq new-string (concat "~ilc[" word)) ;; (setq new-string nil))) ;; Let's play it safe here and query on, e.g., :guard. ;; Otherwise, we could use the commented-out test above. ((and (member downcase-real-word acldoc-suspect-topics) (not (and acldoc-suspect-topic-query-p (setq queried-user-p t) (acldoc-query (format "[%s]: This use of \"%s\" is suspect; %s" current-topic word "invisibly-link anyway? ") markup-start-pos (1+ markup-end-marker))))) (setq new-string nil)) (p (setq new-string (format "~c[%s]~ilc[%s" (substring word 0 p) (substring word p)))) (t (setq new-string (concat "~ilc[" word))))) (and new-string (progn (goto-char markup-start-pos) (delete-region (point) markup-end-marker) (insert-before-markers new-string) (setq changep t))) (goto-char markup-end-marker)) ;; This makes changes to the screen made by the acldoc-query ;; go away; emacs only does redisplay when waiting for input ;; or during explicit sit-for or sleep-for calls. (and queried-user-p (sit-for 0)) changep)) ;; Search for all unmarked keywords and ask whether to put them in ~il[]. ;; This function probably uses a terrible search algorithm, but it is the ;; most straightforward. ;; ;; Questions: ;; * Should text be matched case-sensitively? Maybe just ignore ;; capitalizations but consider all pure uppercase or lowercase ;; instances? ;; There are times when `let', for example, is used at the beginning of ;; a sentence and is capitalized. Those almost certainly aren't ;; referring to the documented word. ;; * Ignore anything in the suspected-topic list for things normally in ~c[]? ;; (defun acldoc-update-unmarked-keywords (&optional current-topic) (let ((case-fold-search t) (data (match-data)) (word-list acldoc-topics) (match-list nil) (current-topic-length (length current-topic)) (changep nil) (start-point nil) (verbatim-region-list nil)) (message "Searching %s..." current-topic) ;; skip first line in doc, since the documentation frobs dynamically ;; handle that case. (search-forward "\n" nil t) (setq start-point (point)) ;; Use substring to make sure string is modifiable. ;; Making a single string and mutating it results in less string consing. (let ((end-re (substring "~e.\\[\\]" 0)) (beg nil)) (while (re-search-forward "~b[fqv]\\[\\]" nil t) (setq beg (match-beginning 0)) (aset end-re 2 (char-after (+ beg 2))) (re-search-forward end-re) (setq verbatim-region-list (cons (cons beg (match-end 0)) verbatim-region-list)))) (while word-list (goto-char start-point) (cond ((member (car word-list) acldoc-topics-common-words)) (t (while (search-forward (car word-list) nil t) (cond ((acldoc-verbatim-region-p (point) verbatim-region-list) ;; TODO: simply move to end of verbatim region to avoid ;; needless comparisons. ) (t (let* ((beg (match-beginning 0)) (end (match-end 0)) (back1 (- beg 1)) (back2 (- beg 2)) (char1 (char-after back1)) (char2 (char-after back2))) (cond ((eq char1 ?') (setq beg back1)) ((eq char1 ?:) (if (eq char2 ?') (setq beg back2) (setq beg back1)))) (let ((pchar (char-after (- beg 1))) (pchar1 (char-after (- beg 2))) (nchar (char-after end)) (nchar1 (char-after (+ end 1))) ;; Characters around words that are to be treated as ;; whitespace when deciding whether this is a possible ;; topic word, rather than just a substring of another ;; word. ;; Note that in addition to this, words are checked to ;; see if they end in "ed" or "es". ;; 32 is decimal ascii for SPC, 0 is NUL. ;; NUL probably doesn't show up in any docstrings, but it ;; simplifies a conditional in the code that uses ;; char-after, which may return NUL if attempting to find ;; a character before the beginning or after the end of ;; the buffer. (letters '(?d ?s)) (punc '(?! ?, ?. ?: ?\; ?? ?\" ?\( ?\) ?` ?' ?~ ; for "~/" 32 0 ?\f ?\n ?\t nil))) (cond ((acldoc-point-in-markup-p end)) ;; Handle the case that a word ends in `ed' or `es'. ((and (eq nchar ?e) (memq nchar1 '(?d ?s)) (or (memq pchar punc) (and (memq pchar letters) (memq pchar1 punc)))) (and (memq (char-after (+ end 2)) punc) (setq match-list (cons (cons (set-marker (make-marker) beg) (set-marker (make-marker) end)) match-list)))) ((not (or (memq pchar punc) (and (memq pchar letters) (memq pchar1 punc))))) ((not (or (memq nchar punc) (and (memq nchar letters) (memq nchar1 punc))))) ((and (= current-topic-length (- end beg)) ;; above check avoids needless string consing (string= (downcase current-topic) (downcase (buffer-substring beg end))))) (t (setq match-list (cons (cons (set-marker (make-marker) beg) (set-marker (make-marker) end)) match-list))))))))))) (setq word-list (cdr word-list))) (store-match-data data) ;; Put the matches in order by starting position; ;; querying in this order is easier on the user. (setq match-list (sort match-list (function (lambda (a b) (< (car a) (car b)))))) (while match-list (let ((beg (car (car match-list))) (end (cdr (car match-list)))) (goto-char beg) (and (acldoc-query (format "[%s]: make this use of \"%s\" a link? " current-topic (buffer-substring beg end)) beg end) (progn (setq changep t) (goto-char beg) (insert-before-markers "~il[") (goto-char end) (insert-before-markers "]")))) (setq match-list (cdr match-list))) changep)) ;; Random useful subroutines (defun acldoc-verbatim-region-p (point regions) (let ((answer nil)) (while regions (cond ((and (> point (car (car regions))) (< point (cdr (car regions)))) (setq answer t) (setq regions nil)) (t (setq regions (cdr regions))))) answer)) (defun acldoc-point-in-markup-p (&optional point) (or point (setq point (point))) (save-match-data (let ((p (point)) (markup-end-pos nil) (ans nil)) (goto-char point) (cond ((re-search-backward "[^~]?~[a-z]+\\[" nil t) (goto-char (match-end 0)) (while (re-search-forward "[]~]" nil t) (let ((char (char-after (match-beginning 0)))) (cond ((eq char ?~) (goto-char (1+ (match-end 0)))) (t (and (> (match-end 0) point) (setq ans t)) (goto-char (point-max)))))))) (goto-char p) ans))) ;; make portion of buffer in question extra visible, either by highlighting ;; (when possible), or by surrounding the text with "***> <***" and putting ;; blank lines around the target line. ;; ;; When used in a tight loop, it makes sense not to force unecessary ;; redisplay between queries since it will flash the screen annoyingly. ;; The caller should choose the appropriate time to do redisplay, if ever. (defun acldoc-query (prompt &optional reg-beg reg-end) (let ((ans nil) ;; Don't record temporary changes or make undo boundaries (buffer-undo-list nil)) (cond ((and window-system reg-beg reg-end (fboundp 'make-overlay)) (let ((overlay (make-overlay reg-beg reg-end))) (overlay-put overlay 'face 'highlight) (unwind-protect (setq ans (funcall acldoc-query-function prompt)) (overlay-put overlay 'face 'default) (delete-overlay overlay)))) ((and reg-beg reg-end) ;; The overlay arrow isn't quite good enough; it's hard to tell ;; exactly which occurence on the line is in question, and in ;; fact any overlay arrow might obscure the text in question! (let ((p (point)) (bol (progn (beginning-of-line) (point))) (beg-mark (set-marker (make-marker) reg-beg)) (end-mark (set-marker (make-marker) reg-end)) (bol-arr "\n==> ") (beg-arr " ***> ") (end-arr " <*** ") ;; If buffer is not yet modified, disable autosaves and ;; file locking while making temporary modifications to ;; the buffer. Those operations are too slow if they're ;; not needed. ;; "Don't try this at home, kids!" (buffer-auto-save-file-name buffer-auto-save-file-name) (buffer-file-name buffer-file-name) (modp (buffer-modified-p))) (or modp (progn (setq buffer-auto-save-file-name nil) (setq buffer-file-name nil))) (goto-char bol) (insert-before-markers bol-arr) (goto-char beg-mark) (insert-before-markers beg-arr) (goto-char end-mark) (insert-before-markers end-arr) (end-of-line) (insert-before-markers "\n") (set-buffer-modified-p modp) (unwind-protect (setq ans (funcall acldoc-query-function prompt)) (goto-char bol) (delete-char (length bol-arr)) (end-of-line) (delete-char 1) (goto-char p) (delete-region (- beg-mark (length beg-arr)) beg-mark) ;; end-mark was pushed forward past end-arr due to ;; using insert-before-markers. (delete-region (- end-mark (length end-arr)) end-mark) (set-buffer-modified-p modp)))) (t (setq ans (funcall acldoc-query-function prompt)))) ans)) ;; forward-sexp calls scan-sexps, which returns an error if it hits the ;; beginning or end of the sexp. I think that's bogus, but this is life. ;; This version also returns the relative distance moved, or nil. ;; If given a negative arg, searches backward. (defun acldoc-forward-sexp (&optional count) (or count (setq count 1)) (condition-case errlist (- (- (point) (progn (let ((parse-sexp-ignore-comments t)) (forward-sexp count)) (point)))) (error (if (string= (car (cdr errlist)) "Containing expression ends prematurely") nil (error "%s" (car (cdr errlist))))))) (defun acldoc-backward-sexp (&optional count) (or count (setq count 1)) (acldoc-forward-sexp (- count))) (provide 'acldoc) ;; local variables: ;; vc-make-backup-files: t ;; end: ;; acldoc.el ends here