;; 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 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
When COND yields non-nil, eval BODY forms sequentially and return
value of last one, or nil if there are none.
-\(fn COND BODY ...)"
+\(fn COND BODY...)"
(declare (indent 1) (debug t))
(list 'if cond (cons 'progn body)))
When COND yields nil, eval BODY forms sequentially and return
value of last one, or nil if there are none.
-\(fn COND BODY ...)"
+\(fn COND BODY...)"
(declare (indent 1) (debug t))
(cons 'if (cons cond (cons nil body))))
(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))))
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)
(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.
(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.
(or (input-pending-p)
,@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.
If BODY makes changes in the buffer, they are recorded
\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,
(with-current-buffer (let ((,win (minibuffer-selected-window)))
(if (window-live-p ,win) (window-buffer ,win)
(current-buffer)))
- (cond
- ((eq ,mode t) (all-completions ,string (,fun ,string) ,predicate))
- ((not ,mode) (try-completion ,string (,fun ,string) ,predicate))
- (t (test-completion ,string (,fun ,string) ,predicate)))))))
+ (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
(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.
(cons (substring string start)
list)))
(nreverse list)))
+
+(defun combine-and-quote-strings (strings &optional separator)
+ "Concatenate the STRINGS, adding the SEPARATOR (default \" \").
+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 " ")))
+ (mapconcat
+ (lambda (str)
+ (if (string-match "[\\\"]" str)
+ (concat "\"" (replace-regexp-in-string "[\\\"]" "\\\\\\&" str) "\"")
+ str))
+ strings sep)))
+
+(defun split-string-and-unquote (string &optional separator)
+ "Split the STRING into a list of strings.
+It understands Emacs Lisp quoting within STRING, such that
+ (split-string-and-unquote (combine-and-quote-strings strs)) == strs
+The SEPARATOR regexp defaults to \"\\s-+\"."
+ (let ((sep (or separator "\\s-+"))
+ (i (string-match "[\"]" string)))
+ (if (null i)
+ (split-string string sep t) ; no quoting: easy
+ (append (unless (eq i 0) (split-string (substring string 0 i) sep t))
+ (let ((rfs (read-from-string string i)))
+ (cons (car rfs)
+ (split-string-and-unquote (substring string (cdr rfs))
+ sep)))))))
+
\f
;;;; Replacement in strings.
HCoop / bpt / emacs.git / blobdiff