;;(checkpoint 123)
(defun toggle--remove-lisp-checkpoints ()
  (interactive)
  (assert (eq major-mode 'emacs-lisp-mode))
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward "^[ \t]*(checkpoint\\(.*\\)" nil t)
      (setq region (buffer-substring-no-properties (match-beginning 1)
                                                   (match-end 1)))
      (delete-region (point-at-bol) (point-at-eol))
      (insert ";;(checkpoint" region)
      )
    )
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward "^[ \t]*(BEGIN_FUNCTION)" nil t)
      (delete-region (point-at-bol) (point-at-eol))
      (insert ";;(BEGIN_FUNCTION)")
      )
    )
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward "^[ \t]*(END_FUNCTION)" nil t)
      (delete-region (point-at-bol) (point-at-eol))
      (insert ";;(END_FUNCTION)")
      )
    )
  (indent-region (point-min) (point-max) nil)
  )

(defun toggle--remove-lisp++-checkpoints ()
  (interactive)
  (assert (eq major-mode 'c++-mode))
  (assert (boundp 'lisp++))
  (assert lisp++)
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward "^[ \t]*(s CHECKPOINT;)" nil t)
      (delete-region (point-at-bol) (point-at-eol))
      (insert "//(s CHECKPOINT;)"))
    )
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward "^[ \t]*(s BEGIN_FUNCTION;)" nil t)
      (delete-region (point-at-bol) (point-at-eol))
      (insert "//(s BEGIN_FUNCTION;)"))
    )
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward "^[ \t]*(s END_FUNCTION;)" nil t)
      (delete-region (point-at-bol) (point-at-eol))
      (insert "//(s END_FUNCTION;)"))
    )
  (indent-region (point-min) (point-max) nil)
  )
;;(setq deep t)
(defun toggle--remove-cc-checkpoints (deep)
  (interactive)
  (let* ((list (directory-files "." nil "\\(cc\\|ch\\|hh\\)$"))
         (ptr  list)
         (i    0)
         (len  (length list)))
    (if (not deep) (setq ptr (cons (buffer-file-name) nil)))
    (while ptr
      (when deep
        (find-file (car ptr))
        (incf i)
        (message "Processing file %s/%s ..." i len))
      (assert (or (eq major-mode 'c-mode)
                  (eq major-mode 'c++-mode)
                  (eq major-mode 'java-mode)))
      (save-excursion
        (goto-char (point-min))
        (while (re-search-forward "^[ \t]*CHECKPOINT;" nil t)
          (delete-region (point-at-bol) (point-at-eol))
          (insert "//CHECKPOINT;"))
        )
      (save-excursion
        (goto-char (point-min))
        (while (re-search-forward "^[ \t]*BEGIN_FUNCTION;" nil t)
          (delete-region (point-at-bol) (point-at-eol))
          (insert "//BEGIN_FUNCTION;"))
        )
      (save-excursion
        (goto-char (point-min))
        (while (re-search-forward "^[ \t]*END_FUNCTION;" nil t)
          (delete-region (point-at-bol) (point-at-eol))
          (insert "//END_FUNCTION;"))
        )
      (save-excursion
        (goto-char (point-min))
        (while (re-search-forward "^[ \t]*PRINT(" nil t)
          (delete-region (point-at-bol) (match-end 0))
          (insert "//PRINT("))
        )
      ;;(d-foo)
      (indent-region (point-min) (point-max) nil)
      (when deep
        (save-buffer)
        (kill-buffer nil))
      (setq ptr (cdr ptr))
      )))

(defun toggle--add-lisp-checkpoints ()
  (interactive)
  (assert (eq major-mode 'emacs-lisp-mode))
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward "^[ \t]*;;(checkpoint\\(.*\\)" nil t)
      (setq region (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
      (delete-region (point-at-bol) (point-at-eol))
      (insert "  (checkpoint" region))
    )
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward "^[ \t]*;;(BEGIN_FUNCTION)" nil t)
      (delete-region (point-at-bol) (point-at-eol))
      (insert "  (BEGIN_FUNCTION)"))
    )
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward "^[ \t]*;;(END_FUNCTION)" nil t)
      (delete-region (point-at-bol) (point-at-eol))
      (insert "  (END_FUNCTION)"))
    )
  (indent-region (point-min) (point-max) nil)
  )

(defun toggle--add-lisp++-checkpoints ()
  (interactive)
  (assert (eq major-mode 'c++-mode))
  (assert (boundp 'lisp++))
  (assert lisp++)
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward "^[ \t]*//(s CHECKPOINT;)" nil t)
      (delete-region (point-at-bol) (point-at-eol))
      (insert "  (s CHECKPOINT;)"))
    )
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward "^[ \t]*//(s BEGIN_FUNCTION;)" nil t)
      (delete-region (point-at-bol) (point-at-eol))
      (insert "  (s BEGIN_FUNCTION;)"))
    )
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward "^[ \t]*//(s END_FUNCTION;)" nil t)
      (delete-region (point-at-bol) (point-at-eol))
      (insert "  (s END_FUNCTION;)"))
    )
  (indent-region (point-min) (point-max) nil)
  )

