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

merge emacs

Browse source
This commit is contained in:
Kenichi Handa 2013-06-18 23:49:59 +09:00
commit de86fd6193
34 changed files with 48884 additions and 48468 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
doc/lispref/ChangeLog
View file

@ -1,3 +1,11 @@
2013-06-17 Juanma Barranquero <lekktu@gmail.com>
* text.texi (Undo, Changing Properties): Fix typos.
2013-06-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
* text.texi (Changing Properties): Document `add-face-text-property'.
2013-06-17 Kenichi Handa <handa@gnu.org>
* display.texi (Face Attributes): Refer to "Low-Level font" (not

24
doc/lispref/text.texi
View file

@ -1226,7 +1226,7 @@ list, which is in the variable @code{buffer-undo-list}.
@defvar buffer-undo-list
This buffer-local variable's value is the undo list of the current
buffer. A value of @code{t} disables the recording of undo information.
buffer. A value of @code{t} disables the recording of undo information.
@end defvar
Here are the kinds of elements an undo list can have:
@ -2803,6 +2803,28 @@ from the specified range of text. Here's an example:
@end example
Do not rely on the return value of this function.
@end defun
@defun add-face-text-property start end face &optional appendp object
@code{face} text attributes can be combined. If you want to make a
section both italic and green, you can either define a new face that
have those attributes, or you can add both these attributes separately
to text:
@example
(add-face-text-property @var{start} @var{end} 'italic)
(add-face-text-property @var{start} @var{end} '(:foreground "#00ff00"))
@end example
The attribute is (by default) prepended to the list of face
attributes, and the first attribute of the same type takes
precedence. So if you have two @code{:foreground} specifications, the
first one will take effect.
If you pass in @var{appendp}, the attribute will be appended instead
of prepended, which means that it will have no effect if there is
already an attribute of the same type.
@end defun
The easiest way to make a string with text properties

3
etc/NEWS
View file

@ -103,6 +103,9 @@ Available only on X, this option allows to control over-scrolling
using the scroll bar (i.e. dragging the thumb down even when the end
of the buffer is visible).
** New function `add-face-text-property' has been added, which can be
used to conveniently prepend/append new face attributes to text.
** In compiled Lisp files, the header no longer includes a timestamp.
** Multi-monitor support has been added.

25269
lisp/ChangeLog
View file

File diff suppressed because it is too large Load diff

25241
lisp/ChangeLog.16 Normal file
View file

File diff suppressed because it is too large Load diff

9
lisp/cedet/ChangeLog
View file

@ -1,7 +1,12 @@
2013-06-18 Glenn Morris <rgm@gnu.org>
* semantic/ctxt.el (semantic-ctxt-end-of-symbol-default):
Remove unused free variable `symlist'.
2013-06-02 Eric Ludlam <zappo@gnu.org>
* semantic/edit.el (semantic-change-function): Use
`save-match-data' around running hooks.
* semantic/edit.el (semantic-change-function):
Use `save-match-data' around running hooks.
* semantic/decorate/mode.el
(semantic-decorate-style-predicate-default)

1
lisp/cedet/semantic/ctxt.el
View file

@ -397,7 +397,6 @@ work on C like languages."
t)
(error nil))
(looking-at fieldsep1)))
(setq symlist (list ""))
(forward-sexp -1)
;; Skip array expressions.
(while (looking-at "\\s(") (forward-sexp -1))

7
lisp/emacs-lisp/generic.el
View file

@ -44,11 +44,8 @@
;; end at the end of the line.) Emacs does not support comment
;; strings of more than two characters in length.
;;
;; * List of keywords to font-lock. Each keyword should be a string.
;; If you have additional keywords which should be highlighted in a
;; face different from `font-lock-keyword-face', you can use the
;; convenience function `generic-make-keywords-list' (which see),
;; and add the result to the following list:
;; * List of keywords to font-lock in `font-lock-keyword-face'.
;; Each keyword should be a string.
;;
;; * Additional expressions to font-lock. This should be a list of
;; expressions, each of which should be of the same form as those in

37
lisp/emacs-lisp/package.el
View file

