;;; misc.el --- miscellaneous functions for XEmacs

;; Copyright (C) 1989 Free Software Foundation, Inc.

;; Maintainer: FSF

;; This file is part of XEmacs.

;; XEmacs 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.

;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Code:

(defun copy-from-above-command (&optional arg)
  "Copy characters from previous nonblank line, starting just above point.
Copy ARG characters, but not past the end of that line.
If no argument given, copy the entire rest of the line.
The characters copied are inserted in the buffer before point."
  (interactive "P")
  (let ((cc (current-column))
	n
	(string ""))
    (save-excursion
      (beginning-of-line)
      (backward-char 1)
      (skip-chars-backward "\ \t\n")
      (move-to-column cc)
      ;; Default is enough to copy the whole rest of the line.
      (setq n (if arg (prefix-numeric-value arg) (point-max)))
      ;; If current column winds up in middle of a tab,
      ;; copy appropriate number of "virtual" space chars.
      (if (< cc (current-column))
	  (if (= (preceding-char) ?\t)
	      (progn
		(setq string (make-string (min n (- (current-column) cc)) ?\ ))
		(setq n (- n (min n (- (current-column) cc)))))
	    ;; In middle of ctl char => copy that whole char.
	    (backward-char 1)))
      (setq string (concat string
			   (buffer-substring
			    (point)
			    (min (save-excursion (end-of-line) (point))
				 (+ n (point)))))))
    (insert string)))

;; This replaces the idiom
;;
;; (or (assq 'isearch-mode minor-mode-alist)
;;     (setq minor-mode-alist
;;           (purecopy
;;            (append minor-mode-alist
;;                    '((isearch-mode isearch-mode))))))

(defun add-minor-mode (toggle name &optional keymap after)
  "Add a minor mode to `minor-mode-alist' and `minor-mode-map-alist'.
TOGGLE is a symbol which is used as the variable which toggle the minor mode,
NAME is the name that should appear in the modeline (it should be a string
beginning with a space), KEYMAP is a keymap to make active when the minor
mode is active, and AFTER is the toggling symbol used for another minor
mode.  If AFTER is non-nil, then it is used to position the new mode in the
minor-mode alists.

Example:  (add-minor-mode 'view-minor-mode \" View\" view-mode-map)"
  (let (el place
	(add-elt #'(lambda (elt sym)
		     (cond ((null after) ; add to front
			    (set sym (cons elt (symbol-value sym))))
			   ((and (not (eq after t))
				 (setq place (memq (assq after (symbol-value sym))
						   (symbol-value sym))))
			    (setq elt (cons elt (cdr place)))
			    (setcdr place elt))
			   (t
			    (set sym (append (symbol-value sym) (list elt))))
			   )
		     (symbol-value sym))))
    (and name
	 (if (setq el (assq toggle minor-mode-alist))
	     (setcdr el (list name))
	   (funcall add-elt 
		    (list toggle name)
		    'minor-mode-alist)))
    (and keymap
	 (if (setq el (assq toggle minor-mode-map-alist))
	     (setcdr el keymap)
	   (funcall add-elt
		    (cons toggle keymap)
		    'minor-mode-map-alist)))
    ))

;;; misc.el ends here
