;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs 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 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(setq custom-declare-variable-list
(cons arguments custom-declare-variable-list)))
+(defmacro declare-function (fn file &optional arglist fileonly)
+ "Tell the byte-compiler that function FN is defined, in FILE.
+Optional ARGLIST is the argument list used by the function. The
+FILE argument is not used by the byte-compiler, but by the
+`check-declare' package, which checks that FILE contains a
+definition for FN. ARGLIST is used by both the byte-compiler and
+`check-declare' to check for consistency.
+
+FILE can be either a Lisp file (in which case the \".el\"
+extension is optional), or a C file. C files are expanded
+relative to the Emacs \"src/\" directory. Lisp files are
+searched for using `locate-library', and if that fails they are
+expanded relative to the location of the file containing the
+declaration. A FILE with an \"ext:\" prefix is an external file.
+`check-declare' will check such files if they are found, and skip
+them without error if they are not.
+
+FILEONLY non-nil means that `check-declare' will only check that
+FILE exists, not that it defines FN. This is intended for
+function-definitions that `check-declare' does not recognize, e.g.
+`defstruct'.
+
+To specify a value for FILEONLY without passing an argument list,
+set ARGLIST to `t'. This is necessary because `nil' means an
+empty argument list, rather than an unspecified one.
+
+Note that for the purposes of `check-declare', this statement
+must be the first non-whitespace on a line, and everything up to
+the end of FILE must be all on the same line. For example:
+
+\(declare-function c-end-of-defun \"progmodes/cc-cmds.el\"
+ \(&optional arg))
+
+For more information, see Info node `elisp(Declaring Functions)'."
+ ;; Does nothing - byte-compile-declare-function does the work.
+ nil)
\f
;;;; Basic Lisp macros.
Treated as a declaration when used at the right place in a
`defmacro' form. \(See Info anchor `(elisp)Definition of declare'.)"
nil)
+
+(defmacro ignore-errors (&rest body)
+ "Execute BODY; if an error occurs, return nil.
+Otherwise, return result of last form in BODY."
+ `(condition-case nil (progn ,@body) (error nil)))
\f
;;;; Basic Lisp functions.
(eq (car object) 'frame-configuration)))
(defun functionp (object)
- "Non-nil if OBJECT is any kind of function or a special form.
-Also non-nil if OBJECT is a symbol and its function definition is
-\(recursively) a function or special form. This does not include
-macros."
+ "Non-nil if OBJECT is a function."
(or (and (symbolp object) (fboundp object)
(condition-case nil
(setq object (indirect-function object))
(error nil))
(eq (car-safe object) 'autoload)
(not (car-safe (cdr-safe (cdr-safe (cdr-safe (cdr-safe object)))))))
- (subrp object) (byte-code-function-p object)
+ (and (subrp object)
+ ;; Filter out special forms.
+ (not (eq 'unevalled (cdr (subr-arity object)))))
+ (byte-code-function-p object)
(eq (car-safe object) 'lambda)))
\f
;;;; List functions.
(setq tail (cdr tail)))
value))
-(make-obsolete 'assoc-ignore-case 'assoc-string)
+(make-obsolete 'assoc-ignore-case 'assoc-string "22.1")
(defun assoc-ignore-case (key alist)
"Like `assoc', but ignores differences in case and text representation.
KEY must be a string. Upper-case and lower-case letters are treated as equal.
Unibyte strings are converted to multibyte for comparison."
(assoc-string key alist t))
-(make-obsolete 'assoc-ignore-representation 'assoc-string)
+(make-obsolete 'assoc-ignore-representation 'assoc-string "22.1")
(defun assoc-ignore-representation (key alist)
"Like `assoc', but ignores differences in text representation.
KEY must be a string.
(setq inserted t)))
(setq tail (cdr tail)))))
-(defun map-keymap-internal (function keymap &optional sort-first)
+(defun map-keymap-sorted (function keymap)
"Implement `map-keymap' with sorting.
Don't call this function; it is for internal use only."
- (if sort-first
- (let (list)
- (map-keymap (lambda (a b) (push (cons a b) list))
- keymap)
- (setq list (sort list
- (lambda (a b)
- (setq a (car a) b (car b))
- (if (integerp a)
- (if (integerp b) (< a b)
- t)
- (if (integerp b) t
- (string< a b))))))
- (dolist (p list)
- (funcall function (car p) (cdr p))))
- (map-keymap function keymap)))
+ (let (list)
+ (map-keymap (lambda (a b) (push (cons a b) list))
+ keymap)
+ (setq list (sort list
+ (lambda (a b)
+ (setq a (car a) b (car b))
+ (if (integerp a)
+ (if (integerp b) (< a b)
+ t)
+ (if (integerp b) t
+ ;; string< also accepts symbols.
+ (string< a b))))))
+ (dolist (p list)
+ (funcall function (car p) (cdr p)))))
+
+(defun keymap-canonicalize (map)
+ "Return an equivalent keymap, without inheritance."
+ (let ((bindings ())
+ (ranges ()))
+ (while (keymapp map)
+ (setq map (map-keymap-internal
+ (lambda (key item)
+ (if (consp key)
+ ;; Treat char-ranges specially.
+ (push (cons key item) ranges)
+ (push (cons key item) bindings)))
+ map)))
+ (setq map (funcall (if ranges 'make-keymap 'make-sparse-keymap)
+ (keymap-prompt map)))
+ (dolist (binding ranges)
+ ;; Treat char-ranges specially.
+ (define-key map (vector (car binding)) (cdr binding)))
+ (dolist (binding (prog1 bindings (setq bindings ())))
+ (let* ((key (car binding))
+ (item (cdr binding))
+ (oldbind (assq key bindings)))
+ ;; Newer bindings override older.
+ (if oldbind (setq bindings (delq oldbind bindings)))
+ (when item ;nil bindings just hide older ones.
+ (push binding bindings))))
+ (nconc map bindings)))
(put 'keyboard-translate-table 'char-table-extra-slots 0)
;; Filter out integers too large to be events.
;; M is the biggest modifier.
(zerop (logand obj (lognot (1- (lsh ?\M-\^@ 1)))))
- (char-valid-p (event-basic-type obj)))
+ (characterp (event-basic-type obj)))
(and (symbolp obj)
(get obj 'event-symbol-elements))
(and (consp obj)
(if (listp type)
(setq type (car type)))
(if (symbolp type)
- (cdr (get type 'event-symbol-elements))
+ ;; Don't read event-symbol-elements directly since we're not
+ ;; sure the symbol has already been parsed.
+ (cdr (internal-event-symbol-parse-modifiers type))
(let ((list nil)
(char (logand type (lognot (logior ?\M-\^@ ?\C-\^@ ?\S-\^@
?\H-\^@ ?\s-\^@ ?\A-\^@)))))
"Return non-nil if OBJECT is a mouse movement event."
(eq (car-safe object) 'mouse-movement))
+(defun mouse-event-p (object)
+ "Return non-nil if OBJECT is a mouse click event."
+ ;; is this really correct? maybe remove mouse-movement?
+ (memq (event-basic-type object) '(mouse-1 mouse-2 mouse-3 mouse-movement)))
+
(defsubst event-start (event)
"Return the starting position of EVENT.
If EVENT is a mouse or key press or a mouse click, this returns the location
(x (/ (car pair) (frame-char-width frame)))
(y (/ (cdr pair) (+ (frame-char-height frame)
(or (frame-parameter frame 'line-spacing)
- default-line-spacing
+ ;; FIXME: Why the `default'?
+ (default-value 'line-spacing)
0)))))
(cons x y))))))
\f
;;;; Obsolescence declarations for variables, and aliases.
+(make-obsolete-variable 'redisplay-end-trigger-functions 'jit-lock-register "23.1")
+(make-obsolete 'window-redisplay-end-trigger nil "23.1")
+(make-obsolete 'set-window-redisplay-end-trigger nil "23.1")
+
+(make-obsolete 'process-filter-multibyte-p nil "23.1")
+(make-obsolete 'set-process-filter-multibyte nil "23.1")
+
(make-obsolete-variable 'directory-sep-char "do not use it." "21.1")
(make-obsolete-variable
'mode-line-inverse-video
(defvaralias 'x-sent-selection-hooks 'x-sent-selection-functions)
(make-obsolete-variable 'x-sent-selection-hooks
'x-sent-selection-functions "22.1")
+;; This was introduced in 21.4 for pre-unicode unification and was rendered
+;; obsolete by the use of Unicode internally in 23.1.
+(make-obsolete-variable 'translation-table-for-input nil "23.1")
(defvaralias 'messages-buffer-max-lines 'message-log-max)
\f
(append hook-value (list function))
(cons function hook-value))))
;; Set the actual variable
- (if local (set hook hook-value) (set-default hook hook-value))))
+ (if local
+ (progn
+ ;; If HOOK isn't a permanent local,
+ ;; but FUNCTION wants to survive a change of modes,
+ ;; mark HOOK as partially permanent.
+ (and (symbolp function)
+ (get function 'permanent-local-hook)
+ (not (get hook 'permanent-local))
+ (put hook 'permanent-local 'permanent-local-hook))
+ (set hook hook-value))
+ (set-default hook hook-value))))
(defun remove-hook (hook function &optional local)
"Remove from the value of HOOK the function FUNCTION.
Execution is delayed if `delay-mode-hooks' is non-nil.
If `delay-mode-hooks' is nil, run `after-change-major-mode-hook'
after running the mode hooks.
-Major mode functions should use this."
+Major mode functions should use this instead of `run-hooks' when running their
+FOO-mode-hook."
(if delay-mode-hooks
;; Delaying case.
(dolist (hook hooks)
(setq files (cdr files)))
file)))
-;;;###autoload
(defun locate-library (library &optional nosuffix path interactive-call)
"Show the precise file name of Emacs library LIBRARY.
This command searches the directories in `load-path' like `\\[load-library]'
string. When run interactively, the argument INTERACTIVE-CALL is t,
and the file name is displayed in the echo area."
(interactive (list (completing-read "Locate library: "
- 'locate-file-completion
- (cons load-path (get-load-suffixes)))
+ (apply-partially
+ 'locate-file-completion-table
+ load-path (get-load-suffixes)))
nil nil
t))
(let ((file (locate-file library
\f
;;;; Process stuff.
+(defun process-lines (program &rest args)
+ "Execute PROGRAM with ARGS, returning its output as a list of lines.
+Signal an error if the program returns with a non-zero exit status."
+ (with-temp-buffer
+ (let ((status (apply 'call-process program nil (current-buffer) nil args)))
+ (unless (eq status 0)
+ (error "%s exited with status %s" program status))
+ (goto-char (point-min))
+ (let (lines)
+ (while (not (eobp))
+ (setq lines (cons (buffer-substring-no-properties
+ (line-beginning-position)
+ (line-end-position))
+ lines))
+ (forward-line 1))
+ (nreverse lines)))))
+
;; open-network-stream is a wrapper around make-network-process.
(when (featurep 'make-network-process)
;; We could try and use read-key-sequence instead, but then C-q ESC
;; or C-q C-x might not return immediately since ESC or C-x might be
;; bound to some prefix in function-key-map or key-translation-map.
- (setq translated char)
- (let ((translation (lookup-key function-key-map (vector char))))
+ (setq translated
+ (if (integerp char)
+ (char-resolve-modifers char)
+ char))
+ (let ((translation (lookup-key local-function-key-map (vector char))))
(if (arrayp translation)
(setq translated (aref translation 0))))
(cond ((null translated))
floating point support.
\(fn SECONDS &optional NODISP)"
- (when (or obsolete (numberp nodisp))
- (setq seconds (+ seconds (* 1e-3 nodisp)))
- (setq nodisp obsolete))
+ (if (numberp nodisp)
+ (setq seconds (+ seconds (* 1e-3 nodisp))
+ nodisp obsolete)
+ (if obsolete (setq nodisp obsolete)))
(cond
(noninteractive
(sleep-for seconds)
(with-current-buffer (car elt)
(setq elt (cdr elt))
(let ((old-car
- (if (consp elt) (car elt)))
- (old-cdr
- (if (consp elt) (cdr elt))))
- ;; Temporarily truncate the undo log at ELT.
- (when (consp elt)
- (setcar elt nil) (setcdr elt nil))
- (unless (eq last-command 'undo) (undo-start))
- ;; Make sure there's no confusion.
- (when (and (consp elt) (not (eq elt (last pending-undo-list))))
- (error "Undoing to some unrelated state"))
- ;; Undo it all.
- (while (listp pending-undo-list) (undo-more 1))
- ;; Reset the modified cons cell ELT to its original content.
- (when (consp elt)
- (setcar elt old-car)
- (setcdr elt old-cdr))
- ;; Revert the undo info to what it was when we grabbed the state.
- (setq buffer-undo-list elt)))))
+ (if (consp elt) (car elt)))
+ (old-cdr
+ (if (consp elt) (cdr elt))))
+ ;; Temporarily truncate the undo log at ELT.
+ (when (consp elt)
+ (setcar elt nil) (setcdr elt nil))
+ (unless (eq last-command 'undo) (undo-start))
+ ;; Make sure there's no confusion.
+ (when (and (consp elt) (not (eq elt (last pending-undo-list))))
+ (error "Undoing to some unrelated state"))
+ ;; Undo it all.
+ (save-excursion
+ (while (listp pending-undo-list) (undo-more 1)))
+ ;; Reset the modified cons cell ELT to its original content.
+ (when (consp elt)
+ (setcar elt old-car)
+ (setcdr elt old-cdr))
+ ;; Revert the undo info to what it was when we grabbed the state.
+ (setq buffer-undo-list elt)))))
\f
;;;; Display-related functions.
(put 'cl-assertion-failed 'error-conditions '(error))
(put 'cl-assertion-failed 'error-message "Assertion failed")
+(defconst user-emacs-directory
+ (if (eq system-type 'ms-dos)
+ ;; MS-DOS cannot have initial dot.
+ "~/_emacs.d/"
+ "~/.emacs.d/")
+ "Directory beneath which additional per-user Emacs-specific files are placed.
+Various programs in Emacs store information in this directory.
+Note that this should end with a directory separator.")
+
\f
;;;; Misc. useful functions.
(defun find-tag-default ()
"Determine default tag to search for, based on text at point.
If there is no plausible default, return nil."
- (save-excursion
- (while (looking-at "\\sw\\|\\s_")
- (forward-char 1))
- (if (or (re-search-backward "\\sw\\|\\s_"
- (save-excursion (beginning-of-line) (point))
- t)
- (re-search-forward "\\(\\sw\\|\\s_\\)+"
- (save-excursion (end-of-line) (point))
- t))
- (progn
- (goto-char (match-end 0))
- (condition-case nil
- (buffer-substring-no-properties
- (point)
- (progn (forward-sexp -1)
- (while (looking-at "\\s'")
- (forward-char 1))
- (point)))
- (error nil)))
- nil)))
+ (let (from to bound)
+ (when (or (progn
+ ;; Look at text around `point'.
+ (save-excursion
+ (skip-syntax-backward "w_") (setq from (point)))
+ (save-excursion
+ (skip-syntax-forward "w_") (setq to (point)))
+ (> to from))
+ ;; Look between `line-beginning-position' and `point'.
+ (save-excursion
+ (and (setq bound (line-beginning-position))
+ (skip-syntax-backward "^w_" bound)
+ (> (setq to (point)) bound)
+ (skip-syntax-backward "w_")
+ (setq from (point))))
+ ;; Look between `point' and `line-end-position'.
+ (save-excursion
+ (and (setq bound (line-end-position))
+ (skip-syntax-forward "^w_" bound)
+ (< (setq from (point)) bound)
+ (skip-syntax-forward "w_")
+ (setq to (point)))))
+ (buffer-substring-no-properties from to))))
(defun play-sound (sound)
"SOUND is a list of the form `(sound KEYWORD VALUE...)'.
(play-sound-internal sound)
(error "This Emacs binary lacks sound support")))
+(declare-function w32-shell-dos-semantics "w32-fns" nil)
+
(defun shell-quote-argument (argument)
"Quote an argument for passing as argument to an inferior shell."
(if (or (eq system-type 'ms-dos)
(start-process name buffer shell-file-name shell-command-switch
(mapconcat 'identity args " ")))))
+(defun start-file-process-shell-command (name buffer &rest args)
+ "Start a program in a subprocess. Return the process object for it.
+Similar to `start-process-shell-command', but calls `start-file-process'."
+ (start-file-process
+ name buffer
+ (if (file-remote-p default-directory) "/bin/sh" shell-file-name)
+ (if (file-remote-p default-directory) "-c" shell-command-switch)
+ (mapconcat 'identity args " ")))
+
(defun call-process-shell-command (command &optional infile buffer display
&rest args)
"Execute the shell command COMMAND synchronously in separate process.
infile buffer display
shell-command-switch
(mapconcat 'identity (cons command args) " ")))))
+
+(defun process-file-shell-command (command &optional infile buffer display
+ &rest args)
+ "Process files synchronously in a separate process.
+Similar to `call-process-shell-command', but calls `process-file'."
+ (process-file
+ (if (file-remote-p default-directory) "/bin/sh" shell-file-name)
+ infile buffer display
+ (if (file-remote-p default-directory) "-c" shell-command-switch)
+ (mapconcat 'identity (cons command args) " ")))
\f
;;;; Lisp macros to do various things temporarily.
(if (window-live-p save-selected-window-window)
(select-window save-selected-window-window 'norecord))))))
+(defmacro with-selected-frame (frame &rest body)
+ "Execute the forms in BODY with FRAME as the selected frame.
+The value returned is the value of the last form in BODY.
+See also `with-temp-buffer'."
+ (declare (indent 1) (debug t))
+ (let ((old-frame (make-symbol "old-frame"))
+ (old-buffer (make-symbol "old-buffer")))
+ `(let ((,old-frame (selected-frame))
+ (,old-buffer (current-buffer)))
+ (unwind-protect
+ (progn (select-frame ,frame)
+ ,@body)
+ (if (frame-live-p ,old-frame)
+ (select-frame ,old-frame))
+ (if (buffer-live-p ,old-buffer)
+ (set-buffer ,old-buffer))))))
+
(defmacro with-temp-file (file &rest body)
"Create a new buffer, evaluate BODY there, and write the buffer to FILE.
The value returned is the value of the last form in BODY.
(with-current-buffer ,temp-buffer
,@body)
(with-current-buffer ,temp-buffer
- (widen)
- (write-region (point-min) (point-max) ,temp-file nil 0)))
+ (write-region nil nil ,temp-file nil 0)))
(and (buffer-name ,temp-buffer)
(kill-buffer ,temp-buffer))))))
(declare (indent 0) (debug t))
(let ((temp-buffer (make-symbol "temp-buffer")))
`(let ((,temp-buffer (generate-new-buffer " *temp*")))
- (unwind-protect
- (with-current-buffer ,temp-buffer
- ,@body)
- (and (buffer-name ,temp-buffer)
- (kill-buffer ,temp-buffer))))))
+ ;; FIXME: kill-buffer can change current-buffer in some odd cases.
+ (with-current-buffer ,temp-buffer
+ (unwind-protect
+ (progn ,@body)
+ (and (buffer-name ,temp-buffer)
+ (kill-buffer ,temp-buffer)))))))
(defmacro with-output-to-string (&rest body)
"Execute BODY, return the text it sent to `standard-output', as a string."
(catch ',catch-sym
(let ((throw-on-input ',catch-sym))
(or (input-pending-p)
- ,@body))))))
+ (progn ,@body)))))))
+
+(defmacro condition-case-no-debug (var bodyform &rest handlers)
+ "Like `condition-case' except that it does not catch anything when debugging.
+More specifically if `debug-on-error' is set, then it does not catch any signal."
+ (declare (debug condition-case) (indent 2))
+ (let ((bodysym (make-symbol "body")))
+ `(let ((,bodysym (lambda () ,bodyform)))
+ (if debug-on-error
+ (funcall ,bodysym)
+ (condition-case ,var
+ (funcall ,bodysym)
+ ,@handlers)))))
+
+(defmacro with-demoted-errors (&rest body)
+ "Run BODY and demote any errors to simple messages.
+If `debug-on-error' is non-nil, run BODY without catching its errors.
+This is to be used around code which is not expected to signal an error
+but which should be robust in the unexpected case that an error is signalled."
+ (declare (debug t) (indent 0))
+ (let ((err (make-symbol "err")))
+ `(condition-case-no-debug ,err
+ (progn ,@body)
+ (error (message "Error: %s" ,err) nil))))
(defmacro combine-after-change-calls (&rest body)
"Execute BODY, but don't call the after-change functions till the end.
(with-current-buffer ,old-buffer
(set-case-table ,old-case-table))))))
\f
-;;;; Constructing completion tables.
-
-(defun complete-with-action (action table string pred)
- "Perform completion ACTION.
-STRING is the string to complete.
-TABLE is the completion table, which should not be a function.
-PRED is a completion predicate.
-ACTION can be one of nil, t or `lambda'."
- ;; (assert (not (functionp table)))
- (funcall
- (cond
- ((null action) 'try-completion)
- ((eq action t) 'all-completions)
- (t 'test-completion))
- string table pred))
-
-(defmacro dynamic-completion-table (fun)
- "Use function FUN as a dynamic completion table.
-FUN is called with one argument, the string for which completion is required,
-and it should return an alist containing all the intended possible
-completions. This alist may be a full list of possible completions so that FUN
-can ignore the value of its argument. If completion is performed in the
-minibuffer, FUN will be called in the buffer from which the minibuffer was
-entered.
-
-The result of the `dynamic-completion-table' form is a function
-that can be used as the ALIST argument to `try-completion' and
-`all-completion'. See Info node `(elisp)Programmed Completion'."
- (declare (debug (lambda-expr)))
- (let ((win (make-symbol "window"))
- (string (make-symbol "string"))
- (predicate (make-symbol "predicate"))
- (mode (make-symbol "mode")))
- `(lambda (,string ,predicate ,mode)
- (with-current-buffer (let ((,win (minibuffer-selected-window)))
- (if (window-live-p ,win) (window-buffer ,win)
- (current-buffer)))
- (complete-with-action ,mode (,fun ,string) ,string ,predicate)))))
-
-(defmacro lazy-completion-table (var fun)
- ;; We used to have `&rest args' where `args' were evaluated late (at the
- ;; time of the call to `fun'), which was counter intuitive. But to get
- ;; them to be evaluated early, we have to either use lexical-let (which is
- ;; not available in subr.el) or use `(lambda (,str) ...) which prevents the use
- ;; of lexical-let in the callers.
- ;; So we just removed the argument. Callers can then simply use either of:
- ;; (lazy-completion-table var (lambda () (fun x y)))
- ;; or
- ;; (lazy-completion-table var `(lambda () (fun ',x ',y)))
- ;; or
- ;; (lexical-let ((x x)) ((y y))
- ;; (lazy-completion-table var (lambda () (fun x y))))
- ;; depending on the behavior they want.
- "Initialize variable VAR as a lazy completion table.
-If the completion table VAR is used for the first time (e.g., by passing VAR
-as an argument to `try-completion'), the function FUN is called with no
-arguments. FUN must return the completion table that will be stored in VAR.
-If completion is requested in the minibuffer, FUN will be called in the buffer
-from which the minibuffer was entered. The return value of
-`lazy-completion-table' must be used to initialize the value of VAR.
-
-You should give VAR a non-nil `risky-local-variable' property."
- (declare (debug (symbol lambda-expr)))
- (let ((str (make-symbol "string")))
- `(dynamic-completion-table
- (lambda (,str)
- (when (functionp ,var)
- (setq ,var (,fun)))
- ,var))))
-
-(defmacro complete-in-turn (a b)
- "Create a completion table that first tries completion in A and then in B.
-A and B should not be costly (or side-effecting) expressions."
- (declare (debug (def-form def-form)))
- `(lambda (string predicate mode)
- (cond
- ((eq mode t)
- (or (all-completions string ,a predicate)
- (all-completions string ,b predicate)))
- ((eq mode nil)
- (or (try-completion string ,a predicate)
- (try-completion string ,b predicate)))
- (t
- (or (test-completion string ,a predicate)
- (test-completion string ,b predicate))))))
-\f
;;; Matching and match data.
(defvar save-match-data-internal)
(buffer-substring-no-properties (match-beginning num)
(match-end num)))))
+
+(defun match-substitute-replacement (replacement
+ &optional fixedcase literal string subexp)
+ "Return REPLACEMENT as it will be inserted by `replace-match'.
+In other words, all back-references in the form `\\&' and `\\N'
+are substituted with actual strings matched by the last search.
+Optional FIXEDCASE, LITERAL, STRING and SUBEXP have the same
+meaning as for `replace-match'."
+ (let ((match (match-string 0 string)))
+ (save-match-data
+ (set-match-data (mapcar (lambda (x)
+ (if (numberp x)
+ (- x (match-beginning 0))
+ x))
+ (match-data t)))
+ (replace-match replacement fixedcase literal match subexp))))
+
+
(defun looking-back (regexp &optional limit greedy)
"Return non-nil if text before point matches regular expression REGEXP.
Like `looking-at' except matches before point, and is slower.
(looking-at (concat "\\(?:" regexp "\\)\\'")))))
(not (null pos))))
+(defsubst looking-at-p (regexp)
+ "\
+Same as `looking-at' except this function does not change the match data."
+ (let ((inhibit-changing-match-data t))
+ (looking-at regexp)))
+
+(defsubst string-match-p (regexp string &optional start)
+ "\
+Same as `string-match' except this function does not change the match data."
+ (let ((inhibit-changing-match-data t))
+ (string-match regexp string start)))
+
(defun subregexp-context-p (regexp pos &optional start)
"Return non-nil if POS is in a normal subregexp context in REGEXP.
A subregexp context is one where a sub-regexp can appear.
This tries to quote the strings to avoid ambiguity such that
(split-string-and-unquote (combine-and-quote-strings strs)) == strs
Only some SEPARATORs will work properly."
- (let ((sep (or separator " ")))
+ (let* ((sep (or separator " "))
+ (re (concat "[\\\"]" "\\|" (regexp-quote sep))))
(mapconcat
(lambda (str)
- (if (string-match "[\\\"]" str)
+ (if (string-match re str)
(concat "\"" (replace-regexp-in-string "[\\\"]" "\\\\\\&" str) "\"")
str))
strings sep)))