@ -420,10 +420,9 @@ This is, approximately, the inverse of `version-to-list'.
(with-temp-buffer
(insert-file-contents pkg-file)
(goto-char (point-min))
(with-syntax-table emacs-lisp-mode-syntax-table
(let ((pkg-desc (package-process-define-package
(read (current-buffer)) pkg-file)))
(setf (package-desc-dir pkg-desc) pkg-dir)))))))
(let ((pkg-desc (package-process-define-package
(read (current-buffer)) pkg-file)))
(setf (package-desc-dir pkg-desc) pkg-dir))))))
(defun package-load-all-descriptors ()
"Load descriptors for installed Emacs Lisp packages.
@ -641,7 +640,8 @@ untar into a directory named DIR; otherwise, signal an error."
;; FIXME: should we delete PKG-DIR if it exists?
(let* ((default-directory (file-name-as-directory package-user-dir)))
(package-untar-buffer dirname)
(package--make-autoloads-and-compile package pkg-dir))))
(package--make-autoloads-and-compile package pkg-dir)
pkg-dir)))
(defun package--make-autoloads-and-compile (name pkg-dir)
"Generate autoloads and do byte-compilation for package named NAME.
@ -697,7 +697,8 @@ PKG-DIR is the name of the package directory."
nil
pkg-file
nil nil nil 'excl))
(package--make-autoloads-and-compile name pkg-dir))))
(package--make-autoloads-and-compile name pkg-dir)
pkg-dir)))
(defmacro package--with-work-buffer (location file &rest body)
"Run BODY in a buffer containing the contents of FILE at LOCATION.
@ -923,16 +924,20 @@ using `package-compute-transaction'."
(hold (cadr (assq elt package-load-list)))
(v-string (or (and (stringp hold) hold)
(package-version-join (package-desc-version desc))))
(kind (package-desc-kind desc)))
(cond
((eq kind 'tar)
(package-download-tar elt v-string))
((eq kind 'single)
(package-download-single elt v-string
(package-desc-summary desc)
(package-desc-reqs desc)))
(t
(error "Unknown package kind: %s" (symbol-name kind))))
(kind (package-desc-kind desc))
(pkg-dir
(cond
((eq kind 'tar)
(package-download-tar elt v-string))
((eq kind 'single)
(package-download-single elt v-string
(package-desc-summary desc)
(package-desc-reqs desc)))
(t
(error "Unknown package kind: %s" (symbol-name kind))))))
;; Update package-alist.
;; FIXME: Check that the installed package's descriptor matches `desc'!
(package-load-descriptor pkg-dir)
;; If package A depends on package B, then A may `require' B
;; during byte compilation. So we need to activate B before
;; unpacking A.

14
lisp/face-remap.el
View file

@ -72,7 +72,7 @@
:font :inherit :fontset :vector])
(defun face-attrs-more-relative-p (attrs1 attrs2)
"Return true if ATTRS1 contains a greater number of relative
"Return true if ATTRS1 contains a greater number of relative
face-attributes than ATTRS2. A face attribute is considered
relative if `face-attribute-relative-p' returns non-nil.
@ -395,9 +395,9 @@ one face is listed, that specifies an aggregate face, like in a
`face' text property.
If `buffer-face-mode' is already enabled, and is currently using
the face specs SPECS, then it is disabled; if buffer-face-mode is
disabled, or is enabled and currently displaying some other face,
then is left enabled, but the face changed to reflect SPECS.
the face specs SPECS, then it is disabled; if `buffer-face-mode'
is disabled, or is enabled and currently displaying some other
face, then is left enabled, but the face changed to reflect SPECS.
This function will make the variable `buffer-face-mode-face'
buffer local, and set it to SPECS."
@ -411,13 +411,13 @@ buffer local, and set it to SPECS."
(buffer-face-mode t)))
(defun buffer-face-mode-invoke (specs arg &optional interactive)
"Enable or disable `buffer-face-mode' using face specs SPECS, and argument ARG.
"Enable or disable `buffer-face-mode' using face specs SPECS.
ARG controls whether the mode is enabled or disabled, and is
interpreted in the usual manner for minor-mode commands.
SPECS can be any value suitable for a `face' text property,
including a face name, a plist of face attributes and values, or
a list of faces.
including a face name, a plist of face attributes and values,
or a list of faces.
If INTERACTIVE is non-nil, display a message describing the
result.

101
lisp/generic-x.el
View file

@ -483,38 +483,30 @@ like an INI file. You can add this hook to `find-file-hook'."
;; are frequently used in simple text, we punt.)
;; In `generic-bat-mode-setup-function' we make the keywords
;; case-insensitive
(generic-make-keywords-list
'("for"
"if")
font-lock-keyword-face "^[@ \t]*")
'("^[@ \t]*\\_<\\(for\\|if\\)\\_>" 1 font-lock-keyword-face)
;; These keywords can be anywhere on a line
;; In `generic-bat-mode-setup-function' we make the keywords
;; case-insensitive
(generic-make-keywords-list
'("do"
"exist"
"errorlevel"
"goto"
"not")
font-lock-keyword-face)
(list (regexp-opt '("do" "exist" "errorlevel" "goto" "not") 'symbols)
1 font-lock-keyword-face)
;; These are built-in commands. Only frequently-used ones are listed.
(generic-make-keywords-list
'("CALL" "call" "Call"
"CD" "cd" "Cd"
"CLS" "cls" "Cls"
"COPY" "copy" "Copy"
"DEL" "del" "Del"
"ECHO" "echo" "Echo"
"MD" "md" "Md"
"PATH" "path" "Path"
"PAUSE" "pause" "Pause"
"PROMPT" "prompt" "Prompt"
"RD" "rd" "Rd"
"REN" "ren" "Ren"
"SET" "set" "Set"
"START" "start" "Start"
"SHIFT" "shift" "Shift")
font-lock-builtin-face "[ \t|\n]")
(list (concat "[ \t|\n]"
(regexp-opt '("CALL" "call" "Call"
"CD" "cd" "Cd"
"CLS" "cls" "Cls"
"COPY" "copy" "Copy"
"DEL" "del" "Del"
"ECHO" "echo" "Echo"
"MD" "md" "Md"
"PATH" "path" "Path"
"PAUSE" "pause" "Pause"
"PROMPT" "prompt" "Prompt"
"RD" "rd" "Rd"
"REN" "ren" "Ren"
"SET" "set" "Set"
"START" "start" "Start"
"SHIFT" "shift" "Shift") 'symbols))
1 font-lock-builtin-face)
'("^[ \t]*\\(:\\sw+\\)" 1 font-lock-function-name-face t)
'("\\(%\\sw+%\\)" 1 font-lock-variable-name-face t)
'("\\(%[0-9]\\)" 1 font-lock-variable-name-face t)
@ -841,21 +833,16 @@ like an INI file. You can add this hook to `find-file-hook'."
;; the choice of face for each token group
(eval-when-compile
(list
(generic-make-keywords-list
'("FILEFLAGSMASK"
"FILEFLAGS"
"FILEOS"
"FILESUBTYPE"
"FILETYPE"
"FILEVERSION"
"PRODUCTVERSION")
font-lock-type-face)
(generic-make-keywords-list
'("BEGIN"
"BLOCK"
"END"
"VALUE")
font-lock-function-name-face)
(list (regexp-opt '("FILEFLAGSMASK"
"FILEFLAGS"
"FILEOS"
"FILESUBTYPE"
"FILETYPE"
"FILEVERSION"
"PRODUCTVERSION") 'symbols)
1 font-lock-type-face)
(list (regexp-opt '("BEGIN" "BLOCK" "END" "VALUE") 'symbols)
1 font-lock-function-name-face)
'("^#[ \t]*include[ \t]+\\(<[^>\"\n]+>\\)" 1 font-lock-string-face)
'("^#[ \t]*define[ \t]+\\(\\sw+\\)(" 1 font-lock-function-name-face)
'("^#[ \t]*\\(elif\\|if\\)\\>"
@ -1470,21 +1457,25 @@ like an INI file. You can add this hook to `find-file-hook'."
(1 font-lock-keyword-face)
(2 font-lock-constant-face nil t))
;; system variables
(generic-make-keywords-list
installshield-system-variables-list
font-lock-variable-name-face "[^_]" "[^_]")
(list (concat "[^_]"
(regexp-opt installshield-system-variables-list 'symbols)
"[^_]")
1 font-lock-variable-name-face)
;; system functions
(generic-make-keywords-list
installshield-system-functions-list
font-lock-function-name-face "[^_]" "[^_]")
(list (concat "[^_]"
(regexp-opt installshield-system-functions-list 'symbols)
"[^_]")
1 font-lock-function-name-face)
;; type keywords
(generic-make-keywords-list
installshield-types-list
font-lock-type-face "[^_]" "[^_]")
(list (concat "[^_]"
(regexp-opt installshield-types-list 'symbols)
"[^_]")
1 font-lock-type-face)
;; function argument constants
(generic-make-keywords-list
installshield-funarg-constants-list
font-lock-variable-name-face "[^_]" "[^_]"))) ; is this face the best choice?
(list (concat "[^_]"
(regexp-opt installshield-funarg-constants-list 'symbols)
"[^_]")
1 font-lock-variable-name-face))) ; is this face the best choice?
'("\\.[rR][uU][lL]\\'")
'(generic-rul-mode-setup-function)
"Generic mode for InstallShield RUL files.")

54
lisp/gnus/ChangeLog
View file

@ -1,5 +1,59 @@
2013-06-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
* shr.el (shr-tag-table): Insert the images after the table, so that
they're not covered by the table colourisation, which often looked
awkward.
(shr-tag-dl, shr-tag-dt, shr-tag-dd): Add support for <dl>, <dt> and
<dd>.
2013-06-18 Katsumi Yamaoka <yamaoka@jpl.org>
* eww.el (eww-detect-charset): Improve regexp; move backward.
2013-06-18 Glenn Morris <rgm@gnu.org>
* mm-decode.el (widget-convert-button): Autoload.
* sieve-manage.el (mm-enable-multibyte): Autoload.
* shr.el (libxml-parse-html-region): Declare.
(shr-render-buffer): Explicit error if no libxml2 support.
2013-06-17 Teodor Zlatanov <tzz@lifelogs.com>
* auth-source.el (auth-source-current-line): New function.
(auth-source-netrc-parse-entries): When a data token is "machine",
assume we're in the wrong place and abort parsing the current line.
2013-06-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
* eww.el (eww-tag-select): Don't render totally empty <select> forms.
(eww-convert-widgets): Don't bug out if the first widget starts at the
beginning of the buffer.
(eww-convert-widgets): Fix last patch.
(eww-tag-input): Support <input type=image>.
* shr.el (shr-insert-table): Respect border-collapse: collapse.
(shr-tag-base): Protect against base specs that are degenerate.
(shr-ensure-paragraph): Don't delete empty lines that have text
properties, because these may be input fields.
* eww.el (eww-convert-widgets): Put `help-echo' on input fields so that
we can navigate to them.
* shr.el (shr-colorize-region): Put the colours over the entire region.
(shr-inhibit-decoration): New variable.
(shr-add-font): Use it to inhibit text property decorations while doing
preliminary table renderings. This speeds up typical Wikipedia page
renderings by 15%.
(shr-tag-span): Don't respect the <title>, because that overwrites the
help-echo from links inside the spans.
(shr-next-link): Use `help-echo' for navigation, so that we can
navigate to form elements, too.
* eww.el (eww-button): New face.
(eww-convert-widgets): Use it to make submit buttons more button-like.
* mm-decode.el (mm-convert-shr-links): Override the shr local map, so
that Gnus commands work.

23
lisp/gnus/auth-source.el
View file

@ -1055,6 +1055,13 @@ Note that the MAX parameter is used so we can exit the parse early."
(auth-source-netrc-parse-next-interesting)
(match-string-no-properties 1)))
;; with thanks to org-mode
(defsubst auth-source-current-line (&optional pos)
(save-excursion
(and pos (goto-char pos))
;; works also in narrowed buffer, because we start at 1, not point-min
(+ (if (bolp) 1 0) (count-lines 1 (point)))))
(defun auth-source-netrc-parse-entries(check max)
"Parse up to MAX netrc entries, passed by CHECK, from the current buffer."
(let ((adder (lambda(check alist all)
@ -1071,6 +1078,8 @@ Note that the MAX parameter is used so we can exit the parse early."
(when (and alist
(or default
(equal item "machine")))
(auth-source-do-trivia
"auth-source-netrc-parse-entries: got entry %S" alist)
(setq all (funcall adder check alist all)
alist nil))
;; In default entries, we don't have a next token.
@ -1079,11 +1088,21 @@ Note that the MAX parameter is used so we can exit the parse early."
(push (cons "machine" t) alist)
;; Not a default entry. Grab the next item.
(when (setq item2 (auth-source-netrc-parse-one))
(push (cons item item2) alist))))
;; Did we get a "machine" value?
(if (equal item2 "machine")
(progn
(gnus-error 1
"%s: Unexpected 'machine' token at line %d"
"auth-source-netrc-parse-entries"
(auth-source-current-line))
(forward-line 1))
(push (cons item item2) alist)))))
;; Clean up: if there's an entry left over, use it.
(when alist
(setq all (funcall adder check alist all)))
(setq all (funcall adder check alist all))
(auth-source-do-trivia
"auth-source-netrc-parse-entries: got2 entry %S" alist))
(nreverse all)))
(defvar auth-source-passphrase-alist nil)