(defun toggle--add-cc-checkpoints (deep)
  (interactive)
  (let* ((list (directory-files "." nil "\\(cc\\|ch\\|hh\\)$"))
         (ptr  list)
         (i    0)
         (len  (length list)))
    (if (not deep) (setq ptr (cons (buffer-file-name) nil)))
    (while ptr
      (when deep
        (find-file (car ptr))
        (incf i)
        (message "Processing file %s/%s ..." i len))
      (assert (or (eq major-mode 'c-mode)
                  (eq major-mode 'c++-mode)
                  (eq major-mode 'java-mode)))
      (save-excursion
        (goto-char (point-min))
        (while (re-search-forward "^[ \t]*//CHECKPOINT;" nil t)
          (delete-region (point-at-bol) (point-at-eol))
          (insert "  CHECKPOINT;"))
        )
      (save-excursion
        (goto-char (point-min))
        (while (re-search-forward "^[ \t]*//BEGIN_FUNCTION;" nil t)
          (delete-region (point-at-bol) (point-at-eol))
          (insert "  BEGIN_FUNCTION;"))
        )
      (save-excursion
        (goto-char (point-min))
        (while (re-search-forward "^[ \t]*//END_FUNCTION;" nil t)
          (delete-region (point-at-bol) (point-at-eol))
          (insert "  END_FUNCTION;"))
        )
      (save-excursion
        (goto-char (point-min))
        (while (re-search-forward "^[ \t]*//PRINT(" nil t)
          (delete-region (point-at-bol) (match-end 0))
          (insert "  PRINT("))
        )
      (setq ptr (cdr ptr))
      (indent-region (point-min) (point-max) nil)
      (when deep
        (save-buffer)
        (kill-buffer nil))
      )))

(defun toggle-checkpoints (foo)
  (interactive "P")
  ;;(message "foo=%s" foo)
  (cond
   ((eq major-mode 'emacs-lisp-mode)
    (save-excursion
      (if (save-excursion
            (goto-char (point-min))
            (re-search-forward "^[ \t]*;;(checkpoint" nil t))
          (toggle--add-lisp-checkpoints)
        (toggle--remove-lisp-checkpoints))))
   ((and (eq major-mode 'c++-mode)
         (boundp 'lisp++)
         lisp++)
    (save-excursion
      (if (save-excursion
            (goto-char (point-min))
            (re-search-forward "^[ \t]*//(s CHECKPOINT;)" nil t))
          (toggle--add-lisp++-checkpoints)
        (toggle--remove-lisp++-checkpoints))))
   ((or (eq major-mode 'c-mode)
        (eq major-mode 'c++-mode)
        (eq major-mode 'java-mode))
    (save-excursion
      (if (save-excursion
            (goto-char (point-min))
            (re-search-forward "^[ \t]*//CHECKPOINT;" nil t))
          (toggle--add-cc-checkpoints foo)
        (toggle--remove-cc-checkpoints foo))))
   )
  )

(defun purge-comment-lines ()
  (interactive)
  (assert (eq major-mode 'emacs-lisp-mode))
  (save-excursion
    (goto-char (point-min))
    (while (not (eobp))
      (beginning-of-line)
      (if (looking-at "^[ \t]*;;[^;]")
          (delete-region (point-at-bol) (1+ (point-at-eol))))
      (forward-line 1))
    )
  )

(defun purge-blank-lines-keep-defuns-separate ()
  (interactive)
  (assert (eq major-mode 'emacs-lisp-mode))
  (progn
    (save-excursion
      (goto-char (point-min))
      (flush-lines "^[ \t]*$"))
    (save-excursion
      (goto-char (point-min))
      (while (re-search-forward "^(defun " nil t)
        ;;(debug)
        (save-excursion
          (forward-line -1)
          (end-of-line)
          (insert "\n")))
      (goto-char (point-min))
      (d-quote while (re-search-forward "(\\(save-excursion\\|save-match-data\\)" nil t)
               (save-excursion
                 (forward-line -1)
                 (end-of-line)
                 (insert "\n")))))
  )

(defun d-delete-line ()
  (delete-region (point-at-bol) (1+ (point-at-eol))))

(defun debug-remove-debugging ()
  (interactive)
  (assert (eq major-mode 'c++-mode))
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward "CHECKPOINT;" nil t)
      (d-delete-line))
    (goto-char (point-min))
    (while (re-search-forward "PRINT(" nil t)
      (d-delete-line))
    (goto-char (point-min))
    (while (re-search-forward "BEGIN_FUNCTION(" nil t)
      (d-delete-line))
    (goto-char (point-min))
    (while (re-search-forward "END_FUNCTION(" nil t)
      (d-delete-line))))

(defun name-checkpoints ()
  (interactive)
  (save-excursion
    (let ((name  (cfm--get-defun))
          (count 0))
      (goto-char (point-min))
      ;;(debug "fence")
      (while (re-search-forward "(checkpoint ?[^()]*)" nil t)
        (incf count)
        (setq chk (buffer-substring-no-properties (match-beginning 0) (match-end 0)))
        (setq new-name (cfm--get-defun))
        (if (not (string= new-name name))
            (setq count 0))
        (setq name new-name)
        (cond
         ((string-match "\\((checkpoint\\) ?\"\\([^()\"]*\\)\")" chk)
          (setq s1 (substring chk (match-beginning 1) (match-end 1)))
          (setq s2 (concat name ":" (format "%s" count)))
          (setq s3 (concat s1 " \"" s2 "\")"))
          )
         ((string-match "\\((checkpoint\\) ?\\([^()\"]*\\))" chk)
          (setq s1 (substring chk (match-beginning 1) (match-end 1)))
          (setq s2 (concat name ":" (format "%s" count)))
          (setq s3 (concat s1 " \"" s2 "\")"))
          )
         (t
          (error "Smeg")))
        (delete-region (point-at-bol) (point-at-eol))
        (insert s3))
      (indent-region (point-min) (point-max) nil)
      )))

;;; (setq str "abc:0")
(defun checkpoint (str)
  (message "*** checkpoint %s" str))

(provide 'toggle-checkpoints)
;;; toggle-checkpoints.el ends here
