procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-60

Browse source 
Merge from emacs--devo--0

Patches applied:

 * emacs--devo--0  (patch 259-273)

   - Update from CVS
   - lisp/replace.el (occur-engine): Bind `inhibit-field-text-motion' to t
   - Merge from gnus--rel--5.10
   - Rename "field-at-point" to "field-at-pos"
   - (comint-insert-input): Remove redundant calls to setq and goto-char

 * gnus--rel--5.10  (patch 99-100)

   - Merge from emacs--devo--0
   - Update from CVS
This commit is contained in:
Miles Bader 2006-05-10 20:42:41 +00:00
commit 3bcf2b084a
140 changed files with 8969 additions and 6350 deletions
Download patch file Download diff file Expand all files Collapse all files

41
lisp/emacs-lisp/crm.el
View file

@ -592,25 +592,28 @@ The return value of this function is a list of the read strings.
See the documentation for `completing-read' for details on the arguments:
PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST, DEF, and
INHERIT-INPUT-METHOD."
(let ((minibuffer-completion-table (function crm-collection-fn))
(minibuffer-completion-predicate predicate)
;; see completing_read in src/minibuf.c
(minibuffer-completion-confirm
(unless (eq require-match t) require-match))
(crm-completion-table table)
crm-last-exact-completion
crm-current-element
crm-left-of-element
crm-right-of-element
crm-beginning-of-element
crm-end-of-element
(map (if require-match
crm-local-must-match-map
crm-local-completion-map)))
(split-string (read-from-minibuffer
prompt initial-input map
nil hist def inherit-input-method)
crm-separator)))
(let* ((minibuffer-completion-table (function crm-collection-fn))
(minibuffer-completion-predicate predicate)
;; see completing_read in src/minibuf.c
(minibuffer-completion-confirm
(unless (eq require-match t) require-match))
(crm-completion-table table)
crm-last-exact-completion
crm-current-element
crm-left-of-element
crm-right-of-element
crm-beginning-of-element
crm-end-of-element
(map (if require-match
crm-local-must-match-map
crm-local-completion-map))
;; If the user enters empty input, read-from-minibuffer returns
;; the empty string, not DEF.
(input (read-from-minibuffer
prompt initial-input map
nil hist def inherit-input-method)))
(and def (string-equal input "") (setq input def))
(split-string input crm-separator)))
;; testing and debugging
;; (defun crm-init-test-environ ()

8
lisp/emacs-lisp/easy-mmode.el
View file

@ -139,7 +139,8 @@ For example, you could write
(setq body (list* lighter keymap body) lighter nil keymap nil))
((keywordp keymap) (push keymap body) (setq keymap nil)))
(let* ((mode-name (symbol-name mode))
(let* ((last-message (current-message))
(mode-name (symbol-name mode))
(pretty-name (easy-mmode-pretty-mode-name mode lighter))
(globalp nil)
(set nil)
@ -236,7 +237,10 @@ With zero or negative ARG turn mode off.
(if (called-interactively-p)
(progn
,(if globalp `(customize-mark-as-set ',mode))
(unless (current-message)
;; Avoid overwriting a message shown by the body,
;; but do overwrite previous messages.
(unless ,(and (current-message)
(not (equal last-message (current-message))))
(message ,(format "%s %%sabled" pretty-name)
(if ,mode "en" "dis")))))
(force-mode-line-update)

101
lisp/emacs-lisp/ewoc.el
View file

@ -144,13 +144,6 @@
\(fn NODE CHILD)")
(defun ewoc--dll-create ()
"Create an empty doubly linked list."
(let ((dummy-node (ewoc--node-create 'DL-LIST 'DL-LIST)))
(setf (ewoc--node-right dummy-node) dummy-node)
(setf (ewoc--node-left dummy-node) dummy-node)
dummy-node))
(defun ewoc--node-enter-before (node elemnode)
"Insert ELEMNODE before NODE in a DLL."
(assert (and (null (ewoc--node-left elemnode)) (null (ewoc--node-right elemnode))))
@ -159,14 +152,6 @@
(setf (ewoc--node-right (ewoc--node-left node)) elemnode)
(setf (ewoc--node-left node) elemnode))
(defun ewoc--node-enter-first (dll node)
"Add a free floating NODE first in DLL."
(ewoc--node-enter-before (ewoc--node-right dll) node))
(defun ewoc--node-enter-last (dll node)
"Add a free floating NODE last in DLL."
(ewoc--node-enter-before dll node))
(defun ewoc--node-next (dll node)
"Return the node after NODE, or nil if NODE is the last node."
(unless (eq (ewoc--node-right node) dll) (ewoc--node-right node)))
@ -175,16 +160,6 @@
"Return the node before NODE, or nil if NODE is the first node."
(unless (eq (ewoc--node-left node) dll) (ewoc--node-left node)))
(defun ewoc--node-delete (node)
"Unbind NODE from its doubly linked list and return it."
;; This is a no-op when applied to the dummy node. This will return
;; nil if applied to the dummy node since it always contains nil.
(setf (ewoc--node-right (ewoc--node-left node)) (ewoc--node-right node))
(setf (ewoc--node-left (ewoc--node-right node)) (ewoc--node-left node))
(setf (ewoc--node-left node) nil)
(setf (ewoc--node-right node) nil)
node)
(defun ewoc--node-nth (dll n)
"Return the Nth node from the doubly linked list DLL.
N counts from zero. If DLL is not that long, nil is returned.
@ -221,16 +196,12 @@ dll bound to ewoc--dll, and VARLIST bound as in a let*.
dll will be bound when VARLIST is initialized, but the current
buffer will *not* have been changed.
Return value of last form in FORMS."
(let ((old-buffer (make-symbol "old-buffer"))
(hnd (make-symbol "ewoc")))
`(let* ((,old-buffer (current-buffer))
(,hnd ,ewoc)
(let ((hnd (make-symbol "ewoc")))
`(let* ((,hnd ,ewoc)
(dll (ewoc--dll ,hnd))
,@varlist)
(set-buffer (ewoc--buffer ,hnd))
(unwind-protect
(progn ,@forms)
(set-buffer ,old-buffer)))))
(with-current-buffer (ewoc--buffer ,hnd)
,@forms))))
(defmacro ewoc--set-buffer-bind-dll (ewoc &rest forms)
`(ewoc--set-buffer-bind-dll-let* ,ewoc nil ,@forms))
@ -261,26 +232,6 @@ start position and the element DATA."
(funcall pretty-printer data)
(ewoc--node-create (copy-marker pos) data))))
(defun ewoc--delete-node-internal (ewoc node)
"Delete a data string from EWOC.
Can not be used on the footer. Return the wrapper that is deleted.
The start-marker in the wrapper is set to nil, so that it doesn't
consume any more resources."
(let ((dll (ewoc--dll ewoc))
(inhibit-read-only t))
;; If we are about to delete the node pointed at by last-node,
;; set last-node to nil.
(if (eq (ewoc--last-node ewoc) node)
(setf (ewoc--last-node ewoc) nil))
(delete-region (ewoc--node-start-marker node)
(ewoc--node-start-marker (ewoc--node-next dll node)))
(set-marker (ewoc--node-start-marker node) nil)
;; Delete the node, and return the wrapper.
(ewoc--node-delete node)))
(defun ewoc--refresh-node (pp node)
"Redisplay the element represented by NODE using the pretty-printer PP."
(let ((inhibit-read-only t))
@ -313,19 +264,23 @@ Optional second argument HEADER is a string that will always be
present at the top of the ewoc. HEADER should end with a
newline. Optional third argument FOOTER is similar, and will
be inserted at the bottom of the ewoc."
(let ((new-ewoc
(ewoc--create (current-buffer)
pretty-printer nil nil (ewoc--dll-create)))
(pos (point)))
(let* ((dummy-node (ewoc--node-create 'DL-LIST 'DL-LIST))
(dll (progn (setf (ewoc--node-right dummy-node) dummy-node)
(setf (ewoc--node-left dummy-node) dummy-node)
dummy-node))
(new-ewoc
(ewoc--create (current-buffer)
pretty-printer nil nil dll))
(pos (point)))
(ewoc--set-buffer-bind-dll new-ewoc
;; Set default values
(unless header (setq header ""))
(unless footer (setq footer ""))
(setf (ewoc--node-start-marker dll) (copy-marker pos))
(let ((foot (ewoc--create-node footer (lambda (x) (insert footer)) pos))
(head (ewoc--create-node header (lambda (x) (insert header)) pos)))
(ewoc--node-enter-first dll head)
(ewoc--node-enter-last dll foot)
(let ((foot (ewoc--create-node footer 'insert pos))
(head (ewoc--create-node header 'insert pos)))
(ewoc--node-enter-before (ewoc--node-right dll) head)
(ewoc--node-enter-before dll foot)
(setf (ewoc--header new-ewoc) head)
(setf (ewoc--footer new-ewoc) foot)))
;; Return the ewoc
@ -421,11 +376,27 @@ ARGS are given they will be passed to the PREDICATE."
(ewoc--set-buffer-bind-dll-let* ewoc
((node (ewoc--node-nth dll 1))
(footer (ewoc--footer ewoc))
(next nil))
(next nil)
(L nil) (R nil)
(inhibit-read-only t))
(while (not (eq node footer))
(setq next (ewoc--node-next dll node))
(unless (apply predicate (ewoc--node-data node) args)
(ewoc--delete-node-internal ewoc node))
;; If we are about to delete the node pointed at by last-node,
;; set last-node to nil.
(if (eq (ewoc--last-node ewoc) node)
(setf (ewoc--last-node ewoc) nil))
(delete-region (ewoc--node-start-marker node)
(ewoc--node-start-marker (ewoc--node-next dll node)))
(set-marker (ewoc--node-start-marker node) nil)
(setf L (ewoc--node-left node)
R (ewoc--node-right node)
;; Link neighbors to each other.
(ewoc--node-right L) R
(ewoc--node-left R) L
;; Forget neighbors.
(ewoc--node-left node) nil
(ewoc--node-right node) nil))
(setq node next))))
(defun ewoc-locate (ewoc &optional pos guess)
@ -601,8 +572,8 @@ Return nil if the buffer has been deleted."
"Set the HEADER and FOOTER of EWOC."
(setf (ewoc--node-data (ewoc--header ewoc)) header)
(setf (ewoc--node-data (ewoc--footer ewoc)) footer)
(ewoc--refresh-node (lambda (x) (insert header)) (ewoc--header ewoc))
(ewoc--refresh-node (lambda (x) (insert footer)) (ewoc--footer ewoc)))
(ewoc--refresh-node 'insert (ewoc--header ewoc))
(ewoc--refresh-node 'insert (ewoc--footer ewoc)))
(provide 'ewoc)

35
lisp/emacs-lisp/re-builder.el
View file

@ -112,7 +112,7 @@
(if (not (fboundp 'make-overlay))
(require 'overlay))
;; User costomizable variables
;; User customizable variables
(defgroup re-builder nil
"Options for the RE Builder."
:group 'lisp
@ -627,11 +627,9 @@ Return t if the (cooked) expression changed."
beg (match-end 0)))
i))
(defun reb-update-overlays (&optional subexp)
"Switch to `reb-target-buffer' and mark all matches of `reb-regexp'.
If SUBEXP is non-nil mark only the corresponding sub-expressions."
(let* ((re (reb-target-binding reb-regexp))
(subexps (reb-count-subexps re))
(matches 0)
@ -645,24 +643,35 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions."
(or (not reb-auto-match-limit)
(< matches reb-auto-match-limit)))
(if (= 0 (length (match-string 0)))
(error "Empty regular expression!"))
(let ((i 0))
(error "Empty regular expression!"))
(let ((i 0)
suffix max-suffix)
(setq matches (1+ matches))
(while (<= i subexps)
(if (and (or (not subexp) (= subexp i))
(match-beginning i))
(let ((overlay (make-overlay (match-beginning i)
(match-end i)))
(face-name (format "reb-match-%d" i)))
(if (not firstmatch)
(setq firstmatch (match-data)))
;; When we have exceeded the number of provided faces,
;; cycle thru them where `max-suffix' denotes the maximum
;; suffix for `reb-match-*' that has been defined and
;; `suffix' the suffix calculated for the current match.
(face
(cond
(max-suffix
(if (= suffix max-suffix)
(setq suffix 1)
(setq suffix (1+ suffix)))
(intern-soft (format "reb-match-%d" suffix)))
((intern-soft (format "reb-match-%d" i)))
((setq max-suffix (1- i))
(setq suffix 1)
;; `reb-match-1' must exist.
'reb-match-1))))
(unless firstmatch (setq firstmatch (match-data)))
(setq reb-overlays (cons overlay reb-overlays)
submatches (1+ submatches))
(overlay-put
overlay 'face
(or (intern-soft face-name)
(error "Too many subexpressions - face `%s' not defined"
face-name )))
(overlay-put overlay 'face face)
(overlay-put overlay 'priority i)))
(setq i (1+ i))))))
(let ((count (if subexp submatches matches)))

17
lisp/emacs-lisp/syntax.el
View file

@ -27,9 +27,9 @@
;; The main exported function is `syntax-ppss'. You might also need
;; to call `syntax-ppss-flush-cache' or to add it to
;; after-change-functions'(although this is automatically done by
;; before-change-functions'(although this is automatically done by
;; syntax-ppss when needed, but that might fail if syntax-ppss is
;; called in a context where after-change-functions is temporarily
;; called in a context where before-change-functions is temporarily
;; let-bound to nil).
;;; Todo:
@ -94,10 +94,9 @@ point (where the PPSS is equivalent to nil).")
(setq syntax-ppss-last nil)
(setcar syntax-ppss-last nil)))
;; Unregister if there's no cache left. Sadly this doesn't work
;; because `after-change-functions' is temporarily bound to nil here.
;; because `before-change-functions' is temporarily bound to nil here.
;; (unless syntax-ppss-cache
;; (remove-hook 'after-change-functions
;; 'syntax-ppss-after-change-function t))
;; (remove-hook 'before-change-functions 'syntax-ppss-flush-cache t))
)
(defvar syntax-ppss-stats
@ -148,7 +147,7 @@ Point is at POS when this function returns."
;; too far from `pos', we could try to use other positions
;; in (nth 9 old-ppss), but that doesn't seem to happen in
;; practice and it would complicate this code (and the
;; after-change-function code even more). But maybe it
;; before-change-function code even more). But maybe it
;; would be useful in "degenerate" cases such as when the
;; whole file is wrapped in a set of parenthesis.
(setq pt-min (or (car (nth 9 old-ppss))
@ -176,10 +175,10 @@ Point is at POS when this function returns."
(setq cache (cdr cache)))
(if cache (setq pt-min (caar cache) ppss (cdar cache)))
;; Setup the after-change function if necessary.
;; Setup the before-change function if necessary.
(unless (or syntax-ppss-cache syntax-ppss-last)
(add-hook 'after-change-functions
'syntax-ppss-flush-cache nil t))
(add-hook 'before-change-functions
'syntax-ppss-flush-cache t t))
;; Use the best of OLD-POS and CACHE.
(if (or (not old-pos) (< old-pos pt-min))