[Emacs-diffs] Changes to emacs/lisp/forms.el [lexbind]

[Miles Bader]

Index: emacs/lisp/forms.el
diff -c emacs/lisp/forms.el:2.43.2.1 emacs/lisp/forms.el:2.43.2.2
*** emacs/lisp/forms.el:2.43.2.1        Fri Apr  4 01:20:05 2003
--- emacs/lisp/forms.el Tue Oct 14 19:51:04 2003
***************
*** 286,292 ****
  ;; forms mode functions next/prev record and first/last
  ;; record.
  ;;
! ;; `local-write-file-hooks' is defined to save the actual data file
  ;; instead of the buffer data, `revert-file-hook' is defined to
  ;; revert a forms to original.
  
--- 286,292 ----
  ;; forms mode functions next/prev record and first/last
  ;; record.
  ;;
! ;; `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.
  
***************
*** 301,312 ****
  (provide 'forms)                      ;;; official
  (provide 'forms-mode)                 ;;; for compatibility
  
! (defconst forms-version (substring "$Revision: 2.43.2.1 $" 11 -2)
    "The version number of forms-mode (as string).  The complete RCS id is:
  
!   $Id: forms.el,v 2.43.2.1 2003/04/04 06:20:05 miles Exp $")
  
! (defcustom forms-mode-hooks nil
    "Hook run upon entering Forms mode."
    :group 'forms
    :type 'hook)
--- 301,312 ----
  (provide 'forms)                      ;;; official
  (provide 'forms-mode)                 ;;; for compatibility
  
! (defconst forms-version (substring "$Revision: 2.43.2.2 $" 11 -2)
    "The version number of forms-mode (as string).  The complete RCS id is:
  
!   $Id: forms.el,v 2.43.2.2 2003/10/14 23:51:04 miles Exp $")
  
! (defcustom forms-mode-hook nil
    "Hook run upon entering Forms mode."
    :group 'forms
    :type 'hook)
***************
*** 648,677 ****
    (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)
          (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)))))
        (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))))))
  
    ;; count the number of records, and set see if it may be modified
    (let (ro)
      (setq forms--total-records
!         (save-excursion
            (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)))
--- 648,671 ----
    (let ((read-file-filter forms-read-file-filter)
        (write-file-filter forms-write-file-filter))
      (if read-file-filter
!       (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
!             (add-hook 'write-file-functions write-file-filter nil t)))
        (if 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
!         (with-current-buffer forms--file-buffer
            (prog1
                (progn
                  ;;(message "forms: counting records...")
                  (bury-buffer (current-buffer))
                  (setq ro buffer-read-only)
                  (count-lines (point-min) (point-max)))
***************
*** 724,730 ****
  
    ;; user customising
    ;;(message "forms: proceeding setup (user hooks)...")
!   (run-hooks 'forms-mode-hooks)
    ;;(message "forms: setting up... done.")
  
    ;; be helpful
--- 718,724 ----
  
    ;; user customising
    ;;(message "forms: proceeding setup (user hooks)...")
!   (run-hooks 'forms-mode-hook 'forms-mode-hooks)
    ;;(message "forms: setting up... done.")
  
    ;; be helpful
***************
*** 757,763 ****
    (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
  
--- 751,756 ----
***************
*** 1226,1233 ****
        (let ((read-file-filter forms-read-file-filter)
              (the-record))
          (setq the-record
!               (save-excursion
!                 (set-buffer forms--file-buffer)
                  (let ((inhibit-read-only t))
                    (run-hooks 'read-file-filter))
                  (goto-char (point-min))
--- 1219,1225 ----
        (let ((read-file-filter forms-read-file-filter)
              (the-record))
          (setq the-record
!               (with-current-buffer forms--file-buffer
                  (let ((inhibit-read-only t))
                    (run-hooks 'read-file-filter))
                  (goto-char (point-min))
***************
*** 1238,1245 ****
          (kill-buffer forms--file-buffer)
  
          ;; Count the number of fields in `the-record'.