80
lisp/gnus/eww.el
View file

@ -43,6 +43,14 @@
:group 'eww
:type 'string)
(defface eww-button
'((((type x w32 ns) (class color)) ; Like default mode line
:box (:line-width 2 :style released-button)
:background "lightgrey" :foreground "black"))
"Face for eww buffer buttons."
:version "24.4"
:group 'eww)
(defvar eww-current-url nil)
(defvar eww-current-title ""
"Title of current page.")
@ -56,18 +64,6 @@
(setq url (concat "http://" url)))
(url-retrieve url 'eww-render (list url)))
(defun eww-detect-charset (html-p)
(let ((case-fold-search t)
(pt (point)))
(or (and html-p
(re-search-forward
"<meta[\t\n\r ]+[^>]*charset=\\([^\t\n\r \"/>]+\\)" nil t)
(goto-char pt)
(match-string 1))
(and (looking-at
"[\t\n\r ]*<\\?xml[\t\n\r ]+[^>]*encoding=\"\\([^\"]+\\)")
(match-string 1)))))
(defun eww-render (status url &optional point)
(let ((redirect (plist-get status :redirect)))
(when redirect
@ -120,6 +116,18 @@
(forward-line 1))
headers))
(defun eww-detect-charset (html-p)
(let ((case-fold-search t)
(pt (point)))
(or (and html-p
(re-search-forward
"<meta[\t\n\r ]+[^>]*charset=\"?\\([^\t\n\r \"/>]+\\)" nil t)
(goto-char pt)
(match-string 1))
(and (looking-at
"[\t\n\r ]*<\\?xml[\t\n\r ]+[^>]*encoding=\"\\([^\"]+\\)")
(match-string 1)))))
(defun eww-display-html (charset url)
(unless (eq charset 'utf8)
(decode-coding-region (point) (point-max) charset))
@ -268,34 +276,40 @@
(let* ((start (point))
(type (downcase (or (cdr (assq :type cont))
"text")))
(value (cdr (assq :value cont)))
(widget
(cond
((equal type "submit")
((or (equal type "submit")
(equal type "image"))
(list 'push-button
:notify 'eww-submit
:name (cdr (assq :name cont))
:value (cdr (assq :value cont))
:value (if (zerop (length value))
"Submit"
value)
:eww-form eww-form
(or (cdr (assq :value cont)) "Submit")))
(or (if (zerop (length value))
"Submit"
value))))
((or (equal type "radio")
(equal type "checkbox"))
(list 'checkbox
:notify 'eww-click-radio
:name (cdr (assq :name cont))
:checkbox-value (cdr (assq :value cont))
:checkbox-value value
:checkbox-type type
:eww-form eww-form
(cdr (assq :checked cont))))
((equal type "hidden")
(list 'hidden
:name (cdr (assq :name cont))
:value (cdr (assq :value cont))))
:value value))
(t
(list 'editable-field
:size (string-to-number
(or (cdr (assq :size cont))
"40"))
:value (or (cdr (assq :value cont)) "")
:value (or value "")
:secret (and (equal type "password") ?*)
:action 'eww-submit
:name (cdr (assq :name cont))
@ -303,7 +317,8 @@
(nconc eww-form (list widget))
(unless (eq (car widget) 'hidden)
(apply 'widget-create widget)
(put-text-property start (point) 'eww-widget widget))))
(put-text-property start (point) 'eww-widget widget)
(insert " "))))
(defun eww-tag-textarea (cont)
(let* ((start (point))
@ -336,13 +351,14 @@
:value (cdr (assq :value (cdr elem)))
:tag (cdr (assq 'text (cdr elem))))
options)))
;; If we have no selected values, default to the first value.
(unless (plist-get (cdr menu) :value)
(nconc menu (list :value (nth 2 (car options)))))
(nconc menu options)
(apply 'widget-create menu)
(put-text-property start (point) 'eww-widget menu)
(shr-ensure-paragraph)))
(when options
;; If we have no selected values, default to the first value.
(unless (plist-get (cdr menu) :value)
(nconc menu (list :value (nth 2 (car options)))))
(nconc menu options)
(apply 'widget-create menu)
(put-text-property start (point) 'eww-widget menu)
(shr-ensure-paragraph))))
(defun eww-click-radio (widget &rest ignore)
(let ((form (plist-get (cdr widget) :eww-form))
@ -434,7 +450,9 @@
;; so we need to nix out the list of widgets and recreate them.
(setq widget-field-list nil
widget-field-new nil)
(while (setq start (next-single-property-change start 'eww-widget))
(while (setq start (if (get-text-property start 'eww-widget)
start
(next-single-property-change start 'eww-widget)))
(setq widget (get-text-property start 'eww-widget))
(goto-char start)
(let ((end (next-single-property-change start 'eww-widget)))
@ -445,7 +463,13 @@
(delete-region start end))
(when (and widget
(not (eq (car widget) 'hidden)))
(apply 'widget-create widget)))
(apply 'widget-create widget)
(put-text-property start (point) 'help-echo
(if (memq (car widget) '(text editable-field))
"Input field"
"Button"))
(when (eq (car widget) 'push-button)
(add-face-text-property start (point) 'eww-button t))))
(widget-setup)
(eww-fix-widget-keymap)))

2
lisp/gnus/mm-decode.el
View file

@ -1819,6 +1819,8 @@ If RECURSIVE, search recursively."
(defvar shr-map)
(autoload 'widget-convert-button "wid-edit")
(defun mm-convert-shr-links ()
(let ((start (point-min))
end)

171
lisp/gnus/shr.el
View file

@ -125,6 +125,7 @@ cid: URL as the argument.")
(defvar shr-ignore-cache nil)
(defvar shr-external-rendering-functions nil)
(defvar shr-target-id nil)
(defvar shr-inhibit-decoration nil)
(defvar shr-map
(let ((map (make-sparse-keymap)))
@ -141,10 +142,14 @@ cid: URL as the argument.")
map))
;; Public functions and commands.
(declare-function libxml-parse-html-region "xml.c"
(start end &optional base-url))
(defun shr-render-buffer (buffer)
"Display the HTML rendering of the current buffer."
(interactive (list (current-buffer)))
(or (fboundp 'libxml-parse-html-region)
(error "This function requires Emacs to be compiled with libxml2"))
(pop-to-buffer "*html*")
(erase-buffer)
(shr-insert-document
@ -222,9 +227,9 @@ redirects somewhere else."
(defun shr-next-link ()
"Skip to the next link."
(interactive)
(let ((skip (text-property-any (point) (point-max) 'shr-url nil)))
(let ((skip (text-property-any (point) (point-max) 'help-echo nil)))
(if (not (setq skip (text-property-not-all skip (point-max)
'shr-url nil)))
'help-echo nil)))
(message "No next link")
(goto-char skip)
(message "%s" (get-text-property (point) 'help-echo)))))
@ -236,11 +241,11 @@ redirects somewhere else."
(found nil))
;; Skip past the current link.
(while (and (not (bobp))
(get-text-property (point) 'shr-url))
(get-text-property (point) 'help-echo))
(forward-char -1))
;; Find the previous link.
(while (and (not (bobp))
(not (setq found (get-text-property (point) 'shr-url))))
(not (setq found (get-text-property (point) 'help-echo))))
(forward-char -1))
(if (not found)
(progn
@ -248,7 +253,7 @@ redirects somewhere else."
(goto-char start))
;; Put point at the start of the link.
(while (and (not (bobp))
(get-text-property (point) 'shr-url))
(get-text-property (point) 'help-echo))
(forward-char -1))
(forward-char 1)
(message "%s" (get-text-property (point) 'help-echo)))))
@ -349,7 +354,7 @@ size, and full-buffer size."
(shr-stylesheet shr-stylesheet)
(start (point)))
(when style
(if (string-match "color\\|display" style)
(if (string-match "color\\|display\\|border-collapse" style)
(setq shr-stylesheet (nconc (shr-parse-style style)
shr-stylesheet))
(setq style nil)))
@ -595,7 +600,14 @@ size, and full-buffer size."
(insert "\n"))
(if (save-excursion
(beginning-of-line)
(looking-at " *$"))
;; If the current line is totally blank, and doesn't even
;; have any face properties set, then delete the blank
;; space.
(and (looking-at " *$")
(not (get-text-property (point) 'face))
(not (= (next-single-property-change (point) 'face nil
(line-end-position))
(line-end-position)))))
(delete-region (match-beginning 0) (match-end 0))
(insert "\n\n")))))
@ -613,15 +625,16 @@ size, and full-buffer size."
;; blank text at the start of the line, and the newline at the end, to
;; avoid ugliness.
(defun shr-add-font (start end type)
(save-excursion
(goto-char start)
(while (< (point) end)
(when (bolp)
(skip-chars-forward " "))
(add-face-text-property (point) (min (line-end-position) end) type t)
(if (< (line-end-position) end)
(forward-line 1)
(goto-char end)))))
(unless shr-inhibit-decoration
(save-excursion
(goto-char start)
(while (< (point) end)
(when (bolp)
(skip-chars-forward " "))
(add-face-text-property (point) (min (line-end-position) end) type t)
(if (< (line-end-position) end)
(forward-line 1)
(goto-char end))))))
(defun shr-browse-url ()
"Browse the URL under point."
@ -797,12 +810,13 @@ START, and END. Note that START and END should be markers."
(shr-ensure-paragraph))
(defun shr-urlify (start url &optional title)
(when (and title (string-match "ctx" title)) (debug))
(shr-add-font start (point) 'shr-link)
(add-text-properties
start (point)
(list 'shr-url url
'local-map shr-map
'help-echo (if title (format "%s (%s)" url title) url))))
'help-echo (if title (format "%s (%s)" url title) url)
'local-map shr-map)))
(defun shr-encode-url (url)
"Encode URL."
@ -834,13 +848,18 @@ ones, in case fg and bg are nil."
(shr-color-visible bg fg)))))))
(defun shr-colorize-region (start end fg &optional bg)
(when (or fg bg)
(when (and (not shr-inhibit-decoration)
(or fg bg))
(let ((new-colors (shr-color-check fg bg)))
(when new-colors
(when fg
(shr-add-font start end (list :foreground (cadr new-colors))))
(add-face-text-property start end
(list :foreground (cadr new-colors))
t))
(when bg
(shr-add-font start end (list :background (car new-colors)))))
(add-face-text-property start end
(list :background (car new-colors))
t)))
new-colors)))
(defun shr-expand-newlines (start end color)
@ -1008,7 +1027,9 @@ ones, in case fg and bg are nil."
plist)))
(defun shr-tag-base (cont)
(setq shr-base (shr-parse-base (cdr (assq :href cont))))
(let ((base (cdr (assq :href cont))))
(when base
(setq shr-base (shr-parse-base base))))
(shr-generic cont))
(defun shr-tag-a (cont)
@ -1017,7 +1038,8 @@ ones, in case fg and bg are nil."
(start (point))
shr-start)
(shr-generic cont)
(when url
(when (and url
(not shr-inhibit-decoration))
(shr-urlify (or shr-start start) (shr-expand-url url) title))))
(defun shr-tag-object (cont)
@ -1117,6 +1139,21 @@ ones, in case fg and bg are nil."
(shr-generic cont))
(shr-ensure-paragraph))
(defun shr-tag-dl (cont)
(shr-ensure-paragraph)
(shr-generic cont)
(shr-ensure-paragraph))
(defun shr-tag-dt (cont)
(shr-ensure-newline)
(shr-generic cont)
(shr-ensure-newline))
(defun shr-tag-dd (cont)
(shr-ensure-newline)
(let ((shr-indentation (+ shr-indentation 4)))
(shr-generic cont)))
(defun shr-tag-ul (cont)
(shr-ensure-paragraph)
(let ((shr-list-mode 'ul))
@ -1154,11 +1191,7 @@ ones, in case fg and bg are nil."
(shr-generic cont))
(defun shr-tag-span (cont)
(let ((title (cdr (assq :title cont))))
(shr-generic cont)
(when (and title
shr-start)
(put-text-property shr-start (point) 'help-echo title))))
(shr-generic cont))
(defun shr-tag-h1 (cont)
(shr-heading cont 'bold 'underline))
@ -1230,13 +1263,7 @@ ones, in case fg and bg are nil."
(frame-width))
(setq truncate-lines t))
;; Then render the table again with these new "hard" widths.
(shr-insert-table (shr-make-table cont sketch-widths t) sketch-widths))
;; Finally, insert all the images after the table. The Emacs buffer
;; model isn't strong enough to allow us to put the images actually
;; into the tables.
(when (zerop shr-table-depth)
(dolist (elem (shr-find-elements cont 'img))
(shr-tag-img (cdr elem)))))
(shr-insert-table (shr-make-table cont sketch-widths t) sketch-widths)))
(defun shr-tag-table (cont)
(shr-ensure-paragraph)
@ -1300,7 +1327,13 @@ ones, in case fg and bg are nil."
body))))))
(when bgcolor
(shr-colorize-region start (point) (cdr (assq 'color shr-stylesheet))
bgcolor))))
bgcolor))
;; Finally, insert all the images after the table. The Emacs buffer
;; model isn't strong enough to allow us to put the images actually
;; into the tables.
(when (zerop shr-table-depth)
(dolist (elem (shr-find-elements cont 'img))
(shr-tag-img (cdr elem))))))
(defun shr-find-elements (cont type)
(let (result)
@ -1312,35 +1345,40 @@ ones, in case fg and bg are nil."
(nreverse result)))
(defun shr-insert-table (table widths)
(shr-insert-table-ruler widths)
(dolist (row table)
(let ((start (point))
(height (let ((max 0))
(dolist (column row)
(setq max (max max (cadr column))))
max)))
(dotimes (i height)
(shr-indent)
(insert shr-table-vertical-line "\n"))
(dolist (column row)
(goto-char start)
(let ((lines (nth 2 column)))
(dolist (line lines)
(end-of-line)
(insert line shr-table-vertical-line)
(forward-line 1))
;; Add blank lines at padding at the bottom of the TD,
;; possibly.
(dotimes (i (- height (length lines)))
(end-of-line)
(let ((start (point)))
(insert (make-string (string-width (car lines)) ? )
shr-table-vertical-line)
(when (nth 4 column)
(shr-add-font start (1- (point))
(list :background (nth 4 column)))))
(forward-line 1)))))
(shr-insert-table-ruler widths)))
(let* ((collapse (equal (cdr (assq 'border-collapse shr-stylesheet))
"collapse"))
(shr-table-vertical-line (if collapse "" shr-table-vertical-line)))
(unless collapse
(shr-insert-table-ruler widths))
(dolist (row table)
(let ((start (point))
(height (let ((max 0))
(dolist (column row)
(setq max (max max (cadr column))))
max)))
(dotimes (i height)
(shr-indent)
(insert shr-table-vertical-line "\n"))
(dolist (column row)
(goto-char start)
(let ((lines (nth 2 column)))
(dolist (line lines)
(end-of-line)
(insert line shr-table-vertical-line)
(forward-line 1))
;; Add blank lines at padding at the bottom of the TD,
;; possibly.
(dotimes (i (- height (length lines)))
(end-of-line)
(let ((start (point)))
(insert (make-string (string-width (car lines)) ? )
shr-table-vertical-line)
(when (nth 4 column)
(shr-add-font start (1- (point))
(list :background (nth 4 column)))))
(forward-line 1)))))
(unless collapse
(shr-insert-table-ruler widths)))))
(defun shr-insert-table-ruler (widths)
(when (and (bolp)
@ -1393,7 +1431,8 @@ ones, in case fg and bg are nil."
data)))
(defun shr-make-table-1 (cont widths &optional fill)
(let ((trs nil))
(let ((trs nil)
(shr-inhibit-decoration (not fill)))
(dolist (row cont)
(when (eq (car row) 'tr)
(let ((tds nil)

2
lisp/gnus/sieve-manage.el
View file

@ -168,6 +168,8 @@ Valid states are `closed', `initial', `nonauth', and `auth'.")
(defvar sieve-manage-capability nil)
;; Internal utility functions
(autoload 'mm-enable-multibyte "mm-util")
(defun sieve-manage-make-process-buffer ()
(with-current-buffer
(generate-new-buffer (format " *sieve %s:%s*"

1
lisp/net/browse-url.el
View file

@ -234,6 +234,7 @@ regexp should probably be \".\" to specify a default browser."
(function-item :tag "Epiphany" :value browse-url-epiphany)
(function-item :tag "Netscape" :value browse-url-netscape)
(function-item :tag "Mosaic" :value browse-url-mosaic)
(function-item :tag "eww" :value eww)
(function-item :tag "Mosaic using CCI" :value browse-url-cci)
(function-item :tag "Text browser in an xterm window"
:value browse-url-text-xterm)

2
lisp/net/tramp-cache.el
View file

@ -64,7 +64,7 @@
Every entry has the form (REGEXP PROPERTY VALUE). The regexp
matches remote file names. It can be nil. PROPERTY is a string,
and VALUE the corresponding value. They are used, if there is no
matching entry in for PROPERTY in `tramp-cache-data'."
matching entry for PROPERTY in `tramp-cache-data'."
:group 'tramp
:version "24.4"
:type '(repeat (list (choice :tag "File Name regexp" regexp (const nil))

3
lisp/net/webjump.el
View file

@ -217,6 +217,9 @@
"www.emacswiki.org/cgi-bin/wiki/" ""])
;; Internet search engines.
("DuckDuckGo" .
[simple-query "duckduckgo.com"
"duckduckgo.com/?q=" ""])
("Google" .
[simple-query "www.google.com"
"www.google.com/search?q=" ""])

2
lisp/progmodes/python.el
View file

@ -2881,6 +2881,8 @@ The skeleton will be bound to python-skeleton-NAME."
(when module-file
(substring-no-properties module-file 1 -1))))))
(defvar ffap-alist)
(eval-after-load "ffap"
'(progn
(push '(python-mode . python-ffap-module-path) ffap-alist)

4
lisp/startup.el
View file

@ -1203,7 +1203,9 @@ the `--debug-init' option to view a complete error backtrace."
(when (let ((subdir (expand-file-name subdir dir)))
(and (file-directory-p subdir)
(file-exists-p
(package--description-file subdir))))
(expand-file-name
(package--description-file subdir)
subdir))))
(throw 'package-dir-found t)))))))
(package-initialize))

18
lisp/tabify.el
View file

@ -28,12 +28,17 @@
;;; Code:
;;;###autoload
(defun untabify (start end)
(defun untabify (start end &optional arg)
"Convert all tabs in region to multiple spaces, preserving columns.
If called interactively with prefix ARG, convert for the entire
buffer.
Called non-interactively, the region is specified by arguments
START and END, rather than by the position of point and mark.
The variable `tab-width' controls the spacing of tab stops."
(interactive "r")
(interactive (if current-prefix-arg
(list (point-min) (point-max) current-prefix-arg)
(list (region-beginning) (region-end) nil)))
(let ((c (current-column)))
(save-excursion
(save-restriction
@ -56,14 +61,19 @@ Usually this will be \" [ \\t]+\" to match a space followed by whitespace.
\"^\\t* [ \\t]+\" is also useful, for tabifying only initial whitespace.")
;;;###autoload
(defun tabify (start end)
(defun tabify (start end &optional arg)
"Convert multiple spaces in region to tabs when possible.
A group of spaces is partially replaced by tabs
when this can be done without changing the column they end at.
If called interactively with prefix ARG, convert for the entire
buffer.
Called non-interactively, the region is specified by arguments
START and END, rather than by the position of point and mark.
The variable `tab-width' controls the spacing of tab stops."
(interactive "r")
(interactive (if current-prefix-arg
(list (point-min) (point-max) current-prefix-arg)
(list (region-beginning) (region-end) nil)))
(save-excursion
(save-restriction
;; Include the beginning of the line in the narrowing

2
lisp/textmodes/reftex.el
View file

@ -2256,6 +2256,8 @@ IGNORE-WORDS List of words which should be removed from the string."
(define-key reftex-mode-map [(shift mouse-2)]
'reftex-mouse-view-crossref)))
(defvar bibtex-mode-map)
;; Bind `reftex-view-crossref-from-bibtex' in BibTeX mode map
(eval-after-load
"bibtex"

22969
src/ChangeLog
View file

File diff suppressed because it is too large Load diff

22949
src/ChangeLog.12 Normal file
View file

File diff suppressed because it is too large Load diff

198
src/eval.c
View file

@ -76,17 +76,19 @@ Lisp_Object Vrun_hooks;
Lisp_Object Vautoload_queue;
/* Current number of specbindings allocated in specpdl. */
/* Current number of specbindings allocated in specpdl, not counting
the dummy entry specpdl[-1]. */
ptrdiff_t specpdl_size;
/* Pointer to beginning of specpdl. */
/* Pointer to beginning of specpdl. A dummy entry specpdl[-1] exists
only so that its address can be taken. */
struct specbinding *specpdl;
union specbinding *specpdl;
/* Pointer to first unused element in specpdl. */
struct specbinding *specpdl_ptr;
union specbinding *specpdl_ptr;
/* Depth in Lisp evaluations and function calls. */
@ -116,102 +118,112 @@ static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *);
static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args);
static Lisp_Object
specpdl_symbol (struct specbinding *pdl)
specpdl_symbol (union specbinding *pdl)
{
eassert (pdl->kind >= SPECPDL_LET);
return pdl->v.let.symbol;
return pdl->let.symbol;
}
static Lisp_Object
specpdl_old_value (struct specbinding *pdl)
specpdl_old_value (union specbinding *pdl)
{
eassert (pdl->kind >= SPECPDL_LET);
return pdl->v.let.old_value;
return pdl->let.old_value;
}
static Lisp_Object
specpdl_where (struct specbinding *pdl)
specpdl_where (union specbinding *pdl)
{
eassert (pdl->kind > SPECPDL_LET);
return pdl->v.let.where;
return pdl->let.where;
}
static Lisp_Object
specpdl_arg (struct specbinding *pdl)
specpdl_arg (union specbinding *pdl)
{
eassert (pdl->kind == SPECPDL_UNWIND);
return pdl->v.unwind.arg;
return pdl->unwind.arg;
}
static specbinding_func
specpdl_func (struct specbinding *pdl)
specpdl_func (union specbinding *pdl)
{
eassert (pdl->kind == SPECPDL_UNWIND);
return pdl->v.unwind.func;
return pdl->unwind.func;
}
static Lisp_Object
backtrace_function (struct specbinding *pdl)
backtrace_function (union specbinding *pdl)
{
eassert (pdl->kind == SPECPDL_BACKTRACE);
return pdl->v.bt.function;
return pdl->bt.function;
}
static ptrdiff_t
backtrace_nargs (struct specbinding *pdl)
backtrace_nargs (union specbinding *pdl)
{
eassert (pdl->kind == SPECPDL_BACKTRACE);
return pdl->v.bt.nargs;
return pdl->bt.nargs;
}
static Lisp_Object *
backtrace_args (struct specbinding *pdl)
backtrace_args (union specbinding *pdl)
{
eassert (pdl->kind == SPECPDL_BACKTRACE);
return pdl->v.bt.args;
return pdl->bt.args;
}
static bool
backtrace_debug_on_exit (struct specbinding *pdl)
backtrace_debug_on_exit (union specbinding *pdl)
{
eassert (pdl->kind == SPECPDL_BACKTRACE);
return pdl->v.bt.debug_on_exit;
return pdl->bt.debug_on_exit;
}
/* Functions to modify slots of backtrace records. */
static void
set_backtrace_args (struct specbinding *pdl, Lisp_Object *args)
{ eassert (pdl->kind == SPECPDL_BACKTRACE); pdl->v.bt.args = args; }
set_backtrace_args (union specbinding *pdl, Lisp_Object *args)
{
eassert (pdl->kind == SPECPDL_BACKTRACE);
pdl->bt.args = args;
}
static void
set_backtrace_nargs (struct specbinding *pdl, ptrdiff_t n)
{ eassert (pdl->kind == SPECPDL_BACKTRACE); pdl->v.bt.nargs = n; }
set_backtrace_nargs (union specbinding *pdl, ptrdiff_t n)
{
eassert (pdl->kind == SPECPDL_BACKTRACE);
pdl->bt.nargs = n;
}
static void
set_backtrace_debug_on_exit (struct specbinding *pdl, bool doe)
{ eassert (pdl->kind == SPECPDL_BACKTRACE); pdl->v.bt.debug_on_exit = doe; }
set_backtrace_debug_on_exit (union specbinding *pdl, bool doe)
{
eassert (pdl->kind == SPECPDL_BACKTRACE);
pdl->bt.debug_on_exit = doe;
}
/* Helper functions to scan the backtrace. */
bool backtrace_p (struct specbinding *) EXTERNALLY_VISIBLE;
struct specbinding *backtrace_top (void) EXTERNALLY_VISIBLE;
struct specbinding *backtrace_next (struct specbinding *pdl) EXTERNALLY_VISIBLE;
bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE;
union specbinding *backtrace_top (void) EXTERNALLY_VISIBLE;
union specbinding *backtrace_next (union specbinding *pdl) EXTERNALLY_VISIBLE;
bool backtrace_p (struct specbinding *pdl)
bool
backtrace_p (union specbinding *pdl)
{ return pdl >= specpdl; }
struct specbinding *
union specbinding *
backtrace_top (void)
{
struct specbinding *pdl = specpdl_ptr - 1;
union specbinding *pdl = specpdl_ptr - 1;
while (backtrace_p (pdl) && pdl->kind != SPECPDL_BACKTRACE)
pdl--;
return pdl;
}
struct specbinding *
backtrace_next (struct specbinding *pdl)
union specbinding *
backtrace_next (union specbinding *pdl)
{
pdl--;
while (backtrace_p (pdl) && pdl->kind != SPECPDL_BACKTRACE)
@ -224,9 +236,9 @@ void
init_eval_once (void)
{
enum { size = 50 };
specpdl = xmalloc (size * sizeof *specpdl);
union specbinding *pdlvec = xmalloc ((size + 1) * sizeof *specpdl);
specpdl_size = size;
specpdl_ptr = specpdl;
specpdl = specpdl_ptr = pdlvec + 1;
/* Don't forget to update docs (lispref node "Local Variables"). */
max_specpdl_size = 1300; /* 1000 is not enough for CEDET's c-by.el. */
max_lisp_eval_depth = 600;
@ -615,7 +627,7 @@ The return value is BASE-VARIABLE. */)
set_internal (base_variable, find_symbol_value (new_alias), Qnil, 1);
{
struct specbinding *p;
union specbinding *p;
for (p = specpdl_ptr; p > specpdl; )
if ((--p)->kind >= SPECPDL_LET
@ -681,7 +693,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
else
{ /* Check if there is really a global binding rather than just a let
binding that shadows the global unboundness of the var. */
struct specbinding *pdl = specpdl_ptr;
union specbinding *pdl = specpdl_ptr;
while (pdl > specpdl)
{
if ((--pdl)->kind >= SPECPDL_LET
@ -1480,7 +1492,7 @@ See also the function `condition-case'. */)
Vsignaling_function = Qnil;
if (!NILP (error_symbol))
{
struct specbinding *pdl = backtrace_next (backtrace_top ());
union specbinding *pdl = backtrace_next (backtrace_top ());
if (backtrace_p (pdl) && EQ (backtrace_function (pdl), Qerror))
pdl = backtrace_next (pdl);
if (backtrace_p (pdl))
@ -1984,8 +1996,10 @@ If LEXICAL is t, evaluate using lexical scoping. */)
static void
grow_specpdl (void)
{
register ptrdiff_t count = SPECPDL_INDEX ();
ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX);
ptrdiff_t count = SPECPDL_INDEX ();
ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX - 1000);
union specbinding *pdlvec = specpdl - 1;
ptrdiff_t pdlvecsize = specpdl_size + 1;
if (max_size <= specpdl_size)
{
if (max_specpdl_size < 400)
@ -1993,7 +2007,9 @@ grow_specpdl (void)
if (max_size <= specpdl_size)
signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil);
}
specpdl = xpalloc (specpdl, &specpdl_size, 1, max_size, sizeof *specpdl);
pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl);
specpdl = pdlvec + 1;
specpdl_size = pdlvecsize - 1;
specpdl_ptr = specpdl + count;
}
@ -2003,11 +2019,11 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs)
eassert (nargs >= UNEVALLED);
if (specpdl_ptr == specpdl + specpdl_size)
grow_specpdl ();
specpdl_ptr->kind = SPECPDL_BACKTRACE;
specpdl_ptr->v.bt.function = function;
specpdl_ptr->v.bt.args = args;
specpdl_ptr->v.bt.nargs = nargs;
specpdl_ptr->v.bt.debug_on_exit = false;
specpdl_ptr->bt.kind = SPECPDL_BACKTRACE;
specpdl_ptr->bt.debug_on_exit = false;
specpdl_ptr->bt.function = function;
specpdl_ptr->bt.args = args;
specpdl_ptr->bt.nargs = nargs;
specpdl_ptr++;
}
@ -3044,7 +3060,7 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
bool
let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
{
struct specbinding *p;
union specbinding *p;
Lisp_Object buf = Fcurrent_buffer ();
for (p = specpdl_ptr; p > specpdl; )
@ -3063,7 +3079,7 @@ let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
bool
let_shadows_global_binding_p (Lisp_Object symbol)
{
struct specbinding *p;
union specbinding *p;
for (p = specpdl_ptr; p > specpdl; )
if ((--p)->kind >= SPECPDL_LET && EQ (specpdl_symbol (p), symbol))
@ -3105,9 +3121,9 @@ specbind (Lisp_Object symbol, Lisp_Object value)
case SYMBOL_PLAINVAL:
/* The most common case is that of a non-constant symbol with a
trivial value. Make that as fast as we can. */
specpdl_ptr->kind = SPECPDL_LET;
specpdl_ptr->v.let.symbol = symbol;
specpdl_ptr->v.let.old_value = SYMBOL_VAL (sym);
specpdl_ptr->let.kind = SPECPDL_LET;
specpdl_ptr->let.symbol = symbol;
specpdl_ptr->let.old_value = SYMBOL_VAL (sym);
++specpdl_ptr;
if (!sym->constant)
SET_SYMBOL_VAL (sym, value);
@ -3120,10 +3136,10 @@ specbind (Lisp_Object symbol, Lisp_Object value)
case SYMBOL_FORWARDED:
{
Lisp_Object ovalue = find_symbol_value (symbol);
specpdl_ptr->kind = SPECPDL_LET_LOCAL;
specpdl_ptr->v.let.symbol = symbol;
specpdl_ptr->v.let.old_value = ovalue;
specpdl_ptr->v.let.where = Fcurrent_buffer ();
specpdl_ptr->let.kind = SPECPDL_LET_LOCAL;
specpdl_ptr->let.symbol = symbol;
specpdl_ptr->let.old_value = ovalue;
specpdl_ptr->let.where = Fcurrent_buffer ();
eassert (sym->redirect != SYMBOL_LOCALIZED
|| (EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ())));
@ -3131,7 +3147,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
if (sym->redirect == SYMBOL_LOCALIZED)
{
if (!blv_found (SYMBOL_BLV (sym)))
specpdl_ptr->kind = SPECPDL_LET_DEFAULT;
specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT;
}
else if (BUFFER_OBJFWDP (SYMBOL_FWD (sym)))
{
@ -3142,14 +3158,14 @@ specbind (Lisp_Object symbol, Lisp_Object value)
happens with other buffer-local variables. */
if (NILP (Flocal_variable_p (symbol, Qnil)))
{
specpdl_ptr->kind = SPECPDL_LET_DEFAULT;
specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT;
++specpdl_ptr;
Fset_default (symbol, value);
return;
}
}
else
specpdl_ptr->kind = SPECPDL_LET;
specpdl_ptr->let.kind = SPECPDL_LET;
specpdl_ptr++;
set_internal (symbol, value, Qnil, 1);
@ -3164,9 +3180,9 @@ record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg)
{
if (specpdl_ptr == specpdl + specpdl_size)
grow_specpdl ();
specpdl_ptr->kind = SPECPDL_UNWIND;
specpdl_ptr->v.unwind.func = function;
specpdl_ptr->v.unwind.arg = arg;
specpdl_ptr->unwind.kind = SPECPDL_UNWIND;
specpdl_ptr->unwind.func = function;
specpdl_ptr->unwind.arg = arg;
specpdl_ptr++;
}
@ -3181,33 +3197,31 @@ unbind_to (ptrdiff_t count, Lisp_Object value)
while (specpdl_ptr != specpdl + count)
{
/* Copy the binding, and decrement specpdl_ptr, before we do
the work to unbind it. We decrement first
so that an error in unbinding won't try to unbind
the same entry again, and we copy the binding first
in case more bindings are made during some of the code we run. */
/* Decrement specpdl_ptr before we do the work to unbind it, so
that an error in unbinding won't try to unbind the same entry
again. Take care to copy any parts of the binding needed
before invoking any code that can make more bindings. */
struct specbinding this_binding;
this_binding = *--specpdl_ptr;
specpdl_ptr--;
switch (this_binding.kind)
switch (specpdl_ptr->kind)
{
case SPECPDL_UNWIND:
(*specpdl_func (&this_binding)) (specpdl_arg (&this_binding));
specpdl_func (specpdl_ptr) (specpdl_arg (specpdl_ptr));
break;
case SPECPDL_LET:
/* If variable has a trivial value (no forwarding), we can
just set it. No need to check for constant symbols here,
since that was already done by specbind. */
if (XSYMBOL (specpdl_symbol (&this_binding))->redirect
if (XSYMBOL (specpdl_symbol (specpdl_ptr))->redirect
== SYMBOL_PLAINVAL)
SET_SYMBOL_VAL (XSYMBOL (specpdl_symbol (&this_binding)),
specpdl_old_value (&this_binding));
SET_SYMBOL_VAL (XSYMBOL (specpdl_symbol (specpdl_ptr)),
specpdl_old_value (specpdl_ptr));
else
/* NOTE: we only ever come here if make_local_foo was used for
the first time on this var within this let. */
Fset_default (specpdl_symbol (&this_binding),
specpdl_old_value (&this_binding));
Fset_default (specpdl_symbol (specpdl_ptr),
specpdl_old_value (specpdl_ptr));
break;
case SPECPDL_BACKTRACE:
break;
@ -3220,17 +3234,17 @@ unbind_to (ptrdiff_t count, Lisp_Object value)
binding. WHERE nil means that the variable had the default
value when it was bound. CURRENT-BUFFER is the buffer that
was current when the variable was bound. */
Lisp_Object symbol = specpdl_symbol (&this_binding);
Lisp_Object where = specpdl_where (&this_binding);
Lisp_Object symbol = specpdl_symbol (specpdl_ptr);
Lisp_Object where = specpdl_where (specpdl_ptr);
Lisp_Object old_value = specpdl_old_value (specpdl_ptr);
eassert (BUFFERP (where));
if (this_binding.kind == SPECPDL_LET_DEFAULT)
Fset_default (symbol, specpdl_old_value (&this_binding));
if (specpdl_ptr->kind == SPECPDL_LET_DEFAULT)
Fset_default (symbol, old_value);
/* If this was a local binding, reset the value in the appropriate
buffer, but only if that buffer's binding still exists. */
else if (!NILP (Flocal_variable_p (symbol, where)))
set_internal (symbol, specpdl_old_value (&this_binding),
where, 1);
set_internal (symbol, old_value, where, 1);
}
break;
}
@ -3259,7 +3273,7 @@ DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
The debugger is entered when that frame exits, if the flag is non-nil. */)
(Lisp_Object level, Lisp_Object flag)
{
struct specbinding *pdl = backtrace_top ();
union specbinding *pdl = backtrace_top ();
register EMACS_INT i;
CHECK_NUMBER (level);
@ -3278,7 +3292,7 @@ DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "",
Output stream used is value of `standard-output'. */)
(void)
{
struct specbinding *pdl = backtrace_top ();
union specbinding *pdl = backtrace_top ();
Lisp_Object tem;
Lisp_Object old_print_level = Vprint_level;
@ -3328,7 +3342,7 @@ or a lambda expression for macro calls.
If NFRAMES is more than the number of frames, the value is nil. */)
(Lisp_Object nframes)
{
struct specbinding *pdl = backtrace_top ();
union specbinding *pdl = backtrace_top ();
register EMACS_INT i;
CHECK_NATNUM (nframes);
@ -3354,7 +3368,7 @@ If NFRAMES is more than the number of frames, the value is nil. */)
void
mark_specpdl (void)
{
struct specbinding *pdl;
union specbinding *pdl;
for (pdl = specpdl; pdl != specpdl_ptr; pdl++)
{
switch (pdl->kind)
@ -3362,6 +3376,7 @@ mark_specpdl (void)
case SPECPDL_UNWIND:
mark_object (specpdl_arg (pdl));
break;
case SPECPDL_BACKTRACE:
{
ptrdiff_t nargs = backtrace_nargs (pdl);
@ -3372,12 +3387,15 @@ mark_specpdl (void)
mark_object (backtrace_args (pdl)[nargs]);
}
break;
case SPECPDL_LET_DEFAULT:
case SPECPDL_LET_LOCAL:
mark_object (specpdl_where (pdl));
/* Fall through. */
case SPECPDL_LET:
mark_object (specpdl_symbol (pdl));
mark_object (specpdl_old_value (pdl));
break;
}
}
}
@ -3385,7 +3403,7 @@ mark_specpdl (void)
void
get_backtrace (Lisp_Object array)
{
struct specbinding *pdl = backtrace_next (backtrace_top ());
union specbinding *pdl = backtrace_next (backtrace_top ());
ptrdiff_t i = 0, asize = ASIZE (array);
/* Copy the backtrace contents into working memory. */
@ -3403,7 +3421,7 @@ get_backtrace (Lisp_Object array)
Lisp_Object backtrace_top_function (void)
{
struct specbinding *pdl = backtrace_top ();
union specbinding *pdl = backtrace_top ();
return (backtrace_p (pdl) ? backtrace_function (pdl) : Qnil);
}

2
src/fileio.c
View file

@ -4764,7 +4764,7 @@ This calls `write-region-annotate-functions' at the start, and
struct stat st;
EMACS_TIME modtime;
ptrdiff_t count = SPECPDL_INDEX ();
int count1;
ptrdiff_t count1;
Lisp_Object handler;
Lisp_Object visit_file;
Lisp_Object annotations;

2
src/frame.c
View file

@ -2925,7 +2925,7 @@ x_report_frame_params (struct frame *f, Lisp_Object *alistptr)
if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
tem = Qnil;
else
XSETFASTINT (tem, FRAME_X_OUTPUT (f)->parent_desc);
tem = make_natnum ((uintptr_t) FRAME_X_OUTPUT (f)->parent_desc);
store_in_alist (alistptr, Qexplicit_name, (f->explicit_name ? Qt : Qnil));
store_in_alist (alistptr, Qparent_id, tem);
store_in_alist (alistptr, Qtool_bar_position, f->tool_bar_position);

46
src/lisp.h
View file

@ -73,7 +73,6 @@ enum
BITS_PER_SHORT = CHAR_BIT * sizeof (short),
BITS_PER_INT = CHAR_BIT * sizeof (int),
BITS_PER_LONG = CHAR_BIT * sizeof (long int),
BITS_PER_PTRDIFF_T = CHAR_BIT * sizeof (ptrdiff_t),
BITS_PER_EMACS_INT = CHAR_BIT * sizeof (EMACS_INT)
};
@ -2679,9 +2678,9 @@ typedef jmp_buf sys_jmp_buf;
WHERE being a buffer or frame means we saw a buffer-local or frame-local
value. Other values of WHERE mean an internal error.
NOTE: The specbinding struct is defined here, because SPECPDL_INDEX is
NOTE: The specbinding union is defined here, because SPECPDL_INDEX is
used all over the place, needs to be fast, and needs to know the size of
struct specbinding. But only eval.c should access it. */
union specbinding. But only eval.c should access it. */
typedef Lisp_Object (*specbinding_func) (Lisp_Object);
@ -2694,29 +2693,30 @@ enum specbind_tag {
SPECPDL_LET_DEFAULT /* A global binding for a localized var. */
};
struct specbinding
union specbinding
{
enum specbind_tag kind;
union {
struct {
Lisp_Object arg;
specbinding_func func;
} unwind;
struct {
/* `where' is not used in the case of SPECPDL_LET. */
Lisp_Object symbol, old_value, where;
} let;
struct {
Lisp_Object function;
Lisp_Object *args;
ptrdiff_t nargs : BITS_PER_PTRDIFF_T - 1;
bool debug_on_exit : 1;
} bt;
} v;
ENUM_BF (specbind_tag) kind : CHAR_BIT;
struct {
ENUM_BF (specbind_tag) kind : CHAR_BIT;
Lisp_Object arg;
specbinding_func func;
} unwind;
struct {
ENUM_BF (specbind_tag) kind : CHAR_BIT;
/* `where' is not used in the case of SPECPDL_LET. */
Lisp_Object symbol, old_value, where;
} let;
struct {
ENUM_BF (specbind_tag) kind : CHAR_BIT;
bool debug_on_exit : 1;
Lisp_Object function;
Lisp_Object *args;
ptrdiff_t nargs;
} bt;
};
extern struct specbinding *specpdl;
extern struct specbinding *specpdl_ptr;
extern union specbinding *specpdl;
extern union specbinding *specpdl_ptr;
extern ptrdiff_t specpdl_size;
LISP_INLINE ptrdiff_t

2
src/nsfont.m
View file

@ -362,7 +362,7 @@ seems to be limited for now (2009/05) to ja, zh, and ko. */
*ns_registry_to_script (char *reg)
{
Lisp_Object script, r, rts = Vns_reg_to_script;
while CONSP (rts)
while (CONSP (rts))
{
r = XCAR (XCAR (rts));
if (!strncmp (SSDATA (r), reg, SBYTES (r)))

2
src/process.c
View file

@ -2524,7 +2524,7 @@ usage: (make-serial-process &rest ARGS) */)
struct gcpro gcpro1;
Lisp_Object name, buffer;
Lisp_Object tem, val;
ptrdiff_t specpdl_count = -1;
ptrdiff_t specpdl_count;
if (nargs == 0)
return Qnil;

101
src/textprop.c
View file

@ -60,6 +60,13 @@ Lisp_Object Qinvisible, Qintangible, Qmouse_face;
static Lisp_Object Qread_only;
Lisp_Object Qminibuffer_prompt;
enum property_set_type
{
TEXT_PROPERTY_REPLACE,
TEXT_PROPERTY_PREPEND,
TEXT_PROPERTY_APPEND
};
/* Sticky properties. */
Lisp_Object Qfront_sticky, Qrear_nonsticky;
@ -370,7 +377,8 @@ set_properties (Lisp_Object properties, INTERVAL interval, Lisp_Object object)
are actually added to I's plist) */
static bool
add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object)
add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object,
enum property_set_type set_type)
{
Lisp_Object tail1, tail2, sym1, val1;
bool changed = 0;
@ -416,7 +424,30 @@ add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object)
}
/* I's property has a different value -- change it */
Fsetcar (this_cdr, val1);
if (set_type == TEXT_PROPERTY_REPLACE)
Fsetcar (this_cdr, val1);
else {
if (CONSP (Fcar (this_cdr)) &&
/* Special-case anonymous face properties. */
(! EQ (sym1, Qface) ||
NILP (Fkeywordp (Fcar (Fcar (this_cdr))))))
/* The previous value is a list, so prepend (or
append) the new value to this list. */
if (set_type == TEXT_PROPERTY_PREPEND)
Fsetcar (this_cdr, Fcons (val1, Fcar (this_cdr)));
else
nconc2 (Fcar (this_cdr), Fcons (val1, Qnil));
else {
/* The previous value is a single value, so make it
into a list. */
if (set_type == TEXT_PROPERTY_PREPEND)
Fsetcar (this_cdr,
Fcons (val1, Fcons (Fcar (this_cdr), Qnil)));
else
Fsetcar (this_cdr,
Fcons (Fcar (this_cdr), Fcons (val1, Qnil)));
}
}
changed = 1;
break;
}
@ -1124,19 +1155,12 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */)
return make_number (previous->position + LENGTH (previous));
}
/* Callers note, this can GC when OBJECT is a buffer (or nil). */
/* Used by add-text-properties and add-face-text-property. */
DEFUN ("add-text-properties", Fadd_text_properties,
Sadd_text_properties, 3, 4, 0,
doc: /* Add properties to the text from START to END.
The third argument PROPERTIES is a property list
specifying the property values to add. If the optional fourth argument
OBJECT is a buffer (or nil, which means the current buffer),
START and END are buffer positions (integers or markers).
If OBJECT is a string, START and END are 0-based indices into it.
Return t if any property value actually changed, nil otherwise. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
{
static Lisp_Object
add_text_properties_1 (Lisp_Object start, Lisp_Object end,
Lisp_Object properties, Lisp_Object object,
enum property_set_type set_type) {
INTERVAL i, unchanged;
ptrdiff_t s, len;
bool modified = 0;
@ -1230,7 +1254,7 @@ Return t if any property value actually changed, nil otherwise. */)
if (LENGTH (i) == len)
{
add_properties (properties, i, object);
add_properties (properties, i, object, set_type);
if (BUFFERP (object))
signal_after_change (XINT (start), XINT (end) - XINT (start),
XINT (end) - XINT (start));
@ -1241,7 +1265,7 @@ Return t if any property value actually changed, nil otherwise. */)
unchanged = i;
i = split_interval_left (unchanged, len);
copy_properties (unchanged, i);
add_properties (properties, i, object);
add_properties (properties, i, object, set_type);
if (BUFFERP (object))
signal_after_change (XINT (start), XINT (end) - XINT (start),
XINT (end) - XINT (start));
@ -1249,13 +1273,31 @@ Return t if any property value actually changed, nil otherwise. */)
}
len -= LENGTH (i);
modified |= add_properties (properties, i, object);
modified |= add_properties (properties, i, object, set_type);
i = next_interval (i);
}
}
/* Callers note, this can GC when OBJECT is a buffer (or nil). */
DEFUN ("add-text-properties", Fadd_text_properties,
Sadd_text_properties, 3, 4, 0,
doc: /* Add properties to the text from START to END.
The third argument PROPERTIES is a property list
specifying the property values to add. If the optional fourth argument
OBJECT is a buffer (or nil, which means the current buffer),
START and END are buffer positions (integers or markers).
If OBJECT is a string, START and END are 0-based indices into it.
Return t if any property value actually changed, nil otherwise. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object properties,
Lisp_Object object)
{
return add_text_properties_1 (start, end, properties, object,
TEXT_PROPERTY_REPLACE);
}
/* Callers note, this can GC when OBJECT is a buffer (or nil). */
DEFUN ("put-text-property", Fput_text_property,
Sput_text_property, 4, 5, 0,
doc: /* Set one property of the text from START to END.
@ -1287,6 +1329,29 @@ the designated part of OBJECT. */)
}
DEFUN ("add-face-text-property", Fadd_face_text_property,
Sadd_face_text_property, 3, 5, 0,
doc: /* Add the face property to the text from START to END.
The third argument FACE specifies the face to add.
If any text in the region already has any face properties, this new
face property will be added to the front of the face property list.
If the optional fourth argument APPENDP is non-nil, append to the end
of the face property list instead.
If the optional fifth argument OBJECT is a buffer (or nil, which means
the current buffer), START and END are buffer positions (integers or
markers). If OBJECT is a string, START and END are 0-based indices
into it. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object face,
Lisp_Object appendp, Lisp_Object object)
{
add_text_properties_1 (start, end,
Fcons (Qface, Fcons (face, Qnil)),
object,
NILP (appendp)? TEXT_PROPERTY_PREPEND:
TEXT_PROPERTY_APPEND);
return Qnil;
}
/* Replace properties of text from START to END with new list of
properties PROPERTIES. OBJECT is the buffer or string containing
the text. OBJECT nil means use the current buffer.
@ -2292,6 +2357,7 @@ inherits it if NONSTICKINESS is nil. The `front-sticky' and
DEFSYM (Qforeground, "foreground");
DEFSYM (Qbackground, "background");
DEFSYM (Qfont, "font");
DEFSYM (Qface, "face");
DEFSYM (Qstipple, "stipple");
DEFSYM (Qunderline, "underline");
DEFSYM (Qread_only, "read-only");
@ -2326,6 +2392,7 @@ inherits it if NONSTICKINESS is nil. The `front-sticky' and
defsubr (&Sadd_text_properties);
defsubr (&Sput_text_property);
defsubr (&Sset_text_properties);
defsubr (&Sadd_face_text_property);
defsubr (&Sremove_text_properties);
defsubr (&Sremove_list_of_text_properties);
defsubr (&Stext_property_any);

3
src/w32fns.c
View file

@ -3184,7 +3184,8 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
form.rcArea.left = WINDOW_TEXT_TO_FRAME_PIXEL_X (w, 0);
form.rcArea.top = WINDOW_TOP_EDGE_Y (w);
if (BUFFERP (w->contents))
if (BUFFERP (w->contents)
&& FRAMEP (WINDOW_FRAME (w)))
form.rcArea.top += WINDOW_HEADER_LINE_HEIGHT (w);
form.rcArea.right = (WINDOW_BOX_RIGHT_EDGE_X (w)
- WINDOW_RIGHT_MARGIN_WIDTH (w)