procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Initial revision

Browse source
This commit is contained in:
Richard M. Stallman 1994-05-02 05:16:59 +00:00
parent 7ce486180b
commit 813f532d2f
6 changed files with 4599 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3076
lisp/ediff.el Normal file
View file

File diff suppressed because it is too large Load diff

366
lisp/ielm.el Normal file
View file

@ -0,0 +1,366 @@
;;; ielm.el --- interaction mode for Emacs Lisp
;; Copyright (C) 1994 Free Software Foundation, Inc.
;; Author: David Smith <maa036@lancaster.ac.uk>
;; Created: 25 Feb 1994
;; Keywords: lisp
;; This file is part of GNU Emacs.
;; GNU Emacs 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 2, or (at your option)
;; any later version.
;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary:
;; Provides a nice interface to evaluating Emacs-Lisp expressions.
;; Input is handled by the comint package, and output is passed
;; through the pretty-printer.
;; To install: copy this file to a directory in your load-path, and
;; add the line
;;
;; (autoload 'ielm "ielm" "Start an inferior emacs-lisp session" t)
;;
;; For completion to work, the comint.el from FSF Emacs 19.23 is
;; required. If you do not have it, or if you are running Lemacs,
;; also add the following code to your .emacs:
;;
;; (setq ielm-mode-hook
;; '(lambda nil
;; (define-key ielm-map "\t"
;; '(lambda nil (interactive) (or (ielm-tab)
;; (lisp-complete-symbol))))))
;; To start: M-x ielm. Type C-h m in the *ielm* buffer for more info.
;; The latest version is available by WWW from
;; http://mathssun5.lancs.ac.uk:2080/~maa036/elisp/dir.html
;; or by anonymous FTP from
;; /anonymous@wingra.stat.wisc.edu:pub/src/emacs-lisp/ielm.el.gz
;; or from the author: David M. Smith <maa036@lancaster.ac.uk>
;;; Code:
(require 'comint)
(require 'pp)
;;; User variables
(defvar ielm-noisy t
"*If non-nil, beep on error")
(defvar ielm-prompt "ELISP> ")
(defvar ielm-dynamic-return t
"*If non-nil, RET either evaluates input or inserts a newline,
depending on context")
(defvar ielm-mode-hook nil
"*Hooks to be run when the inferior-emacs-lisp-mode is started")
;;; System variables
(defvar ielm-working-buffer nil
"Buffer, if any, to use in ielm. Usually buffer-local")
(defvar ielm-header
(concat
"*** Welcome to IELM mode version "
(substring "$Revision: 1.15 $" 11 -2)
" *** Type (describe-mode) for help.\n"
"IELM has ABSOLUTELY NO WARRANTY; type (describe-no-warranty) for details\n"))
(defvar ielm-map nil)
(if ielm-map nil
(if (string-match "Lucid" emacs-version)
;; Lemacs
(progn
(setq ielm-map (make-sparse-keymap))
(set-keymap-parent ielm-map comint-mode-map))
;; FSF
(setq ielm-map (cons 'keymap comint-mode-map)))
(define-key ielm-map "\t" 'comint-dynamic-complete)
(define-key ielm-map "\C-m" 'ielm-return)
(define-key ielm-map "\C-j" 'ielm-send-input))
;;; Completion stuff
(defun ielm-tab nil
"Possibly indent the current line as lisp code"
(interactive)
(if (or (eq (preceding-char) ?\n)
(eq (char-syntax (preceding-char)) ? ))
(progn
(ielm-indent-line)
t)))
(defun ielm-complete-symbol nil
"Just like lisp-complete-symbol"
;; except that it returns non-nil if completion has occurred
(let* ((btick (buffer-modified-tick))
(cbuffer (get-buffer " *Completions*"))
(ctick (and cbuffer (buffer-modified-tick cbuffer))))
(lisp-complete-symbol)
;; completion has occurred if:
(or
;; the buffer has been modified
(not (= btick (buffer-modified-tick)))
;; a completions buffer has been modifed or created
(if cbuffer
(not (= ctick (buffer-modified-tick cbuffer)))
(get-buffer " *Completions*")))))
(defun ielm-complete-filename nil
;; Completes filenames if in a string
(if (nth 3 (parse-partial-sexp comint-last-input-start (point)))
(comint-dynamic-complete-filename)))
(defun ielm-indent-line nil
"Indent the current line as lisp code if it is not a prompt line"
(if (save-excursion
(beginning-of-line)
(looking-at comint-prompt-regexp)) nil
(lisp-indent-line)))
;;; Other bindings
(defun ielm-return nil
"Evaluate the sexp at the prompt if it is complete, otherwise newline
and indent. If ielm-dynamic-return is nil, just insert a newline."
(interactive)
(if ielm-dynamic-return
(let ((state
(save-excursion
(end-of-line)
(parse-partial-sexp (ielm-pm)
(point)))))
(if (and (< (car state) 1) (not (nth 3 state)))
(ielm-send-input)
(newline-and-indent)))
(newline)))
(defun ielm-input-sender (proc input)
(setq ielm-input input))
(defun ielm-send-input nil
"Evaluate the Emacs Lisp expression after the prompt"
(interactive)
(let ((buf (current-buffer))
ielm-input) ; set by ielm-input-sender
(comint-send-input) ; update history, markers etc.
(ielm-eval-input ielm-input)))
;;; Utility functions
(defun ielm-is-whitespace (string)
"Return non-nil if STRING is all whitespace"
(or (string= string "") (string-match "\\`[ \t\n]+\\'" string)))
(defun ielm-format-errors (errlist)
(let ((result ""))
(while errlist
(setq result (concat result (prin1-to-string (car errlist)) ", "))
(setq errlist (cdr errlist)))
(substring result 0 -2)))
(defun ielm-format-error (err)
"Return a string form of the error ERR"
(format "%s%s"
(or (get (car err) 'error-message) "Peculiar error")
(if (cdr err)
(format ": %s" (ielm-format-errors (cdr err)))
"")))
;;; Evaluation
(defun ielm-eval-input (string)
"Evaluate the lisp expression STRING, and pretty-print the result"
;; This is the function that actually `sends' the input to the
;; `inferior lisp process'. All comint-send-input does is works out
;; what that input is. What this function does is evaluates that
;; input and produces `output' which gets inserted into the buffer,
;; along with a new prompt. A better way of doing this might have
;; been to actually send the output to the `cat' process, and write
;; this as in output filter that converted sexps in the output
;; stream to their evaluated value. But that would have involved
;; more process coordination than I was happy to deal with.
(let (form ; form to evaluate
pos ; End posn of parse in string
result ; Result, or error message
error-type ; string, nil if no error
(output "") ; result to display
(wbuf ielm-working-buffer) ; current buffer after evaluation
(pmark (ielm-pm)))
(if (not (ielm-is-whitespace string))
(progn
(condition-case err
(let (rout)
(setq rout (read-from-string string))
(setq form (car rout))
(setq pos (cdr rout)))
(error (setq result (ielm-format-error err))
(setq error-type "Read error")))
(if error-type nil
(if (ielm-is-whitespace (substring string pos))
;; need this awful let convolution to work around
;; an Emacs bug involving local vbls and let binding
(let ((:save :)
(::save ::)
(:::save :::))
(save-excursion
(set-buffer ielm-working-buffer)
(condition-case err
(let ((: :save)
(:: ::save)
(::: :::save))
(save-excursion
(setq result (eval form))
(setq wbuf (current-buffer))))
(error (setq result (ielm-format-error err))
(setq error-type "Eval error"))
(quit (setq result "Quit during evaluation")
(setq error-type "Eval error")))))
(setq error-type "IELM error")
(setq result "More than one sexp in input")))
;; If the eval changed the current buffer, mention it here
(if (eq wbuf ielm-working-buffer) nil
(message "current buffer is now: %s" wbuf)
(setq ielm-working-buffer wbuf))
(goto-char pmark)
(if (not error-type)
(condition-case err
;; Self-referential objects cause loops in the printer, so
;; trap quits here. May as well do errors, too
(setq output (concat output (pp-to-string result)))
(error (setq error-type "IELM Error")
(setq result "Error during pretty-printing (bug in pp)"))
(quit (setq error-type "IELM Error")
(setq result "Quit during pretty-printing"))))
(if error-type
(progn
(if ielm-noisy (ding))
(setq output (concat output "*** " error-type " *** "))
(setq output (concat output result)))
;; There was no error, so shift the ::: values
(setq ::: ::)
(setq :: :)
(setq : result))
(setq output (concat output "\n"))))
(setq output (concat output ielm-prompt))
(comint-output-filter (ielm-process) output)))
;;; Process and marker utilities
(defun ielm-process nil
"Return the current buffer's process"
(get-buffer-process (current-buffer)))
(defun ielm-pm nil
"Return the process mark of the current buffer"
(process-mark (get-buffer-process (current-buffer))))
(defun ielm-set-pm (pos)
"Set the process mark in the current buffer to POS"
(set-marker (process-mark (get-buffer-process (current-buffer))) pos))
;;; Major mode
(defun inferior-emacs-lisp-mode nil
"Major mode for interactively evaluating Emacs-Lisp expressions
Uses the interface provided by `comint-mode' (q.v.)
\\[ielm-send-input] evaluates the sexp following the prompt. There must be at most
one top-level sexp per prompt.
\\[ielm-return] inserts a newline and indents. However, if the variable
ielm-dynamic-return is non-nil (the default) then it will also evaluate
a complete expression.
\\[comint-dynamic-complete] completes lisp symbols (or filenames, within strings),
or indents the line if there is nothing to complete.
During evaluations, the values of the variables `:', `::', and `:::'
are the results of the previous, second previous and third previous
evaluations respectively.
The current buffer may be changed, and its value is preserved between
successive evaluations. In this way, expressions may be evaluated in
a different buffer than the *ielm* buffer.
Expressions evaluated by IELM are not subject to debug-on-quit or
debug-on-error.
The behaviour of IELM may be customised with the following variables:
* To stop beeping on error, set `ielm-noisy' to nil
* If you don't like the prompt, you can change it by setting `ielm-prompt'.
* Set `ielm-dynamic-return' to nil for bindings like `lisp-interaction-mode'
* Entry to this mode runs `comint-mode-hook' and `ielm-mode-hook'
(in that order).
Customised bindings may be defined in `ielm-map', which currently contains:
\\{ielm-map}"
(interactive)
(comint-mode)
(setq comint-prompt-regexp (concat "^" (regexp-quote ielm-prompt)))
(make-local-variable 'paragraph-start)
(setq paragraph-start comint-prompt-regexp)
(setq comint-input-sender 'ielm-input-sender)
(setq comint-process-echoes nil)
(setq comint-dynamic-complete-functions
'(ielm-tab comint-replace-by-expanded-history ielm-complete-filename ielm-complete-symbol))
(setq major-mode 'inferior-emacs-lisp-mode)
(setq mode-name "IELM")
(use-local-map ielm-map)
(set-syntax-table emacs-lisp-mode-syntax-table)
(make-local-variable 'indent-line-function)
(make-local-variable 'ielm-working-buffer)
(setq ielm-working-buffer (current-buffer))
(setq indent-line-function 'ielm-indent-line)
;;; Value holders
(setq : nil)
(make-local-variable ':)
(setq :: nil)
(make-local-variable '::)
(setq ::: nil)
(make-local-variable ':::)
;; A dummy process to keep comint happy. It will never get any input
(if (comint-check-proc (current-buffer)) nil
(start-process "ielm" (current-buffer) "cat")
(process-kill-without-query (ielm-process))
(goto-char (point-max))
;; Add a silly header
(insert ielm-header)
(ielm-set-pm (point-max))
(comint-output-filter (ielm-process) ielm-prompt)
(set-marker comint-last-input-start (ielm-pm))
(set-process-filter (get-buffer-process (current-buffer)) 'comint-output-filter))
(run-hooks 'ielm-mode-hook))
;;; User command
(defun ielm nil
"Switch to or create the buffer *ielm* for evaluating emacs-lisp expressions"
(interactive)
(if (comint-check-proc "*ielm*") nil
(progn
(set-buffer (get-buffer-create "*ielm*"))
(inferior-emacs-lisp-mode)))
(switch-to-buffer "*ielm*"))
;; ielm.el ends here

282
lisp/mail/mail-hist.el Normal file
View file

@ -0,0 +1,282 @@
;;; mail-hist.el --- Headers and message body history for outgoing mail.
;; Copyright (C) 1994 Free Software Foundation, Inc.
;; Author: Karl Fogel <kfogel@cs.oberlin.edu>
;; Created: March, 1994
;; Version: 1.2.2
;; Keywords: mail
;; This file is part of GNU Emacs.
;; GNU Emacs 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 2, or (at your option)
;; any later version.
;; GNU Emacs 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.
;;; Commentary:
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;; Thanks to Jim Blandy for mentioning ring.el. It saved a lot of
;; time.
;;
;; To use this package, put it in a directory in your load-path, and
;; put this in your .emacs file:
;;
;; (load "mail-hist" nil t)
;;
;; Or you could do it with autoloads and hooks in your .emacs:
;;
;; (add-hook 'mail-mode-hook 'mail-hist-define-keys)
;; (add-hook 'mail-send-hook 'mail-hist-put-headers-into-history)
;; (add-hook 'vm-mail-mode-hook 'mail-hist-define-keys) ;or rmail, etc
;; (autoload 'mail-hist-define-keys "mail-hist")
;; (autoload 'mail-hist-put-headers-into-history "mail-hist")
;;
;; Once it's installed, use M-p and M-n from mail headers to recover
;; previous/next contents in the history for that header, or, in the
;; body of the message, to recover previous/next text of the message.
;; This only applies to outgoing mail -- mail-hist ignores received
;; messages.
;;
;; Although repeated history requests do clear out the text from the
;; previous request, an isolated request just inserts its text at
;; point, so that you can mix the histories of different messages
;; easily. This might be confusing at times, but there should be no
;; problems that undo can't handle.
;;; Code:
(require 'ring)
;;;###autoload
(defun mail-hist-define-keys ()
"Define keys for accessing mail header history. For use in hooks."
(local-set-key "\M-p" 'mail-hist-previous-input)
(local-set-key "\M-n" 'mail-hist-next-input))
;;;###autoload
(add-hook 'mail-mode-hook 'mail-hist-define-keys)
;;;###autoload
(add-hook 'vm-mail-mode-hook 'mail-hist-define-keys)
;;;###autoload
(add-hook 'mail-send-hook 'mail-hist-put-headers-into-history)
(defvar mail-hist-header-ring-alist nil
"Alist of form (header-name . history-ring).
Used for knowing which history list to look in when the user asks for
previous/next input.")
(defvar mail-hist-history-size (or kill-ring-max 1729)
"*The maximum number of elements in a mail field's history.
Oldest elements are dumped first.")
;;;###autoload
(defvar mail-hist-keep-history t
"*Non-nil means keep a history for headers and text of outgoing mail.")
;; For handling repeated history requests
(defvar mail-hist-access-count 0)
(defvar mail-hist-last-bounds nil)
;; (start . end) A pair indicating the buffer positions delimiting the
;; last inserted history, so it can be replaced by a new input if the
;; command is repeated.
(defvar mail-hist-header-regexp "^[^:]*:"
"Regular expression for matching headers in a mail message.")
(defsubst mail-hist-current-header-name ()
"Get name of mail header point is currently in, without the colon.
Returns nil if not in a header, implying that point is in the body of
the message."
(if (save-excursion
(re-search-backward (concat "^" mail-header-separator) nil t))
nil ; then we are in the body of the message
(save-excursion
(let* ((body-start ; limit possibility of false headers
(save-excursion
(re-search-forward (concat "^" mail-header-separator) nil t)))
(name-start
(re-search-backward mail-hist-header-regexp nil t))
(name-end
(prog2 (search-forward ":" body-start t) (1- (point)))))
(and
name-start
name-end
(buffer-substring name-start name-end))))))
(defsubst mail-hist-forward-header (count)
"Move forward COUNT headers (backward if COUNT is negative).
If last/first header is encountered first, stop there and returns
nil.
Places point on the first non-whitespace on the line following the
colon after the header name, or on the second space following that if
the header is empty."
(let ((boundary (save-excursion
(re-search-forward (concat "^" mail-header-separator) nil t))))
(and
boundary
(let ((unstopped t))
(setq boundary (save-excursion
(goto-char boundary)
(beginning-of-line)
(1- (point))))
(if (> count 0)
(while (> count 0)
(setq
unstopped
(re-search-forward mail-hist-header-regexp boundary t))
(setq count (1- count)))
;; because the current header will match too.
(setq count (1- count))
;; count is negative
(while (< count 0)
(setq
unstopped
(re-search-backward mail-hist-header-regexp nil t))
(setq count (1+ count)))
;; we end up behind the header, so must move to the front
(re-search-forward mail-hist-header-regexp boundary t))
;; Now we are right after the colon
(and (looking-at "\\s-") (forward-char 1))
;; return nil if didn't go as far as asked, otherwise point
unstopped))))
(defsubst mail-hist-beginning-of-header ()
"Move to the start of the current header.
The start of the current header is defined as one space after the
colon, or just after the colon if it is not followed by whitespace."
;; this is slick as all heck:
(if (mail-hist-forward-header -1)
(mail-hist-forward-header 1)
(mail-hist-forward-header 1)
(mail-hist-forward-header -1)))
(defsubst mail-hist-current-header-contents ()
"Get the contents of the mail header in which point is located."
(save-excursion
(mail-hist-beginning-of-header)
(let ((start (point)))
(or (mail-hist-forward-header 1)
(re-search-forward (concat "^" mail-header-separator)))
(beginning-of-line)
(buffer-substring start (1- (point))))))
(defsubst mail-hist-get-header-ring (header)
"Get HEADER's history ring, or nil if none.
HEADER is a string without the colon."
(cdr (assoc header mail-hist-header-ring-alist)))
(defsubst mail-hist-add-header-contents-to-ring (header &optional contents)
"Add the contents of HEADER to the header history ring.
Optional argument CONTENTS is a string which will be the contents
(instead of whatever's found in the header)."
(let ((ring (cdr (assoc header mail-hist-header-ring-alist))))
(or ring
;; If the ring doesn't exist, we'll have to make it and add it
;; to the mail-header-ring-alist:
(prog1
(setq ring (make-ring mail-hist-history-size))
(setq mail-hist-header-ring-alist
(cons (cons header ring) mail-hist-header-ring-alist))))
(ring-insert
ring
(or contents (mail-hist-current-header-contents)))))
;;;###autoload
(defun mail-hist-put-headers-into-history ()
"Put headers and contents of this message into mail header history.
Each header has its own independent history, as does the body of the
message.
This function normally would be called when the message is sent."
(and
mail-hist-keep-history
(progn
(goto-char (point-min))
(while (mail-hist-forward-header 1)
(mail-hist-add-header-contents-to-ring
(mail-hist-current-header-name)))
(let ((body-contents
(save-excursion
(goto-char (point-min))
(re-search-forward (concat "^" mail-header-separator) nil)
(forward-line 1)
(buffer-substring (point) (point-max)))))
(mail-hist-add-header-contents-to-ring "body" body-contents)))))
(defun mail-hist-previous-input (header)
"Insert the previous contents of this mail header or message body.
Moves back through the history of sent mail messages. Each header has
its own independent history, as does the body of the message.
The history only contains the contents of outgoing messages, not
received mail."
(interactive (list (or (mail-hist-current-header-name) "body")))
(let* ((ring (cdr (assoc header mail-hist-header-ring-alist)))
(len (ring-length ring))
(repeat (eq last-command 'mail-hist-input-access)))
(if repeat
(setq mail-hist-access-count
(ring-plus1 mail-hist-access-count len))
(setq mail-hist-access-count 0))
(if (null ring)
(progn
(ding)
(message "No history for \"%s\"." header))
(if (ring-empty-p ring)
(error "\"%s\" ring is empty." header)
(and repeat
(delete-region (car mail-hist-last-bounds)
(cdr mail-hist-last-bounds)))
(let ((start (point)))
(insert (ring-ref ring mail-hist-access-count))
(setq mail-hist-last-bounds (cons start (point)))
(setq this-command 'mail-hist-input-access))))))
(defun mail-hist-next-input (header)
"Insert next contents of this mail header or message body.
Moves back through the history of sent mail messages. Each header has
its own independent history, as does the body of the message.
Although you can do so, it does not make much sense to call this
without having called `mail-hist-previous-header' first
(\\[mail-hist-previous-header]).
The history only contains the contents of outgoing messages, not
received mail."
(interactive (list (or (mail-hist-current-header-name) "body")))
(let* ((ring (cdr (assoc header mail-hist-header-ring-alist)))
(len (ring-length ring))
(repeat (eq last-command 'mail-hist-input-access)))
(if repeat
(setq mail-hist-access-count
(ring-minus1 mail-hist-access-count len))
(setq mail-hist-access-count 0))
(if (null ring)
(progn
(ding)
(message "No history for \"%s\"." header))
(if (ring-empty-p ring)
(error "\"%s\" ring is empty." header)
(and repeat
(delete-region (car mail-hist-last-bounds)
(cdr mail-hist-last-bounds)))
(let ((start (point)))
(insert (ring-ref ring mail-hist-access-count))
(setq mail-hist-last-bounds (cons start (point)))
(setq this-command 'mail-hist-input-access))))))
(provide 'mail-hist)
;; mail-hist.el ends here

226
lisp/mldrag.el Normal file
View file

@ -0,0 +1,226 @@
;;; mldrag.el -- Mode line and vertical line dragging to resize windows.
;;; Copyright (C) 1994 Free Software Foundation, Inc.
;; Author: Kyle E. Jones <kyle@wonderworks.com>
;; Keywords: mouse
;; This file is part of GNU Emacs.
;; GNU Emacs 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 2, or (at your option)
;; any later version.
;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary:
;; This package lets you drag the modeline, vertical bar and
;; scrollbar to resize windows. Suggested bindings are:
;;
;; (global-set-key [mode-line down-mouse-1] 'mldrag-drag-mode-line)
;; (global-set-key [vertical-line down-mouse-1] 'mldrag-drag-vertical-line)
;; (global-set-key [vertical-scroll-bar S-down-mouse-1]
;; 'mldrag-drag-vertical-line)
;;
;; Put the bindings and (require 'mldrag) in your .emacs file.
;;; Code:
(provide 'mldrag)
(defun mldrag-drag-mode-line (start-event)
"Change the height of the current window with the mouse.
This command should be bound to a down-mouse- event, and is most
usefully bound with the `mode-line' prefix. Holding down a mouse
button and moving the mouse up and down will make the clicked-on
window taller or shorter."
(interactive "e")
(let ((done nil)
(echo-keystrokes 0)
(start-event-frame (window-frame (car (car (cdr start-event)))))
(start-event-window (car (car (cdr start-event))))
(start-nwindows (count-windows t))
(old-selected-window (selected-window))
should-enlarge-minibuffer
event mouse minibuffer y top bot edges wconfig params growth)
(setq params (frame-parameters))
(if (and (not (setq minibuffer (cdr (assq 'minibuffer params))))
(one-window-p t))
(error "Attempt to resize sole window"))
(unwind-protect
(track-mouse
(progn
;; enlarge-window only works on the selected window, so
;; we must select the window where the start event originated.
;; unwind-protect will restore the old selected window later.
(select-window start-event-window)
;; if this is the bottommost ordinary window, then to
;; move its modeline the minibuffer must be enlarged.
(setq should-enlarge-minibuffer
(and minibuffer
(not (one-window-p t))
(= (nth 1 (window-edges minibuffer))
(nth 3 (window-edges)))))
;; loop reading events and sampling the position of
;; the mouse.
(while (not done)
(setq event (read-event)
mouse (mouse-position))
;; do nothing if
;; - there is a switch-frame event.
;; - the mouse isn't in the frame that we started in
;; - the mouse isn't in any Emacs frame
;; drag if
;; - there is a mouse-movement event
;; - there is a scroll-bar-movement event
;; (same as mouse movement for our purposes)
;; quit if
;; - there is a keyboard event or some other unknown event
;; unknown event.
(cond ((integerp event)
(setq done t))
((eq (car event) 'switch-frame)
nil)
((not (memq (car event)
'(mouse-movement scroll-bar-movement)))
(setq done t))
((not (eq (car mouse) start-event-frame))
nil)
((null (car (cdr mouse)))
nil)
(t
(setq y (cdr (cdr mouse))
edges (window-edges)
top (nth 1 edges)
bot (nth 3 edges))
;; scale back a move that would make the
;; window too short.
(cond ((< (- y top -1) window-min-height)
(setq y (+ top window-min-height -1))))
;; compute size change needed
(setq growth (- y bot -1)
wconfig (current-window-configuration))
;; grow/shrink minibuffer?
(if should-enlarge-minibuffer
(progn
;; yes. briefly select minibuffer so
;; ealarge-window will affect the
;; correct window.
(select-window minibuffer)
;; scale back shrinkage if it would
;; make the minibuffer less than 1
;; line tall.
(if (and (> growth 0)
(< (- (window-height minibuffer)
growth)
1))
(setq growth (1- (window-height minibuffer))))
(enlarge-window (- growth))
(select-window start-event-window))
;; no. grow/shrink the selected window
(enlarge-window growth))
;; if this window's growth caused another
;; window to be deleted because it was too
;; short, rescind the change.
;;
;; if size change caused space to be stolen
;; from a window above this one, rescind the
;; change, but only if we didn't grow/srhink
;; the minibuffer. minibuffer size changes
;; can cause all windows to shrink... no way
;; around it.
(if (or (/= start-nwindows (count-windows t))
(and (not should-enlarge-minibuffer)
(/= top (nth 1 (window-edges)))))
(set-window-configuration wconfig)))))))
;; restore the old selected window
(select-window old-selected-window))))
(defun mldrag-drag-vertical-line (start-event)
"Change the width of the current window with the mouse.
This command should be bound to a down-mouse- event, and is most
usefully bound with the `vertical-line' or the `vertical-scroll-bar'
prefix. Holding down a mouse button and moving the mouse left and
right will make the clicked-on window thinner or wider."
(interactive "e")
(let ((done nil)
(echo-keystrokes 0)
(start-event-frame (window-frame (car (car (cdr start-event)))))
(start-event-window (car (car (cdr start-event))))
(start-nwindows (count-windows t))
(old-selected-window (selected-window))
event mouse x left right edges wconfig growth)
(if (one-window-p t)
(error "Attempt to resize sole ordinary window"))
(if (= (nth 2 (window-edges start-event-window))
(frame-width start-event-frame))
(error "Attempt to drag rightmost scrollbar"))
(unwind-protect
(track-mouse
(progn
;; enlarge-window only works on the selected window, so
;; we must select the window where the start event originated.
;; unwind-protect will restore the old selected window later.
(select-window start-event-window)
;; loop reading events and sampling the position of
;; the mouse.
(while (not done)
(setq event (read-event)
mouse (mouse-position))
;; do nothing if
;; - there is a switch-frame event.
;; - the mouse isn't in the frame that we started in
;; - the mouse isn't in any Emacs frame
;; drag if
;; - there is a mouse-movement event
;; - there is a scroll-bar-movement event
;; (same as mouse movement for our purposes)
;; quit if
;; - there is a keyboard event or some other unknown event
;; unknown event.
(cond ((integerp event)
(setq done t))
((eq (car event) 'switch-frame)
nil)
((not (memq (car event)
'(mouse-movement scroll-bar-movement)))
(setq done t))
((not (eq (car mouse) start-event-frame))
nil)
((null (car (cdr mouse)))
nil)
(t
(setq x (car (cdr mouse))
edges (window-edges)
left (nth 0 edges)
right (nth 2 edges))
;; scale back a move that would make the
;; window too thin.
(cond ((< (- x left -1) window-min-width)
(setq x (+ left window-min-width -1))))
;; compute size change needed
(setq growth (- x right -1)
wconfig (current-window-configuration))
(enlarge-window growth t)
;; if this window's growth caused another
;; window to be deleted because it was too
;; thin, rescind the change.
;;
;; if size change caused space to be stolen
;; from a window to the left of this one,
;; rescind the change.
(if (or (/= start-nwindows (count-windows t))
(/= left (nth 0 (window-edges))))
(set-window-configuration wconfig)))))))
;; restore the old selected window
(select-window old-selected-window))))
;; mldrag.el ends here

200
lisp/rsz-mini.el Normal file
View file

@ -0,0 +1,200 @@
;;; rsz-mini.el --- dynamically resize minibuffer to display entire contents
;;; Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc.
;;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
;;; Roland McGrath <roland@prep.ai.mit.edu>
;;; Maintainer: friedman@prep.ai.mit.edu
;;; Keywords: minibuffer, window, frame, display
;;; Status: Known to work in FSF GNU Emacs 19.23.
;; This file is part of GNU Emacs.
;; GNU Emacs 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 2, or (at your option)
;; any later version.
;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary:
;;; This package allows the entire contents (or as much as possible) of the
;;; minibuffer to be visible at once when typing. As the end of a line is
;;; reached, the minibuffer will resize itself. When the user is done
;;; typing, the minibuffer will return to its original size.
;;; In window systems where it is possible to have a frame in which the
;;; minibuffer is the only window, the frame itself can be resized. In FSF
;;; GNU Emacs 19.22 and earlier, the frame may not be properly returned to
;;; its original size after it ceases to be active because
;;; `minibuffer-exit-hook' didn't exist until version 19.23.
;;; Note that the minibuffer and echo area are not the same! They simply
;;; happen to occupy roughly the same place on the frame. Messages put in
;;; the echo area will not cause any resizing by this package.
;;; This package is considered a minor mode but it doesn't put anything in
;;; minor-mode-alist because this mode is specific to the minibuffer, which
;;; has no mode line.
;;; To use this package, put the following in your .emacs:
;;;
;;; (autoload 'resize-minibuffer-mode "rsz-mini" nil t)
;;;
;;; Invoking the command `resize-minibuffer-mode' will then enable this mode.
;;; Code:
;;;###autoload
(defvar resize-minibuffer-mode nil
"*If non-`nil', resize the minibuffer so its entire contents are visible.")
;;;###autoload
(defvar resize-minibuffer-window-max-height nil
"*Maximum size the minibuffer window is allowed to become.
If less than 1 or not a number, the limit is the height of the frame in
which the active minibuffer window resides.")
;;;###autoload
(defvar resize-minibuffer-window-exactly t
"*If non-`nil', make minibuffer exactly the size needed to display all its contents.
Otherwise, the minibuffer window can temporarily increase in size but
never get smaller while it is active.")
;;;###autoload
(defvar resize-minibuffer-frame nil
"*If non-`nil' and the active minibuffer is the sole window in its frame, allow changing the frame height.")
;;;###autoload
(defvar resize-minibuffer-frame-max-height nil
"*Maximum size the minibuffer frame is allowed to become.
If less than 1 or not a number, there is no limit.")
;;;###autoload
(defvar resize-minibuffer-frame-exactly nil
"*If non-`nil', make minibuffer frame exactly the size needed to display all its contents.
Otherwise, the minibuffer frame can temporarily increase in size but
never get smaller while it is active.")
;;;###autoload
(defun resize-minibuffer-mode (&optional prefix)
"Enable or disable resize-minibuffer mode.
A negative prefix argument disables this mode. A positive argument or
argument of 0 enables it.
When this minor mode is enabled, the minibuffer is dynamically resized to
contain the entire region of text put in it as you type.
The variable `resize-minibuffer-mode' is set to t or nil depending on
whether this mode is active or not.
The maximum height to which the minibuffer can grow is controlled by the
variable `resize-minibuffer-window-max-height'.
The variable `resize-minibuffer-window-exactly' determines whether the
minibuffer window should ever be shrunk to make it no larger than needed to
display its contents.
When using a window system, it is possible for a minibuffer to tbe the sole
window in a frame. Since that window is already its maximum size, the only
way to make more text visible at once is to increase the size of the frame.
The variable `resize-minibuffer-frame' controls whether this should be
done. The variables `resize-minibuffer-frame-max-height' and
`resize-minibuffer-frame-exactly' are analogous to their window
counterparts."
(interactive "p")
(or prefix (setq prefix 0))
(cond
((>= prefix 0)
(setq resize-minibuffer-mode t))
(t
(setq resize-minibuffer-mode nil))))
(defun resize-minibuffer-setup ()
(cond
(resize-minibuffer-mode
(cond
((and window-system
(eq 'only (cdr (assq 'minibuffer (frame-parameters)))))
(and resize-minibuffer-frame
(progn
(make-local-variable 'minibuffer-exit-hook)
(add-hook 'minibuffer-exit-hook 'resize-minibuffer-frame-restore)
(make-local-variable 'post-command-hook)
(add-hook 'post-command-hook 'resize-minibuffer-frame))))
(t
(make-local-variable 'post-command-hook)
(add-hook 'post-command-hook 'resize-minibuffer-window))))))
(defun resize-minibuffer-count-window-lines (&optional start end)
"Return number of window lines occupied by text in region.
The number of window lines may be greater than the number of actual lines
in the buffer if any wrap on the display due to their length.
Optional arguments START and END default to point-min and point-max,
respectively."
(or start (setq start (point-min)))
(or end (setq end (point-max)))
(if (= start end)
0
(save-excursion
(save-restriction
(widen)
(narrow-to-region start end)
(goto-char start)
(vertical-motion (buffer-size))))))
;; Resize the minibuffer window to contain the minibuffer's contents.
;; The minibuffer must be the current window.
(defun resize-minibuffer-window ()
(let ((height (window-height))
(lines (1+ (resize-minibuffer-count-window-lines))))
(and (numberp resize-minibuffer-window-max-height)
(> resize-minibuffer-window-max-height 0)
(setq lines (min lines resize-minibuffer-window-max-height)))
(or (if resize-minibuffer-window-exactly
(= lines height)
(<= lines height))
(enlarge-window (- lines height)))))
;; Resize the minibuffer frame to contain the minibuffer's contents.
;; The minibuffer frame must be the current frame.
(defun resize-minibuffer-frame ()
(let ((height (frame-height))
(lines (1+ (resize-minibuffer-count-window-lines))))
(and (numberp resize-minibuffer-frame-max-height)
(> resize-minibuffer-frame-max-height 0)
(setq lines (min lines resize-minibuffer-frame-max-height)))
(cond
((> lines height)
(set-frame-size (selected-frame) (frame-width) lines))
((and resize-minibuffer-frame-exactly
(> height (cdr (assq 'height minibuffer-frame-alist)))
(< lines height))
(set-frame-size (selected-frame) (frame-width) lines)))))
;; Restore the original height of the frame.
(defun resize-minibuffer-frame-restore ()
(set-frame-size (selected-frame)
(frame-width)
(cdr (assq 'height minibuffer-frame-alist))))
(provide 'rsz-mini)
(add-hook 'minibuffer-setup-hook 'resize-minibuffer-setup)
;; rsz-mini.el ends here

449
lisp/tempo.el Normal file
View file

@ -0,0 +1,449 @@
;;; tempo.el --- templates with hotspots
;; Copyright (C) 1994 Free Software Foundation, Inc.
;; Author: David Kegedal <davidk@lysator.liu.se >
;; Created: 16 Feb 1994
;; Version: 1.0
;; Keywords: extensions, languages, tools
;; This file is part of GNU Emacs.
;; GNU Emacs 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 2, or (at your option)
;; any later version.
;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary:
;; This file provides a simple way to define powerful templates, or
;; macros, if you wish. It is mainly intended for, but not limited to,
;; other programmers to be used for creating shortcuts for editing
;; certain kind of documents. It was originally written to be used by
;; a HTML editing mode written by Nelson Minar <nelson@reed.edu>, and
;; his html-helper-mode.el is probably the best example of how to use
;; this program.
;; A template is defined as a list of items to be inserted in the
;; current buffer at point. Some of the items can be simple strings,
;; while other can control formatting or define special points of
;; interest in the inserted text.
;; If a template defines a "point of interest" that point is inserted
;; in a buffer-local list of "points of interest" that the user can
;; jump between with the commands `tempo-backward-mark' and
;; `tempo-forward-mark'. If the template definer provides a prompt for
;; the point, and the variable `tempo-interactive' is non-nil, the
;; user will be prompted for a string to be inserted in the buffer,
;; using the minibuffer.
;; The template can also define one point to be replaced with the
;; current region if the template command is called with a prefix (or
;; a non-nil argument).
;; More flexible templates can be created by including lisp symbols,
;; which will be evaluated as variables, or lists, which will will be
;; evaluated as lisp expressions.
;; See the documentation for tempo-define-template for the different
;; items that can be used to define a tempo template.
;; One of the more powerful features of tempo templates are automatic
;; completion. With every template can be assigned a special tag that
;; should be recognized by `tempo-complete-tag' and expanded to the
;; complete template. By default the tags are added to a global list
;; of template tags, and are matched against the last word before
;; point. But if you assign your tags to a specific list, you can also
;; specify another method for matching text in the buffer against the
;; tags. In the HTML mode, for instance, the tags are matched against
;; the text between the last `<' and point.
;; When defining a template named `foo', a symbol named
;; `tempo-template-foo' will be created whose value as a variable will
;; be the template definition, and its function value will be an
;; interactive function that inserts the template at the point.
;; Full documentation for tempo.el can be found on the World Wide Web
;; at http://www.lysator.liu.se:7500/~davidk/tempo.html (not yet
;; completed)
;; The latest tempo.el distribution can be fetched from
;; ftp.lysator.liu.se in the directory /pub/emacs
;;; Code:
(provide 'tempo)
;;; Variables
(defvar tempo-interactive nil
"*Prompt user for strings in templates.
If this variable is non-nil, `tempo-insert' prompts the
user for text to insert in the templates")
(defvar tempo-insert-string-functions nil
"List of functions to run when inserting a string.
Each function is called with a single arg, STRING." )
(defvar tempo-tags nil
"An association list with tags and corresponding templates")
(defvar tempo-local-tags '((tempo-tags . nil))
"A list of locally installed tag completion lists.
It is a association list where the car of every element is a symbol
whose varable value is a template list. The cdr part, if non-nil, is a
function or a regexp that defines the string to match. See the
documentation for the function `tempo-complete-tag' for more info.
`tempo-tags' is always in the last position in this list.")
(defvar tempo-marks nil
"A list of marks to jump to with `\\[tempo-forward-mark]' and `\\[tempo-backward-mark]'.")
(defvar tempo-default-match-finder "\\b\\([^\\b]*\\)\\="
"The default regexp used to find the string to match against the tags.")
;; Make some variables local to every buffer
(make-variable-buffer-local 'tempo-marks)
(make-variable-buffer-local 'tempo-local-tags)
;;; Functions
;;
;; tempo-define-template
(defun tempo-define-template (name elements &optional tag documentation taglist)
"Define a template.
This function creates a template variable `tempo-template-NAME' and an
interactive function `tempo-template-NAME' that inserts the template
at the point. The created function is returned.
NAME is a string that contains the name of the template, ELEMENTS is a
list of elements in the template, TAG is the tag used for completion,
DOCUMENTATION is the documentation string for the insertion command
created, and TAGLIST (a symbol) is the tag list that TAG (if provided)
should be added to). If TAGLIST is nil and TAG is non-nil, TAG is
added to `tempo-tags'
The elements in ELEMENTS can be of several types:
- A string. It is sent to the hooks in `tempo-insert-string-functions',
and the result is inserted.
- The symbol 'p. This position is saved in `tempo-marks'.
- The symbol 'r. If `tempo-insert' is called with ON-REGION non-nil
the current region is placed here. Otherwise it works like 'p.
- (p . PROMPT) If `tempo-interactive' is non-nil, the user is
prompted in the minbuffer with PROMPT for a string to be inserted.
If `tempo-interactive is nil, it works like 'p.
- (r . PROMPT) like the previou, but if `tempo-interactive' is nil
and `tempo-insert' is called with ON-REGION non-nil, the current
region is placed here.
- '& If there is only whitespace between the line start and point,
nothing happens. Otherwise a newline is inserted.
- '% If there is only whitespace between point and end-of-line
nothing happens. Otherwise a newline is inserted.
- 'n inserts a newline.
- '> The line is indented using `indent-according-to-mode'. Note that
you often should place this item after the text you want on the
line.
- 'n> inserts a newline and indents line.
- nil. It is ignored.
- Anything else. It is evaluated and the result is parsed again."
(let* ((template-name (intern (concat "tempo-template-"
name)))
(command-name template-name))
(set template-name elements)
(fset command-name (list 'lambda (list '&optional 'arg)
(or documentation
(concat "Insert a " name "."))
(list 'interactive "*P")
(list 'tempo-insert-template (list 'quote
template-name)
'arg)))
(and tag
(tempo-add-tag tag template-name taglist))
command-name))
;;;
;;; tempo-insert-template
(defun tempo-insert-template (template on-region)
"Insert a template.
TEMPLATE is the template to be inserted. If ON-REGION is non-nil the
`r' elements are replaced with the current region."
(and on-region
(< (mark) (point))
(exchange-point-and-mark))
(save-excursion
(tempo-insert-mark (point-marker))
(mapcar 'tempo-insert
(symbol-value template))
(tempo-insert-mark (point-marker)))
(tempo-forward-mark))
;;;
;;; tempo-insert
(defun tempo-insert (element)
"Insert a template element.
Insert one element from a template. See documentation for
`tempo-define-template' for the kind of elements possible."
(cond ((stringp element) (tempo-process-and-insert-string element))
((and (consp element) (eq (car element) 'p))
(tempo-insert-prompt (cdr element)))
((and (consp element) (eq (car element) 'r))
(if on-region
(exchange-point-and-mark)
(tempo-insert-prompt (cdr element))))
((eq element 'p) (tempo-insert-mark (point-marker)))
((eq element 'r) (if on-region
(exchange-point-and-mark)
(tempo-insert-mark (point-marker))))
((eq element '>) (indent-according-to-mode))
((eq element '&) (if (not (or (= (current-column) 0)
(save-excursion
(re-search-backward
"^\\s-*\\=" nil t))))
(insert "\n")))
((eq element '%) (if (not (or (eolp)
(save-excursion
(re-search-forward
"\\=\\s-*$" nil t))))
(insert "\n")))
((eq element 'n) (insert "\n"))
((eq element 'n>) (insert "\n") (indent-according-to-mode))
((null element))
(t (tempo-insert (eval element)))))
;;;
;;; tempo-insert-prompt
(defun tempo-insert-prompt (prompt)
"Prompt for a text string and insert it in the current buffer.
If the variable `tempo-interactive' is non-nil the user is prompted
for a string in the minibuffer, which is then inserted in the current
buffer. If `tempo-interactive' is nil, the current point is placed on
`tempo-forward-mark-list'.
PROMPT is the prompt string."
(if tempo-interactive
(insert (read-string prompt))
(tempo-insert-mark (point-marker))))
;;;
;;; tempo-process-and-insert-string
(defun tempo-process-and-insert-string (string)
"Insert a string from a template.
Run a string through the preprocessors in `tempo-insert-string-functions'
and insert the results."
(cond ((null tempo-insert-string-functions)
nil)
((symbolp tempo-insert-string-functions)
(setq string
(apply tempo-insert-string-functions (list string))))
((listp tempo-insert-string-functions)
(mapcar (function (lambda (fn)
(setq string (apply fn string))))
tempo-insert-string-functions))
(t
(error "Bogus value in tempo-insert-string-functions: %s"
tempo-insert-string-functions)))
(insert string))
;;;
;;; tempo-insert-mark
(defun tempo-insert-mark (mark)
"Insert a mark `tempo-marks' while keeping it sorted"
(cond ((null tempo-marks) (setq tempo-marks (list mark)))
((< mark (car tempo-marks)) (setq tempo-marks (cons mark tempo-marks)))
(t (let ((lp tempo-marks))
(while (and (cdr lp)
(<= (car (cdr lp)) mark))
(setq lp (cdr lp)))
(if (not (= mark (car lp)))
(setcdr lp (cons mark (cdr lp))))))))
;;;
;;; tempo-forward-mark
(defun tempo-forward-mark ()
"Jump to the next mark in `tempo-forward-mark-list'."
(interactive)
(let ((next-mark (catch 'found
(mapcar
(function
(lambda (mark)
(if (< (point) mark)
(throw 'found mark))))
tempo-marks)
;; return nil if not found
nil)))
(if next-mark
(goto-char next-mark))))
;;;
;;; tempo-backward-mark
(defun tempo-backward-mark ()
"Jump to the previous mark in `tempo-back-mark-list'."
(interactive)
(let ((prev-mark (catch 'found
(let (last)
(mapcar
(function
(lambda (mark)
(if (<= (point) mark)
(throw 'found last))
(setq last mark)))
tempo-marks)
last))))
(if prev-mark
(goto-char prev-mark))))
;;;
;;; tempo-add-tag
(defun tempo-add-tag (tag template &optional tag-list)
"Add a template tag.
Add the TAG, that should complete to TEMPLATE to the list in TAG-LIST,
or to `tempo-tags' if TAG-LIST is nil."
(interactive "sTag: \nCTemplate: ")
(if (null tag-list)
(setq tag-list 'tempo-tags))
(if (not (assoc tag (symbol-value tag-list)))
(set tag-list (cons (cons tag template) (symbol-value tag-list)))))
;;;
;;; tempo-use-tag-list
(defun tempo-use-tag-list (tag-list &optional completion-function)
"Install TAG-LIST to be used for template completion in the current buffer.
TAG-LIST is a symbol whose variable value is a tag list created with
`tempo-add-tag' and COMPLETION-FUNCTION is an optional function or
string that is used by `\\[tempo-complete-tag]' to find a string to
match the tag against.
If COMPLETION-FUNCTION is a string, it should contain a regular
expression with at least one \\( \\) pair. When searching for tags,
`tempo-complete-tag' calls `re-search-backward' with this string, and
the string between the first \\( and \\) is used for matching against
each string in the tag list. If one is found, the whole text between
the first \\( and the point is replaced with the inserted template.
You will probably want to include \\ \= at the end of the regexp to make
sure that the string is matched only against text adjacent to the
point.
If COPMLETION-FUNCTION is a symbol, it should be a function that
returns a cons cell of the form (STRING . POS), where STRING is the
string used for matching and POS is the buffer position after which
text should be replaced with a template."
(let ((old (assq tag-list tempo-local-tags)))
(if old
(setcdr old completion-function)
(setq tempo-local-tags (cons (cons tag-list completion-function)
tempo-local-tags)))))
;;;
;;; tempo-find-match-string
(defun tempo-find-match-string (finder)
"Find a string to be matched against a tag list.
FINDER is a function or a string. Returns (STRING . POS)."
(cond ((stringp finder)
(save-excursion
(re-search-backward finder nil t))
(cons (buffer-substring (match-beginning 1) (1+ (match-end 1)))
(match-beginning 1)))
(t
(funcall finder))))
;;;
;;; tempo-complete-tag
(defun tempo-complete-tag (&optional silent)
"Look for a tag and expand it..
It goes through the tag lists in `tempo-local-tags' (this includes
`tempo-tags') and for each list it uses the corresponding match-finder
function, or `tempo-default-match-finder' if none is given, and tries
to match the match string against the tags in the list using
`try-completion'. If none is found it proceeds to the next list until
one is found. If a partial completion is found, it is replaced by the
template if it can be completed uniquely, or completed as far as
possible.
When doing partial completion, only tags in the currently examined
list are considered, so if you provide similar tags in different lists
in `tempo-local-tags', the result may not be desirable.
If no match is found or a partial match is found, and SILENT is
non-nil, the function will give a signal."
(interactive)
(if (catch 'completed
(mapcar
(function
(lambda (tag-list-a)
(let* ((tag-list (symbol-value(car tag-list-a)))
(match-string-finder (or (cdr tag-list-a)
tempo-default-match-finder))
(match-info (tempo-find-match-string match-string-finder))
(match-string (car match-info))
(match-start (cdr match-info))
(compl (or (cdr (assoc match-string tag-list))
(try-completion (car match-info)
tag-list))))
(if compl ;any match
(delete-region match-start (point)))
(cond
((null compl)
nil)
((symbolp compl)
(tempo-insert-template compl nil)
(throw 'completed t))
((eq compl t)
(tempo-insert-template (cdr (assoc match-string tag-list))
nil)
(throw 'completed t))
((stringp compl)
(let ((compl2 (assoc compl tag-list)))
(if compl2
(tempo-insert-template (cdr compl2) nil)
(insert compl)
(if (string= match-string compl)
(if (not silent)
(ding)))))
(throw 'completed t))))))
tempo-local-tags)
;; No completion found. Return nil
nil)
;; Do nothing if a completion was found
t
;; No completion was found
(if (not silent)
(ding))
nil))
;;; tempo.el ends here