;; file: $ISIP_IFC/login/editor_emacs_library_general.el
;; version: $Id: editor_emacs_library_general.el 9614 2004-07-03 18:24:30Z picone $
;;
;; this file contains some useful emacs lisp functions that
;; are used by the basic isip environment.

;;---------------------------------------------------------------------------;;
;;									     ;;
;; c++-mode-related functions						     ;;
;;									     ;;
;;---------------------------------------------------------------------------;;

;; function: isip-c++-insert-error-handler
;;
;;  insert the call to the error handler in c++ code
;;  
(defun isip-c++-insert-error-handler ()
  "insert the error handler line in a standard manner"
  (interactive)
  
  (let ((isip-cname nil) (isip-mname nil))
    
    ;; first find the method name
    ;;
    (save-excursion
      (if (search-backward "method: ") 
	  (let ((tmp 0)) 
	    (forward-char (length "method: "))
	    (setq tmp (point))
	    (end-of-line)
	    (setq isip-mname (buffer-substring tmp (point))))))
	    
    (if (equal isip-mname "diagnose")
	(setq isip-ecode "Error::TEST")
      (setq isip-ecode "Error::ARG"))
    
    ;; now insert the text
    ;;
    (insert "return Error::handle(name(), L\"" isip-mname 
	    "\", " isip-ecode ", __FILE__, __LINE__);")

    ;; make sure indention is correct
    ;;
    (c-indent-command)))


;;---------------------------------------------------------------------------;;
;;									     ;;
;; spell-mode-related functions						     ;;
;;									     ;;
;;---------------------------------------------------------------------------;;

;; function: spell-buffer-into-buffer
;;
;;  this function runs a buffer through the spell checker and dumps its
;;  output into another buffer. this is useful because it allows you
;;  to interact with the misspelled words, and search the original document
;;  for their occurrences.
;;
(defun spell-buffer-into-buffer ()
  "generate spell command output in a buffer."
  (interactive)
  (shell-command-on-region (point-min) (point-max) "spell"))

;;---------------------------------------------------------------------------;;
;;									     ;;
;; screen management					     		     ;;
;;									     ;;
;;---------------------------------------------------------------------------;;

;; function: decrease-window
;;
;;  this function decreases the size of the current window by one line.
;;
(defun decrease-window-line ()
  "decreases the size of the current window by one line."
  (interactive)
  (enlarge-window -1))

;; function: decrease-window-column
;;
;;  this function decreases the size of the current window by one column.
;;
(defun decrease-window-column ()
  "decreases the size of the current window by one column."
  (interactive)
  (enlarge-window-horizontally -1))

;; function: recenter-top
;;
;;  this function moves the current line to the top of the screen.
;;
(defun recenter-top ()
  "move the current line to the top of the window."
  (interactive)
  (recenter 0))

;; function: scroll-up-center
;;
;;  this function scrolls the screen in a more sensible way. when used
;;  with scroll-down-center, excursions up and down (or down and up)
;;  will land you on the same line from which you began.
;;
(defun scroll-up-center (num)
  "scroll the display up and center the mark."
  (interactive "p")
  (scroll-up (+ (window-height) -1))
  (move-to-window-line (/ (window-height) 2)))

;; function: scroll-down-center
;;
;;  this function scrolls the screen in a more sensible way. when used
;;  with scroll-down-center, excursions up and down (or down and up)
;;  will land you on the same line from which you began.
;;
(defun scroll-down-center (num)
  "scroll the display down and center the mark."
  (interactive "p")
  (scroll-down (+ (window-height) -1))
  (move-to-window-line (/ (window-height) 2)))

;;---------------------------------------------------------------------------;;
;;									     ;;
;; editing operations					     		     ;;
;;									     ;;
;;---------------------------------------------------------------------------;;

