aboutsummaryrefslogtreecommitdiffhomepage
path: root/generic
diff options
context:
space:
mode:
authorGravatar David Aspinall <da@inf.ed.ac.uk>2004-08-25 10:44:29 +0000
committerGravatar David Aspinall <da@inf.ed.ac.uk>2004-08-25 10:44:29 +0000
commitf2aa386c21802f3e11281c99d01374db17da1878 (patch)
tree63e93ecd16476de1442896df5ccd06fb2e4e8dc5 /generic
parent484efe820f44f7e8fa103e65bf63a3a5fd138e7e (diff)
Renamed file
Diffstat (limited to 'generic')
-rw-r--r--generic/holes.el927
-rw-r--r--generic/span-extent.el144
-rw-r--r--generic/span-overlay.el391
-rw-r--r--generic/texi-docstring-magic.el400
4 files changed, 0 insertions, 1862 deletions
diff --git a/generic/holes.el b/generic/holes.el
deleted file mode 100644
index 98cbff56..00000000
--- a/generic/holes.el
+++ /dev/null
@@ -1,927 +0,0 @@
-;
-; holes.el - a little piece of elisp to define holes in your buffer
-; Copyright (C) 2001 Pierre Courtieu
-;
-; This file uses spans, an interface for extent (Xemacs) and overlays
-; (emacs), by Healfdene Goguen for the proofgeneral mode.
-;
-; This software is free software; you can redistribute it and/or
-; modify it under the terms of the GNU General Public
-; License version 2, as published by the Free Software Foundation.
-;
-; This software 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 version 2 for more details
-; (enclosed in the file GPL).
-;
-
-
-(require 'span)
-
-
-(defun holes-short-doc ()
- "prints a short doc for holes"
- (interactive)
- (switch-to-buffer-other-window "*doc holes*")
- (insert "
-
-The highlighted characters in your buffer are \"holes\", holes are a
-powerful feature for program editing. You can delete them like usual
-characters. If you don't replace holes by something else (see below),
-they will be saved in the buffer's file as usual characters. See the
-short documentation below to learn how to use holes.
-
- HOLES
-
-
-A hole is a piece of (highlighted) text that may be replaced by
-another part of text later. This feature is useful to build
-complicated expressions by copy pasting several peaces of text from
-different parts of a buffer (or even from different buffers).
-
- USE
-
-At any time only one particular hole, called \"active\", can be
-\"filled\". Holes can be in several buffers but there is always one or
-zero active hole globally. It is highlighted with a different color.
-
-TO DEFINE A HOLE, two methods:
-
- o Select a region with keyboard (ctrl-space) or mouse, then hit
-ctrl-meta-h. If the selected region is empty (i.e. if you just hit
-ctrl+meta+h), then a hole containing '#' is created.
-
- o Select text with mouse while pressing ctrl + meta. If the selected
-region is empty (i.e. if you just click while pressing ctrl+meta),
-then a hole containing '#' is created.
-
-TO ACTIVATE A HOLE, click on it with the button 1 of your mouse. You
-can also hit meta-space, it will activate the first hole following the
-point. The previous active hole will be deactivated.
-
-TO FORGET A HOLE without deleting its text, click on it with the
-button 2 (middle) of your mouse.
-
-TO DESTROY A HOLE and delete its text, click on it with the button 3
-of your mouse.
-
-TO FILL A HOLE with a text selection, first make sure it is active,
-then two methods:
-
- o Select text with keyboard (ctrl-space) or mouse and hit ctrl-meta-y
-
- o Select text with mouse while pressing ctrl + meta + shift. This is
-a generalization of the mouse-track-insert feature (ctrl + select
-text, if you don't know this trick, try it :-)). This method allows to
-fill different holes faster than with the usual copy-paste method.
-
-After replacement the next hole is automatically made active so you
-can fill it immediately by hitting again ctrl-meta-y or ctrl + meta +
-shift + mouse select.
-
-TO JUMP TO THE ACTIVE HOLE, just hit meta-return. You must be in the
-buffer containing the active hole. the point will move to the active
-hole, and the active hole will be destroyed so you can type something
-to put at its place. The following hole is automatically made active,
-so you can hit meta-return again.
-
-It is useful in combination with abbreviations. For example in
-coq-mode \"fix\" is an abbreviation for Fixpoint # (# : #) {struct #} :
-# := #, where each # is a hole. Then hitting meta-return goes from one
-hole to the following and you can fill-in each hole very quickly.
-
- BUGS
-
- o Replacing holes with mouse in fsf emacs works but it seems that one
-more click is needed to really see the replacement
-
- o Don't try to make overlapping holes, it doesn't work. (what would
-it mean anyway?)
-
- o With FSF emacs, cutting or pasting a hole wil not produce new
-holes, and undoing on holes cannot make holes re-appear. With Xemacs
-it will, but if you copy paste the active hole, you will get several
-holes highlighted as the active one (whereas only one of them really
-is), which is annoying.
-
- o Tell me (Pierre.Courtieu@univ-orleans.fr)
-
-")
- (goto-char (point-min))
- (if (string-match "NU Emacs" (emacs-version))
- (view-buffer (current-buffer) (function (lambda (b) (bury-buffer))))
- (view-mode nil (function (lambda (b) (bury-buffer))))
- )
- )
-
-
-
-(cond
- ((string-match "NU Emacs" (emacs-version))
- (transient-mark-mode 1) ; for holes created by a simple click
-;Pierre: should do almost what region-exists-p does in xemacs
- (defmacro hole-region-exists-p nil
- "Returns t if the mark is active, nil otherwise."
- `(not (eq mark-active nil))
- )
- (defmacro hole-get-selection nil "see x-get-selection"
- '(x-get-selection))))
-
-(cond
- ((string-match "XEmacs" (emacs-version))
- (defmacro hole-region-exists-p nil "see region-exists-p"
- '(region-exists-p)
- )
- (defmacro hole-get-selection nil "see get-selection"
- '(get-selection))))
-
-;intialization;;;;;;;;;;;;;;;;;;;;;;;;;
-(setq default-hole (make-detached-span))
-(detach-span default-hole)
-(setq active-hole default-hole)
-;this counter is used to differenciate every hole
-(setq hole-counter 0)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;customizable;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defcustom empty-hole-string "#"
- "string to be inserted for empty hole (don't put an empty string).")
-
-(defcustom empty-hole-regexp "#\\|\\(@{\\)\\([^{}]*\\)\\(}\\)"
- "Regexp denoting a hole in abbrevs. Must match either `empty-hole-string' or a regexp formed by three consecutive groups (i.e. \\\\(...\\\\) ) (other groups must be shy (i.e. \\\\(?:...\\\\))), denoting the exact limits of the hole (the middle group), the opening and closing delimiters of the hole (first and third groups) which will be deleted after abbrev expand. For example: \"#\\|\\(@{\\)\\([^{}]*\\)\\(}\\)\" matches any # or @{text} but in the second case the abbrev expand will be a hole containing text without brackets.")
-
-(defcustom hole-search-limit 1000
- "number of chars to look forward when looking for the next hole, unused for now");unused for the moment
-
-
-; The following is customizable by a command of the form:
-;for dark background
-;(custom-set-faces
-; '(active-hole-face
-; ((((type x) (class color) (background light))
-; (:background "paleVioletRed")))
-; )
-; )
-
-(defface active-hole-face
- '((((class grayscale) (background light)) (:background "dimgrey"))
- (((class grayscale) (background dark)) (:background "LightGray"))
- (((class color) (background dark)) (:background "darkred") (:foreground "white"))
- (((class color) (background light)) (:background "paleVioletRed" (:foreground "black")))
- ;??(t (:background t))
- )
- "Font Lock face used to highlight the active hole."
- )
-
-(defface inactive-hole-face
- '((((class grayscale) (background light)) (:background "lightgrey"))
- (((class grayscale) (background dark)) (:background "Grey"))
- (((class color) (background dark)) (:background "mediumblue") (:foreground "white"))
- (((class color) (background light)) (:background "lightsteelblue" (:foreground "black")))
- ;??(t (:background t))
- )
- "Font Lock face used to highlight the active hole."
- )
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(setq hole-map (make-keymap))
-
-
-
-
-
-
-(defun region-beginning-or-nil ()
- (and (hole-region-exists-p) (region-beginning))
- )
-
-(defun region-end-or-nil ()
- (and (hole-region-exists-p) (region-end))
- )
-
-(defun copy-active-region ()
- (assert (hole-region-exists-p) nil "the region is not active now.")
- (copy-region-as-kill (region-beginning) (region-end))
- (car kill-ring)
- )
-
-(defun is-hole-p (SPAN)
- (span-property SPAN 'hole)
-
- )
-
-(defun hole-start-position (HOLE)
- (assert (is-hole-p HOLE) t "hole-start-position: given span is not a hole")
- (span-start HOLE)
- )
-
-(defun hole-end-position (HOLE)
- (assert (is-hole-p HOLE) t "hole-end-position:given span is not a hole")
- (span-end HOLE)
- )
-
-(defun hole-buffer (HOLE)
- (assert (is-hole-p HOLE) t "hole-buffer: given span is not a hole")
- (span-buffer HOLE)
- )
-
-(defun hole-at (&optional pos)
- "Returns the hole (an span) at pos in current buffer if pos is not
- in a hole raises an error."
-
- (interactive)
- (span-at (or pos (point)) 'hole)
- )
-
-
-(defun active-hole-exist-p ()
-
- "Returns t if the active hole exists and is not empty (ie
- detached). Use this to know if the active hole is set and
- usable (don't use the active-hole-marker variable)."
-
- (not (span-detached-p active-hole))
- )
-
-
-(defun active-hole-start-position ()
- "Returns the position of the start of the active hole
- (see `active-hole-buffer' to get its buffer). Returns an
- error if active hole doesn't exist (the marker is set to
- nothing)."
-
- (assert (active-hole-exist-p) t
- "active-hole-start-position: no active hole")
- (hole-start-position active-hole)
- )
-
-(defun active-hole-end-position ()
- "Returns the position of the start of the active hole
- (see `active-hole-buffer' to get its buffer). Returns an
- error if active hole doesn't exist (the marker is set to
- nothing)."
-
- (assert (active-hole-exist-p) t
- "active-hole-end-position: no active hole")
- (hole-end-position active-hole)
- )
-
-
-(defun active-hole-buffer ()
-
- "Returns the buffer containing the active hole, raise an
- error if the active hole is not set. Don't care if the
- active hole is empty."
-
- (assert (active-hole-exist-p) t
- "active-hole-buffer: no active hole")
- (hole-buffer active-hole)
- )
-
-(defun goto-active-hole ()
-
- "Sets point to active hole and raises an error if
- active-hole is not set"
-
- (interactive)
- (assert (active-hole-exist-p) t
- "goto-active-hole: no active hole")
- (goto-char (active-hole-start-position)) ; (active-hole-buffer)
- )
-
-
-(defun highlight-hole-as-active (HOLE)
- "Highlights a hole with the `active-hole-face'. DON'T USE
- this as it would break synchronization (non active hole
- highlighted)."
-
- (assert (is-hole-p HOLE) t
- "highlight-hole-as-active: given span is not a hole")
- (set-span-face HOLE 'active-hole-face)
- )
-
-(defun highlight-hole (HOLE)
- "Highlights a hole with the not active face. DON'T USE
- this as it would break synchronization (active hole non
- highlighted)."
-
- (assert (is-hole-p HOLE) t
- "highlight-hole: given span is not a hole %S" HOLE)
- (set-span-face HOLE 'inactive-hole-face)
- )
-
-
-(defun disable-active-hole ()
- "Disable the active hole, the goal remains but is not the
- active one anymore. Does nothing if the active hole is
- already disable."
-
- (if (not (active-hole-exist-p))
- ()
- ; HACK: normal hole color, this way undo will show this
- ; hole normally and not as active hole. Ideally, undo
- ; should restore the active hole, but it doesn't, so
- ; we put the 'not active' color
- (highlight-hole active-hole)
- (setq active-hole default-hole)
- )
- )
-
-
-
-(defun set-active-hole (HOLE)
-
- "Sets active hole to HOLE. Error if HOle is not a hole."
-
- (assert (is-hole-p HOLE) t
- "set-active-hole: given span is not a hole")
- (if (active-hole-exist-p) (highlight-hole active-hole))
- (setq active-hole HOLE)
- (highlight-hole-as-active active-hole)
- )
-
-
-(defun is-in-hole-p (&optional pos)
-
- "Returns t if pos (default: point) is in a hole, nil
- otherwise."
-
- (not (eq (hole-at pos) nil))
- )
-
-
-
-(defun make-hole (start end)
- "Makes and returns an (span) hole from start to end."
- (let ((ext (make-span start end)))
- (set-span-properties
- ext `(
- hole ,hole-counter
- mouse-face highlight
- priority 100 ; what should I put here? I want holes to have big priority
- face secondary-selection
- start-open nil
- end-open t
- duplicable t
-; unique t
- detachable t ;really disappear if empty; doesn't work with gnu emacs
-; pointer frame-icon-glyph
- help-echo "this is a \"hole\", button 2 to forget, button 3 to destroy, button 1 to make active"
- 'balloon-help "this is a \"hole\", button 2 to forget, button 3 to destroy, button 1 to make active"
- ))
-
- (set-span-keymap ext hole-map)
- (setq hole-counter (+ hole-counter 1))
- ext
- )
- )
-
-(defun make-hole-at (&optional start end)
-
- "makes a hole from start to end, if no arg default hole after point,
- if only one arg: error. Returns the span"
- (interactive)
-
- (let* ((rstart (or start (region-beginning-or-nil) (point)))
- (rend (or end (region-end-or-nil) (point))))
- (if (eq rstart rend)
- (progn
- (insert-string empty-hole-string)
- (setq rend (point))
- )
- )
- (make-hole rstart rend)
- )
- )
-
-
-(defun clear-hole (HOLE)
- (assert (is-hole-p HOLE) t
- "clear-hole: given span is not a hole")
-
- (if (and (active-hole-exist-p) (eq active-hole HOLE))
- (disable-active-hole)
- )
- (delete-span HOLE)
- )
-
-(defun clear-hole-at (&optional pos)
- "Clears hole at pos (default=point)."
- (interactive)
- (if (not (is-in-hole-p (or pos (point))))
- (error "clear-hole-at: no hole here"))
- (clear-hole (hole-at (or pos (point))))
- )
-
-
-(defun map-holes (FUNCTION &optional OBJECT FROM TO)
- (fold-spans FUNCTION OBJECT FROM TO nil nil 'hole)
- )
-
-
-
-(defun mapcar-holes (FUNCTION &optional FROM TO PROP)
- (mapcar-spans FUNCTION FROM TO 'hole)
- )
-
-(defun clear-all-buffer-holes (&optional start end)
-
- "clears all holes leaving their contents"
-
- (interactive)
- (disable-active-hole)
- (mapcar-holes 'clear-hole (or start (point-min)) (or end (point-max)) 'hole)
- )
-
-
-
-; limit ?
-(defun next-hole (pos BUFFER)
-
- "returns the first hole after pos (or after the hole at pos if there
- is one) (default pos= point), if no hole found, returns nil. limit
- is unused for now."
-
- (map-holes '(lambda (h x) (and (is-hole-p h) h)) BUFFER pos)
- )
-
-(defun next-after-active-hole ()
- (assert (active-hole-exist-p) t
- "next-active-hole: no active hole")
- (next-hole (active-hole-end-position)
- (active-hole-buffer))
- )
-
-(defun set-active-hole-next (&optional BUFFER pos)
-
- "sets the active hole to the first hole after pos
- (default pos=point), in BUFFER."
-
- (interactive)
- (let ((nxthole (next-hole (or pos (point))
- (or BUFFER (current-buffer)))))
- (if nxthole
- (progn
- (set-active-hole nxthole)
- )
- (disable-active-hole)
- )
- )
- )
-
-(defun set-active-hole-next-after-active ()
- "sets the active hole to the first hole after active
- hole."
-
- (interactive)
- (next-after-active-hole)
-)
-
-
-
-
-(defun replace-segment (start end str &optional BUFFER)
-
- "Erase chars between start and end, and insert str at its
- place, shifting markers."
-
- (interactive)
- (save-excursion
- (set-buffer (or BUFFER (current-buffer)))
- (delete-region start end)
- (goto-char start)
- (insert-string str)
- )
- )
-
-
-
-(defun replace-hole (str &optional thehole)
-
- "Replace the hole (default = the active hole) by str (str was
- optionnal but not anymore), do not use this, it breaks the right
- colorization of the active goal(FIXME?). Use `replace-active-hole'
- instead. "
-
- (if (and (not thehole)
- (not (active-hole-exist-p)))
- (error "no hole to fill")
- ; defensive: replacing the hole should make it
- ; detached and therefore inexistent
- ; other reason: this a hack: unhighlight so
- ; that undo wont show it highlighted)
- (if (and (active-hole-exist-p)
- thehole
- (eq active-hole thehole))
- (disable-active-hole)
- )
- (let ((exthole (or thehole active-hole)))
- (replace-segment (hole-start-position exthole)
- (hole-end-position exthole)
- (or str (car kill-ring)) ;kill ring?
- (span-buffer exthole)
- )
- (detach-span exthole) ; this seems necessary for span overlays,
- ; where the buffer attached to the span is not removed
- ; automatically by the fact that the span is removed from
- ; the buffer (replace-segment should perhaps take care of
- ; that)
- )
- )
- )
-
-(defun replace-active-hole (&optional str)
- "Replace the active hole by str, if no str is given, then put the selection instead."
- (if (not (active-hole-exist-p)) ()
- (replace-hole
- (or str (hole-get-selection) (error "nothing to put in hole"))
- active-hole)
- ))
-
-
-(defun replace-update-active-hole (&optional str)
-
- "replace active-hole by str like replace-active-hole,
- but then sets active-hole to the following hole if it
- exists."
-
- (interactive)
- (assert (active-hole-exist-p) t
- "replace-update-active-hole: no active hole")
- (if (not (active-hole-exist-p))
- ()
- (let ((nxthole (next-after-active-hole)))
- (replace-active-hole
- (or str
- (and (hole-region-exists-p) (copy-active-region))
- (hole-get-selection) (error "nothing to put in hole")))
- (if nxthole (set-active-hole nxthole)
- (setq active-hole default-hole))
- )
- )
- )
-
-
-(defun delete-update-active-hole ()
-
- "deletes active-hole and supresses its content and sets
- active-hole to the next hole if it exists"
-
- (interactive)
- (replace-update-active-hole "")
- )
-
-(defun set-make-active-hole (&optional start end)
- (interactive)
- (set-active-hole (make-hole-at start end))
- )
-
-;;; mouse stuff, I want to make something close to mouse-track-insert
-;;; of xemacs, but with modifier ctrl-meta and ctrl-meta-shift
-
-;; emacs and xemacs have different ways of dealing with mouse
-;; selection, but mouse-track(xemacs) mouse-drag-region(fsf emacs)
-;; have nearly the same meaning for me. So I define this
-;; track-mouse-selection.
-(eval-and-compile
- (cond
- ((fboundp 'mouse-track)
- (defsubst track-mouse-selection (event)
- "see `mouse-track'"
- (mouse-track event)))
- ((fboundp 'mouse-drag-region)
- (defsubst track-mouse-selection (event)
- "see `mouse-drag-region'"
- (mouse-drag-region event)))
- (t
- (error
- "Your (X)Emacs version is not compatible with holes (too old or
- new version?), sorry."))
- )
- )
-
-;; number of clicks for emacs and xemacs
-(eval-and-compile
- (cond
- ((fboundp 'mouse-track)
- (defsubst track-mouse-clicks ()
- "see `mouse-track-click-count'"
- mouse-track-click-count))
- ((fboundp 'mouse-drag-region)
- (defsubst track-mouse-clicks ()
- "see `mouse-selection-click-count'"
- (+ mouse-selection-click-count 1)))
- (t
- (error
- "Your (X)Emacs version is not compatible with holes (too old or
- new version?), sorry."))
- )
- )
-
-(defun mouse-replace-active-hole (event)
- (interactive "*e")
- (track-mouse-selection event)
- (save-excursion
- ;;HACK: nothing if one click (but a second is perhaps coming)
- (if (and (eq (track-mouse-clicks) 1)
- (not (hole-region-exists-p)))
- ()
- (if (not (hole-region-exists-p))
- (error "nothing to put in hole")
- (replace-update-active-hole (hole-get-selection))
- (message "hole replaced")
- )
- )
- )
-; (zmacs-deactivate-region)
- )
-
-(defun destroy-hole (&optional SPAN)
- (interactive)
- (let* ((sp (or SPAN (hole-at (point)) (error "no hole to destroy"))))
- (save-excursion
- (if (and (active-hole-exist-p)
- (eq sp active-hole))
- (disable-active-hole))
- (replace-hole "" sp)
- (detach-span sp)
- )
- (message "hole killed")
- )
- )
-
-
-(defun hole-at-event (event) (span-at-event event 'hole))
-
-(defun mouse-destroy-hole (event)
- (interactive "*e")
- (destroy-hole (hole-at-event event))
- )
-
-
-;(span-at-event EVENT &optional PROPERTY BEFORE AT-FLAG)
-;;comprend pas??
-(defun mouse-forget-hole (event)
- (interactive "*e")
- (save-excursion
- (let ((ext (hole-at-event event)))
- (if (eq ext active-hole)
- (disable-active-hole))
- (detach-span ext)
- )
- )
- (message "hole deleted")
- )
-
-
-
-(defun mouse-set-make-active-hole (event)
- (interactive "*e")
- ;(set-mark (point))
- (track-mouse-selection event)
-
- (if (and (eq (track-mouse-clicks) 1)
- (not (hole-region-exists-p)))
- (set-make-active-hole (point) (point))
-
- (if (hole-region-exists-p)
- (set-make-active-hole)
- (let ((ext (hole-at-event event)))
- (if (and ext (is-hole-p ext))
- (error "Already a hole here")
- (set-active-hole (make-hole-at)))
- )
- )
- )
- )
-
-(defun mouse-set-active-hole (event)
- (interactive "*e")
- (let ((ext (hole-at-event event)))
- (if (and ext (is-hole-p ext))
- (set-active-hole ext)
- (error "No hole here"))
- )
- )
-
-
-(defun set-point-next-hole-destroy ()
- (interactive)
- (assert (active-hole-exist-p) nil "no active hole")
- (assert (eq (current-buffer) (active-hole-buffer)) nil
- "active hole not in this buffer")
- (goto-active-hole)
- (delete-update-active-hole)
- )
-
-
-;;;;;;;;;Customizable key bindings;;;;;;;;;;
-
-
-
-
-;;this for both, these are global keybindings because holes.el is
-;;actually a mini mode that can be used in any mode.
-
-(cond
- ((string-match "NU Emacs" (emacs-version))
- ; the mouse binding specific to the keymap of an overlay does not
- ; work for fsf emacs < 21
- (define-key hole-map [(mouse-1)] 'mouse-set-active-hole)
- (define-key hole-map [(mouse-3)] 'mouse-destroy-hole)
- (define-key hole-map [(mouse-2)] 'mouse-forget-hole)
- ; this shortcut was for mark-sexp
- (global-set-key [(control meta ? ) ] 'set-active-hole-next)
- )
-
- ((string-match "XEmacs" (emacs-version))
- ;don't know how to make these three work for fsf emacs
- (define-key hole-map [(button1)] 'mouse-set-active-hole)
- (define-key hole-map [(button3)] 'mouse-destroy-hole)
- (define-key hole-map [(button2)] 'mouse-forget-hole)
- ; this shortcut was for mark-sexp
- (global-set-key [(control meta space)] 'set-active-hole-next)
- ))
-
- (global-set-key [(control meta y)] 'replace-update-active-hole)
- ; this shortcut was for mark-defun
- (global-set-key [(control meta h)] 'set-make-active-hole)
- (global-set-key [(control meta down-mouse-1)] 'mouse-set-make-active-hole)
- (global-set-key [(control meta shift down-mouse-1)]
- 'mouse-replace-active-hole)
- (global-set-key [(meta return)] 'set-point-next-hole-destroy)
-
-;;;;;;;;;;; End Customizable key bindings ;;;;;
-
-;;; utilities to be used in conjunction with abbrevs.
-;;; The idea is to put abbrevs of the form:
-;(define-abbrev-table 'tuareg-mode-abbrev-table
-; '(
-; ("l" "let # = # in" replace-#-after-abbrev2 0)
-; )
-; )
-; where replace-#-after-abbrev2 should be a function which replace the
-; two #'s (two occurences going backward from abbrev expantion point)
-; by holes and leave point at the first # (deleting
-; it). set-point-next-hole-destroy allow to go to the next hole.
-
-;following function allow to replace occurrences of a string by a
-;hole.
-
-;c must be a string of length 1
-(defun count-char-in-string (c str)
- (let ((cpt 0) (s str))
- (while (not (string-equal s ""))
- (if (string-equal (substring s 0 1) c) (setq cpt (+ cpt 1)))
- (setq s (substring s 1))
- )
- cpt
- )
- )
-
-(defun count-re-in-string (regexp str)
- (let ((cpt 0) (s str))
- (while (and (not (string-equal s "")) (string-match regexp s) )
- (setq cpt (+ cpt 1))
- (setq s (substring s (match-end 0)))
- )
- cpt
- )
- )
-
-(defun count-chars-in-last-expand ()
- (length (abbrev-expansion last-abbrev-text))
- )
-
-(defun count-newlines-in-last-expand ()
- (count-char-in-string "\n" (abbrev-expansion last-abbrev-text))
- )
-
-(defun indent-last-expand ()
- "Indents last abbrev expansion. Must be called when the point is at
-end of last abbrev expansion. "
- (let ((n (count-newlines-in-last-expand)))
- (save-excursion
- (previous-line n)
- (while (>= n 0)
- (funcall indent-line-function)
- (next-line 1)
- (setq n (- n 1))
- )
- )
- )
- )
-
-(defun count-holes-in-last-expand ()
- (count-re-in-string empty-hole-regexp (abbrev-expansion last-abbrev-text))
- )
-
-(defun replace-string-by-holes (start end str)
-
- "make occurrence of str holes between start and end. sets the
-active hole to the last created hole and unsets it if no hole is
-created"
-
- (interactive)
- (disable-active-hole)
- (let ((lgth (length str)))
- (save-excursion
- (goto-char end)
- (while (search-backward str start t)
- (make-hole (point) (+ (point) lgth))
- (set-active-hole-next)
- )
- )
- )
- )
-
-(defun replace-string-by-holes-backward (num regexp)
-
- "make num occurrences of str be holes looking backward. sets the
-active hole to the last created hole and unsets it if no hole is
-created. return t if num is > 0, nil otherwise."
-
- (interactive)
- (disable-active-hole)
- (if (<= num 0) nil
- (let* ((n num) (lgth 0))
- (save-excursion
- (while (> n 0)
- (progn
- (re-search-backward regexp)
- (if (string-equal (match-string 0) empty-hole-string)
- (make-hole (match-beginning 0) (match-end 0))
- (make-hole (match-beginning 2) (match-end 2))
- (goto-char (match-beginning 3))
- (delete-char (length (match-string 3)))
- (goto-char (match-beginning 1))
- (delete-char (length (match-string 1))))
- (set-active-hole-next)
- (setq n (- n 1)))
- )
- )
- t
- )
- )
- )
-
-
-(defun replace-string-by-holes-move-point (start end str)
-
- (interactive)
- (replace-string-by-holes start end str)
- (set-point-next-hole-destroy)
- )
-
-(defun replace-string-by-holes-backward-move-point (num str)
-
- (interactive)
- (and (replace-string-by-holes-backward num str)
- t ;(set-point-next-hole-destroy)
- )
- )
-
-
-
-(defun holes-abbrev-complete ()
- "Complete abbrev by putting holes and indenting. Moves point at beginning of expanded text."
- (let ((pos last-abbrev-location))
- (indent-last-expand)
- (replace-string-by-holes-backward-move-point
- (count-holes-in-last-expand) empty-hole-regexp)
- (if (> (count-holes-in-last-expand) 1)
- (progn (goto-char pos)
- (message "Hit M-ret to jump to active hole. M-x holes-short-doc to see holes doc."))
-
- (if (= (count-holes-in-last-expand) 0) () ; no hole, stay here.
- (goto-char pos)
- (set-point-next-hole-destroy) ; if only one hole, go to it.
- )
- )
- )
- )
-
-; insert the expansion of abbrev s, and replace #s by holes. It was
-; possible to implement it with a simple ((insert s) (expand-abbrev))
-; but undo would show the 2 steps, which is bad.
-
-(defun insert-and-expand (s)
- (let* ((pos (point))
- (exp (abbrev-expansion s))
- (c (count-re-in-string empty-hole-regexp exp)))
- (insert exp)
- (replace-string-by-holes-backward-move-point c empty-hole-regexp)
- (if (> c 1) (goto-char pos)
- (goto-char pos)
- (set-point-next-hole-destroy) ; if only one hole, go to it.
- )
- (if (> c 1) (message "Hit M-ret to jump to active hole. M-x holes-short-doc to see holes doc.")
- )
- )
- )
-
-(provide 'holes)
-
diff --git a/generic/span-extent.el b/generic/span-extent.el
deleted file mode 100644
index 8bd37441..00000000
--- a/generic/span-extent.el
+++ /dev/null
@@ -1,144 +0,0 @@
-;; This file implements spans in terms of extents, for xemacs.
-;;
-;; Copyright (C) 1998 LFCS Edinburgh
-;; Author: Healfdene Goguen
-;; Maintainer: David Aspinall <David.Aspinall@ed.ac.uk>
-;; License: GPL (GNU GENERAL PUBLIC LICENSE)
-;;
-;; $Id$
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Bridging the emacs19/xemacs gulf ;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Now define "spans" in terms of extents.
-
-(defsubst make-span (start end)
- "Make a span for the range [START, END) in current buffer."
- (make-extent start end))
-
-(defsubst detach-span (span)
- "Remove SPAN from its buffer."
- (detach-extent span))
-
-(defsubst set-span-endpoints (span start end)
- "Set the endpoints of SPAN to START, END."
- (set-extent-endpoints span start end))
-
-(defsubst set-span-property (span name value)
- "Set SPAN's property NAME to VALUE."
- (set-extent-property span name value))
-
-(defsubst span-read-only (span)
- "Set SPAN to be read only."
- (set-span-property span 'read-only t))
-
-(defsubst span-read-write (span)
- "Set SPAN to be writeable."
- (set-span-property span 'read-only nil))
-
-(defun span-give-warning ()
- "Give a warning message."
- (message "You should not edit here!"))
-
-(defun span-write-warning (span)
- "Give a warning message when SPAN is changed."
- ;; FIXME: implement this in XEmacs, perhaps with after-change-functions
- (set-span-property span 'read-only nil))
-
-(defsubst span-property (span name)
- "Return SPAN's value for property PROPERTY."
- (extent-property span name))
-
-(defsubst delete-span (span)
- "Delete SPAN."
- (let ((predelfn (span-property span 'span-delete-action)))
- (and predelfn (funcall predelfn)))
- (delete-extent span))
-
-(defsubst mapcar-spans (fn start end prop &optional val)
- "Apply function FN to all spans between START and END with property PROP set"
- (mapcar-extents fn nil (current-buffer) start end nil prop val))
-
-(defsubst span-at (pt prop)
- "Return the smallest SPAN at point PT with property PROP."
- (extent-at pt nil prop))
-
-(defsubst span-at-before (pt prop)
- "Return the smallest SPAN at before PT with property PROP.
-A span is before PT if it covers the character before PT."
- (extent-at pt nil prop nil 'before))
-
-(defsubst span-start (span)
- "Return the start position of SPAN, or nil if SPAN is detatched."
- (extent-start-position span))
-
-(defsubst span-end (span)
- "Return the end position of SPAN, or nil if SPAN is detatched."
- (extent-end-position span))
-
-(defsubst prev-span (span prop)
- "Return span before SPAN with property PROP."
- (extent-at (extent-start-position span) nil prop nil 'before))
-
-(defsubst next-span (span prop)
- "Return span after SPAN with property PROP."
- (extent-at (extent-end-position span) nil prop nil 'after))
-
-(defsubst span-live-p (span)
- "Return non-nil if SPAN is live and in a live buffer."
- (and span
- (extent-live-p span)
- (buffer-live-p (extent-object span))
- ;; PG 3.4: add third test here to see not detached.
- (not (extent-detached-p span))))
-
-(defun span-raise (span)
- "Function added for FSF Emacs compatibility. Do nothing here."
- nil)
-
-(defalias 'span-object 'extent-object)
-(defalias 'span-string 'extent-string)
-
-;Pierre: new utility functions for "holes"
-(defsubst make-detached-span ()
- "Return the buffer owning span."
- (make-extent nil nil)
- )
-
-
-(defsubst span-buffer (span)
- "Return the buffer owning span."
- (extent-object span)
- )
-
-(defsubst span-detached-p (span)
- "is this span detached? nil for no, t for yes"
- (extent-detached-p span)
-)
-
-(defsubst set-span-face (span face)
- "set the face of a span"
- (set-extent-face span face)
-)
-
-(defsubst fold-spans (FUNCTION &optional OBJECT FROM TO MAPARG FLAGS PROPERTY VALUE)
- "map on span, see map-extent on xemacs"
- (map-extents FUNCTION OBJECT FROM TO MAPARG FLAGS PROPERTY VALUE)
-)
-
-(defsubst set-span-properties (span plist)
- "see extent-properties"
- (set-extent-properties span plist)
-)
-
-(defsubst set-span-keymap (span kmap)
- (set-extent-keymap span kmap)
- )
-
-;there are more args to extent-at-event
-(defsubst span-at-event (event &optional prop)
- (extent-at-event event prop)
- )
-
-(provide 'span-extent)
diff --git a/generic/span-overlay.el b/generic/span-overlay.el
deleted file mode 100644
index 5c047bed..00000000
--- a/generic/span-overlay.el
+++ /dev/null
@@ -1,391 +0,0 @@
-;; This file implements spans in terms of extents, for emacs19.
-;;
-;; Copyright (C) 1998 LFCS Edinburgh
-;; Author: Healfdene Goguen
-;; Maintainer: David Aspinall <David.Aspinall@ed.ac.uk>
-;; License: GPL (GNU GENERAL PUBLIC LICENSE)
-;;
-;; $Id$
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Bridging the emacs19/xemacs gulf ;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; before-list represents a linked list of spans for each buffer.
-;; It has the invariants of:
-;; * being ordered wrt the starting point of the spans in the list,
-;; with detached spans at the end.
-;; * not having overlapping overlays of the same type.
-
-(defvar before-list nil
- "Start of backwards-linked list of spans")
-
-(make-variable-buffer-local 'before-list)
-
-
-(or (fboundp 'foldr)
-(defun foldr (func a seq)
- "Return (func (func (func (... (func a Sn) ...) S2) S1) S0)
-when func's argument is 2 and seq is a sequence whose
-elements = S0 S1 S2 ... Sn. [tl-seq.el]"
- (let ((i (length seq)))
- (while (> i 0)
- (setq i (1- i))
- (setq a (funcall func a (elt seq i)))
- )
- a)))
-
-(or (fboundp 'foldl)
-(defun foldl (func a seq)
- "Return (... (func (func (func a S0) S1) S2) ...)
-when func's argument is 2 and seq is a sequence whose
-elements = S0 S1 S2 .... [tl-seq.el]"
- (let ((len (length seq))
- (i 0))
- (while (< i len)
- (setq a (funcall func a (elt seq i)))
- (setq i (1+ i))
- )
- a)))
-
-(defsubst span-start (span)
- "Return the start position of SPAN."
- (overlay-start span))
-
-(defsubst span-end (span)
- "Return the end position of SPAN."
- (overlay-end span))
-
-(defun set-span-property (span name value)
- "Set SPAN's property NAME to VALUE."
- (overlay-put span name value))
-
-(defsubst span-property (span name)
- "Return SPAN's value for property PROPERTY."
- (overlay-get span name))
-
-(defun span-read-only-hook (overlay after start end &optional len)
- (unless inhibit-read-only
- (error "Region is read-only")))
-
-(defun span-read-only (span)
- "Set SPAN to be read only."
- ;; This function may be called on spans which are detached from a
- ;; buffer, which gives an error here, since text-properties are
- ;; associated with text in a particular buffer position. So we use
- ;; our own read only hook.
- ;(add-text-properties (span-start span) (span-end span) '(read-only t)))
- ;; 30.8.02: tested using overlay-put as below with Emacs 21.2.1,
- ;; bit this seems to have no effect when the overlay is added to
- ;; the buffer. (Maybe read-only is only a text property, not an
- ;; overlay property?).
- ;; (overlay-put span 'read-only t))
- (set-span-property span 'modification-hooks '(span-read-only-hook))
- (set-span-property span 'insert-in-front-hooks '(span-read-only-hook)))
-
-(defun span-read-write (span)
- "Set SPAN to be writeable."
- ;; See comment above for text properties problem.
- (set-span-property span 'modification-hooks nil)
- (set-span-property span 'insert-in-front-hooks nil))
-
-(defun span-give-warning (&rest args)
- "Give a warning message."
- (message "You should not edit here!"))
-
-(defun span-write-warning (span)
- "Give a warning message when SPAN is changed."
- (set-span-property span 'modification-hooks '(span-give-warning))
- (set-span-property span 'insert-in-front-hooks '(span-give-warning)))
-
-(defun int-nil-lt (m n)
- (cond
- ((eq m n) nil)
- ((not n) t)
- ((not m) nil)
- (t (< m n))))
-
-;; We use end first because proof-locked-queue is often changed, and
-;; its starting point is always 1
-(defun span-lt (s u)
- (or (int-nil-lt (span-end s) (span-end u))
- (and (eq (span-end s) (span-end u))
- (int-nil-lt (span-start s) (span-start u)))))
-
-(defun span-traverse (span prop)
- (cond
- ((not before-list)
- ;; before-list empty
- 'empty)
- ((funcall prop before-list span)
- ;; property holds for before-list and span
- 'hd)
- (t
- ;; traverse before-list for property
- (let ((l before-list) (before (span-property before-list 'before)))
- (while (and before (not (funcall prop before span)))
- (setq l before)
- (setq before (span-property before 'before)))
- l))))
-
-(defun add-span (span)
- (let ((ans (span-traverse span 'span-lt)))
- (cond
- ((eq ans 'empty)
- (set-span-property span 'before nil)
- (setq before-list span))
- ((eq ans 'hd)
- (set-span-property span 'before before-list)
- (setq before-list span))
- (t
- (set-span-property span 'before
- (span-property ans 'before))
- (set-span-property ans 'before span)))))
-
-(defun make-span (start end)
- "Make a span for the range [START, END) in current buffer."
- (add-span (make-overlay start end)))
-
-(defun remove-span (span)
- (let ((ans (span-traverse span 'eq)))
- (cond
- ((eq ans 'empty)
- (error "Bug: empty span list"))
- ((eq ans 'hd)
- (setq before-list (span-property before-list 'before)))
- (ans
- (set-span-property ans 'before (span-property span 'before)))
- (t (error "Bug: span does not occur in span list")))))
-
-;; extent-at gives "smallest" extent at pos
-;; we're assuming right now that spans don't overlap
-(defun spans-at-point (pt)
- (let ((overlays nil) (os nil))
- (setq os (overlays-at pt))
- (while os
- (if (not (memq (car os) overlays))
- (setq overlays (cons (car os) overlays)))
- (setq os (cdr os)))
- ;; NB: 6.4 (PG 3.4) da: added this next reverse
- ;; since somewhere order is being confused;
- ;; PBP is selecting _largest_ region rather than
- ;; smallest!?
- (if overlays (nreverse overlays))))
-
-;; assumes that there are no repetitions in l or m
-(defun append-unique (l m)
- (foldl (lambda (n a) (if (memq a m) n (cons a n))) m l))
-
-(defun spans-at-region (start end)
- (let ((overlays nil) (pos start))
- (while (< pos end)
- (setq overlays (append-unique (spans-at-point pos) overlays))
- (setq pos (next-overlay-change pos)))
- overlays))
-
-(defun spans-at-point-prop (pt prop)
- (let ((f (cond
- (prop (lambda (spans span)
- (if (span-property span prop) (cons span spans)
- spans)))
- (t (lambda (spans span) (cons span spans))))))
- (foldl f nil (spans-at-point pt))))
-
-(defun spans-at-region-prop (start end prop &optional val)
- (let ((f (cond
- (prop
- (lambda (spans span)
- (if (if val (eq (span-property span prop) val)
- (span-property span prop))
- (cons span spans)
- spans)))
- (t
- (lambda (spans span) (cons span spans))))))
- (foldl f nil (spans-at-region start end))))
-
-(defun span-at (pt prop)
- "Return the SPAN at point PT with property PROP.
-For XEmacs, span-at gives smallest extent at pos.
-For Emacs, we assume that spans don't overlap."
- (car (spans-at-point-prop pt prop)))
-
-(defsubst detach-span (span)
- "Remove SPAN from its buffer."
- (remove-span span)
- (delete-overlay span)
- (add-span span))
-
-(defsubst delete-span (span)
- "Delete SPAN."
- (let ((predelfn (span-property span 'span-delete-action)))
- (and predelfn (funcall predelfn)))
- (remove-span span)
- (delete-overlay span))
-
-;; The next two change ordering of list of spans:
-(defsubst set-span-endpoints (span start end)
- "Set the endpoints of SPAN to START, END.
-Re-attaches SPAN if it was removed from the buffer."
- (remove-span span)
- (move-overlay span start end)
- (add-span span))
-
-(defsubst mapcar-spans (fn start end prop &optional val)
- "Apply function FN to all spans between START and END with property PROP set"
- (mapcar fn (spans-at-region-prop start end prop (or val nil))))
-
-(defun map-spans-aux (f l)
- (cond (l (cons (funcall f l) (map-spans-aux f (span-property l 'before))))
- (t ())))
-
-(defsubst map-spans (f)
- (map-spans-aux f before-list))
-
-(defun find-span-aux (prop-p l)
- (while (and l (not (funcall prop-p l)))
- (setq l (span-property l 'before)))
- l)
-
-(defun find-span (prop-p)
- (find-span-aux prop-p before-list))
-
-(defun span-at-before (pt prop)
- "Return the smallest SPAN at before PT with property PROP.
-A span is before PT if it covers the character before PT."
- (let ((prop-pt-p
- (cond (prop (lambda (span)
- (let ((start (span-start span)))
- (and start (> pt start)
- (span-property span prop)))))
- (t (lambda (span)
- (let ((start (span-start span)))
- (and start (> pt start))))))))
- (find-span prop-pt-p)))
-
-(defun prev-span (span prop)
- "Return span before SPAN with property PROP."
- (let ((prev-prop-p
- (cond (prop (lambda (span) (span-property span prop)))
- (t (lambda (span) t)))))
- (find-span-aux prev-prop-p (span-property span 'before))))
-
-; overlays are [start, end)
-
-(defun next-span (span prop)
- "Return span after SPAN with property PROP."
- ;; 3.4 fix here: Now we do a proper search, so this should work with
- ;; nested overlays, after a fashion. Use overlays-in to get a list
- ;; for the entire buffer, this avoids repeatedly checking the same
- ;; overlays in an ever expanding list (see v6.1). (However, this
- ;; list may be huge: is it a bottleneck?)
- ;; [Why has this function never used the before-list ?]
- (let* ((start (overlay-start span))
- ;; (pos start)
- (nextos (overlays-in
- (1+ start)
- (point-max)))
- (resstart (1+ (point-max)))
- spanres)
- ;; overlays are returned in an unspecified order; we
- ;; must search whole list for a closest-next one.
- (dolist (newres nextos spanres)
- (if (and (span-property newres prop)
- (< start (span-start newres))
- (< (span-start newres) resstart))
- (progn
- (setq spanres newres)
- (setq resstart (span-start spanres)))))))
-
-(defsubst span-live-p (span)
- "Return non-nil if SPAN is in a live buffer."
- (and span
- (overlay-buffer span)
- (buffer-live-p (overlay-buffer span))))
-
-(defun span-raise (span)
- "Set priority of span to make it appear above other spans.
-FIXME: new hack added nov 99 because of disappearing overlays.
-Behaviour is still worse than before."
- (set-span-property span 'priority 100))
-
-(defalias 'span-object 'overlay-buffer)
-
-(defun span-string (span)
- (with-current-buffer (overlay-buffer span)
- (buffer-substring (overlay-start span) (overlay-end span))))
-
-
-;Pierre: new utility functions for "holes"
-(defun set-span-properties (span plist)
- "Set SPAN's properties, plist is a plist."
- (let ((pl plist))
- (while pl
- (let* ((name (car pl))
- (value (car (cdr pl))))
- (overlay-put span name value)
- (setq pl (cdr (cdr pl))))
- )
- )
- )
-
-(defun span-find-span (overlay-list &optional prop)
- "Returns the first overlay of overlay-list having property prop (default 'span), nil if no such overlay belong to the list."
- (let* ((l overlay-list))
- (while (and
- (not (eq l nil))
- (not (overlay-get (car l) (or prop 'span))))
- (setq l (cdr l)))
- (if (eq l nil) nil (car l))
- )
- )
-
-(defsubst span-at-event (event &optional prop)
- (span-find-span (overlays-at (posn-point (event-start event))) prop)
- )
-
-
-(defun make-detached-span ()
- "Make a span for the range [START, END) in current buffer."
- (add-span (make-overlay 0 0))
- )
-
-;hack
-(defun fold-spans-aux (f l &optional FROM MAPARGS)
- (cond ((and l
- (or (span-detached-p l)
- (>= (span-start l) (or FROM (point-min)))))
- (cons (funcall f l MAPARGS)
- (fold-spans-aux f (span-property l 'before) FROM MAPARGS)))
- (t ())))
-
-(defun fold-spans (f &optional BUFFER FROM TO DUMMY1 DUMMY2 DUMMY3 DUMMY4)
- (save-excursion
- (set-buffer (or BUFFER (current-buffer)))
- (car (or (last (fold-spans-aux f before-list FROM))))
- )
- )
-
-(defsubst span-buffer (span)
- "Return the buffer owning span"
- (overlay-buffer span)
- )
-
-(defsubst span-detached-p (span)
- "is this span detached? nil for no, t for yes"
- ;(or
- (eq (span-buffer span) nil)
- ; this should not be necessary
- ;(= (span-start span) (span-end span)))
- )
-
-(defsubst set-span-face (span face)
- "set the face of a span"
- (overlay-put span 'face face)
- )
-
-(defsubst set-span-keymap (span kmap)
- "set the face of a span"
- (overlay-put span 'keymap kmap)
- )
-
-(provide 'span-overlay)
diff --git a/generic/texi-docstring-magic.el b/generic/texi-docstring-magic.el
deleted file mode 100644
index 7e491e5e..00000000
--- a/generic/texi-docstring-magic.el
+++ /dev/null
@@ -1,400 +0,0 @@
-;; texi-docstring-magic.el -- munge internal docstrings into texi
-;;
-;; Keywords: lisp, docs, tex
-;; Author: David Aspinall <David.Aspinall@ed.ac.uk>
-;; Copyright (C) 1998 David Aspinall
-;; License: GPL (GNU GENERAL PUBLIC LICENSE)
-;;
-;; $Id$
-;;
-;; This file is distributed under the terms of the GNU General Public
-;; License, Version 2. Find a copy of the GPL with your version of
-;; GNU Emacs or Texinfo.
-;;
-;;
-;; This package generates Texinfo source fragments from Emacs
-;; docstrings. This avoids documenting functions and variables in
-;; more than one place, and automatically adds Texinfo markup to
-;; docstrings.
-;;
-;; It relies heavily on you following the Elisp documentation
-;; conventions to produce sensible output, check the Elisp manual
-;; for details. In brief:
-;;
-;; * The first line of a docstring should be a complete sentence.
-;; * Arguments to functions should be written in upper case: ARG1..ARGN
-;; * User options (variables users may want to set) should have docstrings
-;; beginning with an asterisk.
-;;
-;; Usage:
-;;
-;; Write comments of the form:
-;;
-;; @c TEXI DOCSTRING MAGIC: my-package-function-or-variable-name
-;;
-;; In your texi source, mypackage.texi. From within an Emacs session
-;; where my-package is loaded, visit mypackage.texi and run
-;; M-x texi-docstring-magic to update all of the documentation strings.
-;;
-;; This will insert @defopt, @deffn and the like underneath the
-;; magic comment strings.
-;;
-;; The default value for user options will be printed.
-;;
-;; Symbols are recognized if they are defined for faces, functions,
-;; or variables (in that order).
-;;
-;; Automatic markup rules:
-;;
-;; 1. Indented lines are gathered into a @lisp environment.
-;; 2. Pieces of text `stuff' or surrounded in quotes marked up with @samp.
-;; 3. Words *emphasized* are made @strong{emphasized}
-;; 4. Words sym-bol which are symbols become @code{sym-bol}.
-;; 5. Upper cased words ARG corresponding to arguments become @var{arg}.
-;; In fact, you can use any word longer than three letters, so that
-;; metavariables can be used easily.
-;; FIXME: to escape this, use `ARG'
-;; 6. Words 'sym which are lisp-quoted are marked with @code{'sym}.
-;;
-;; -----
-;;
-;; Useful key binding when writing Texinfo:
-;;
-;; (define-key TeXinfo-mode-map "C-cC-d" 'texi-docstring-magic-insert-magic)
-;;
-;; -----
-;;
-;; Useful enhancements to do:
-;;
-;; * Tweak replacement: at the moment it skips blank lines
-;; under magic comment.
-;; * Use customize properties (e.g. group, simple types)
-;; * Look for a "texi-docstring" property for symbols
-;; so TeXInfo can be defined directly in case automatic markup
-;; goes badly wrong.
-;; * Add tags to special comments so that user can specify face,
-;; function, or variable binding for a symbol in case more than
-;; one binding exists.
-;;
-;; ------
-;;
-;; Thanks to: Christoph Conrad for an Emacs compatibility fix.
-;;
-;;
-
-(defun texi-docstring-magic-find-face (face)
- ;; Compatibility between FSF Emacs and XEmacs
- (or (facep face)
- (and (fboundp 'find-face) (find-face face))))
-
-(defun texi-docstring-magic-splice-sep (strings sep)
- "Return concatenation of STRINGS spliced together with separator SEP."
- (let (str)
- (while strings
- (setq str (concat str (car strings)))
- (if (cdr strings)
- (setq str (concat str sep)))
- (setq strings (cdr strings)))
- str))
-
-(defconst texi-docstring-magic-munge-table
- '(;; 0. Escape @, { and } characters
- ("\\(@\\)" t "@@")
- ("\\({\\)" t "@{")
- ("\\(}\\)" t "@}")
- ;; 1. Indented lines are gathered into @lisp environment.
- ("\\(^.*\\S-.*$\\)"
- t
- (let
- ((line (match-string 0 docstring)))
- (if (eq (char-syntax (string-to-char line)) ?\ )
- ;; whitespace
- (if in-quoted-region
- line
- (setq in-quoted-region t)
- (concat "@lisp\n" line))
- ;; non-white space
- (if in-quoted-region
- (progn
- (setq in-quoted-region nil)
- (concat "@end lisp\n" line))
- line))))
- ;; 2. Pieces of text `stuff' or surrounded in quotes
- ;; are marked up with @samp. NB: Must be backquote
- ;; followed by forward quote for this to work.
- ;; Can't use two forward quotes else problems with
- ;; symbols.
- ;; Odd hack: because ' is a word constituent in text/texinfo
- ;; mode, putting this first enables the recognition of args
- ;; and symbols put inside quotes.
- ("\\(`\\([^']+\\)'\\)"
- t
- (concat "@samp{" (match-string 2 docstring) "}"))
- ;; 3. Words *emphasized* are made @strong{emphasized}
- ("\\(\\*\\(\\w+\\)\\*\\)"
- t
- (concat "@strong{" (match-string 2 docstring) "}"))
- ;; 4. Words sym-bol which are symbols become @code{sym-bol}.
- ;; Must have at least one hyphen to be recognized,
- ;; terminated in whitespace, end of line, or punctuation.
- ;; Only consider symbols made from word constituents
- ;; and hyphen.
- ("\\(\\(\\w+\\-\\(\\w\\|\\-\\)+\\)\\)\\(\\s\)\\|\\s-\\|\\s.\\|$\\)"
- (or (boundp (intern (match-string 2 docstring)))
- (fboundp (intern (match-string 2 docstring))))
- (concat "@code{" (match-string 2 docstring) "}"
- (match-string 4 docstring)))
- ;; 5. Upper cased words ARG corresponding to arguments become
- ;; @var{arg}
- ;; In fact, include any word so long as it is more than 3 characters
- ;; long. (Comes after symbols to avoid recognizing the
- ;; lowercased form of an argument as a symbol)
- ;; FIXME: maybe we don't want to downcase stuff already
- ;; inside @samp
- ;; FIXME: should - terminate? should _ be included?
- ("\\([A-Z0-9_\\-]+\\)\\(/\\|\)\\|}\\|\\s-\\|\\s.\\|$\\)"
- (or (> (length (match-string 1 docstring)) 3)
- (member (downcase (match-string 1 docstring)) args))
- (concat "@var{" (downcase (match-string 1 docstring)) "}"
- (match-string 2 docstring)))
-
- ;; 6. Words 'sym which are lisp quoted are
- ;; marked with @code.
- ("\\(\\(\\s-\\|^\\)'\\(\\(\\w\\|\\-\\)+\\)\\)\\(\\s\)\\|\\s-\\|\\s.\\|$\\)"
- t
- (concat (match-string 2 docstring)
- "@code{'" (match-string 3 docstring) "}"
- (match-string 5 docstring)))
- ;; 7,8. Clean up for @lisp environments left with spurious newlines
- ;; after 1.
- ("\\(\\(^\\s-*$\\)\n@lisp\\)" t "@lisp")
- ("\\(\\(^\\s-*$\\)\n@end lisp\\)" t "@end lisp")
- ;; 9. Hack to remove @samp{@var{...}} sequences.
- ;; Changed to just @samp of uppercase.
- ("\\(@samp{@var{\\([^}]+\\)}}\\)"
- t
- (concat "@samp{" (upcase (match-string 2 docstring)) "}")))
- "Table of regexp matches and replacements used to markup docstrings.
-Format of table is a list of elements of the form
- (regexp predicate replacement-form)
-If regexp matches and predicate holds, then replacement-form is
-evaluated to get the replacement for the match.
-predicate and replacement-form can use variables arg,
-and forms such as (match-string 1 docstring)
-Match string 1 is assumed to determine the
-length of the matched item, hence where parsing restarts from.
-The replacement must cover the whole match (match string 0),
-including any whitespace included to delimit matches.")
-
-
-(defun texi-docstring-magic-untabify (string)
- "Convert tabs in STRING into multiple spaces."
- (save-excursion
- (set-buffer
- (get-buffer-create " texi-docstring-magic-untabify"))
- (insert string)
- (untabify (point-min) (point-max))
- (prog1 (buffer-string)
- (kill-buffer (current-buffer)))))
-
-(defun texi-docstring-magic-munge-docstring (docstring args)
- "Markup DOCSTRING for texi according to regexp matches."
- (let ((case-fold-search nil))
- (setq docstring (texi-docstring-magic-untabify docstring))
- (dolist (test texi-docstring-magic-munge-table)
- (let ((regexp (nth 0 test))
- (predicate (nth 1 test))
- (replace (nth 2 test))
- (i 0)
- in-quoted-region)
-
- (while (and
- (< i (length docstring))
- (string-match regexp docstring i))
- (setq i (match-end 1))
- (if (eval predicate)
- (let* ((origlength (- (match-end 0) (match-beginning 0)))
- (replacement (eval replace))
- (newlength (length replacement)))
- (setq docstring
- (replace-match replacement t t docstring))
- (setq i (+ i (- newlength origlength))))))
- (if in-quoted-region
- (setq docstring (concat docstring "\n@end lisp"))))))
- ;; Force a new line after (what should be) the first sentence,
- ;; if not already a new paragraph.
- (let*
- ((pos (string-match "\n" docstring))
- (needscr (and pos
- (not (string= "\n"
- (substring docstring
- (1+ pos)
- (+ pos 2)))))))
- (if (and pos needscr)
- (concat (substring docstring 0 pos)
- "@*\n"
- (substring docstring (1+ pos)))
- docstring)))
-
-(defun texi-docstring-magic-texi (env grp name docstring args &optional endtext)
- "Make a texi def environment ENV for entity NAME with DOCSTRING."
- (concat "@def" env (if grp (concat " " grp) "") " " name
- " "
- (texi-docstring-magic-splice-sep args " ")
- ;; " "
- ;; (texi-docstring-magic-splice-sep extras " ")
- "\n"
- (texi-docstring-magic-munge-docstring docstring args)
- "\n"
- (or endtext "")
- "@end def" env "\n"))
-
-(defun texi-docstring-magic-format-default (default)
- "Make a default value string for the value DEFAULT.
-Markup as @code{stuff} or @lisp stuff @end lisp."
- ;; NB: might be nice to use a 'default-value-description
- ;; property here, in case the default value is computed.
- (let ((text (format "%S" default)))
- (concat
- "\nThe default value is "
- (if (string-match "\n" text)
- ;; Carriage return will break @code, use @lisp
- (if (stringp default)
- (concat "the string: \n@lisp\n" default "\n@end lisp\n")
- (concat "the value: \n@lisp\n" text "\n@end lisp\n"))
- (concat "@code{" text "}.\n")))))
-
-
-(defun texi-docstring-magic-texi-for (symbol &optional noerror)
- (cond
- ;; Faces
- ((texi-docstring-magic-find-face symbol)
- (let*
- ((face symbol)
- (name (symbol-name face))
- (docstring (or (face-doc-string face)
- "Not documented."))
- (useropt (eq ?* (string-to-char docstring))))
- ;; Chop off user option setting
- (if useropt
- (setq docstring (substring docstring 1)))
- (texi-docstring-magic-texi "fn" "Face" name docstring nil)))
- ((boundp symbol)
- ;; Variables.
- (let*
- ((variable symbol)
- (name (symbol-name variable))
- (docstring (or (documentation-property variable
- 'variable-documentation)
- "Not documented."))
- (useropt (eq ?* (string-to-char docstring)))
- (default (if useropt
- (texi-docstring-magic-format-default
- (default-value symbol)))))
- ;; Chop off user option setting
- (if useropt
- (setq docstring (substring docstring 1)))
- (texi-docstring-magic-texi
- (if useropt "opt" "var") nil name docstring nil default)))
- ((fboundp symbol)
- ;; Functions. Functions with same name as variables are documented
- ;; as variables.
- ;; We don't handle macros, aliases, or compiled fns properly.
- (let*
- ((function symbol)
- (name (symbol-name function))
- (docstring (or (documentation function)
- "Not documented."))
- (def (symbol-function function))
- (macrop (eq 'macro (car-safe def)))
- (argsyms (cond ((eq (car-safe def) 'lambda)
- (nth 1 def))))
- (args (mapcar 'symbol-name argsyms)))
- (cond
- ((commandp function)
- (texi-docstring-magic-texi "fn" "Command" name docstring args))
- (macrop
- (texi-docstring-magic-texi "fn" "Macro" name docstring args))
- (t
- (texi-docstring-magic-texi "un" nil name docstring args)))))
- (noerror
- (message "Warning: symbol `%s' not defined" (symbol-name symbol))
- "")
- (t
- (error "Don't know anything about symbol %s" (symbol-name symbol)))))
-
-(defconst texi-docstring-magic-comment
- "@c TEXI DOCSTRING MAGIC:"
- "Magic string in a texi buffer expanded into @defopt, or @deffn.")
-
-
-;;;###autoload
-(defun texi-docstring-magic (&optional noerror)
- "Update all texi docstring magic annotations in buffer.
-With prefix arg, no errors on unknown symbols. (This results in
-@def .. @end being deleted if not known)."
- (interactive "P")
- (save-excursion
- (goto-char (point-min))
- (let ((magic (concat "^"
- (regexp-quote texi-docstring-magic-comment)
- "\\s-*\\(\\(\\w\\|\\-\\)+\\)[ \t]*$"))
- p
- symbol
- deleted)
- (while (re-search-forward magic nil t)
- (setq symbol (intern (match-string 1)))
- (forward-line)
- (setq p (point))
- ;; delete any whitespace following magic comment
- (skip-chars-forward " \n\t")
- (delete-region p (point))
- ;; If comment already followed by an environment, delete it.
- (if (and
- (looking-at "@def\\(\\w+\\)\\s-")
- (search-forward (concat "@end def" (match-string 1)) nil t))
- (progn
- (forward-line)
- (delete-region p (point))
- (setq deleted t)))
- (insert
- (texi-docstring-magic-texi-for symbol noerror))
- (unless deleted
- ;; Follow newly inserted @def with a single blank.
- (insert "\n"))))))
-
-(defun texi-docstring-magic-face-at-point ()
- (ignore-errors
- (let ((stab (syntax-table)))
- (unwind-protect
- (save-excursion
- (set-syntax-table emacs-lisp-mode-syntax-table)
- (or (not (zerop (skip-syntax-backward "_w")))
- (eq (char-syntax (char-after (point))) ?w)
- (eq (char-syntax (char-after (point))) ?_)
- (forward-sexp -1))
- (skip-chars-forward "'")
- (let ((obj (read (current-buffer))))
- (and (symbolp obj) (texi-docstring-magic-find-face obj) obj)))
- (set-syntax-table stab)))))
-
-(defun texi-docstring-magic-insert-magic (symbol)
- (interactive
- (let* ((v (or (variable-at-point)
- (function-at-point)
- (texi-docstring-magic-face-at-point)))
- (val (let ((enable-recursive-minibuffers t))
- (completing-read
- (if v
- (format "Magic docstring for symbol (default %s): " v)
- "Magic docstring for symbol: ")
- obarray '(lambda (sym)
- (or (boundp sym)
- (fboundp sym)
- (texi-docstring-magic-find-face sym)))
- t nil 'variable-history))))
- (list (if (equal val "") v (intern val)))))
- (insert "\n" texi-docstring-magic-comment " " (symbol-name symbol)))
-
-
-(provide 'texi-docstring-magic)