;;; forms.el --- Forms mode: edit a file as a form to fill in
-;; Copyright (C) 1991, 1994, 1995, 1996, 1997, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 1994, 1995, 1996, 1997, 2001, 2002, 2003,
+;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Johan Vromans <jvromans@squirrel.nl>
;; 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)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; 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, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Automatic mode switching is supported if you specify
;; "-*- forms -*-" in the first line of the control file.
;;
-;; The control file is visited, evaluated using `eval-current-buffer',
+;; The control file is visited, evaluated using `eval-buffer',
;; and should set at least the following variables:
;;
;; forms-file [string]
;; forms mode functions next/prev record and first/last
;; record.
;;
-;; `local-write-file-hooks' is defined to save the actual data file
+;; `write-file-functions' is defined to save the actual data file
;; instead of the buffer data, `revert-file-hook' is defined to
;; revert a forms to original.
\f
(provide 'forms) ;;; official
(provide 'forms-mode) ;;; for compatibility
-(defconst forms-version (substring "$Revision: 2.45 $" 11 -2)
- "The version number of forms-mode (as string). The complete RCS id is:
-
- $Id: forms.el,v 2.45 2003/02/04 11:21:12 lektu Exp $")
-
-(defcustom forms-mode-hooks nil
+(defcustom forms-mode-hook nil
"Hook run upon entering Forms mode."
:group 'forms
:type 'hook)
(if (or (eq enable-local-eval t)
(yes-or-no-p
(concat "Evaluate lisp code in buffer "
- (buffer-name) " to display forms ")))
- (eval-current-buffer)
+ (buffer-name) " to display forms? ")))
+ (eval-buffer)
(error "`enable-local-eval' inhibits buffer evaluation"))
;; Check if the mandatory variables make sense.
(eq (length forms-multi-line) 1))
(if (string= forms-multi-line forms-field-sep)
(error (concat "Forms control file error: "
- "`forms-multi-line' is equal to 'forms-field-sep'")))
+ "`forms-multi-line' is equal to `forms-field-sep'")))
(error (concat "Forms control file error: "
"`forms-multi-line' must be nil or a one-character string"))))
(or (fboundp 'set-text-properties)
(let ((read-file-filter forms-read-file-filter)
(write-file-filter forms-write-file-filter))
(if read-file-filter
- (save-excursion
- (set-buffer forms--file-buffer)
+ (with-current-buffer forms--file-buffer
(let ((inhibit-read-only t)
(file-modified (buffer-modified-p)))
(run-hooks 'read-file-filter)
(if (not file-modified) (set-buffer-modified-p nil)))
(if write-file-filter
- (progn
- (make-variable-buffer-local 'local-write-file-hooks)
- (setq local-write-file-hooks (list write-file-filter)))))
+ (add-hook 'write-file-functions write-file-filter nil t)))
(if write-file-filter
- (save-excursion
- (set-buffer forms--file-buffer)
- (make-variable-buffer-local 'local-write-file-hooks)
- (setq local-write-file-hooks (list write-file-filter))))))
+ (with-current-buffer forms--file-buffer
+ (add-hook 'write-file-functions write-file-filter nil t)))))
;; count the number of records, and set see if it may be modified
(let (ro)
(setq forms--total-records
- (save-excursion
+ (with-current-buffer forms--file-buffer
(prog1
(progn
;;(message "forms: counting records...")
- (set-buffer forms--file-buffer)
(bury-buffer (current-buffer))
(setq ro buffer-read-only)
(count-lines (point-min) (point-max)))
;;(message "forms: proceeding setup (new file)...")
(progn
(insert
- "GNU Emacs Forms Mode version " forms-version "\n\n"
+ "GNU Emacs Forms Mode\n\n"
(if (file-exists-p forms-file)
(concat "No records available in file `" forms-file "'\n\n")
(format "Creating new file `%s'\nwith %d field%s per record\n\n"
;; user customising
;;(message "forms: proceeding setup (user hooks)...")
- (run-hooks 'forms-mode-hooks)
+ (run-mode-hooks 'forms-mode-hook 'forms-mode-hooks)
;;(message "forms: setting up... done.")
;; be helpful
(setq forms--elements (make-vector forms-number-of-fields nil))
(let ((the-list forms-format-list) ; the list of format elements
- (this-item 0) ; element in list
(prev-item nil)
(field-num 0)) ; highest field number
;; Need a file to do this.
(if (not (file-exists-p forms-file))
- (error "Need existing file or explicit 'forms-number-of-records'")
+ (error "Need existing file or explicit `forms-number-of-fields'")
;; Visit the file and extract the first record.
(setq forms--file-buffer (find-file-noselect forms-file))
(let ((read-file-filter forms-read-file-filter)
(the-record))
(setq the-record
- (save-excursion
- (set-buffer forms--file-buffer)
+ (with-current-buffer forms--file-buffer
(let ((inhibit-read-only t))
(run-hooks 'read-file-filter))
(goto-char (point-min))
(kill-buffer forms--file-buffer)
;; Count the number of fields in `the-record'.
- (let (the-result
- (start-pos 0)
+ (let ((start-pos 0)
found-pos
(field-sep-length (length forms-field-sep)))
(setq forms-number-of-fields 1)
"Translate in SUBJ all chars ARG into char REP. ARG and REP should
be single-char strings."
(let ((i 0)
- (x (length subj))
(re (regexp-quote arg))
(k (string-to-char rep)))
(while (setq i (string-match re subj i))
(aset subj i k)
(setq i (1+ i)))))
-(defun forms--exit (query &optional save)
+(defun forms--exit (&optional save)
"Internal exit from forms mode function."
(let ((buf (buffer-name forms--file-buffer)))
(if (and save
(buffer-modified-p forms--file-buffer))
(forms-save-buffer))
- (save-excursion
- (set-buffer forms--file-buffer)
+ (with-current-buffer forms--file-buffer
(delete-auto-save-file-if-necessary)
(kill-buffer (current-buffer)))
(if (get-buffer buf) ; not killed???
(if (string-match "\n" the-record)
(error "Multi-line fields in this record - update refused"))
- (save-excursion
- (set-buffer forms--file-buffer)
+ (with-current-buffer forms--file-buffer
;; Use delete-region instead of kill-region, to avoid
;; adding junk to the kill-ring.
- (delete-region (save-excursion (beginning-of-line) (point))
- (save-excursion (end-of-line) (point)))
+ (delete-region (line-beginning-position) (line-end-position))
(insert the-record)
(beginning-of-line))))
(find-file-other-window fn)
(or forms--mode-setup (forms-mode t))))
-(defun forms-exit (query)
+(defun forms-exit ()
"Normal exit from Forms mode. Modified buffers are saved."
- (interactive "P")
- (forms--exit query t))
+ (interactive)
+ (forms--exit t))
-(defun forms-exit-no-save (query)
+(defun forms-exit-no-save ()
"Exit from Forms mode without saving buffers."
- (interactive "P")
- (forms--exit query nil))
+ (interactive)
+ (forms--exit nil))
\f
;;; Navigating commands
(interactive "P")
(forms-jump-record (- forms--current-record (prefix-numeric-value arg)) t))
+(defun forms--goto-record (rn &optional current)
+ "Goto record number RN.
+If CURRENT is provided, it specifies the current record and can be used
+to speed up access to RN. Returns the number of records missing, if any."
+ (if current
+ (forward-line (- rn current))
+ ;; goto-line does not do what we want when the buffer is narrowed.
+ (goto-char (point-min))
+ (forward-line (1- rn))))
+
(defun forms-jump-record (arg &optional relative)
"Jump to a random record."
(interactive "NRecord number: ")
(forms--checkmod)
;; Calculate displacement.
- (let ((disp (- arg forms--current-record))
- (cur forms--current-record))
+ (let ((cur forms--current-record))
;; `forms--show-record' needs it now.
(setq forms--current-record arg)
;; Get the record and show it.
(forms--show-record
- (save-excursion
- (set-buffer forms--file-buffer)
+ (with-current-buffer forms--file-buffer
(beginning-of-line)
;; Move, and adjust the amount if needed (shouldn't happen).
- (if relative
- (if (zerop disp)
- nil
- (setq cur (+ cur disp (- (forward-line disp)))))
- (goto-char (point-min))
- (setq cur (+ cur disp (- (forward-line (1- arg))))))
+ (setq cur (- arg (forms--goto-record arg (if relative cur))))
(forms--get-record)))
(interactive)
(let
((numrec
- (save-excursion
- (set-buffer forms--file-buffer)
+ (with-current-buffer forms--file-buffer
(count-lines (point-min) (point-max)))))
(if (= numrec forms--total-records)
nil
;; Enable edit mode, if possible.
(let ((ro forms-read-only))
- (if (save-excursion
- (set-buffer forms--file-buffer)
+ (if (with-current-buffer forms--file-buffer
buffer-read-only)
(progn
(setq forms-read-only t)
the-list
forms-field-sep))
- (save-excursion
- (set-buffer forms--file-buffer)
- (goto-char (point-min))
- (forward-line (1- ln))
+ (with-current-buffer forms--file-buffer
+ (forms--goto-record ln)
(open-line 1)
(insert the-record)
(beginning-of-line))
(if (or arg
(y-or-n-p "Really delete this record? "))
(let ((ln forms--current-record))
- (save-excursion
- (set-buffer forms--file-buffer)
- (goto-char (point-min))
- (forward-line (1- ln))
+ (with-current-buffer forms--file-buffer
+ (forms--goto-record ln)
;; Use delete-region instead of kill-region, to avoid
;; adding junk to the kill-ring.
(delete-region (progn (beginning-of-line) (point))
(setq regexp forms--search-regexp))
(forms--checkmod)
- (let (the-line the-record here
- (fld-sep forms-field-sep))
- (save-excursion
- (set-buffer forms--file-buffer)
+ (let (the-line the-record here)
+ (with-current-buffer forms--file-buffer
(end-of-line)
(setq here (point))
(if (or (re-search-forward regexp nil t)
(setq regexp forms--search-regexp))
(forms--checkmod)
- (let (the-line the-record here
- (fld-sep forms-field-sep))
- (save-excursion
- (set-buffer forms--file-buffer)
+ (let (the-line the-record here)
+ (with-current-buffer forms--file-buffer
(beginning-of-line)
(setq here (point))
(if (or (re-search-backward regexp nil t)
(let ((write-file-filter forms-write-file-filter)
(read-file-filter forms-read-file-filter)
(cur forms--current-record))
- (save-excursion
- (set-buffer forms--file-buffer)
+ (with-current-buffer forms--file-buffer
(let ((inhibit-read-only t))
- ;; Write file hooks are run via local-write-file-hooks.
+ ;; Write file hooks are run via write-file-functions.
;; (if write-file-filter
;; (save-excursion
;; (run-hooks 'write-file-filter)))
(goto-char (aref forms--markers (1- (length forms--markers)))))))
(defun forms-print ()
- "Send the records to the printer with 'print-buffer', one record per page."
+ "Send the records to the printer with `print-buffer', one record per page."
(interactive)
(let ((inhibit-read-only t)
(save-record forms--current-record)
(while (<= nb-record forms--total-records)
(forms-jump-record nb-record)
(setq record (buffer-string))
- (save-excursion
- (set-buffer (get-buffer-create "*forms-print*"))
+ (with-current-buffer (get-buffer-create "*forms-print*")
(goto-char (buffer-end 1))
(insert record)
(setq buffer-read-only nil)
(if (< nb-record total-nb-records)
(insert "\n\f\n")))
(setq nb-record (1+ nb-record)))
- (save-excursion
- (set-buffer "*forms-print*")
+ (with-current-buffer "*forms-print*"
(print-buffer)
(set-buffer-modified-p nil)
(kill-buffer (current-buffer)))
(if (fboundp el)
(setq ret (concat ret (prin1-to-string (symbol-function el))
"\n"))))))
- (save-excursion
- (set-buffer (get-buffer-create "*forms-mode debug*"))
+ (with-current-buffer (get-buffer-create "*forms-mode debug*")
(if (zerop (buffer-size))
(emacs-lisp-mode))
(goto-char (point-max))
(insert ret)))))
+;;; arch-tag: 4a6695c7-d47a-4a21-809b-5cec7f8ec7a1
;;; forms.el ends here
HCoop / bpt / emacs.git / blobdiff