[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
simple+.el - extensions to GNU `simple.el'
|
From: |
Drew Adams |
|
Subject: |
simple+.el - extensions to GNU `simple.el' |
|
Date: |
Tue, 16 Jan 2001 21:35:20 -0500 |
;;; simple+.el --- Extensions to `simple.el'.
;;
;; Filename: simple+.el
;; Description: Extensions to `simple.el'.
;; Author: Drew Adams
;; Maintainer: Drew Adams
;; Copyright (C) 1996-2001, Drew Adams, all rights reserved.
;; Created: Fri Apr 12 10:56:45 1996
;; Version: $Id: simple+.el,v 1.5 2001/01/09 22:22:12 dadams Exp $
;; Last-Updated: Tue Jan 9 14:22:06 2001
;; By: dadams
;; Update #: 210
;; Keywords: internal, lisp, extensions, abbrev, local
;; Compatibility: GNU Emacs 20.x
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Extensions to `simple.el'.
;;
;;
;; ***** NOTE: The following functions defined in `simple.el' have
;; been REDEFINED HERE:
;;
;; `choose-completion-string' -
;; Don't exit minibuffer after `lisp-complete-symbol' completion.
;; `completion-setup-function' - 1. Put faces on inserted string(s).
;; 2. Help on help.
;; `edit-and-eval-command' - Bug fix: Adds COMMAND as a command to
;; `command-history', not as a string.
;; `kill-ring' - Bug fix: `mouse-save-then-kill' expects a consp, so
;; ensure a consp.
;; `switch-to-completions' - Always selects *Completions* window.
;;
;;
;; This file should be loaded after loading the standard GNU file
;; `simple.el'. So, in your `~/.emacs' file, do this:
;; (eval-after-load "simple" '(require 'simple+))
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change log:
;;
;; RCS $Log: simple+.el,v $
;; RCS Revision 1.5 2001/01/09 22:22:12 dadams
;; RCS Adapted file header for Emacs Lisp Archive.
;; RCS
;; RCS Revision 1.4 2001/01/03 17:46:09 dadams
;; RCS *** empty log message ***
;; RCS
;; RCS Revision 1.3 2001/01/03 01:15:38 dadams
;; RCS *** empty log message ***
;; RCS
;; RCS Revision 1.2 2000/11/28 20:36:22 dadams
;; RCS Optional require's via 3rd arg=t now.
;; RCS
;; RCS Revision 1.1 2000/09/14 17:24:07 dadams
;; RCS Initial revision
;; RCS
; Revision 1.2 1999/03/17 15:50:35 dadams
; 1. Removed require: std-faces.
; 2. Removed: choose-completion.
; 3. choose-completion-string: Added doc string. Updated to correspond to
; Emacs 34.1 version.
; 4. completion-setup-function: diff prompt setups. face1 & face2 tests.
; 5. Added: switch-to-completions.
;
; Revision 1.1 1997/03/20 10:56:58 dadams
; Initial revision
;
; Revision 1.7 1996/07/01 13:26:12 dadams
; (trivial)
;
; Revision 1.6 1996/06/28 13:59:00 dadams
; (trivial)
;
; Revision 1.5 1996/06/14 06:16:25 dadams
; kill-ring: Bug fix: `mouse-save-then-kill' expects a consp, so ensure this.
;
; Revision 1.4 1996/06/06 14:52:50 dadams
; 1. Require std-faces.el.
; 2. Update of file dependency comments (e.g. "Autoloaded from...").
;
; Revision 1.3 1996/04/26 09:59:29 dadams
; Put escaped newlines on long-line strings.
;
; Revision 1.2 1996/04/12 11:24:18 dadams
; (trivial - Keywords)
;
; Revision 1.1 1996/04/12 11:05:56 dadams
; Initial revision
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program 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.
;; This program 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 this program; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
;; Cannot do (require 'simple), because `simple.el' does no `provide'.
;; Don't want to do a (load-library "simple") either, because it wouldn't
;; allow doing (eval-after-load "simple" '(require 'simple+))
(require 'cl) ;; when, unless, push, pop
(require 'strings nil t) ;; (no error if not found): concat-w-faces,
string-w-face
(require 'elect-mbuf nil t) ;; (no error if not found):
;; command-calling-for-completion,
completing-read-prompt-suffix
(require 'icomplete+ nil t) ;; (no error if not found): read-from-minibuffer
(provide 'simple+)
;;;;;;;;;;;;;;;;;;;;
(defvar completion-reference-buffer) ; To quiet byte compiler (`simple.el').
;; REPLACES ORIGINAL in `simple.el':
;; Original was bugged: it added COMMAND as a string to
;; `command-history'. This version adds it as a command.
;;;###autoload
(defun edit-and-eval-command (prompt command)
"Prompting with PROMPT, let user edit COMMAND and eval result.
COMMAND is a Lisp expression. Let user edit that expression in
the minibuffer, then read and evaluate the result."
(let* ((minibuffer-history-sexp-flag t)
(command (read-from-minibuffer prompt (prin1-to-string command)
read-expression-map t
'(command-history . 1))))
;; If command was added to `command-history' as a string,
;; get rid of that. We want only evaluable expressions there.
(when (stringp (car command-history)) (pop command-history))
;; If command to be redone does not match front of `command-history',
;; add it to `command-history'.
(unless (equal command (car command-history))
(push command command-history))
(eval command)))
;; REPLACES ORIGINAL binding in `simple.el' (nil):
;; Fixes bug: `mouse-save-then-kill' expects a consp.
(unless kill-ring (kill-new ""))
;; REPLACES ORIGINAL in `simple.el':
;; Just updates 20.3 with version from 20.6.1: corrects deletion of multiple.
(unless (string-match "20.6.1" emacs-version)
(defun comment-region (beg end &optional arg)
"Comment or uncomment each line in the region.
With just C-u prefix arg, uncomment each line in region.
Numeric prefix arg ARG means use ARG comment characters.
If ARG is negative, delete that many comment characters instead.
Comments are terminated on each line, even for syntax in which newline does
not end the comment. Blank lines do not get comments."
;; if someone wants it to only put a comment-start at the beginning and
;; comment-end at the end then typing it, C-x C-x, closing it, C-x C-x
;; is easy enough. No option is made here for other than commenting
;; every line.
(interactive "r\nP")
(or comment-start (error "No comment syntax is defined"))
(if (> beg end) (let (mid) (setq mid beg beg end end mid)))
(save-excursion
(save-restriction
(let ((cs comment-start) (ce comment-end)
(cp (when comment-padding
(make-string comment-padding ? )))
numarg)
(if (consp arg) (setq numarg t)
(setq numarg (prefix-numeric-value arg))
;; For positive arg > 1, replicate the comment delims now,
;; then insert the replicated strings just once.
(while (> numarg 1)
(setq cs (concat cs comment-start)
ce (concat ce comment-end))
(setq numarg (1- numarg))))
;; Loop over all lines from BEG to END.
(narrow-to-region beg end)
(goto-char beg)
(if (or (eq numarg t) (< numarg 0))
(while (not (eobp))
(let (found-comment)
;; Delete comment start from beginning of line.
(if (eq numarg t)
(while (looking-at (regexp-quote cs))
(setq found-comment t)
(delete-char (length cs)))
(let ((count numarg))
(while (and (> 1 (setq count (1+ count)))
(looking-at (regexp-quote cs)))
(setq found-comment t)
(delete-char (length cs)))))
;; Delete comment padding from beginning of line
(when (and found-comment comment-padding
(looking-at (regexp-quote cp)))
(delete-char comment-padding))
;; Delete comment end from end of line.
(if (string= "" ce)
nil
(if (eq numarg t)
(progn
(end-of-line)
;; This is questionable if comment-end ends in
;; whitespace. That is pretty brain-damaged,
;; though.
(while (progn (skip-chars-backward " \t")
(and (>= (- (point) (point-min))
(length ce))
(save-excursion
(backward-char (length ce))
(looking-at (regexp-quote ce)))))
(delete-char (- (length ce)))))
(let ((count numarg))
(while (> 1 (setq count (1+ count)))
(end-of-line)
;; this is questionable if comment-end ends in
whitespace
;; that is pretty brain-damaged though
(skip-chars-backward " \t")
(if (>= (- (point) (point-min)) (length ce))
(save-excursion
(backward-char (length ce))
(if (looking-at (regexp-quote ce))
(delete-char (length ce)))))))))
(forward-line 1)))
(when comment-padding
(setq cs (concat cs cp)))
(while (not (eobp))
;; Insert at beginning and at end.
(if (looking-at "[ \t]*$") ()
(insert cs)
(if (string= "" ce) ()
(end-of-line)
(insert ce)))
(search-forward "\n" nil 'move)))))))
)
;; REPLACES ORIGINAL in `simple.el':
;; Don't exit minibuffer if this is just a `lisp-complete-symbol' completion.
;; Free variable COMPLETION-REFERENCE-BUFFER is defined in `simple.el'.
;;;###autoload
(defun choose-completion-string (choice &optional buffer base-size)
"Switch to BUFFER and insert the completion choice CHOICE.
BASE-SIZE, if non-nil, says how many chars of BUFFER's text to keep.
If it is nil, use `choose-completion-delete-max-match' instead.
If BUFFER is the minibuffer, then exit the minibuffer, unless:
- it is reading a file name and CHOICE is a directory, *or*
- `completion-no-auto-exit' is non-nil, *or*
- this is just a `lisp-complete-symbol' completion."
(let ((buffer (or buffer completion-reference-buffer))) ; In `simple.el'.
;; If BUFFER is a minibuffer, barf unless it's currently active.
(when (and (string-match "\\` \\*Minibuf-[0-9]+\\*\\'"
(buffer-name buffer))
(or (not (active-minibuffer-window))
(not (equal buffer
(window-buffer (active-minibuffer-window))))))
(error "Minibuffer is not active for completion."))
;; Insert the completion into the buffer where completion was requested.
(set-buffer buffer)
(if base-size
(delete-region (+ base-size (point-min)) (point))
(choose-completion-delete-max-match choice))
(insert choice)
(remove-text-properties (- (point) (length choice)) (point)
'(mouse-face nil))
;; Update point in the window that BUFFER is showing in.
(let ((window (get-buffer-window buffer t)))
(set-window-point window (point)))
;; If completing for the minibuffer, exit it with this choice,
;; unless this was a `lisp-complete-symbol' completion.
(and (not completion-no-auto-exit)
(equal buffer (window-buffer (minibuffer-window)))
minibuffer-completion-table
(not (and (boundp 'command-calling-for-completion) ; Defined in
`elect-mbuf.el'.
(eq 'lisp-complete-symbol command-calling-for-completion)))
;; If this is reading a file name, and the file name chosen
;; is a directory, don't exit the minibuffer.
(if (and (eq minibuffer-completion-table 'read-file-name-internal)
(file-directory-p (buffer-string)))
(select-window (active-minibuffer-window))
(exit-minibuffer)))))
;; REPLACES ORIGINAL in `simple.el':
;; 1. Put faces on inserted string(s).
;; 2. Help on help.
;; `completing-read-prompt-suffix' is defined in `elect-mbuf.el'.
;;;###autoload
(defun completion-setup-function ()
;; This function goes in `completion-setup-hook', so that it is called
;; after the text of the completion list buffer is written.
(save-excursion
(let* ((mainbuf (current-buffer))
(prompt ; Simple string, no face.
(if window-system ; We have a mouse.
(substitute-command-keys
"Click \\<completion-list-mode-map>\
\\[mouse-choose-completion] on a completion to select it.\n")
(substitute-command-keys ; No mouse.
"In this buffer, type \\<completion-list-mode-map>\
\\[choose-completion] to select the completion near point.\n")))
(face1 (and (fboundp 'string-w-face) ; Defined in `strings.el'
(if (boundp 'blue-foreground-face)
blue-foreground-face
'region)))
(face2 (and face1 (boundp 'completing-read-prompt-suffix)
(if (boundp 'red-foreground-face)
red-foreground-face
'secondary-selection))))
(set-buffer standard-output)
(completion-list-mode)
(make-local-variable 'completion-reference-buffer)
(setq completion-reference-buffer mainbuf)
(if (eq minibuffer-completion-table 'read-file-name-internal)
;; For file name completion,
;; use the number of chars before the start of the
;; last file name component.
(setq completion-base-size
(save-excursion
(set-buffer mainbuf)
(goto-char (point-max))
(skip-chars-backward (format "^%c" directory-sep-char))
(- (point) (point-min))))
;; Otherwise, in minibuffer, the whole input is being completed.
(save-match-data
(if (string-match "\\` \\*Minibuf-[0-9]+\\*\\'"
(buffer-name mainbuf))
(setq completion-base-size 0))))
(goto-char (point-min))
(insert
(if face1 ; NB: ensures (fboundp 'concat-w-faces
& `string-w-face)
(if face2 ; Faces, completing-read-prompt-suffix.
(concat-w-faces (list face1 prompt)
(list face2 completing-read-prompt-suffix)
"\n\n")
(string-w-face (list face1 prompt)) prompt) ; Face1, no suffix.
prompt)) ; No faces.
(forward-line 1)
(while (re-search-forward "[^ \t\n]+\\( [^ \t\n]+\\)*" nil t)
(let ((beg (match-beginning 0))
(end (point)))
;;;Emacs20 (when completion-fixup-function (funcall completion-fixup-function))
(put-text-property beg (point) 'mouse-face 'highlight)
(goto-char end))))))
;; REPLACES ORIGINAL in `simple.el':
;; Selects *Completions* window even if on another frame.
(defun switch-to-completions ()
"Select the completion list window."
(interactive)
;; Make sure we have a completions window.
(or (get-buffer-window "*Completions*")
(minibuffer-completion-help))
(let ((window (get-buffer-window "*Completions*" 0))) ; Added 0 arg.
(when window
(select-window window)
(goto-char (point-min))
(search-forward "\n\n")
(forward-line 1))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; `simple+.el' ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- simple+.el - extensions to GNU `simple.el',
Drew Adams <=