;;; GNU Emacs code converted from Mocklisp
(require 'mlsupport)

;Some misc fcns.
(ml-defun 
    (toggle-var v
	(setq v
	      (ml-if (ml-interactive)
		  (read-variable "Var to toggle: ")
		  (ml-arg 1)
	      )
	)
	(ml-set v (ml-if (execute-mlisp-line v) 0 1))
	(ml-if (ml-interactive)
	    (ml-message v " => " (execute-mlisp-line v))
	    (execute-mlisp-line v)	;return value.
	)
    )
)


    

;**** A real keen utility, used in kb.ml and maybe lots more places.
(ml-defun 
    (move-over-white-space s
	(setq s (point-marker))
	(while (not (zerop (logior (= (following-char) (string-to-char " "))
		  (= (following-char) (string-to-char "\t"))
		  (= (following-char) (string-to-char "\n"))
	       )))
	       (forward-character)
	)
	(/= s (point-marker))			;return val.
    )
)
(ml-defun 
    (move-over-to-white-space s
	(setq s (point-marker))
	(while (not (zerop (logand (/= (following-char) (string-to-char " "))
		  (/= (following-char) (string-to-char "\t"))
		  (/= (following-char) (string-to-char "\n"))
	       )))
	       (forward-character)
	)
	(/= s (point-marker))			;return val.
    )
)

;**** hk, at last!!!
(ml-defun 
    (hk (beginning-of-buffer) (set-mark-command) (end-of-buffer) (delete-to-killbuffer)))

    
;**** Re-search-forward-sometimes-goes-one-too-far customization.
(ml-defun 
    (re-search-forward-sit 
	(ml-re-search-forward (ml-arg 1 "RE Search for: "))
	(backward-character)
    )
)

;**** Def of function delete-blank-lines (a la Twemacs)
(ml-defun
    (delete-blank-lines-sucks f
	(ml-if (eolp)
	    (progn 
		   (ml-if (/= (ml-current-column) 1)
		       (setq f 1)
		       (setq f 0)
		   )
		   (while (not (zerop (= (preceding-char) 10)))
			  (backward-character)
		   )
		   (while (not (zerop (logand (eolp)
			     (ml-not (eobp)))))	;no inf loops, please!
			  (delete-next-character)
		   )
		   (ml-if (ml-not f) (ml-newline))
		   (newline-and-backup)		;patch things up.
	    )
	)
    )
)

;NB:  Following didnt work.
;13 Jan 83:  See my-redraw.ml for one that does, now, at last.
;(defun (my-redraw-display
;	   (if prefix-argument-provided
;	       (save-excursion
;		   (beginning-of-line)
;		   (kill-to-end-of-line)
;		   (yank-from-killbuffer)))))


(ml-defun (split-this-buffer		;take current buffer
	   (delete-other-windows)	; make it whole screen
	   (split-current-window)))	; and then split it in two
 					;(useful at 300 baud)


(ml-defun (half-tab (insert-string h-t-spaces))) ;half-tab=4 spaces (usually)


(ml-defun (buffer-is-not-modified (setq (buffer-modified-p) 0)))


(ml-defun
    (meta-return
	(end-of-line)
	(ml-if (eobp)			;Chk if at end of buf.
	    (ml-newline)			;If so, force a new line.
	    (progn 			;Otherwise, just go to beginning
		   (ml-next-line)		; of extant next line.
		   (beginning-of-line)
	    )
	)
    )
)

;Like to-col but doesnt insert, but just moves over.
;Used in trace-k.ml for now.  Probably useful later elsewhere.
(ml-defun 
    (over-to-col (declare-global c)
	(setq c (ml-arg 1 "Col to move over to: "))
	(while (not (zerop (logand (ml-not (bolp)) (< c (ml-current-column)))))
	       (backward-character)
	)
	(while (not (zerop (logand (ml-not (eolp)) (> c (ml-current-column)))))
	       (forward-character)
	)
	(while (not (zerop (< (ml-current-column) c)))	;If to end of line but not there yet
	       (insert-string " ")	; move on out there.
	)
	(ml-if (> (ml-current-column) c)	;Must be a tab -- do up w/ blanks.
	    (progn 
		   (delete-previous-character)
		   (insert-string "        ")
		   (while (not (zerop (< c (ml-current-column))))
			  (backward-character)
		   )
	    )
	)	    
    )
)

(ml-defun 
    (to-left-margin
	(to-col left-margin)))


(ml-defun 
    (append-string-to-buffer
	(temp-switch-to-buffer
	    (ml-arg 1 "buffer to append to: "))
	(end-of-buffer)
	(insert-string (ml-arg 2 "string to append: "))
	(switch-back-from-temp-buffer)
    )
)

(ml-defun 
    (insert-string-in-buffer
	(temp-switch-to-buffer
	    (ml-arg 1 "buffer to append to: "))
	(hk)
	(insert-string (ml-arg 2 "string to append: "))
	(switch-back-from-temp-buffer)
    )
)