;; Fill commands for Emacs

(defconst fill-individual-varying-indent nil
  "*Controls criterion for a new paragraph in `fill-individual-paragraphs'.
Non-nil means changing indent doesn't end a paragraph.
That mode can handle paragraphs with extra indentation on the first line,
but it requires separator lines between paragraphs.
Nil means that any change in indentation starts a new paragraph.")

(defun set-fill-prefix ()
  "Set the fill-prefix to the current line up to point.
Filling expects lines to start with the fill prefix
and reinserts the fill prefix in each resulting line."
  (interactive)
  (setq fill-prefix (buffer-substring
		     (save-excursion (beginning-of-line) (point))
		     (point)))
  (if (equal fill-prefix "")
      (setq fill-prefix nil))
  (if fill-prefix
      (message "fill-prefix: \"%s\"" fill-prefix)
    (message "fill-prefix cancelled")))

(defun fill-paragraph (arg)
  "Fill paragraph at or after point.
Prefix arg means justify as well."
  (interactive "P")
  (save-excursion
    (forward-paragraph)
    (or (bolp) (newline 1))
    (let ((end (point)))
      (backward-paragraph)
      (fill-region-as-paragraph (point) end arg))))

(defun fill-region (from to &optional justify-flag)
  "Fill each of the paragraphs in the region.
Prefix arg (non-nil third arg, if called from program)
means justify as well."
  (interactive "r\nP")
  (save-restriction
   (narrow-to-region from to)
   (goto-char (point-min))
   (while (not (eobp))
     (let ((initial (point))
	   (end (progn
		 (forward-paragraph 1) (point))))
       (forward-paragraph -1)
       (if (>= (point) initial)
	   (fill-region-as-paragraph (point) end justify-flag)
	 (goto-char end))))))

========================================================================
;; Basic editing commands for Emacs

(defun open-line (arg)
  "Insert a newline and leave point before it.
With arg, inserts that many newlines."
  (interactive "*p")
  (let ((flag (and (bolp) (not (bobp)))))
    (if flag (forward-char -1))
    (while (> arg 0)
      (insert ?\n)
      (goto-char (1- (point)))
      (setq arg (1- arg)))
    (if flag (forward-char 1))))

(defun split-line ()
  "Split current line, moving portion beyond point vertically down."
  (interactive "*")
  (skip-chars-forward " \t")
  (let ((col (current-column))
	(pos (point)))
    (insert ?\n)
    (indent-to col 0)
    (goto-char pos)))

(defun quoted-insert (arg)
  "Read next input character and insert it.
Useful for inserting control characters.
You may also type up to 3 octal digits, to insert a character with that code"
  (interactive "*p")
  (let ((char (read-quoted-char)))
    (while (> arg 0)
      (insert char)
      (setq arg (1- arg)))))

(defun delete-indentation (&optional arg)
  "Join this line to previous and fix up whitespace at join.
With argument, join this line to following line."
  (interactive "*P")
  (beginning-of-line)
  (if arg (forward-line 1))
  (if (eq (preceding-char) ?\n)
      (progn
	(delete-region (point) (1- (point)))
	(fixup-whitespace))))

(defun fixup-whitespace ()
  "Fixup white space between objects around point.
Leave one space or none, according to the context."
  (interactive "*")
  (save-excursion
    (delete-horizontal-space)
    (if (or (looking-at "^\\|\\s)\\|$")
	    (save-excursion (forward-char -1)
			    (looking-at "\\s(\\|\\s'")))
	nil
      (insert ?\ ))))

(defun delete-horizontal-space ()
  "Delete all spaces and tabs around point."
  (interactive "*")
  (skip-chars-backward " \t")
  (delete-region (point) (progn (skip-chars-forward " \t") (point))))

(defun just-one-space ()
  "Delete all spaces and tabs around point, leaving one space."
  (interactive "*")
  (skip-chars-backward " \t")
  (if (= (following-char) ? )
      (forward-char 1)
    (insert ? ))
  (delete-region (point) (progn (skip-chars-forward " \t") (point))))

(defun delete-blank-lines ()
  "On blank line, delete all surrounding blank lines, leaving just one.
On isolated blank line, delete that one.
On nonblank line, delete all blank lines that follow it."
  (interactive "*")
  (let (thisblank singleblank)
    (save-excursion
      (beginning-of-line)
      (setq thisblank (looking-at "[ \t]*$"))
      (setq singleblank
	    (and thisblank
		 (not (looking-at "[ \t]*\n[ \t]*$"))
		 (or (bobp)
		     (progn (forward-line -1)
			    (not (looking-at "[ \t]*$")))))))
    (if thisblank
	(progn
	  (beginning-of-line)
	  (if singleblank (forward-line 1))
	  (delete-region (point)
			 (if (re-search-backward "[^ \t\n]" nil t)
			     (progn (forward-line 1) (point))
			   (point-min)))))
    (if (not (and thisblank singleblank))
	(save-excursion
	  (end-of-line)
	  (forward-line 1)
	  (delete-region (point)
			 (if (re-search-forward "[^ \t\n]" nil t)
			     (progn (beginning-of-line) (point))
			   (point-max)))))))

(defun back-to-indentation ()
  "Move point to the first non-whitespace character on this line."
  (interactive)
  (beginning-of-line 1)
  (skip-chars-forward " \t"))

(defun newline-and-indent ()
  "Insert a newline, then indent according to major mode.
Indentation is done using the current indent-line-function.
In programming language modes, this is the same as TAB.
In some text modes, where TAB inserts a tab, this indents to the
specified left-margin column."
  (interactive "*")
  (delete-region (point) (progn (skip-chars-backward " \t") (point)))
  (newline)
  (indent-according-to-mode))

(defun reindent-then-newline-and-indent ()
  "Reindent current line, insert newline, then indent the new line.
Indentation of both lines is done according to the current major mode,
which means that the current value of indent-line-function is called.
In programming language modes, this is the same as TAB.
In some text modes, where TAB inserts a tab, this indents to the
specified left-margin column."
  (interactive "*")
  (save-excursion
    (delete-region (point) (progn (skip-chars-backward " \t") (point)))
    (indent-according-to-mode))
  (newline)
  (indent-according-to-mode))

(defun kill-forward-chars (arg)
  (if (listp arg) (setq arg (car arg)))
  (if (eq arg '-) (setq arg -1))
  (kill-region (point) (+ (point) arg)))

(defun kill-backward-chars (arg)
  (if (listp arg) (setq arg (car arg)))
  (if (eq arg '-) (setq arg -1))
  (kill-region (point) (- (point) arg)))

(defun backward-delete-char-untabify (arg &optional killp)
  "Delete characters backward, changing tabs into spaces.
Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
Interactively, ARG is the prefix arg (default 1)
and KILLP is t if prefix arg is was specified."
  (interactive "*p\nP")
  (let ((count arg))
    (save-excursion
      (while (and (> count 0) (not (bobp)))
	(if (= (preceding-char) ?\t)
	    (let ((col (current-column)))
	      (forward-char -1)
	      (setq col (- col (current-column)))
	      (insert-char ?\ col)
	      (delete-char 1)))
	(forward-char -1)
	(setq count (1- count)))))
  (delete-backward-char arg killp))

(defun zap-to-char (arg char)
  "Kill up to (but not including) ARG'th occurrence of CHAR.
Goes backward if ARG is negative; goes to end of buffer if CHAR not found."
  (interactive "*p\ncZap to char: ")
  (kill-region (point) (if (search-forward (char-to-string char) nil t arg)
			 (progn (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
				(point))
		       (if (> arg 0) (point-max) (point-min)))))

====================================================================
;;;------------------------------------------------------------------
;;;  Troff-Unterstuetzung

(defun umlaut-e ()
  (interactive)
  (if (save-excursion 
	(or (bolp)
	    (progn (backward-char 1) (not (looking-at "[aou]")))
	    (and (not (bolp))
		 (progn (backward-char 1) (looking-at "[aeioqu\*]")))))
      (insert "e")
    (backward-char 1)
    (insert "\\*")
    (forward-char 1)))

(defun scharfes-z ()
  (interactive)
  (if (save-excursion 
	(or (bolp)
	    (progn (backward-char 1) (not (looking-at "s")))))
      (insert "z")
    (backward-char 1)
    (insert "\\*")
    (forward-char 1)))

(defun in-troff-command ()
  (save-excursion
    (beginning-of-line)
    (looking-at "[.']")))

(defun backslashed ()
  (save-excursion
    (progn (backward-char 1) (looking-at "\\\\"))))

(defun anfzeichen ()
  (interactive)
  (if (or (in-troff-command) (backslashed))
      (insert "\"")
    (if (save-excursion
	  (or (bolp)
	      (progn (backward-char 1) (looking-at "[[({ \t\n]"))))
	(insert ",,")
      (insert "``"))))

(defun dblengquotes ()
  (interactive)
  (if (or (in-troff-command) (backslashed))
      (insert "\"")
    (if (save-excursion
	  (or (bolp)
	      (progn (backward-char 1) (looking-at "[[({ \t\n]"))))
	(insert "``")
      (insert "''"))))

(defvar abbrev-re "vtl\\|etc\\|e\\.g\\|i\\.e\\|bzw\\|ggf\\|z\\.B\\|z\\.Z\\|u\\.a\\|usw\\|d\\.h")

(defun troff-dot ()
  (interactive)
  (if (save-excursion
	(or (bolp)
	    (progn (backward-char 1)
		   (or (bolp)
		       (progn (backward-char 1)
			      (or (bolp)
				  (progn (backward-char 1)
					 (not
					  (looking-at abbrev-re)))))))))
      (insert ".")
    (insert ".\\&")))

(defun german ()
  (interactive)
  (local-set-key "." 'troff-dot)
  (local-set-key "e" 'umlaut-e)
  (local-set-key "z" 'scharfes-z)
  (local-set-key "\"" 'anfzeichen))

(defun english ()
  (interactive)
  (local-set-key "." 'troff-dot)
  (local-set-key "e" 'self-insert-command)
  (local-set-key "z" 'self-insert-command)
  (local-set-key "\"" 'dblengquotes))