;;; emx-funcs.el --- additional functions for emx

;; Copyright (C) 1992-1996 Eberhard Mattes

;; Author: Eberhard Mattes <mattes@azu.informatik.uni-stuttgart.de>
;; Keywords: emx

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Code:

(provide 'emx-funcs)

(autoload 'find-tag-tag "etags" nil nil nil)
(autoload 'cmd "emx-cmd" "Run CMD.EXE with I/O through buffer *cmd*." t nil)


;;
;; Moving
;;

(defun emx-forward-to-word (arg)
  "Move forward until encountering the beginning of a word.
With argument, do this that many times."
  (interactive "p")
  (or (re-search-forward "\\W\\b" nil t arg)
      (goto-char (point-max))))

(defun emx-backward-to-word (arg)
  "Move backward until encountering the beginning of a word.
With argument, do this that many times."
  (interactive "p")
  (backward-char)
  (if (re-search-backward "\\W\\b" nil t arg) (goto-char (match-end 0))
      (goto-char (point-min))))

(defun emx-beginning-of-buffer nil
  "Move to the beginning of the buffer without setting mark."
  (interactive)
  (goto-char (point-min)))

(defun emx-end-of-buffer nil
  "Move to end of the buffer without setting mark."
  (interactive)
  (goto-char (point-max)))

;;
;; Scrolling
;;

(defun emx-scroll-line-up (arg)
  "Scroll up by one line.
With argument, do this that many times."
  (interactive "p")
  (scroll-up arg))

(defun emx-scroll-line-down (arg)
  "Scroll down by one line.
With argument, do this that many times."
  (interactive "p")
  (scroll-down arg))

;;
;; Killing and copying
;;

(defun emx-kill-left-line nil
  "Kill from the beginning of the line to point."
  (interactive "*")
  (kill-line 0))

(defun emx-kill-word (arg)
  "Delete characters until encountering the beginning of a word.
With argument, do this that many times."
  (interactive "*p")
  (let ((b (point)))
     (emx-forward-to-word arg)
     (kill-region b (point))))

(defun emx-copy-line-as-kill (arg)
  "Copy current line as kill.
With argument, copy that many lines starting with the current line."
  (interactive "p")
  (let ((s (point)))
    (beginning-of-line)
    (let ((b (point)))
      (forward-line arg)
      (copy-region-as-kill b (point)))
    (goto-char s)))

(defun emx-dup-line (arg)
  "Duplicate current line.
Set mark to the beginning of the new line.
With argument, do this that many times."
  (interactive "*p")
  (setq last-command 'identity) ; Don't append to kill ring
  (let ((s (point)))
    (beginning-of-line)
    (let ((b (point)))
      (forward-line)
      (if (not (eq (preceding-char) ?\n)) (insert ?\n))
      (copy-region-as-kill b (point))
    (while (> arg 0)
      (yank)
      (setq arg (1- arg)))
    (goto-char s))))

(defun emx-copy-region (arg)
  "Copy region to point.
With argument, do this that many times."
  (interactive "*p")
  (copy-region-as-kill (point) (mark))
  (while (> arg 0)
    (yank)
    (setq arg (1- arg))))

(defun emx-yank-line (&optional arg)
  "Yank as line: Move to beginning of current line and yank.
Insert newline if not present. The argument is passed to the yank command."
  (interactive "*P")
  (beginning-of-line)
  (yank arg)
  (let ((pos (point-marker)))
    (goto-char (max (point) (mark)))
    (if (looking-at "^")
        nil
      (insert-before-markers "\n"))
    (goto-char (marker-position pos)))
  (setq this-command 'yank))                        ; enable yank-pop

;;
;; Searching
;;

(defun emx-match-paren ()
  "Go to the matching parenthesis if on parenthesis.
This function uses the syntax table."
  (interactive)
  (cond ((looking-at "\\s\(") (forward-list 1) (backward-char 1))
	((looking-at "\\s\)") (forward-char 1) (backward-list 1))))

(defun emx-toggle-case-fold-search ()
  "Toggle and display the case-fold-search variable."
  (interactive)
  (message "case-fold-search is now %s"
           (setq case-fold-search (not case-fold-search))))

(defvar emx-search-string nil
  "Search string for emx-search-forward and emx-search-backward.")

(defvar emx-search-re nil
  "Non-nil means use regular expression for emx-search-forward and -backward.")

(defvar emx-search-goto-first-line nil
  "*Non-nil means display match at the top of the window.")

(defun emx-search-forward (&optional arg)
  "Search forward for a string.
If prefixed by \\[universal-argument], ask for search string.
If prefixed by \\[universal-argument] \\[universal-argument], use regular expression."
  (interactive "P")
  (emx-search-fb arg 'search-forward 're-search-forward))

(defun emx-search-backward (&optional arg)
  "Search backward for a string.
If prefixed by \\[universal-argument], ask for search string.
If prefixed by \\[universal-argument] \\[universal-argument], use
regular expression."
  (interactive "P")
  (emx-search-fb arg 'search-backward 're-search-backward))

(defun emx-search-fb (arg fun re-fun)
  "Search forward or backward for a string.
If the first argument is nil, ask for the string.
The second argument is search-forward or search-backward.
The third argument is re-search-forward or re-search-backward.
See also the documentation of the emx-search-goto-first-line variable."
  (if (or arg (not emx-search-string))
     (progn
       (setq emx-search-re
	     (and (listp arg) (numberp (car arg)) (>= (car arg) 16)))
       (setq emx-search-string
          (read-from-minibuffer
             (if emx-search-re "Re-Search: " "Search: ")
             emx-search-string))))
  (funcall (if emx-search-re re-fun fun) emx-search-string)
  (and emx-search-goto-first-line (recenter 0)))

(defun emx-search-forward-at-point ()
  "Search forward for name around or before point."
  (interactive)
  (setq emx-search-string (find-tag-tag "Search forward: "))
  (setq emx-search-re nil)
  (emx-search-forward))

(defun emx-search-backward-at-point ()
  "Search backward for name around or before point."
  (interactive)
  (setq emx-search-string (find-tag-tag "Search backward: "))
  (setq emx-search-re nil)
  (emx-search-backward))

(defun emx-search-forward-region (start end)
  "Search forward for string given by region.
With prefix arg, use regular expression."
  (interactive "r")
  (setq emx-search-string (buffer-substring start end))
  (setq emx-search-re current-prefix-arg)
  (emx-search-forward))

(defun emx-search-backward-region (start end)
  "Search backward for string given by region.
With prefix arg, use regular expression."
  (interactive "r")
  (setq emx-search-string (buffer-substring start end))
  (setq emx-search-re current-prefix-arg)
  (let ((pos (point)))
    (goto-char start)
    (condition-case err
        (emx-search-backward)
      (error (goto-char pos)
             (signal (car err) (cdr err))))))

;;
;; Buffers and files
;;

(defun emx-buffer-file-name ()
  "Display the name of the file visited in current buffer."
  (interactive)
  (message "%s" (cond (buffer-file-name) (t "Not visiting a file"))))

(defun emx-extract-file-name (at-point)
  "Return the file name around or before point.
If AT-POINT is not nil, the file names starts at point, that is, characters
before point are ignored."
  (let (start end)
    (save-excursion
      (if at-point
          (setq start (point))
        (if (looking-at "[][\0- ()<>\"|;=*?]")
            (re-search-backward "[^][\0- :()<>\"|;=*?]" (point-min) 0))
        (cond ((bobp) (setq start (point-min)))
              (t (re-search-backward "[][\0- :()<>\"|;=*?]" (point-min) 0)
                 (if (and (looking-at ":") (not (bobp)))
                     (progn
                       (goto-char (1- (point)))
                       (if (looking-at "[A-Za-z]:")
                           (setq start (point))
                         (setq start (+ 2 (point)))))
                   (if (bobp)
                       (setq start (point))
                     (setq start (1+ (point))))))))
      (goto-char start)
      (if (looking-at "\\([A-Za-z]:\\|\\)[^][\0- :()<>\"|;=*?]*")
          (setq end (match-end 0)))
      (and start end  (> end start) (buffer-substring start end)))))

(defun emx-find-file-at-point (arg)
  "Find file whose name is around or before point.
With prefix argument find file whose name starts at point."
  (interactive "P")
  (find-file (emx-extract-file-name arg)))

(defun emx-find-file-region (start end)
  "Find file whose name is given by region."
  (interactive "r")
  (find-file (buffer-substring start end)))

;;
;; Formatting
;;

(defun emx-fill-paragraph (arg)
  "Fill paragraph at or before point using em's notion of a paragraph.
Prefix arg means justify as well.
Paragraphs are separated by blank lines. The indentation of the first
line is used for indenting the entire paragraph. If there are two
consecutive blanks (or a tab) in the first line of the paragraphs,
everything to the left of these blanks (or the tab) is left as-is and
the paragraph is indented to the first non-blank character after the
first two consecutive blanks of the first line."
  (interactive "*P")
  (save-excursion
    (let (fill-prefix start end join column (indent-tabs-mode nil))
      (while (looking-at "^\n")
          (forward-line -1))
      (re-search-backward "^\n" (point-min) 0)
      (if (looking-at "^\n")
          (forward-char))
      (setq start (point))
      (re-search-forward "^$" (point-max) 0)
      (or (bolp) (newline 1))
      (setq end (point-marker))
      (goto-char start)
      (if (looking-at "^[ \t]*[^ \t\n]*\\(  \\|\t\\)")
          (progn (goto-char (match-end 0))
                 (re-search-forward "[ \t]*")
                 (setq column (current-column))
                 (split-line)
                 (setq join (point))
                 (forward-line 1)
                 (setq start (point))
                 (forward-char column)
                 (setq fill-prefix
                       (if (zerop column) nil
                         (make-string column ? )))
                 (while (and (zerop (forward-line 1))
                             (< (point) (marker-position end)))
                   (backward-to-indentation 0)
                   (cond ((> (current-column) column)
                          (delete-region (+ (point) column
                                            (- (current-column))) (point)))
                         ((< (current-column) column)
                          (insert-char ?  (- column (current-column))))))
                 (fill-region-as-paragraph start
                                           (marker-position end) arg)
                 (delete-region join (+ start column)))
        (fill-region-as-paragraph (point) (marker-position end) arg)))))

;;
;; Miscellaneous commands
;;

(defvar emx-add-number 0
  "The number used by the emx-add-number command.")

(defvar emx-add-number-adjust nil
  "*Non-nil if emx-add-number should adjust columns.
This is done by adding or removing blanks if the length of the number
has changed.")

(defun emx-add-number (arg)
  "Add a constant to the decimal number at point.
With prefix arg, add that constant. Otherwise add previously used constant.
If there is no previous constant, ask for the constant. To make emx-add-number
ask for a number, use a prefix arg of zero (M-0).
The constant is stored in the emx-add-number variable.

If emx-add-number-adjust is non-nil, blanks are added or removed to keep
columns aligned if the length of the number in the buffer has changed by
adding the constant.

This command is useful for moving controls by adding to coordinates in .rc
files."
  (interactive "*P")
  (if arg (setq emx-add-number (prefix-numeric-value arg)))
  (if (zerop emx-add-number)
      (setq emx-add-number
            (string-to-int (read-from-minibuffer "Number to add: "))))
  (if (zerop emx-add-number)
      nil
    (emx-add-number-2 emx-add-number)))
    
(defun emx-add-number-2 (number)
  "Add NUMBER to the number at point."
  (let (start end str diff)
    (if (not (looking-at "[ \t]*\\([-+]\\|\\)[0-9]+"))
        (error "No number at point"))
    (setq end (match-end 0))
    (skip-chars-backward "0-9")
    (setq start (point))
    (if (or (= (preceding-char) ?-) (= (preceding-char) ?+))
        (setq start (1- start)))
    (setq str (int-to-string
               (+ number (string-to-int (buffer-substring start end)))))
    (delete-region start end)
    (goto-char start)
    (insert str)
    (goto-char start)
    (if emx-add-number-adjust
        (if (> (setq diff (- end start (length str))) 0)
            (insert-char ?  diff)
          (while (and (< diff 0) (= (preceding-char) ? ))
            (backward-delete-char 1)
            (setq diff (1+ diff)))))))

(defun emx-toggle-debug-on-error ()
  "Toggle and display the debug-on-error variable."
  (interactive)
  (message "debug-on-error is now %s"
           (setq debug-on-error (not debug-on-error))))

(defun emx-toggle-truncate-lines ()
  "Toggle and display the truncate-lines variable."
  (interactive)
  (message "truncate-lines is now %s"
           (setq truncate-lines (not truncate-lines)))
  (recenter))

(defun emx-toggle-sentence-end-double-space ()
  "Toggle and display the `sentence-end-double-space' variable."
  (interactive)
  (message "sentence-end-double-space is now %s"
           (setq sentence-end-double-space (not sentence-end-double-space))))

;;
;; Keyboard
;;

(define-prefix-command 'emx-function-keys)

(defun emx-function-key (code event)
  "Define a PC function key.
CODE is the scan code, EVENT is the event for that key (a vector)."
  (define-key emx-function-keys (vector code) event))

;;
;; Key definitions for text mode
;;

(define-key function-key-map "\0" emx-function-keys)

(emx-function-key   1 [A-ESC])
(emx-function-key   2 [?\C-\ ])
(emx-function-key   3 [?\C-2])
(emx-function-key   4 [S-insert])
(emx-function-key   5 [S-delete])
(emx-function-key  14 [A-BS])
(emx-function-key  15 [S-backtab])
(emx-function-key  16 [?\A-q])
(emx-function-key  17 [?\A-w])
(emx-function-key  18 [?\A-e])
(emx-function-key  19 [?\A-r])
(emx-function-key  20 [?\A-t])
(emx-function-key  21 [?\A-y])
(emx-function-key  22 [?\A-u])
(emx-function-key  23 [?\A-i])
(emx-function-key  24 [?\A-o])
(emx-function-key  25 [?\A-p])
(emx-function-key  26 [?\A-\[])
(emx-function-key  27 [?\A-\]])
(emx-function-key  28 [A-RET])
(emx-function-key  30 [?\A-a])
(emx-function-key  31 [?\A-s])
(emx-function-key  32 [?\A-d])
(emx-function-key  33 [?\A-f])
(emx-function-key  34 [?\A-g])
(emx-function-key  35 [?\A-h])
(emx-function-key  36 [?\A-j])
(emx-function-key  37 [?\A-k])
(emx-function-key  38 [?\A-l])
(emx-function-key  39 [?\A-;])
(emx-function-key  40 [?\A-`])
(emx-function-key  43 [?\A-\\])
(emx-function-key  44 [?\A-z])
(emx-function-key  45 [?\A-x])
(emx-function-key  46 [?\A-c])
(emx-function-key  47 [?\A-v])
(emx-function-key  48 [?\A-b])
(emx-function-key  49 [?\A-n])
(emx-function-key  50 [?\A-m])
(emx-function-key  51 [?\A-,])
(emx-function-key  52 [?\A-.])
(emx-function-key  53 [?\A-/])
(emx-function-key  55 [A-kp-*])
(emx-function-key  57 [?\A-\ ])
(emx-function-key  59 [f1])
(emx-function-key  60 [f2])
(emx-function-key  61 [f3])
(emx-function-key  62 [f4])
(emx-function-key  63 [f5])
(emx-function-key  64 [f6])
(emx-function-key  65 [f7])
(emx-function-key  66 [f8])
(emx-function-key  67 [f9])
(emx-function-key  68 [f10])
(emx-function-key  71 [home])
(emx-function-key  72 [up])
(emx-function-key  73 [pageup])
(emx-function-key  74 [A-kp--])
(emx-function-key  75 [left])
(emx-function-key  76 [center])
(emx-function-key  77 [right])
(emx-function-key  78 [A-kp-+])
(emx-function-key  79 [end])
(emx-function-key  80 [down])
(emx-function-key  81 [pagedown])
(emx-function-key  82 [insert])
(emx-function-key  83 [delete])
(emx-function-key  84 [S-f1])
(emx-function-key  85 [S-f2])
(emx-function-key  86 [S-f3])
(emx-function-key  87 [S-f4])
(emx-function-key  88 [S-f5])
(emx-function-key  89 [S-f6])
(emx-function-key  90 [S-f7])
(emx-function-key  91 [S-f8])
(emx-function-key  92 [S-f9])
(emx-function-key  93 [S-f10])
(emx-function-key  94 [C-f1])
(emx-function-key  95 [C-f2])
(emx-function-key  96 [C-f3])
(emx-function-key  97 [C-f4])
(emx-function-key  98 [C-f5])
(emx-function-key  99 [C-f6])
(emx-function-key 100 [C-f7])
(emx-function-key 101 [C-f8])
(emx-function-key 102 [C-f9])
(emx-function-key 103 [C-f10])
(emx-function-key 104 [A-f1])
(emx-function-key 105 [A-f2])
(emx-function-key 106 [A-f3])
(emx-function-key 107 [A-f4])
(emx-function-key 108 [A-f5])
(emx-function-key 109 [A-f6])
(emx-function-key 110 [A-f7])
(emx-function-key 111 [A-f8])
(emx-function-key 112 [A-f9])
(emx-function-key 113 [A-f10])
(emx-function-key 114 [printscrn])
(emx-function-key 115 [C-left])
(emx-function-key 116 [C-right])
(emx-function-key 117 [C-end])
(emx-function-key 118 [C-pagedown])
(emx-function-key 119 [C-home])
(emx-function-key 120 [?\A-1])
(emx-function-key 121 [?\A-2])
(emx-function-key 122 [?\A-3])
(emx-function-key 123 [?\A-4])
(emx-function-key 124 [?\A-5])
(emx-function-key 125 [?\A-6])
(emx-function-key 126 [?\A-7])
(emx-function-key 127 [?\A-8])
(emx-function-key 128 [?\A-9])
(emx-function-key 129 [?\A-0])
(emx-function-key 130 [?\A--])
(emx-function-key 131 [?\A-=])
(emx-function-key 132 [C-pageup])
(emx-function-key 133 [f11])
(emx-function-key 134 [f12])
(emx-function-key 135 [S-f11])
(emx-function-key 136 [S-f12])
(emx-function-key 137 [C-f11])
(emx-function-key 138 [C-f12])
(emx-function-key 139 [A-f11])
(emx-function-key 140 [A-f12])
(emx-function-key 141 [C-up])
(emx-function-key 142 [C-kp--])
(emx-function-key 143 [C-center])
(emx-function-key 144 [C-kp-+])
(emx-function-key 145 [C-down])
(emx-function-key 146 [C-insert])
(emx-function-key 147 [C-delete])
(emx-function-key 148 [C-TAB])
(emx-function-key 149 [C-kp-/])
(emx-function-key 150 [C-kp-*])
(emx-function-key 151 [A-home])
(emx-function-key 152 [A-up])
(emx-function-key 153 [A-pageup])
(emx-function-key 155 [A-left])
(emx-function-key 157 [A-right])
(emx-function-key 159 [A-end])
(emx-function-key 160 [A-down])
(emx-function-key 161 [A-pagedown])
(emx-function-key 162 [A-insert])
(emx-function-key 163 [A-delete])
(emx-function-key 164 [A-kp-/])
(emx-function-key 165 [A-TAB])
(emx-function-key 166 [A-enter])

;;; emx-funcs.el ends here
