Commit de86fd61 authored by Kenichi Handa's avatar Kenichi Handa

merge emacs

parents 3c542890 7946c240
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
......
......@@ -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
......
......@@ -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.
......
This diff is collapsed.
This diff is collapsed.
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)
......
......@@ -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))
......
......@@ -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
......
......@@ -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.
......
......@@ -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.
......
......@@ -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.")
......
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.
......
......@@ -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)
......
......@@ -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)))
......
......@@ -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)
......
......@@ -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))