home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / prim / misc.el < prev    next >
Encoding:
Text File  |  1995-06-01  |  3.6 KB  |  103 lines
  1. ;;; misc.el --- miscellaneous functions for XEmacs
  2.  
  3. ;; Copyright (C) 1989 Free Software Foundation, Inc.
  4.  
  5. ;; Maintainer: FSF
  6.  
  7. ;; This file is part of XEmacs.
  8.  
  9. ;; XEmacs is free software; you can redistribute it and/or modify it
  10. ;; under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 2, or (at your option)
  12. ;; any later version.
  13.  
  14. ;; XEmacs is distributed in the hope that it will be useful, but
  15. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17. ;; General Public License for more details.
  18.  
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  21. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  22.  
  23. ;;; Code:
  24.  
  25. (defun copy-from-above-command (&optional arg)
  26.   "Copy characters from previous nonblank line, starting just above point.
  27. Copy ARG characters, but not past the end of that line.
  28. If no argument given, copy the entire rest of the line.
  29. The characters copied are inserted in the buffer before point."
  30.   (interactive "P")
  31.   (let ((cc (current-column))
  32.     n
  33.     (string ""))
  34.     (save-excursion
  35.       (beginning-of-line)
  36.       (backward-char 1)
  37.       (skip-chars-backward "\ \t\n")
  38.       (move-to-column cc)
  39.       ;; Default is enough to copy the whole rest of the line.
  40.       (setq n (if arg (prefix-numeric-value arg) (point-max)))
  41.       ;; If current column winds up in middle of a tab,
  42.       ;; copy appropriate number of "virtual" space chars.
  43.       (if (< cc (current-column))
  44.       (if (= (preceding-char) ?\t)
  45.           (progn
  46.         (setq string (make-string (min n (- (current-column) cc)) ?\ ))
  47.         (setq n (- n (min n (- (current-column) cc)))))
  48.         ;; In middle of ctl char => copy that whole char.
  49.         (backward-char 1)))
  50.       (setq string (concat string
  51.                (buffer-substring
  52.                 (point)
  53.                 (min (save-excursion (end-of-line) (point))
  54.                  (+ n (point)))))))
  55.     (insert string)))
  56.  
  57. ;; This replaces the idiom
  58. ;;
  59. ;; (or (assq 'isearch-mode minor-mode-alist)
  60. ;;     (setq minor-mode-alist
  61. ;;           (purecopy
  62. ;;            (append minor-mode-alist
  63. ;;                    '((isearch-mode isearch-mode))))))
  64.  
  65. (defun add-minor-mode (toggle name &optional keymap after)
  66.   "Add a minor mode to `minor-mode-alist' and `minor-mode-map-alist'.
  67. TOGGLE is a symbol which is used as the variable which toggle the minor mode,
  68. NAME is the name that should appear in the modeline (it should be a string
  69. beginning with a space), KEYMAP is a keymap to make active when the minor
  70. mode is active, and AFTER is the toggling symbol used for another minor
  71. mode.  If AFTER is non-nil, then it is used to position the new mode in the
  72. minor-mode alists.
  73.  
  74. Example:  (add-minor-mode 'view-minor-mode \" View\" view-mode-map)"
  75.   (let (el place
  76.     (add-elt #'(lambda (elt sym)
  77.              (cond ((null after) ; add to front
  78.                 (set sym (cons elt (symbol-value sym))))
  79.                ((and (not (eq after t))
  80.                  (setq place (memq (assq after (symbol-value sym))
  81.                            (symbol-value sym))))
  82.                 (setq elt (cons elt (cdr place)))
  83.                 (setcdr place elt))
  84.                (t
  85.                 (set sym (append (symbol-value sym) (list elt))))
  86.                )
  87.              (symbol-value sym))))
  88.     (and name
  89.      (if (setq el (assq toggle minor-mode-alist))
  90.          (setcdr el (list name))
  91.        (funcall add-elt 
  92.             (list toggle name)
  93.             'minor-mode-alist)))
  94.     (and keymap
  95.      (if (setq el (assq toggle minor-mode-map-alist))
  96.          (setcdr el keymap)
  97.        (funcall add-elt
  98.             (cons toggle keymap)
  99.             'minor-mode-map-alist)))
  100.     ))
  101.  
  102. ;;; misc.el ends here
  103.