!         (let (the-result
!               (start-pos 0)
                found-pos
                (field-sep-length (length forms-field-sep)))
            (setq forms-number-of-fields 1)
--- 1230,1236 ----
          (kill-buffer forms--file-buffer)
  
          ;; Count the number of fields in `the-record'.
!         (let ((start-pos 0)
                found-pos
                (field-sep-length (length forms-field-sep)))
            (setq forms-number-of-fields 1)
***************
*** 1287,1293 ****
    (setq forms-mode-ro-map (make-keymap))
    (suppress-keymap forms-mode-ro-map)
    (define-key forms-mode-ro-map "\C-c" forms-mode-map)
-   (define-key forms-mode-ro-map "\t" 'forms-next-field)
    (define-key forms-mode-ro-map "q" 'forms-toggle-read-only)
    (define-key forms-mode-ro-map "l" 'forms-jump-record)
    (define-key forms-mode-ro-map "n" 'forms-next-record)
--- 1278,1283 ----
***************
*** 1304,1310 ****
  
    ;; This is the normal, local map.
    (setq forms-mode-edit-map (make-keymap))
-   (define-key forms-mode-edit-map "\t"   'forms-next-field)
    (define-key forms-mode-edit-map "\C-c" forms-mode-map)
    (forms--mode-commands1 forms-mode-edit-map)
    (forms--mode-menu-edit forms-mode-edit-map)
--- 1294,1299 ----
***************
*** 1405,1411 ****
  
  (defun forms--mode-commands1 (map)
    "Helper routine to define keys."
!   (define-key map [TAB] 'forms-next-field)
    (define-key map [S-tab] 'forms-prev-field)
    (define-key map [next] 'forms-next-record)
    (define-key map [prior] 'forms-prev-record)
--- 1394,1400 ----
  
  (defun forms--mode-commands1 (map)
    "Helper routine to define keys."
!   (define-key map "\t" 'forms-next-field)
    (define-key map [S-tab] 'forms-prev-field)
    (define-key map [next] 'forms-next-record)
    (define-key map [prior] 'forms-prev-record)
***************
*** 1455,1468 ****
    "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)
    "Internal exit from forms mode function."
  
    (let ((buf (buffer-name forms--file-buffer)))
--- 1444,1456 ----
    "Translate in SUBJ all chars ARG into char REP.  ARG and REP should
   be single-char strings."
    (let ((i 0)
        (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 (&optional save)
    "Internal exit from forms mode function."
  
    (let ((buf (buffer-name forms--file-buffer)))
***************
*** 1470,1477 ****
      (if (and save
             (buffer-modified-p forms--file-buffer))
        (forms-save-buffer))
!     (save-excursion
!       (set-buffer forms--file-buffer)
        (delete-auto-save-file-if-necessary)
        (kill-buffer (current-buffer)))
      (if (get-buffer buf)      ; not killed???
--- 1458,1464 ----
      (if (and save
             (buffer-modified-p forms--file-buffer))
        (forms-save-buffer))
!     (with-current-buffer forms--file-buffer
        (delete-auto-save-file-if-necessary)
        (kill-buffer (current-buffer)))
      (if (get-buffer buf)      ; not killed???
***************
*** 1598,1609 ****
      (if (string-match "\n" the-record)
        (error "Multi-line fields in this record - update refused"))
  
!     (save-excursion
!       (set-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)))
        (insert the-record)
        (beginning-of-line))))
  
--- 1585,1594 ----
      (if (string-match "\n" the-record)
        (error "Multi-line fields in this record - update refused"))
  
!     (with-current-buffer forms--file-buffer
        ;; Use delete-region instead of kill-region, to avoid
        ;; adding junk to the kill-ring.
!       (delete-region (line-beginning-position) (line-end-position))
        (insert the-record)
        (beginning-of-line))))
  
***************
*** 1635,1649 ****
      (find-file-other-window fn)
      (or forms--mode-setup (forms-mode t))))
  
! (defun forms-exit (query)
    "Normal exit from Forms mode.  Modified buffers are saved."
!   (interactive "P")
!   (forms--exit query t))
  
! (defun forms-exit-no-save (query)
    "Exit from Forms mode without saving buffers."
!   (interactive "P")
!   (forms--exit query nil))
  
  ;;; Navigating commands
  
--- 1620,1634 ----
      (find-file-other-window fn)
      (or forms--mode-setup (forms-mode t))))
  
! (defun forms-exit ()
    "Normal exit from Forms mode.  Modified buffers are saved."
!   (interactive)
!   (forms--exit t))
  
! (defun forms-exit-no-save ()
    "Exit from Forms mode without saving buffers."
!   (interactive)
!   (forms--exit nil))
  
  ;;; Navigating commands
  
***************
*** 1657,1662 ****
--- 1642,1657 ----
    (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: ")
***************
*** 1675,1699 ****
    (forms--checkmod)
  
    ;; Calculate displacement.
!   (let ((disp (- arg forms--current-record))
!       (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)
         (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))))))
  
         (forms--get-record)))
  
--- 1670,1687 ----
    (forms--checkmod)
  
    ;; Calculate displacement.
!   (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
!      (with-current-buffer forms--file-buffer
         (beginning-of-line)
  
         ;; Move, and adjust the amount if needed (shouldn't happen).
!        (setq cur (- arg (forms--goto-record arg (if relative cur))))
  
         (forms--get-record)))
  
***************
*** 1714,1721 ****
    (interactive)
    (let
        ((numrec
!       (save-excursion
!         (set-buffer forms--file-buffer)
          (count-lines (point-min) (point-max)))))
      (if (= numrec forms--total-records)
        nil
--- 1702,1708 ----
    (interactive)
    (let
        ((numrec
!       (with-current-buffer forms--file-buffer
          (count-lines (point-min) (point-max)))))
      (if (= numrec forms--total-records)
        nil
***************
*** 1740,1747 ****
  
        ;; Enable edit mode, if possible.
        (let ((ro forms-read-only))
!       (if (save-excursion
!             (set-buffer forms--file-buffer)
              buffer-read-only)
            (progn
              (setq forms-read-only t)
--- 1727,1733 ----
  
        ;; Enable edit mode, if possible.
        (let ((ro forms-read-only))
!       (if (with-current-buffer forms--file-buffer
              buffer-read-only)
            (progn
              (setq forms-read-only t)
***************
*** 1801,1810 ****
          the-list
          forms-field-sep))
  
!     (save-excursion
!       (set-buffer forms--file-buffer)
!       (goto-char (point-min))
!       (forward-line (1- ln))
        (open-line 1)
        (insert the-record)
        (beginning-of-line))
--- 1787,1794 ----
          the-list
          forms-field-sep))
  
!     (with-current-buffer forms--file-buffer
!       (forms--goto-record ln)
        (open-line 1)
        (insert the-record)
        (beginning-of-line))
***************
*** 1825,1834 ****
    (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))
          ;; Use delete-region instead of kill-region, to avoid
          ;; adding junk to the kill-ring.
          (delete-region (progn (beginning-of-line) (point))
--- 1809,1816 ----
    (if (or arg
          (y-or-n-p "Really delete this record? "))
        (let ((ln forms--current-record))
!       (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))
***************
*** 1852,1861 ****
        (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)
        (end-of-line)
        (setq here (point))
        (if (or (re-search-forward regexp nil t)
--- 1834,1841 ----
        (setq regexp forms--search-regexp))
    (forms--checkmod)
  
!   (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)
***************
*** 1888,1897 ****
        (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)
        (beginning-of-line)
        (setq here (point))
        (if (or (re-search-backward regexp nil t)
--- 1868,1875 ----
        (setq regexp forms--search-regexp))
    (forms--checkmod)
  
!   (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)
***************
*** 1921,1930 ****
    (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)
        (let ((inhibit-read-only t))
!       ;; Write file hooks are run via local-write-file-hooks.
        ;; (if write-file-filter
        ;;  (save-excursion
        ;;   (run-hooks 'write-file-filter)))
--- 1899,1907 ----
    (let ((write-file-filter forms-write-file-filter)
        (read-file-filter forms-read-file-filter)
        (cur forms--current-record))
!     (with-current-buffer forms--file-buffer
        (let ((inhibit-read-only t))
!       ;; Write file hooks are run via write-file-functions.
        ;; (if write-file-filter
        ;;  (save-excursion
        ;;   (run-hooks 'write-file-filter)))
***************
*** 2021,2036 ****
      (while (<= nb-record forms--total-records)
        (forms-jump-record nb-record)
        (setq record (buffer-string))
!       (save-excursion
!       (set-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\n")))
        (setq nb-record (1+ nb-record)))
!     (save-excursion
!       (set-buffer "*forms-print*")
        (print-buffer)
        (set-buffer-modified-p nil)
        (kill-buffer (current-buffer)))
--- 1998,2011 ----
      (while (<= nb-record forms--total-records)
        (forms-jump-record nb-record)
        (setq record (buffer-string))
!       (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\n")))
        (setq nb-record (1+ nb-record)))
!     (with-current-buffer "*forms-print*"
        (print-buffer)
        (set-buffer-modified-p nil)
        (kill-buffer (current-buffer)))
***************
*** 2078,2088 ****
              (if (fboundp el)
                  (setq ret (concat ret (prin1-to-string (symbol-function el))
                                    "\n"))))))
!       (save-excursion
!         (set-buffer (get-buffer-create "*forms-mode debug*"))
          (if (zerop (buffer-size))
              (emacs-lisp-mode))
          (goto-char (point-max))
          (insert ret)))))
  
  ;;; forms.el ends here
--- 2053,2063 ----
              (if (fboundp el)
                  (setq ret (concat ret (prin1-to-string (symbol-function el))
                                    "\n"))))))
!       (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