;; function: delete-word
;;
;;  this function deletes the next word and puts it on the kill stack.
;;
(fset 'delete-word " f")

;; function: delete-line
;;
;;  this function deletes the next line and puts it on the kill stack.
;;
(fset 'delete-line " ")

;; function: tab-self-insert
;;
;;  this function inserts a tab, somewhat overriding whatever programming
;;  mode you are in. it is useful for placing tabs in comments in C++
;;  programs.
;;
(fset 'tab-self-insert "	")

(defun copy-region-to-clipboard (beg end)
  "copy the region onto the clipboard as if killed, but don't kill it."
  (interactive "r")
  (if (eq last-command 'kill-region)
      (let ((x-select-enable-clipboard t))
	(kill-append (buffer-substring beg end) (< end beg)))
    (let ((x-select-enable-clipboard t))
      (kill-new (buffer-substring beg end))))
  (if transient-mark-mode 
      (setq deactivate-mark t))
  nil)

(defun copy-buffer-to-clipboard ()
  "copy the current buffer onto the clipboard as if killed, but don't kill it."
  (interactive)
  (copy-region-to-clipboard (point-min) (point-max)))

(defun copy-to-register-5 () 
  (interactive)
  (copy-to-register 5 (mark) (point)))
(defun insert-register-5 () 
  (interactive)
  (insert-register 5))

(defun copy-to-register-6 () 
  (interactive)
  (copy-to-register 6 (mark) (point)))
(defun insert-register-6 () 
  (interactive)
  (insert-register 6))

;;---------------------------------------------------------------------------;;
;;									     ;;
;; search-mode-related functions					     ;;
;;									     ;;
;;---------------------------------------------------------------------------;;

;; function: search-repeat-char
;;
;;  this function simply defines a global constant to be used by the
;;  isearch-forward function. this definition represents the key you
;;  can hit to search again after a first search. since search has
;;  historically been defined to be "ctrl-s", the same definition is used
;;  here. it would be better to define this constant in terms of the
;;  key binding for isearch-forward, so that the definition need not be
;;  hardcoded.
;;
(defconst search-repeat-char ?\C-s
  "character to repeat incremental search forwards.")

;; function: query-replace
;;
;;  a new query-replace that allows the replace string to be changed during
;;  a query-replace operation. the code below is a modification of the
;;  standard gnu emacs query-replace function.
;;
;;(defconst query-replace-help
;;  "type space or `y' to replace one match, delete or `n' to skip next,
;;ESC or `q' to exit, period to replace one match and exit,
;;comma to replace but not move point immediately,
;;C-r to enter recursive edit (\\[exit-recursive-edit] to get out again),
;;C-w to delete match and recursive edit,
;;C-l to clear the screen, rdisplay, and offer same replacement again,
;;! to replace all remaining matches with no more questions,
;;^ to move point back to previous match,
;;t to change the to-string."
;;  "help message while in query-replace")
;;
;;(defun perform-replace (from-string to-string start end
;;			query-flag regexp-flag delimited-flag)
;;  (let ((nocasify (not (and case-fold-search case-replace
;;			    (string-equal from-string
;;					  (downcase from-string)))))
;;	(literal (not regexp-flag))
;;	(search-function (if regexp-flag 're-search-forward 'search-forward))
;;	(search-string from-string)
;;	(keep-going t)
;;	(lastrepl nil))			;position after last match considered.
;;    (if delimited-flag
;;	(setq search-function 're-search-forward
;;	      search-string (concat "\\b"
;;				    (if regexp-flag from-string
;;				      (regexp-quote from-string))
;;				    "\\b")))
;;    (push-mark)
;;    (push-mark)
;;    (while (and keep-going
;;		(not (eobp))
;;		(progn
;;		  (set-mark (point))
;;		  (funcall search-function search-string nil t)))
;;      ;; don't replace the null string
;;      ;; right after the end of previous replacement.
;;      (if (eq lastrepl (point))
;;	  (forward-char 1)
;;	(undo-boundary)
;;	(if (not query-flag)
;;	    (replace-match to-string nocasify literal)
;;	  (let (done replaced)
;;	    (while (not done)
;;	      ;; preserve the match data. process filters and sentinels
;;	      ;; could run inside read-char.
;;	      (let ((data (match-data))
;;		    (help-form
;;		     '(concat "query replacing "
;;			      (if regexp-flag "regexp " "")
;;			      from-string " with " to-string ".\n\n"
;;			      (substitute-command-keys query-replace-help))))
;;		(setq char help-char)
;;		(while (= char help-char)
;;		  (message "query replacing %s with %s: " from-string to-string)
;;		  (setq char (read-char))
;;		  (if (= char ??)
;;		      (setq unread-command-char help-char char help-char)))
;;		(store-match-data data))
;;	      (cond ((or (= char ?\e)
;;			 (= char ?q))
;;		     (setq keep-going nil)
;;		     (setq done t))
;;		    ((= char ?t)
;;		     (setq to-string
;;			   (read-string
;;			    (format "query replace %s with: " from-string)))
;;		     (setq keep-going t)
;;		     (setq done nil))
;;		    ((= char ?^)
;;		     (goto-char (mark))
;;		     (setq replaced t))
;;		    ((or (= char ?\ )
;;			 (= char ?y))
;;		     (or replaced
;;			 (replace-match to-string nocasify literal))
;;		     (setq done t))
;;		    ((= char ?\.)
;;		     (or replaced
;;			 (replace-match to-string nocasify literal))
;;		     (setq keep-going nil)
;;		     (setq done t))
;;		    ((= char ?\,)
;;		     (if (not replaced)
;;			 (progn
;;			   (replace-match to-string nocasify literal)
;;			   (setq replaced t))))
;;		    ((= char ?!)
;;		     (or replaced
;;			 (replace-match to-string nocasify literal))
;;		     (setq done t query-flag nil))
;;		    ((or (= char ?\177)
;;			 (= char ?n))
;;		     (setq done t))
;;		    ((= char ?\C-l)
;;		     (recenter nil))
;;		    ((= char ?\C-r)
;;		     (store-match-data
;;		      (progl (match-data)
;;			(save-excursion (recursive-edit)))))
;;		    ((= char ?\C-w)
;;		     (delete-region (match-beginning 0) (match-end 0))
;;		     (store-match-data
;;		      (progl (match-data)
;;			(save-excursion (recursive-edit))))
;;		     (setq replaced t))
;;		    (t
;;		     (setq keep-going nil)
;;		     (setq unread-command-char char)
;;		     (setq done t))))))
;;	(setq lastrepl (point))))
;;    (pop-mark)
;;    keep-going))

;; this will force emacs to compile with the current compile command,
;; it won't prompt for an argument
;;
(defun compile-now ()
  "Compile now with the current argument -- don't prompt for argument"
  (interactive)
  (save-buffer)
  (compile compile-command))

;;; Sep 14 1995 <jari.aalto@ntc.nokia.com> (Finland) Public domain.
;;; See also variable compilation-last-buffer
;;;
;;; - Handling other frames corrected by James (Jim) R.R. Service
;;;   jservice@rd.hydro.on.ca. (the extra t's)
;;;
(defadvice compile-internal (after my-scroll act comp)
  "Forces compile buffer to scroll. See around line 363 in compile.el"
  (let* ((ob (current-buffer))
         (obw  (get-buffer-window ob t))
         win
         )
    (save-excursion
      (if (or (null (setq win (get-buffer-window ad-return-value t)))
              (null obw))
          nil
        (select-window win)
        (goto-char (point-max))
        (select-window obw)
      ))))

;; end of file