;; qplace.mut : query replace
  ;; Query replace: both regular expression and straight.
  ;; Has popup documentation.
  ;; C Durland	Public Domain

(string search-pattern replace-pattern)

(defun
  query-replace		;; [ (string search-pattern replace-pattern) ]
  {
    (if (== 2 (nargs))
    {
      (qr (arg 0) (arg 1) (floc search-forward) (floc replace-text))
      (done)
    })

    (if (and
         (get-search-pattern  "Query Replace" search-pattern replace-pattern)
	 (get-replace-pattern "New String"    replace-pattern))
       (qr search-pattern replace-pattern
	   (floc search-forward) (floc replace-text)))
  }
  re-query-replace	;; [ (string search-pattern replace-pattern) ]
  {
    (if (== 2 (nargs))
    {
      (qr (arg 0) (arg 1) (floc re-search-forward) (floc re-replace-text))
      (done)
    })

    (if (and
         (get-search-pattern  "RE Query Replace" search-pattern replace-pattern)
	 (get-replace-pattern "New String"	 replace-pattern))
       (qr search-pattern replace-pattern
	   (floc re-search-forward) (floc re-replace-text)))
  }
  doc HIDDEN	; popup a window with documentation
  {
    (menu-box
	"Dot is left at the start of the search."
	"Query replace commands:"
	'q or ^G : Stop where you are, don''t go back to start.'
	"y or Space : Replace this match and go to next one."
	"n  : Skip to next match."
	"!  : Replace all remaining matches without asking."
	'^  : Move back to previous match.'
	'^L : Redraw screen.'
	"Period : Replace this match and stop."
	"Comma  : Replace but don't move."
	"Any other key:  stop the query replace and do the key."
    )
  }
  MAIN
  {
    (require "popup")	;; for (doc)
  }
)


(const
  QUIT				0	;; ^G
  BLAST-IT			1	;; space, y
  IGNORE-IT			2	;; n
  BLAST-THEM-ALL		3	;; !
  BLAST-IT-AND-STOP		4	;; .
  BACK-TO-LAST-MATCH		5	;; ^
  BLAST-IT-BUT-DON'T-MOVE	6	;; ,
)

(defun
  qr
    (string search-string new-text)
    (pointer defun search-fcn replace-fcn)
    HIDDEN
  {
    (bool stay-here keep-going not-yet-replaced at-end-goto-start)
    (int replaced len mark-id)

    (mark-id (create-mark))
    (replaced 0)
    (len (length-of (search-string)))
    (keep-going TRUE)(at-end-goto-start TRUE)

    (set-mark)				;; remember where QR started
    (while (and keep-going
	    {
	      (msg "Searching for " search-string " ...")
	      (set-mark mark-id)		;; remember last match
	      (search-fcn search-string)	;; find next match
	    })
    {
      (stay-here TRUE)(not-yet-replaced TRUE)
      (while stay-here
      {
	(msg 'Query replacing "' search-string '" with "' new-text '"')
	(update)	;; make sure the cursor is in the correct place
	(switch (ask-about-it)
	  QUIT (keep-going (stay-here (at-end-goto-start FALSE)))
	  IGNORE-IT (stay-here FALSE)
	  BLAST-IT
	    {
	      (if not-yet-replaced
	      {
		(replace-fcn new-text len)
		(+= replaced 1)
	      })
	      (stay-here FALSE)
	    }
	  BLAST-IT-AND-STOP
	    {
	      (if not-yet-replaced
	      {
		(replace-fcn new-text len)
		(+= replaced 1)
	      })
	      (stay-here (keep-going (at-end-goto-start FALSE)))
	    }
	  BLAST-IT-BUT-DON'T-MOVE
	    {
	      (if not-yet-replaced
	      {
		(replace-fcn new-text len)
		(+= replaced 1)
		(not-yet-replaced FALSE)
	      })
	    }
	  BLAST-THEM-ALL	;; replace 'till run out of things to replace
	    {
	      (while 
	      {
		(replace-fcn new-text len)
		(msg "Replacing ... [" (+= replaced 1) "]")
		(search-fcn search-string)
	      } ())
	      (stay-here (keep-going FALSE))
	    }
	  BACK-TO-LAST-MATCH
	    {
	      (goto-mark mark-id)
	      (not-yet-replaced FALSE)
	    }
	)		;; end switch
      })		;; end while
    }) ;; while

    (free-mark mark-id)

		;; restore excursion & set mark at end of replace
    (if at-end-goto-start (swap-marks))
    (msg replaced " Strings Replaced.")
    TRUE
  }
  ask-about-it	HIDDEN
  {
    (int keycode)

    (switch (keycode (get-key))
      0x71  QUIT			;; q
      0x147 QUIT			;; ^G
      0x79  BLAST-IT			;; y
      0x20  BLAST-IT			;; <space>
      0x6E  IGNORE-IT			;; n
      0x2E  BLAST-IT-AND-STOP		;; .
      0x5E  BACK-TO-LAST-MATCH		;; ^
      0x2C  BLAST-IT-BUT-DON'T-MOVE	;; ,
      0x14C				;; ^L : refresh screen
	{
	  (refresh-screen)
	       ;; put cursor at right edge of screen
	  (window-ledge -1 (- (current-column)(screen-width) -1))
	  (update)
	  (msg "Still query replacing: (? for help)")(update)
	  (ask-about-it)
	}
      0x3F { (doc)(update)(refresh-screen)(ask-about-it) }   ;; ? - give doc
      0x21 BLAST-THEM-ALL		;; !
      default				;; execute the unknown key and quit
	{
	  (exe-key keycode)
	  QUIT
	}
    )
  }
  get-search-pattern (string prompt pattern replace-pattern-default) HIDDEN
  {
    (string pat)

    (pat (prompt-and-ask prompt pattern))
    (if (== "" pat)		;; user hit Enter so use default
      {
	(if (== "" pattern)	;; no default
	  { (msg "Gotta search for something!") FALSE (done) })
	;; old pattern exists and is good so use it
      }
      (if (== "^W" pat)		;; C-W => look for word cursor is on
	{
	  (if (looking-at '\w+')
	    {
	      (replace-pattern-default "")  ;; clear replace pattern default
	      (pattern (get-matched '&'))   ;; use user entered pattern
	    }
	    { (msg "Not a word!") FALSE (done) })
	}
	{
	  (replace-pattern-default "")	;; clear replace pattern default
	  (pattern pat)			;; use user entered pattern
	}))
    TRUE
  }
  get-replace-pattern (string prompt pattern) HIDDEN
  {
    (string pat)

    (pat (prompt-and-ask prompt pattern))
    (if (!= "" pat) (pattern pat))
    TRUE
  }
  prompt-and-ask (string prompt pattern) HIDDEN
  {
    (ask-user)
    (ask
      prompt
      (if (!= "" pattern)			;; old pattern exists
	(concat " [" pattern "]")		;; prompt [pattern]:
	"")
      ": ")
  }
)

(defun
  replace-text (string new-text) (int old-text-length) HIDDEN
  {
    (arg-prefix old-text-length)
    (if (delete-previous-character)
      { (insert-text new-text) TRUE }
      (abort))
  }
  re-replace-text (string re-substitute) HIDDEN
  {
    (int n)

    (n (length-of (get-matched "&")))		;; length of matched regexp
    (arg-prefix n)(previous-character)		;; move in front of matched
    (insert-text (get-matched re-substitute))
    (if { (arg-prefix n)(delete-character) }	;; delete matched
      TRUE
      (abort))
  }
)