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

Merge from emacs--devo--0

Browse source 
Patches applied:

 * emacs--devo--0  (patch 852-856)

   - Update from CVS
   - Merge from emacs--rel--22

 * emacs--rel--22  (patch 93-96)

   - Update from CVS
   - Merge from gnus--rel--5.10

 * gnus--rel--5.10  (patch 245)

   - Update from CVS

Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-249
This commit is contained in:
Miles Bader 2007-08-21 04:54:03 +00:00
commit 42216a6b65
74 changed files with 2335 additions and 1347 deletions
Download patch file Download diff file Expand all files Collapse all files

22
lisp/emacs-lisp/cl-macs.el
View file

@ -272,15 +272,19 @@ its argument list allows full Common Lisp conventions."
(nconc (nreverse simple-args)
(list '&rest (car (pop bind-lets))))
(nconc (let ((hdr (nreverse header)))
(require 'help-fns)
(cons (help-add-fundoc-usage
(if (stringp (car hdr)) (pop hdr))
;; orig-args can contain &cl-defs (an internal CL
;; thingy that I do not understand), so remove it.
(let ((x (memq '&cl-defs orig-args)))
(if (null x) orig-args
(delq (car x) (remq (cadr x) orig-args)))))
hdr))
;; Macro expansion can take place in the middle of
;; apparently harmless computation, so it should not
;; touch the match-data.
(save-match-data
(require 'help-fns)
(cons (help-add-fundoc-usage
(if (stringp (car hdr)) (pop hdr))
;; orig-args can contain &cl-defs (an internal
;; CL thingy I don't understand), so remove it.
(let ((x (memq '&cl-defs orig-args)))
(if (null x) orig-args
(delq (car x) (remq (cadr x) orig-args)))))
hdr)))
(list (nconc (list 'let* bind-lets)
(nreverse bind-forms) body)))))))

11
lisp/emacs-lisp/copyright.el
View file

@ -57,6 +57,7 @@ The second \\( \\) construct must match the years."
Only copyright lines where the name matches this regexp will be updated.
This allows you to avoid adding yars to a copyright notice belonging to
someone else or to a group for which you do not work."
:group 'copyright
:type 'regexp)
(defcustom copyright-years-regexp
@ -87,13 +88,16 @@ When this is `function', only ask when called non-interactively."
(defvar copyright-current-year (substring (current-time-string) -4)
"String representing the current year.")
(defsubst copyright-limit () ; re-search-forward BOUND
(and copyright-limit (+ (point) copyright-limit)))
(defun copyright-update-year (replace noquery)
(when
(condition-case err
(re-search-forward (concat "\\(" copyright-regexp
"\\)\\([ \t]*\n\\)?.*\\(?:"
copyright-names-regexp "\\)")
(if copyright-limit (+ (point) copyright-limit))
(copyright-limit)
t)
;; In case the regexp is rejected. This is useful because
;; copyright-update is typically called from before-save-hook where
@ -179,7 +183,7 @@ interactively."
"\\(the Free Software Foundation;\
either \\|; a\\^u eldono \\([0-9]+\\)a, ? a\\^u (la\\^u via \\)\
version \\([0-9]+\\), or (at"
(if copyright-limit (+ (point) copyright-limit)) t)
(copyright-limit) t)
(not (string= (match-string 3) copyright-current-gpl-version))
(or noquery
(y-or-n-p (concat "Replace GPL version by "
@ -201,8 +205,7 @@ Uses heuristic: year >= 50 means 19xx, < 50 means 20xx."
(interactive)
(widen)
(goto-char (point-min))
(if (re-search-forward copyright-regexp
(if copyright-limit (+ (point) copyright-limit)) t)
(if (re-search-forward copyright-regexp (copyright-limit) t)
(let ((s (match-beginning 2))
(e (copy-marker (1+ (match-end 2))))
(p (make-marker))

97
lisp/emacs-lisp/eldoc.el
View file

@ -264,30 +264,43 @@ Emacs Lisp mode) that support Eldoc.")
;; so we need to be careful that errors aren't ignored.
(error (message "eldoc error: %s" err))))
;; Return a string containing the function parameter list, or 1-line
;; docstring if function is a subr and no arglist is obtainable from the
;; docstring or elsewhere.
(defun eldoc-get-fnsym-args-string (sym &optional argument-index)
(let ((args nil)
(doc nil))
(defun eldoc-get-fnsym-args-string (sym &optional index)
"Return a string containing the parameter list of the function SYM.
If SYM is a subr and no arglist is obtainable from the docstring
or elsewhere, return a 1-line docstring. Calls the functions
`eldoc-function-argstring-format' and
`eldoc-highlight-function-argument' to format the result. The
former calls `eldoc-argument-case'; the latter gives the
function name `font-lock-function-name-face', and optionally
highlights argument number INDEX. "
(let (args doc)
(cond ((not (and sym (symbolp sym) (fboundp sym))))
((and (eq sym (aref eldoc-last-data 0))
(eq 'function (aref eldoc-last-data 2)))
(setq doc (aref eldoc-last-data 1)))
((and (eq sym (aref eldoc-last-data 0))
(eq 'function (aref eldoc-last-data 2)))
(setq doc (aref eldoc-last-data 1)))
((setq doc (help-split-fundoc (documentation sym t) sym))
(setq args (car doc))
;; Remove any enclosing (), since e-function-argstring adds them.
(string-match "\\`[^ )]* ?" args)
(setq args (concat "(" (substring args (match-end 0))))
(eldoc-last-data-store sym args 'function))
(t
(setq args (eldoc-function-argstring sym))))
(and args
argument-index
(setq doc (eldoc-highlight-function-argument sym args argument-index)))
doc))
(setq args (substring args (match-end 0)))
(if (string-match ")\\'" args)
(setq args (substring args 0 -1))))
(t
(setq args (help-function-arglist sym))))
(if args
;; Stringify, and store before highlighting, downcasing, etc.
;; FIXME should truncate before storing.
(eldoc-last-data-store sym (setq args (eldoc-function-argstring args))
'function)
(setq args doc)) ; use stored value
;; Change case, highlight, truncate.
(if args
(eldoc-highlight-function-argument
sym (eldoc-function-argstring-format args) index))))
;; Highlight argument INDEX in ARGS list for SYM.
(defun eldoc-highlight-function-argument (sym args index)
"Highlight argument INDEX in ARGS list for function SYM.
In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
(let ((start nil)
(end 0)
(argument-face 'bold))
@ -298,7 +311,7 @@ Emacs Lisp mode) that support Eldoc.")
;; (defun NAME ARGLIST [DOCSTRING] BODY...) case?
;; The problem is there is no robust way to determine if
;; the current argument is indeed a docstring.
(while (>= index 1)
(while (and index (>= index 1))
(if (string-match "[^ ()]+" args end)
(progn
(setq start (match-beginning 0)
@ -438,29 +451,31 @@ Emacs Lisp mode) that support Eldoc.")
(error (setq defn nil))))
defn))
(defun eldoc-function-argstring (fn)
(eldoc-function-argstring-format (help-function-arglist fn)))
(defun eldoc-function-argstring-format (arglist)
(cond ((not (listp arglist))
(setq arglist nil))
((symbolp (car arglist))
(setq arglist
(mapcar (function (lambda (s)
(if (memq s '(&optional &rest))
(symbol-name s)
(funcall eldoc-argument-case
(symbol-name s)))))
arglist)))
((stringp (car arglist))
(setq arglist
(mapcar (function (lambda (s)
(if (member s '("&optional" "&rest"))
s
(funcall eldoc-argument-case s))))
arglist))))
(concat "(" (mapconcat 'identity arglist " ") ")"))
(defun eldoc-function-argstring (arglist)
"Return ARGLIST as a string enclosed by ().
ARGLIST is either a string, or a list of strings or symbols."
(cond ((stringp arglist))
((not (listp arglist))
(setq arglist nil))
((symbolp (car arglist))
(setq arglist
(mapconcat (lambda (s) (symbol-name s))
arglist " ")))
((stringp (car arglist))
(setq arglist
(mapconcat (lambda (s) s)
arglist " "))))
(if arglist
(format "(%s)" arglist)))
(defun eldoc-function-argstring-format (argstring)
"Apply `eldoc-argument-case' to each word in argstring.
The words \"&rest\", \"&optional\" are returned unchanged."
(mapconcat (lambda (s)
(if (member s '("&optional" "&rest"))
s
(funcall eldoc-argument-case s)))
(split-string argstring) " "))
;; When point is in a sexp, the function args are not reprinted in the echo
;; area after every possible interactive command because some of them print

105
lisp/emacs-lisp/lisp-mode.el
View file

@ -539,62 +539,65 @@ If CHAR is not a character, return nil."
string))))
(defun preceding-sexp ()
"Return sexp before the point."
(let ((opoint (point))
ignore-quotes
expr)
(save-excursion
(with-syntax-table emacs-lisp-mode-syntax-table
;; If this sexp appears to be enclosed in `...'
;; then ignore the surrounding quotes.
(setq ignore-quotes
(or (eq (following-char) ?\')
(eq (preceding-char) ?\')))
(forward-sexp -1)
;; If we were after `?\e' (or similar case),
;; use the whole thing, not just the `e'.
(when (eq (preceding-char) ?\\)
(forward-char -1)
(when (eq (preceding-char) ??)
(forward-char -1)))
;; Skip over `#N='s.
(when (eq (preceding-char) ?=)
(let (labeled-p)
(save-excursion
(skip-chars-backward "0-9#=")
(setq labeled-p (looking-at "\\(#[0-9]+=\\)+")))
(when labeled-p
(forward-sexp -1))))
(save-restriction
;; vladimir@cs.ualberta.ca 30-Jul-1997: skip ` in
;; `variable' so that the value is returned, not the
;; name
(if (and ignore-quotes
(eq (following-char) ?`))
(forward-char))
(narrow-to-region (point-min) opoint)
(setq expr (read (current-buffer)))
;; If it's an (interactive ...) form, it's more
;; useful to show how an interactive call would
;; use it.
(and (consp expr)
(eq (car expr) 'interactive)
(setq expr
(list 'call-interactively
(list 'quote
(list 'lambda
'(&rest args)
expr
'args)))))
expr)))))
(defun eval-last-sexp-1 (eval-last-sexp-arg-internal)
"Evaluate sexp before point; print value in minibuffer.
With argument, print output into current buffer."
(let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)))
(let ((value
(eval (let ((stab (syntax-table))
(opoint (point))
ignore-quotes
expr)
(save-excursion
(with-syntax-table emacs-lisp-mode-syntax-table
;; If this sexp appears to be enclosed in `...'
;; then ignore the surrounding quotes.
(setq ignore-quotes
(or (eq (following-char) ?\')
(eq (preceding-char) ?\')))
(forward-sexp -1)
;; If we were after `?\e' (or similar case),
;; use the whole thing, not just the `e'.
(when (eq (preceding-char) ?\\)
(forward-char -1)
(when (eq (preceding-char) ??)
(forward-char -1)))
(eval-last-sexp-print-value (eval (preceding-sexp)))))
;; Skip over `#N='s.
(when (eq (preceding-char) ?=)
(let (labeled-p)
(save-excursion
(skip-chars-backward "0-9#=")
(setq labeled-p (looking-at "\\(#[0-9]+=\\)+")))
(when labeled-p
(forward-sexp -1))))
(save-restriction
;; vladimir@cs.ualberta.ca 30-Jul-1997: skip ` in
;; `variable' so that the value is returned, not the
;; name
(if (and ignore-quotes
(eq (following-char) ?`))
(forward-char))
(narrow-to-region (point-min) opoint)
(setq expr (read (current-buffer)))
;; If it's an (interactive ...) form, it's more
;; useful to show how an interactive call would
;; use it.
(and (consp expr)
(eq (car expr) 'interactive)
(setq expr
(list 'call-interactively
(list 'quote
(list 'lambda
'(&rest args)
expr
'args)))))
expr)))))))
(eval-last-sexp-print-value value))))
(defun eval-last-sexp-print-value (value)
(let ((unabbreviated (let ((print-length nil) (print-level nil))