home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / interfaces / sccs2.el < prev    next >
Encoding:
Text File  |  1993-02-28  |  18.6 KB  |  534 lines
  1. ;;;;
  2. ;;;;    sccs.el
  3. ;;;;
  4. ;;;;    "SCCS: The condom of promiscuous programmers"
  5. ;;;;
  6. ;;;;    "SCCS, the source motel!  Programs check in and never check out!"
  7. ;;;;     -- Ken Thompson
  8. ;;;;
  9. ;;;;    Written and maintained by Johnathan Vail (JV), Tegra Varityper
  10. ;;;;        vail@tegra.com
  11. ;;;;        (508) 663-7435
  12. ;;;;    Modified by Kevin Rodgers (KR), Martin Marietta
  13. ;;;;        kevin@traffic.den.mmc.com
  14. ;;;;        (303) 790-3971
  15.  
  16. ;;;;    Revision History:
  17. ;;;;    19 Feb 1993 KR    - sccs-do: check for null buffer-file-name
  18. ;;;;     2 Feb 1993 KR    - sccs-do: reworked compilation-error-list parsing
  19. ;;;;    11 Jan 1993 KR    - defined sccs-read-comment and count-string-matches
  20. ;;;;    21 Dec 1992 KR    - sccs-prefix bound in global keymap, define sccs-prs
  21. ;;;;     3 Dec 1992 KR    - modularize the "Display SCCS output" code in sccs-do
  22. ;;;;     3 Dec 1992 JV    - incorporate new changes
  23. ;;;;    30 Nov 1992 KR    - wrap calls to sccs-delta-comments in save-excursion
  24. ;;;;    30 Nov 1992 KR    - sccs-delget and -deledit can supply a default comment
  25. ;;;;    30 Nov 1992 KR    - Added sccs-delta-comments logic to sccs-deledit
  26. ;;;;    25 Nov 1992 JV    - Changes to fold back to my original code
  27. ;;;;    19 Nov 1992 KR    - Fixed computation of current line in sccs-do
  28. ;;;;    10 May 1992 KR    - Defined sccs-clean, -deledit, -unedit, and -diffs
  29. ;;;;    10 May 1992 KR    - sccs-delget: tegra-datestamp -> sccs-delta-comments
  30. ;;;;    10 May 1992 KR    - sccs-do: display *SCCS* buffer, instead of message
  31. ;;;;    10 May 1992 KR    - sccs-do: next-error hacks simplified
  32. ;;;;     9 May 1992 KR    - Changed keybinding scheme to use local keymap
  33. ;;;;    14 Nov 1989 JV    - Examine error list to decide to reparse errors
  34. ;;;;    10 Nov 1989 JV    - Add next-error hacks
  35. ;;;;     8 Nov 1989 JV    - Add Comment defaults
  36. ;;;;     7 Nov 1989 JV    - Fix column position bug
  37. ;;;;     6 Nov 1989 JV    - Another day, another hack
  38.  
  39. ;;;;    Purpose:
  40. ;;;;    Perform common 'SCCS' commands from within Emacs.
  41. ;;;;    See sccs-keymap for the defined functions.
  42.  
  43. ;;;;    Installation:
  44. ;;;;    1. Put this file in a directory that is a member of load-path, and
  45. ;;;;       byte-compile it for better performance.
  46. ;;;;    2. Put this form in ~/.emacs:
  47. ;;;;       (require 'sccs)
  48. ;;;;    3. Users on systems which do not support the SCCS 'prt' subcommand 
  49. ;;;;       (e.g. SGI) should also put this form in ~/.emacs:
  50. ;;;;       (define-key sccs-keymap "p" (function sccs-prs))
  51. ;;;;    4. Users who wish to supply multi-line comments when checking in
  52. ;;;;       files with sccs-delget and -deledit may want to see sccs-
  53. ;;;;       comment.el; those who wish to use JV's customization should
  54. ;;;;       see the comment block above sccs-delta-comments' definition.
  55.  
  56. ;;;;    Usage:
  57. ;;;;    While visiting a file or directory, invoke the sccs commands for
  58. ;;;;    information, or to check the file in or out (as appropriate) of
  59. ;;;;    SCCS.
  60.  
  61. ;;;;    Known bugs:
  62. ;;;;    1. Some systems do not support the SCCS prt subcommand.  The work-
  63. ;;;;       around is described under "Installation", above.
  64.  
  65. ;;;;    LCD Archive Entry:
  66. ;;;;    sccs2|Johnathan Vail, Kevin Rodgers|
  67. ;;;;    vail@tegra.com, kevin@traffic.den.mmc.com|
  68. ;;;;    Emacs interface for common SCCS operations.|
  69. ;;;;    1993-02-23|2.0|~/packages/sccs2.el.Z|
  70.  
  71.  
  72. ;;;;    Copyright notice:
  73. ;;;;    Copyright (C) 1993 Johnathan Vail
  74. ;;;;
  75. ;;;;    This program is free software; you can redistribute it and/or modify
  76. ;;;;    it under the terms of the GNU General Public License as published by
  77. ;;;;    the Free Software Foundation; either version 1, or (at your option)
  78. ;;;;    any later version.
  79. ;;;;
  80. ;;;;    This program is distributed in the hope that it will be useful,
  81. ;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
  82. ;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  83. ;;;;    GNU General Public License for more details.
  84. ;;;;
  85. ;;;;    You should have received a copy of the GNU General Public License
  86. ;;;;    along with this program; if not, write to the Free Software
  87. ;;;;    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  88. ;;;;
  89.  
  90.  
  91. ;;;;    To do:
  92. ;;;;    1. Find a way to pass flags other than -rsid and -ycomment to 'sccs'
  93. ;;;;       commands (e.g. 'sccs diffs -C'); either a global variable
  94. ;;;;       sccs-command-args that can be lambda-bound, or a property:
  95. ;;;;       (get 'diffs 'sccs-command-args) => ("-C")
  96. ;;;;    2. Provide appropriate hooks.
  97.  
  98.  
  99. (provide 'sccs)
  100.  
  101.  
  102. ;;; Keybindings:
  103.  
  104. (defvar sccs-keymap nil
  105.   "Keymap for bindings of 'SCCS' functions:
  106. \\{sccs-keymap}
  107. ")
  108.  
  109. (if (null sccs-keymap)
  110.     (progn
  111.       (setq sccs-keymap (make-sparse-keymap))
  112.       (define-key sccs-keymap "i" (function sccs-info))
  113.       (define-key sccs-keymap "p" (function sccs-prt))
  114.       (define-key sccs-keymap "d" (function sccs-diffs))
  115.       (define-key sccs-keymap "c" (function sccs-create))
  116.       (define-key sccs-keymap "C" (function sccs-clean))
  117.       (define-key sccs-keymap "g" (function sccs-get))
  118.       (define-key sccs-keymap "e" (function sccs-edit))
  119.       (define-key sccs-keymap "D" (function sccs-delget))
  120.       (define-key sccs-keymap "E" (function sccs-deledit))
  121.       (define-key sccs-keymap "U" (function sccs-unedit))
  122.       (define-key sccs-keymap "o" (function sccs-display-output))))
  123.  
  124. (defconst sccs-prefix "\C-c\C-s"
  125.   "*Prefix key for sccs-keymap in global keymap, if non-nil.
  126. The value of sccs-prefix is only used when the 'sccs' library is
  127. initially loaded.
  128.  
  129. Here's how to bind 'sccs' commands locally instead of globally:
  130. (setq find-file-hooks
  131.       (cons (function (lambda ()
  132.             (let ((sccs-prefix nil)) ; prevent global binding
  133.               (if (and (file-directory-p \"SCCS\")
  134.                    (or (not (featurep 'sccs))
  135.                        (not (eq (key-binding local-sccs-prefix)
  136.                         sccs-keymap))))
  137.                   (progn
  138.                 (load-library \"sccs\")
  139.                 (local-set-key \"\\C-c\\C-c\" sccs-keymap))))))
  140.         find-file-hooks))
  141. ")
  142.  
  143. (if sccs-prefix
  144.     (global-set-key sccs-prefix sccs-keymap))
  145.  
  146.  
  147. ;; Options:
  148.  
  149. ;;
  150. ;; sccs-delta-comments
  151. ;;
  152. ;; This variable can be used for generating a default comment string
  153. ;; which can be edited in the mini-buffer.  The following is what I have
  154. ;; in my .emacs file for picking the first comment string I put in the
  155. ;; file of the current day.  I include it here as an example of one way
  156. ;; to use this variable. [JV]
  157. ;;
  158. ;;(defun tegra-get-comment-for-sccs ()
  159. ;;  "Gets the comment from today's timestamp entry (if any)"
  160. ;;
  161. ;;  (save-excursion
  162. ;;    (and (fboundp 'tegra-datestamp)
  163. ;;     (goto-char (point-min))
  164. ;;     (re-search-forward (concat (tegra-datestamp) "\\(.*$\\)") nil t)
  165. ;;     (buffer-substring (match-beginning 1) (match-end 1)))))
  166. ;;
  167. ;;(setq sccs-delta-comments (function tegra-get-comment-for-sccs))
  168. ;;
  169.  
  170. (defvar sccs-delta-comments nil
  171.   "*Either nil or a function that takes no arguments and returns a string.
  172. If not nil, its value is invoked by sccs-delget and -deledit to provide a
  173. default 'SCCS' delta comment when they are called interactively; when they
  174. are called non-interactively with a nil COMMENTS arg, its value (when non-
  175. nil) is invoked to generate the comment.")
  176.  
  177.  
  178. ;;
  179. ;; sccs-buffer-name
  180. ;;
  181.  
  182. (defvar sccs-buffer-name "*SCCS*"
  183.   "*The name of the buffer to which 'SCCS' output is sent.")
  184.  
  185. ;;
  186. ;; sccs-show-output
  187. ;;
  188.  
  189. (defvar sccs-show-output nil
  190.   "*If non-nil, display the output from 'SCCS' commands in a buffer;
  191. otherwise, display a synopsis of the output in the echo area.")
  192.  
  193.  
  194.  
  195. ;;; SCCS funtions:
  196.  
  197.  
  198. (defun sccs-info ()
  199.   "*Display the files in the current directory checked out under 'SCCS'
  200. for editing.  Invoked by \\[sccs-info]."
  201.   (interactive)
  202.   (let ((sccs-show-output t))
  203.     (sccs-do "info" nil)))
  204.  
  205.  
  206. (defun sccs-prt ()
  207.   "*Display the 'SCCS' history for the current file.  Invoked by \\[sccs-prt]."
  208.   (interactive)
  209.   (let ((sccs-show-output t))
  210.     (sccs-do "prt" buffer-file-name)))
  211.  
  212. (defun sccs-prs ()
  213.   "*Display the 'SCCS' history for the current file.  Invoked by \\[sccs-prs]."
  214.   (interactive)
  215.   (let ((sccs-show-output t))
  216.     (sccs-do "prs" buffer-file-name)))
  217.  
  218.  
  219. (defun sccs-diffs (version)
  220.   "*If the current buffer is not read-only, compare the file (on disk) to the
  221. VERSION under 'SCCS' control.  Invoked by \\[sccs-diffs]."
  222.   (interactive "sVersion [most recent]: ")
  223.   (if buffer-read-only
  224.       (error "Current buffer is read-only")
  225.     (progn
  226.       (if (buffer-modified-p)
  227.       ;; Give the user the option to save the buffer:
  228.       (if (y-or-n-p "Current buffer has been modified; save it? ")
  229.           (save-buffer)))
  230.       (sccs-do "diffs" buffer-file-name version))))
  231.  
  232.  
  233. (defun sccs-create ()
  234.   "*If the current buffer is read-only or has not been modified, put the
  235. current file under 'SCCS' control.  Invoked by \\[sccs-create]."
  236.   (interactive)
  237.   (if (or buffer-read-only (not (buffer-modified-p)))
  238.       (sccs-do "create" t)
  239.     (error "Current buffer is not read-only or has been modified")))
  240.  
  241.  
  242. (defun sccs-clean ()
  243.   "*Remove all files checked-in under 'SCCS' from the current directory.
  244. Invoked by \\[sccs-clean]."
  245.   (interactive)
  246.   (sccs-do "clean"))
  247.  
  248.  
  249. (defun sccs-get (version)
  250.   "*If the current buffer is read-only, retrieve the 'SCCS' VERSION (which
  251. defaults to the most recent delta id) of the current file into the buffer.
  252. Invoked by \\[sccs-get]."
  253.   (interactive "sVersion [most recent]: ")
  254.   (if buffer-read-only
  255.       (sccs-do "get" t version)
  256.     (error "Current buffer is not read-only")))
  257.  
  258.  
  259. (defun sccs-edit ()
  260.   "*If the current buffer is read only, retrieve a new version of the file
  261. >from 'SCCS' for editing into the buffer.  Invoked by \\[sccs-edit]."
  262.   (interactive)
  263.   (if buffer-read-only
  264.       (sccs-do "edit" t)
  265.     (error "Current buffer is not read-only")))
  266.  
  267.  
  268. (defun sccs-delget (comments)
  269.   "*If the current buffer is not read-only and has not been modified (or is
  270. saved upon query), check it in under 'SCCS' with the annotation COMMENTS, and
  271. retrieve the new version into the buffer.
  272. If COMMENTS is nil and sccs-delta-comments is not nil, it's value will be
  273. invoked and the return value will be used instead.
  274. Invoked by \\[sccs-delget]."
  275.   (interactive (list (sccs-read-comment (if sccs-delta-comments
  276.                         (save-excursion
  277.                           (funcall sccs-delta-comments))))))
  278.   (if (and (not buffer-read-only)
  279.        (or (not (buffer-modified-p))
  280.            (and (y-or-n-p "Current buffer has been modified; save it? ")
  281.             (progn
  282.               (save-buffer)
  283.               t))))
  284.       (progn
  285.     (if (and (not (interactive-p))
  286.          (null comments)
  287.          sccs-delta-comments)
  288.         (setq comments
  289.           (save-excursion
  290.             (funcall sccs-delta-comments))))
  291.     (sccs-do "delget" t nil comments))
  292.     (error "Current buffer is read-only or has been modified")))
  293.  
  294.  
  295. (defun sccs-deledit (comments)
  296.   "*If the current buffer is not read-only and has not been modified (or is
  297. saved upon query), check it in under 'SCCS' with the annotation COMMENTS, get
  298. a new version for editing and retrieve it into the buffer.
  299. If COMMENTS is nil and sccs-delta-comments is not nil, it's value will be
  300. invoked and the return value will be used instead.
  301. Invoked by \\[sccs-deledit]."
  302.   (interactive (list (sccs-read-comment (if sccs-delta-comments
  303.                         (save-excursion
  304.                           (funcall sccs-delta-comments))))))
  305.   (if (and (not buffer-read-only)
  306.        (or (not (buffer-modified-p))
  307.            (and (y-or-n-p "Current buffer has been modified; save it? ")
  308.             (progn
  309.               (save-buffer)
  310.               t))))
  311.       (progn
  312.     (if (and (not (interactive-p))
  313.          (null comments)
  314.          sccs-delta-comments)
  315.         (setq comments
  316.           (save-excursion
  317.             (funcall sccs-delta-comments))))
  318.     (sccs-do "deledit" t nil comments))
  319.     (error "Current buffer is read-only or has been modified")))
  320.  
  321.  
  322. (defun sccs-unedit ()
  323.   "*If the current buffer is not read-only, revoke the 'SCCS' edit (and any
  324. changes written to the file), and retrieve the most recent version into the
  325. buffer.  Invoked by \\[sccs-unedit]."
  326.   (interactive)
  327.   (if (not buffer-read-only)
  328.       (sccs-do "unedit" t)
  329.     (error "Current buffer is read-only")))
  330.  
  331.  
  332. (defun sccs-display-output ()
  333.   "*Display the output from the most recent 'SCCS' command in a buffer."
  334.   (interactive)
  335.   (let ((sccs-buffer (get-buffer sccs-buffer-name)))
  336.     (if sccs-buffer
  337.     (let ((restore-display-key;; see print-help-return-message in help.el
  338.            (substitute-command-keys
  339.         (if (one-window-p t)
  340.             (if pop-up-windows
  341.             "\\[delete-other-windows]"
  342.               "\\[switch-to-buffer] RET")
  343.           "\\[switch-to-buffer-other-window] RET"))))
  344.       (display-buffer sccs-buffer)
  345.       (message (format "Type %s to restore display without %s buffer"
  346.                restore-display-key sccs-buffer-name)))
  347.       (error "'%s' buffer does not exist." sccs-buffer-name))))
  348.  
  349.  
  350. ;;;
  351. ;;; SCCS utility:
  352. ;;;
  353.  
  354.  
  355. (defun sccs-do (command file &optional version comments)
  356.   "Exececute sccs subcommand COMMAND on FILE (may be nil) with optional
  357. arguments VERSION and COMMENTS (may be empty strings).  If FILE is t,
  358. use the file currently visited and re-visit it after the 'SCCS'
  359. operation \(invalidating the mark-ring\); then if compilation-error-list
  360. is also bound to a list, reparse it."
  361.   ;; Translate FILE to filename and get an 'SCCS' output buffer:
  362.   (let ((filename
  363.      (cond ((null file) nil)
  364.            ((eq file 't)
  365.         (if buffer-file-name
  366.             (file-name-nondirectory buffer-file-name)
  367.           (error "Current buffer is not visiting a file.")))
  368.            ((stringp file) (file-name-nondirectory file))
  369.            (t nil)))
  370.     (directory
  371.      (cond ((or (null file)
  372.             (eq file 't))
  373.         (if buffer-file-name
  374.             (file-name-directory buffer-file-name)
  375.           default-directory))
  376.            ((stringp file) (file-name-directory file))
  377.            (t "/"))))
  378.     ;; Translate optional arguments to SCCS subcommand flags:
  379.     (cond ((null version))
  380.       ((string-equal version "") (setq version nil))
  381.       (t (setq version (concat "-r" version))))
  382.     (cond ((null comments))
  383.       ((string-equal comments "") (setq comments nil))
  384.       (t (setq comments (concat "-y" comments))))
  385.     ;; Execute SCCS command and capture its output in a buffer:
  386.     (save-excursion
  387.       (set-buffer (get-buffer-create sccs-buffer-name))
  388.       (setq default-directory directory)
  389.       (setq buffer-read-only nil)
  390.       (widen)
  391.       (erase-buffer)
  392.       (let ((sccs-args
  393.          (nconc (if version (list version))
  394.             (if comments (list comments))
  395.             (if filename (list filename)))))
  396.     (apply (function message) "sccs %s %s..." command sccs-args)
  397.     (apply (function call-process) "sccs" nil t nil command sccs-args)
  398.     (apply (function message) "sccs %s %s...Done" command sccs-args))
  399.       (setq buffer-read-only t)
  400.       (goto-char (point-min)))
  401.     ;; Re-visit FILE:
  402.     (if (eq file 't)
  403.     (let* ((column (current-column))
  404.            (line (+ (count-lines (point-min) (point))
  405.             (if (zerop column) 1 0)))
  406.            (reparse (and (boundp 'compilation-error-list)
  407.                  (listp compilation-error-list)
  408.                  (let ((buffer (current-buffer))
  409.                    (errors compilation-error-list)
  410.                    (buffer-error-marked-p nil))
  411.                    (while (and errors (not buffer-error-marked-p))
  412.                  (if (eq (marker-buffer
  413.                       (car (cdr (car errors))))
  414.                      buffer)
  415.                      (setq buffer-error-marked-p t))
  416.                  (setq errors (cdr errors)))
  417.                    buffer-error-marked-p))))
  418.       (find-alternate-file filename)
  419.       ;; Restore point:
  420.       (goto-line line)
  421.       (move-to-column column)
  422.       ;; Reparse remaining *compilation* errors, if necessary:
  423.       (if reparse            ; see next-error (compile.el)
  424.           (save-excursion
  425.         (set-buffer "*compilation*")
  426.         (set-buffer-modified-p nil) ; ?
  427.         (if (consp compilation-error-list) ; not t, nor ()
  428.             (setq compilation-parsing-end
  429.               (marker-position
  430.                (car (car compilation-error-list)))))
  431.         (compilation-forget-errors)
  432.         (compilation-parse-errors)))))
  433.     ;; Display SCCS output:
  434.     (if (or sccs-show-output
  435.         (null (sccs-display-message command filename)))
  436.     (sccs-display-output))))
  437.  
  438.  
  439. ;; sccs-display-message options (not to be configured by users):
  440.  
  441. (defvar sccs-error-regexp "\\'ERROR.*$"
  442.   "Regular expression to match 'SCCS' error messages.")
  443.  
  444. (defvar sccs-edit-regexp
  445.   "^\\([0-9.]+\\)[^0-9.]new delta \\([0-9.]+\\)[^0-9.]\\([0-9]+\\) lines"
  446.   "Regular expression to match 'SCCS' edit messages.
  447. The first subexpression matches the old version number,
  448. the second subexpression matches new version number, and
  449. the third subexpression matches the number of lines in the file.")
  450.  
  451. (defvar sccs-delta-regexp
  452.   "^\\([0-9.]+\\)[^0-9.]\\([0-9.]+ inserted\\)[^0-9.]\\([0-9]+ deleted\\)$"
  453.   "Regular expression to match 'SCCS' diff summary.
  454. The first subexpression matches the version number,
  455. the second subexpression matches reported insertions,
  456. and the third subexpression matches the reported deletions.")
  457.  
  458. (defvar sccs-version-regexp "^[0-9.]+$"
  459.   "Regular expression to match the most recent 'SCCS' version.")
  460.  
  461.   
  462. (defun sccs-display-message (&optional command filename)
  463.   "Display a synopsis of the output of the most recent 'SCCS' command
  464. in the echo area, prefixed by optional arguments COMMAND and FILENAME.
  465. Returns nil if an error was reported or if the output format is not
  466. recognized."
  467.   (let ((sccs-buffer (get-buffer sccs-buffer-name))
  468.     (synopsis nil)
  469.     (result t))
  470.     (if sccs-buffer
  471.     (save-excursion
  472.       (set-buffer sccs-buffer)
  473.       (goto-char (point-min))
  474.       (cond ((looking-at sccs-error-regexp)
  475.          (setq synopsis (buffer-substring (match-beginning 0)
  476.                           (match-end 0))
  477.                result nil))
  478.         ((re-search-forward sccs-edit-regexp nil t)
  479.          (setq synopsis
  480.                (format "%s -> %s (%s lines)"
  481.                    (buffer-substring (match-beginning 1)
  482.                          (match-end 1))
  483.                    (buffer-substring (match-beginning 2)
  484.                          (match-end 2))
  485.                    (buffer-substring (match-beginning 3)
  486.                          (match-end 3)))))
  487.         ((re-search-forward sccs-delta-regexp nil t)
  488.          (setq synopsis
  489.                (format "-> %s (%s, %s)"
  490.                    (buffer-substring (match-beginning 1)
  491.                          (match-end 1))
  492.                    (buffer-substring (match-beginning 2)
  493.                          (match-end 2))
  494.                    (buffer-substring (match-beginning 3)
  495.                          (match-end 3)))))
  496.         ((re-search-forward sccs-version-regexp nil t)
  497.          (setq synopsis
  498.                (format "-> %s"
  499.                    (buffer-substring (match-beginning 0)
  500.                          (match-end 0)))))
  501.         (t (setq result nil)))
  502.       (if synopsis
  503.           (message "sccs %s %s: %s"
  504.                (or command "")
  505.                (if filename (file-name-nondirectory filename) "")
  506.                synopsis))
  507.       result)
  508.       (error "'%s' buffer does not exist." sccs-buffer-name))))
  509.  
  510.  
  511. (defun sccs-read-comment (default)
  512.   "Prompt for and read an 'SCCS' comment string, with DEFAULT as the
  513. initial contents of the minibuffer.  DEFAULT may be nil; if it is a
  514. string, it may contain embedded newlines."
  515.   (let ((enable-recursive-minibuffers t)) ; select-window ... read-string
  516.     (save-window-excursion
  517.       (select-window (minibuffer-window))
  518.       (enlarge-window (- (+ (count-string-matches "\n" (or default ""))
  519.                 1)
  520.              (window-height (selected-window))))
  521.       (read-string "Comments: " default))))
  522.  
  523. (defun count-string-matches (regexp string &optional start)
  524.   "Return the number of matches for REGEXP in STRING.  If optional
  525. argument START is non-nil, count matches from that index in STRING."
  526.   (let ((match-data (match-data))
  527.     (count 0))
  528.     (unwind-protect
  529.     (while (string-match regexp string start)
  530.       (setq count (1+ count)
  531.         start (match-end 0)))
  532.       (store-match-data match-data))
  533.     count))
  534.