Now on revision 113034. ------------------------------------------------------------ revno: 113034 committer: Glenn Morris branch nick: trunk timestamp: Mon 2013-06-17 22:06:33 -0400 message: * lisp/cedet/semantic/ctxt.el (semantic-ctxt-end-of-symbol-default): Remove unused free variable `symlist'. diff: === modified file 'lisp/cedet/ChangeLog' --- lisp/cedet/ChangeLog 2013-06-02 16:39:32 +0000 +++ lisp/cedet/ChangeLog 2013-06-18 02:06:33 +0000 @@ -1,7 +1,12 @@ +2013-06-18 Glenn Morris + + * semantic/ctxt.el (semantic-ctxt-end-of-symbol-default): + Remove unused free variable `symlist'. + 2013-06-02 Eric Ludlam - * 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) === modified file 'lisp/cedet/semantic/ctxt.el' --- lisp/cedet/semantic/ctxt.el 2013-06-10 23:02:33 +0000 +++ lisp/cedet/semantic/ctxt.el 2013-06-18 02:06:33 +0000 @@ -397,7 +397,6 @@ t) (error nil)) (looking-at fieldsep1))) - (setq symlist (list "")) (forward-sexp -1) ;; Skip array expressions. (while (looking-at "\\s(") (forward-sexp -1)) ------------------------------------------------------------ revno: 113033 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=14632 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2013-06-17 21:26:47 -0400 message: * lisp/emacs-lisp/package.el: Update package-alist after install. (package-unpack, package-unpack-single): Return the pkg-dir. (package-download-transaction): Use it to update package-alist. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-17 23:59:09 +0000 +++ lisp/ChangeLog 2013-06-18 01:26:47 +0000 @@ -1,3 +1,9 @@ +2013-06-18 Stefan Monnier + + * emacs-lisp/package.el: Update package-alist after install (bug#14632). + (package-unpack, package-unpack-single): Return the pkg-dir. + (package-download-transaction): Use it to update package-alist. + 2013-06-17 Lars Magne Ingebrigtsen * net/browse-url.el (browse-url-browser-function): Add `eww' as a === modified file 'lisp/emacs-lisp/package.el' --- lisp/emacs-lisp/package.el 2013-06-17 17:36:21 +0000 +++ lisp/emacs-lisp/package.el 2013-06-18 01:26:47 +0000 @@ -640,7 +640,8 @@ ;; 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. @@ -696,7 +697,8 @@ 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. @@ -922,16 +924,20 @@ (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. ------------------------------------------------------------ revno: 113032 committer: Lars Magne Ingebrigtsen branch nick: trunk timestamp: Tue 2013-06-18 01:59:09 +0200 message: (browse-url-browser-function): Add `eww' as a possible choice. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-17 22:45:14 +0000 +++ lisp/ChangeLog 2013-06-17 23:59:09 +0000 @@ -1,3 +1,8 @@ +2013-06-17 Lars Magne Ingebrigtsen + + * net/browse-url.el (browse-url-browser-function): Add `eww' as a + possible choice. + 2013-06-17 Juri Linkov * net/webjump.el (webjump-sample-sites): Add DuckDuckGo. === modified file 'lisp/net/browse-url.el' --- lisp/net/browse-url.el 2013-05-08 15:10:17 +0000 +++ lisp/net/browse-url.el 2013-06-17 23:59:09 +0000 @@ -234,6 +234,7 @@ (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) ------------------------------------------------------------ revno: 113031 author: Teodor Zlatanov committer: Katsumi Yamaoka branch nick: trunk timestamp: Mon 2013-06-17 23:35:46 +0000 message: lisp/gnus/auth-source.el: When a data token is "machine", abort parsing the current line diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2013-06-17 23:11:40 +0000 +++ lisp/gnus/ChangeLog 2013-06-17 23:35:46 +0000 @@ -1,3 +1,9 @@ +2013-06-17 Teodor Zlatanov + + * 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 * eww.el (eww-tag-select): Don't render totally empty diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2013-06-17 22:06:27 +0000 +++ lisp/gnus/ChangeLog 2013-06-17 23:11:40 +0000 @@ -4,6 +4,7 @@ (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 . * shr.el (shr-insert-table): Respect border-collapse: collapse. (shr-tag-base): Protect against base specs that are degenerate. === modified file 'lisp/gnus/eww.el' --- lisp/gnus/eww.el 2013-06-17 22:06:27 +0000 +++ lisp/gnus/eww.el 2013-06-17 23:11:40 +0000 @@ -279,7 +279,8 @@ (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)) ------------------------------------------------------------ revno: 113029 committer: Juri Linkov branch nick: trunk timestamp: Tue 2013-06-18 01:45:14 +0300 message: * lisp/net/webjump.el (webjump-sample-sites): Add DuckDuckGo. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-17 17:36:21 +0000 +++ lisp/ChangeLog 2013-06-17 22:45:14 +0000 @@ -1,3 +1,7 @@ +2013-06-17 Juri Linkov + + * net/webjump.el (webjump-sample-sites): Add DuckDuckGo. + 2013-06-17 Dmitry Gutov * emacs-lisp/package.el (package-load-descriptor): Remove === modified file 'lisp/net/webjump.el' --- lisp/net/webjump.el 2013-01-01 09:11:05 +0000 +++ lisp/net/webjump.el 2013-06-17 22:45:14 +0000 @@ -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=" ""]) ------------------------------------------------------------ revno: 113028 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Mon 2013-06-17 22:06:27 +0000 message: lisp/gnus/{eww,shr}.el: Merge changes made in Gnus master lisp/gnus/eww.el (eww-tag-select): Don't render totally empty 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. + + * 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 , 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. === modified file 'lisp/gnus/eww.el' --- lisp/gnus/eww.el 2013-06-17 10:51:54 +0000 +++ lisp/gnus/eww.el 2013-06-17 22:06:27 +0000 @@ -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.") @@ -268,34 +276,39 @@ (let* ((start (point)) (type (downcase (or (cdr (assq :type cont)) "text"))) + (value (cdr (assq :value cont))) (widget (cond ((equal type "submit") (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 +316,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 +350,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 +449,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 +462,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))) === modified file 'lisp/gnus/shr.el' --- lisp/gnus/shr.el 2013-06-17 10:51:54 +0000 +++ lisp/gnus/shr.el 2013-06-17 22:06:27 +0000 @@ -125,6 +125,7 @@ (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))) @@ -222,9 +223,9 @@ (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 +237,11 @@ (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 +249,7 @@ (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 +350,7 @@ (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 +596,14 @@ (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 +621,16 @@ ;; 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 +806,13 @@ (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 +844,18 @@ (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 +1023,9 @@ 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 +1034,8 @@ (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) @@ -1154,11 +1172,7 @@ (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)) @@ -1312,35 +1326,40 @@ (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 +1412,8 @@ 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) ------------------------------------------------------------ revno: 113027 author: Paul Eggert <eggert@cs.ucla.edu> committer: Paul Eggert <eggert@cs.ucla.edu> branch nick: trunk timestamp: Mon 2013-06-17 14:12:21 -0700 message: * frame.c (x_report_frame_params): Cast parent_desc to uintptr_t. Needed if HAVE_NTGUI. Reported by Juanma Barranquero. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-06-17 21:10:31 +0000 +++ src/ChangeLog 2013-06-17 21:12:21 +0000 @@ -1,5 +1,8 @@ 2013-06-17 Paul Eggert <eggert@cs.ucla.edu> + * frame.c (x_report_frame_params): Cast parent_desc to uintptr_t. + Needed if HAVE_NTGUI. Reported by Juanma Barranquero. + * nsfont.m (ns_registry_to_script): Parenthesize while expression. 2013-06-17 Eli Zaretskii <eliz@gnu.org> === modified file 'src/frame.c' --- src/frame.c 2013-06-03 18:29:30 +0000 +++ src/frame.c 2013-06-17 21:12:21 +0000 @@ -2925,7 +2925,7 @@ 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); ------------------------------------------------------------ revno: 113026 committer: Paul Eggert <eggert@cs.ucla.edu> branch nick: trunk timestamp: Mon 2013-06-17 14:10:31 -0700 message: * nsfont.m (ns_registry_to_script): Parenthesize while expression. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-06-17 16:30:40 +0000 +++ src/ChangeLog 2013-06-17 21:10:31 +0000 @@ -1,3 +1,7 @@ +2013-06-17 Paul Eggert <eggert@cs.ucla.edu> + + * nsfont.m (ns_registry_to_script): Parenthesize while expression. + 2013-06-17 Eli Zaretskii <eliz@gnu.org> * w32fns.c (w32_wnd_proc): Don't call WINDOW_HEADER_LINE_HEIGHT === modified file 'src/nsfont.m' --- src/nsfont.m 2013-06-02 19:14:25 +0000 +++ src/nsfont.m 2013-06-17 21:10:31 +0000 @@ -362,7 +362,7 @@ *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))) ------------------------------------------------------------ revno: 113025 committer: Dmitry Gutov <dgutov@yandex.ru> branch nick: trunk timestamp: Mon 2013-06-17 21:36:21 +0400 message: * lisp/emacs-lisp/package.el (package-load-descriptor): Remove `with-syntax-table' call, `read' doesn't need it. http://lists.gnu.org/archive/html/emacs-devel/2013-06/msg00539.html diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-17 15:33:52 +0000 +++ lisp/ChangeLog 2013-06-17 17:36:21 +0000 @@ -1,3 +1,9 @@ +2013-06-17 Dmitry Gutov <dgutov@yandex.ru> + + * emacs-lisp/package.el (package-load-descriptor): Remove + `with-syntax-table' call, `read' doesn't need it. + http://lists.gnu.org/archive/html/emacs-devel/2013-06/msg00539.html + 2013-06-17 Juanma Barranquero <lekktu@gmail.com> * startup.el (command-line): Expand package name returned by === modified file 'lisp/emacs-lisp/package.el' --- lisp/emacs-lisp/package.el 2013-06-17 06:24:08 +0000 +++ lisp/emacs-lisp/package.el 2013-06-17 17:36:21 +0000 @@ -420,10 +420,9 @@ (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. ------------------------------------------------------------ revno: 113024 committer: Eli Zaretskii <eliz@gnu.org> branch nick: trunk timestamp: Mon 2013-06-17 19:30:40 +0300 message: src/ChangeLog: Rearrange the last 2 entries in correct order. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-06-17 16:28:47 +0000 +++ src/ChangeLog 2013-06-17 16:30:40 +0000 @@ -1,3 +1,9 @@ +2013-06-17 Eli Zaretskii <eliz@gnu.org> + + * w32fns.c (w32_wnd_proc): Don't call WINDOW_HEADER_LINE_HEIGHT + unless we know that the window w's frame is a frame object. + Another attempt at solving bug#14062 and bug#14630. + 2013-06-17 Lars Magne Ingebrigtsen <larsi@gnus.org> * textprop.c (property_set_type): New enum. @@ -8,12 +14,6 @@ (Fadd_face_text_property): New function that calls add_text_properties_1. -2013-06-17 Eli Zaretskii <eliz@gnu.org> - - * w32fns.c (w32_wnd_proc): Don't call WINDOW_HEADER_LINE_HEIGHT - unless we know that the window w's frame is a frame object. - Another attempt at solving bug#14062 and bug#14630. - 2013-06-17 Paul Eggert <eggert@cs.ucla.edu> Move functions from lisp.h to individual modules when possible. ------------------------------------------------------------ revno: 113023 fixes bug: http://debbugs.gnu.org/14630 committer: Eli Zaretskii <eliz@gnu.org> branch nick: trunk timestamp: Mon 2013-06-17 19:28:47 +0300 message: Possible fix for bug #14630, which continues bug #14062. src/w32fns.c (w32_wnd_proc): Don't call WINDOW_HEADER_LINE_HEIGHT unless we know that the window w's frame is a frame object. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-06-17 15:28:22 +0000 +++ src/ChangeLog 2013-06-17 16:28:47 +0000 @@ -8,6 +8,12 @@ (Fadd_face_text_property): New function that calls add_text_properties_1. +2013-06-17 Eli Zaretskii <eliz@gnu.org> + + * w32fns.c (w32_wnd_proc): Don't call WINDOW_HEADER_LINE_HEIGHT + unless we know that the window w's frame is a frame object. + Another attempt at solving bug#14062 and bug#14630. + 2013-06-17 Paul Eggert <eggert@cs.ucla.edu> Move functions from lisp.h to individual modules when possible. === modified file 'src/w32fns.c' --- src/w32fns.c 2013-05-14 14:09:43 +0000 +++ src/w32fns.c 2013-06-17 16:28:47 +0000 @@ -3184,7 +3184,8 @@ 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) ------------------------------------------------------------ revno: 113022 committer: Juanma Barranquero <lekktu@gmail.com> branch nick: trunk timestamp: Mon 2013-06-17 17:49:43 +0200 message: doc/lispref/text.texi (Undo, Changing Properties): Fix typos. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2013-06-17 15:28:22 +0000 +++ doc/lispref/ChangeLog 2013-06-17 15:49:43 +0000 @@ -1,3 +1,7 @@ +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'. === modified file 'doc/lispref/text.texi' --- doc/lispref/text.texi 2013-06-17 15:28:22 +0000 +++ doc/lispref/text.texi 2013-06-17 15:49:43 +0000 @@ -1226,7 +1226,7 @@ @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: @@ -2818,7 +2818,7 @@ The attribute is (by default) prepended to the list of face attributes, and the first attribute of the same type takes -presedence. So if you have two @code{:foreground} specifications, the +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 ------------------------------------------------------------ revno: 113021 fixes bug: http://debbugs.gnu.org/14639 committer: Juanma Barranquero <lekktu@gmail.com> branch nick: trunk timestamp: Mon 2013-06-17 17:33:52 +0200 message: lisp/startup.el: Fix bug#14639. (command-line): Expand package name returned by `package--description-file'. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-17 06:24:08 +0000 +++ lisp/ChangeLog 2013-06-17 15:33:52 +0000 @@ -1,3 +1,8 @@ +2013-06-17 Juanma Barranquero <lekktu@gmail.com> + + * startup.el (command-line): Expand package name returned by + `package--description-file' (bug#14639). + 2013-06-17 Dmitry Gutov <dgutov@yandex.ru> * emacs-lisp/package.el (package-load-descriptor): Do not call === modified file 'lisp/startup.el' --- lisp/startup.el 2013-06-15 15:36:11 +0000 +++ lisp/startup.el 2013-06-17 15:33:52 +0000 @@ -1203,7 +1203,9 @@ (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)) ------------------------------------------------------------ revno: 113020 committer: Lars Magne Ingebrigtsen <larsi@gnus.org> branch nick: trunk timestamp: Mon 2013-06-17 17:28:22 +0200 message: Implement new function `add-face-text-property' * doc/lispref/text.texi (Changing Properties): Document `add-face-text-property'. * src/textprop.c (property_set_type): New enum. (add_properties): Allow appending/prepending text properties. (add_text_properties_1): Factored out of Fadd_text_properties. (Fadd_text_properties): Moved all the code into add_text_properties_1. (Fadd_face_text_property): New function that calls add_text_properties_1. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2013-06-17 15:07:45 +0000 +++ doc/lispref/ChangeLog 2013-06-17 15:28:22 +0000 @@ -1,3 +1,7 @@ +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 === modified file 'doc/lispref/text.texi' --- doc/lispref/text.texi 2013-04-06 07:39:48 +0000 +++ doc/lispref/text.texi 2013-06-17 15:28:22 +0000 @@ -2805,6 +2805,28 @@ 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 +presedence. 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 is with @code{propertize}: === modified file 'etc/NEWS' --- etc/NEWS 2013-06-17 00:52:24 +0000 +++ etc/NEWS 2013-06-17 15:28:22 +0000 @@ -103,6 +103,9 @@ 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. === modified file 'src/ChangeLog' --- src/ChangeLog 2013-06-17 06:03:19 +0000 +++ src/ChangeLog 2013-06-17 15:28:22 +0000 @@ -1,3 +1,13 @@ +2013-06-17 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * textprop.c (property_set_type): New enum. + (add_properties): Allow appending/prepending text properties. + (add_text_properties_1): Factored out of Fadd_text_properties. + (Fadd_text_properties): Moved all the code into + add_text_properties_1. + (Fadd_face_text_property): New function that calls + add_text_properties_1. + 2013-06-17 Paul Eggert <eggert@cs.ucla.edu> Move functions from lisp.h to individual modules when possible. === modified file 'src/textprop.c' --- src/textprop.c 2013-06-17 06:03:19 +0000 +++ src/textprop.c 2013-06-17 15:28:22 +0000 @@ -60,6 +60,13 @@ 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 @@ 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 @@ } /* 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 @@ 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 @@ 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 @@ 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 @@ } 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 @@ } +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 @@ 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 @@ 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); ------------------------------------------------------------ revno: 113019 [merge] committer: K. Handa <handa@gnu.org> branch nick: trunk timestamp: Tue 2013-06-18 00:08:07 +0900 message: lispref/ChangeLog: Add bug ID to the previous change. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2013-06-17 15:04:50 +0000 +++ doc/lispref/ChangeLog 2013-06-17 15:07:45 +0000 @@ -1,7 +1,7 @@ 2013-06-17 Kenichi Handa <handa@gnu.org> * display.texi (Face Attributes): Refer to "Low-Level font" (not - "Font Selection") in the explanation of :font attribute. + "Font Selection") in the explanation of :font attribute (bug#14629). 2013-06-13 Stefan Monnier <monnier@iro.umontreal.ca> ------------------------------------------------------------ revno: 113018 [merge] committer: K. Handa <handa@gnu.org> branch nick: trunk timestamp: Tue 2013-06-18 00:05:41 +0900 message: display.texi (Face Attributes): Refer to "Low-Level font" (not "Font Selection") in the explanation of :font attribute. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2013-06-13 22:24:52 +0000 +++ doc/lispref/ChangeLog 2013-06-17 15:04:50 +0000 @@ -1,3 +1,8 @@ +2013-06-17 Kenichi Handa <handa@gnu.org> + + * display.texi (Face Attributes): Refer to "Low-Level font" (not + "Font Selection") in the explanation of :font attribute. + 2013-06-13 Stefan Monnier <monnier@iro.umontreal.ca> * loading.texi (Hooks for Loading): Don't document after-load-alist. === modified file 'doc/lispref/display.texi' --- doc/lispref/display.texi 2013-04-06 07:39:48 +0000 +++ doc/lispref/display.texi 2013-06-17 15:04:50 +0000 @@ -2126,7 +2126,8 @@ @item :font The font used to display the face. Its value should be a font object. -@xref{Font Selection}, for information about font objects. +@xref{Low-Level Font}, for information about font objects, font specs, +and font entities. When specifying this attribute using @code{set-face-attribute} (@pxref{Attribute Functions}), you may also supply a font spec, a font @@ -3260,7 +3261,9 @@ properties are intermediate between a font object and a font spec: like a font object, and unlike a font spec, it refers to a single, specific font. Unlike a font object, creating a font entity does not -load the contents of that font into computer memory. +load the contents of that font into computer memory. Emacs may open +multiple font objects of different sizes from a single font entity +referring to a scalable font. @defun find-font font-spec &optional frame This function returns a font entity that best matches the font spec ------------------------------------------------------------ revno: 113017 author: Lars Magne Ingebrigtsen <larsi@gnus.org> committer: Katsumi Yamaoka <yamaoka@jpl.org> branch nick: trunk timestamp: Mon 2013-06-17 10:51:54 +0000 message: lisp/gnus/mm-decode.el (mm-convert-shr-links): Override the shr local map, so that Gnus commands work lisp/gnus/shr.el (shr-render-td): Support horizontal alignment Make eww use `add-face-text-property', too lisp/gnus/shr.el (shr-make-overlay): Obsolete function lisp/gnus/eww.el (eww-put-color): Removed (eww-colorize-region): Use `add-face-text-property' Get correct presedence for font data lisp/gnus/shr.el (shr-add-font): Append face data, so that we get the correct presedence: The innermost value (which is applied first) wins diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2013-06-17 09:19:50 +0000 +++ lisp/gnus/ChangeLog 2013-06-17 10:51:54 +0000 @@ -1,5 +1,17 @@ 2013-06-17 Lars Magne Ingebrigtsen <larsi@gnus.org> + * mm-decode.el (mm-convert-shr-links): Override the shr local map, so + that Gnus commands work. + + * shr.el (shr-render-td): Support horizontal alignment. + + * eww.el (eww-put-color): Removed. + (eww-colorize-region): Use `add-face-text-property'. + + * shr.el (shr-add-font): Append face data, so that we get the correct + presedence: The innermost value (which is applied first) wins. + (shr-make-overlay): Obsolete function. + * mm-decode.el (mm-convert-shr-links): New function to convert new-style shr URL links into widgets. (mm-shr): Use it. === modified file 'lisp/gnus/eww.el' --- lisp/gnus/eww.el 2013-06-17 09:19:50 +0000 +++ lisp/gnus/eww.el 2013-06-17 10:51:54 +0000 @@ -172,12 +172,11 @@ (let ((new-colors (shr-color-check fg bg))) (when new-colors (when fg - (eww-put-color start end :foreground (cadr new-colors))) + (add-face-text-property start end + (list :foreground (cadr new-colors)))) (when bg - (eww-put-color start end :background (car new-colors))))))) - -(defun eww-put-color (start end type color) - (shr-put-color-1 start end type color)) + (add-face-text-property start end + (list :background (car new-colors)))))))) (defun eww-display-raw (charset) (let ((data (buffer-substring (point) (point-max)))) === modified file 'lisp/gnus/mm-decode.el' --- lisp/gnus/mm-decode.el 2013-06-17 09:36:28 +0000 +++ lisp/gnus/mm-decode.el 2013-06-17 10:51:54 +0000 @@ -1831,6 +1831,7 @@ :help-echo (get-text-property start 'help-echo) :keymap shr-map (get-text-property start 'shr-url)) + (put-text-property start end 'local-map nil) (setq start end))))) (defun mm-handle-filename (handle) === modified file 'lisp/gnus/shr.el' --- lisp/gnus/shr.el 2013-06-17 09:19:50 +0000 +++ lisp/gnus/shr.el 2013-06-17 10:51:54 +0000 @@ -609,11 +609,6 @@ (dolist (type types) (shr-add-font (or shr-start (point)) (point) type)))) -(defun shr-make-overlay (beg end &optional buffer front-advance rear-advance) - (let ((overlay (make-overlay beg end buffer front-advance rear-advance))) - (overlay-put overlay 'evaporate t) - overlay)) - ;; Add face to the region, but avoid putting the font properties on ;; blank text at the start of the line, and the newline at the end, to ;; avoid ugliness. @@ -623,7 +618,7 @@ (while (< (point) end) (when (bolp) (skip-chars-forward " ")) - (add-face-text-property (point) (min (line-end-position) end) type) + (add-face-text-property (point) (min (line-end-position) end) type t) (if (< (line-end-position) end) (forward-line 1) (goto-char end))))) @@ -843,32 +838,11 @@ (let ((new-colors (shr-color-check fg bg))) (when new-colors (when fg - (shr-put-color start end :foreground (cadr new-colors))) + (shr-add-font start end (list :foreground (cadr new-colors)))) (when bg - (shr-put-color start end :background (car new-colors)))) + (shr-add-font start end (list :background (car new-colors))))) new-colors))) -;; Put a color in the region, but avoid putting colors on blank -;; text at the start of the line, and the newline at the end, to avoid -;; ugliness. Also, don't overwrite any existing color information, -;; since this can be called recursively, and we want the "inner" color -;; to win. -(defun shr-put-color (start end type color) - (save-excursion - (goto-char start) - (while (< (point) end) - (when (and (bolp) - (not (eq type :background))) - (skip-chars-forward " ")) - (when (> (line-end-position) (point)) - (shr-put-color-1 (point) (min (line-end-position) end) type color)) - (if (< (line-end-position) end) - (forward-line 1) - (goto-char end))) - (when (and (eq type :background) - (= shr-table-depth 0)) - (shr-expand-newlines start end color)))) - (defun shr-expand-newlines (start end color) (save-restriction ;; Skip past all white space at the start and ends. @@ -919,24 +893,6 @@ 'before-string))))) (+ width previous-width)))) -(defun shr-put-color-1 (start end type color) - (let* ((old-props (get-text-property start 'face)) - (do-put (and (listp old-props) - (not (memq type old-props)))) - change) - (while (< start end) - (setq change (next-single-property-change start 'face nil end)) - (when do-put - (add-face-text-property start change (list type color))) - (setq old-props (get-text-property change 'face)) - (setq do-put (and (listp old-props) - (not (memq type old-props)))) - (setq start change)) - (when (and do-put - (> end start)) - (put-text-property start end 'face - (nconc (list type color old-props)))))) - ;;; Tag-specific rendering rules. (defun shr-tag-body (cont) @@ -1381,7 +1337,8 @@ (insert (make-string (string-width (car lines)) ? ) shr-table-vertical-line) (when (nth 4 column) - (shr-put-color start (1- (point)) :background (nth 4 column)))) + (shr-add-font start (1- (point)) + (list :background (nth 4 column))))) (forward-line 1))))) (shr-insert-table-ruler widths))) @@ -1492,11 +1449,23 @@ (if (zerop (buffer-size)) (insert (make-string width ? )) ;; Otherwise, fill the buffer. - (while (not (eobp)) - (end-of-line) - (when (> (- width (current-column)) 0) - (insert (make-string (- width (current-column)) ? ))) - (forward-line 1))) + (let ((align (cdr (assq :align cont))) + length) + (while (not (eobp)) + (end-of-line) + (setq length (- width (current-column))) + (when (> length 0) + (cond + ((equal align "right") + (beginning-of-line) + (insert (make-string length ? ))) + ((equal align "center") + (insert (make-string (/ length 2) ? )) + (beginning-of-line) + (insert (make-string (- length (/ length 2)) ? ))) + (t + (insert (make-string length ? ))))) + (forward-line 1)))) (when style (setq actual-colors (shr-colorize-region @@ -1567,7 +1536,7 @@ ;; Emacs less than 24.3 (unless (fboundp 'add-face-text-property) - (defun add-face-text-property (beg end face) + (defun add-face-text-property (beg end face &optional appendp object) "Combine FACE BEG and END." (let ((b beg)) (while (< b end) @@ -1578,9 +1547,13 @@ face) ((and (consp oldval) (not (keywordp (car oldval)))) - (cons face oldval)) + (if appendp + (nconc oldval (list face)) + (cons face oldval))) (t - (list face oldval))))))))) + (if appendp + (list oldval face) + (list face oldval)))))))))) (provide 'shr) ------------------------------------------------------------ revno: 113016 committer: Glenn Morris <rgm@gnu.org> branch nick: trunk timestamp: Mon 2013-06-17 06:17:40 -0400 message: Auto-commit of generated files. diff: === modified file 'autogen/configure' --- autogen/configure 2013-06-16 10:19:09 +0000 +++ autogen/configure 2013-06-17 10:17:40 +0000 @@ -7585,6 +7585,7 @@ # signed overflow has undefined behavior nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations + nw="$nw -Wbad-function-cast" # These casts are no worse than others. # Emacs doesn't care about shadowing; see # <http://lists.gnu.org/archive/html/emacs-diffs/2011-11/msg00265.html>. ------------------------------------------------------------ revno: 113015 committer: Katsumi Yamaoka <yamaoka@jpl.org> branch nick: trunk timestamp: Mon 2013-06-17 09:36:28 +0000 message: lisp/gnus/mm-decode.el (shr-map): Silence the byte compiler diff: === modified file 'lisp/gnus/mm-decode.el' --- lisp/gnus/mm-decode.el 2013-06-17 09:19:50 +0000 +++ lisp/gnus/mm-decode.el 2013-06-17 09:36:28 +0000 @@ -1817,6 +1817,8 @@ (delete-region ,(point-min-marker) ,(point-max-marker)))))))) +(defvar shr-map) + (defun mm-convert-shr-links () (let ((start (point-min)) end) ------------------------------------------------------------ revno: 113014 author: Lars Magne Ingebrigtsen <larsi@gnus.org> committer: Katsumi Yamaoka <yamaoka@jpl.org> branch nick: trunk timestamp: Mon 2013-06-17 09:19:50 +0000 message: Convert shr.el from using overlays into using text properties * eww.el (eww-mode-map): Use `shr-next-link' (etc) instead of the widget commands, since we're no longer using widgets for links. * mm-decode.el (mm-convert-shr-links): New function to convert new-style shr URL links into widgets. (mm-shr): Use it. * shr.el (shr-next-link): New command. (shr-previous-link): New command. (shr-urlify): Don't use `widget-convert', because that's slow. (shr-put-color-1): Use `add-face-text-property' instead of overlays, because collecting the overlays and reapplying them when generating tables is slow. (shr-insert-table): Ditto. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2013-06-17 00:49:49 +0000 +++ lisp/gnus/ChangeLog 2013-06-17 09:19:50 +0000 @@ -1,3 +1,20 @@ +2013-06-17 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * mm-decode.el (mm-convert-shr-links): New function to convert + new-style shr URL links into widgets. + (mm-shr): Use it. + + * eww.el (eww-mode-map): Use `shr-next-link' (etc) instead of the + widget commands, since we're no longer using widgets for links. + + * shr.el (shr-next-link): New command. + (shr-previous-link): New command. + (shr-urlify): Don't use `widget-convert', because that's slow. + (shr-put-color-1): Use `add-face-text-property' instead of overlays, + because collecting the overlays and reapplying them when generating + tables is slow. + (shr-insert-table): Ditto. + 2013-06-17 Stefan Monnier <monnier@iro.umontreal.ca> * sieve.el (sieve-edit-script): Avoid beginning-of-buffer. === modified file 'lisp/gnus/eww.el' --- lisp/gnus/eww.el 2013-06-17 00:49:49 +0000 +++ lisp/gnus/eww.el 2013-06-17 09:19:50 +0000 @@ -206,8 +206,8 @@ (suppress-keymap map) (define-key map "q" 'eww-quit) (define-key map "g" 'eww-reload) - (define-key map [tab] 'widget-forward) - (define-key map [backtab] 'widget-backward) + (define-key map [tab] 'shr-next-link) + (define-key map [backtab] 'shr-previous-link) (define-key map [delete] 'scroll-down-command) (define-key map "\177" 'scroll-down-command) (define-key map " " 'scroll-up-command) === modified file 'lisp/gnus/mm-decode.el' --- lisp/gnus/mm-decode.el 2013-05-23 05:05:27 +0000 +++ lisp/gnus/mm-decode.el 2013-06-17 09:19:50 +0000 @@ -1809,6 +1809,7 @@ (libxml-parse-html-region (point-min) (point-max)))) (unless (bobp) (insert "\n")) + (mm-convert-shr-links) (mm-handle-set-undisplayer handle `(lambda () @@ -1816,6 +1817,20 @@ (delete-region ,(point-min-marker) ,(point-max-marker)))))))) +(defun mm-convert-shr-links () + (let ((start (point-min)) + end) + (while (and start + (< start (point-max))) + (when (setq start (text-property-not-all start (point-max) 'shr-url nil)) + (setq end (next-single-property-change start 'shr-url nil (point-max))) + (widget-convert-button + 'url-link start end + :help-echo (get-text-property start 'help-echo) + :keymap shr-map + (get-text-property start 'shr-url)) + (setq start end))))) + (defun mm-handle-filename (handle) "Return filename of HANDLE if any." (or (mail-content-type-get (mm-handle-type handle) === modified file 'lisp/gnus/shr.el' --- lisp/gnus/shr.el 2013-06-17 00:49:49 +0000 +++ lisp/gnus/shr.el 2013-06-17 09:19:50 +0000 @@ -131,6 +131,8 @@ (define-key map "a" 'shr-show-alt-text) (define-key map "i" 'shr-browse-image) (define-key map "z" 'shr-zoom-image) + (define-key map [tab] 'shr-next-link) + (define-key map [backtab] 'shr-previous-link) (define-key map "I" 'shr-insert-image) (define-key map "u" 'shr-copy-url) (define-key map "v" 'shr-browse-url) @@ -217,6 +219,40 @@ (copy-region-as-kill (point-min) (point-max)) (message "Copied %s" url)))))) +(defun shr-next-link () + "Skip to the next link." + (interactive) + (let ((skip (text-property-any (point) (point-max) 'shr-url nil))) + (if (not (setq skip (text-property-not-all skip (point-max) + 'shr-url nil))) + (message "No next link") + (goto-char skip) + (message "%s" (get-text-property (point) 'help-echo))))) + +(defun shr-previous-link () + "Skip to the previous link." + (interactive) + (let ((start (point)) + (found nil)) + ;; Skip past the current link. + (while (and (not (bobp)) + (get-text-property (point) 'shr-url)) + (forward-char -1)) + ;; Find the previous link. + (while (and (not (bobp)) + (not (setq found (get-text-property (point) 'shr-url)))) + (forward-char -1)) + (if (not found) + (progn + (message "No previous link") + (goto-char start)) + ;; Put point at the start of the link. + (while (and (not (bobp)) + (get-text-property (point) 'shr-url)) + (forward-char -1)) + (forward-char 1) + (message "%s" (get-text-property (point) 'help-echo))))) + (defun shr-show-alt-text () "Show the ALT text of the image under point." (interactive) @@ -578,17 +614,16 @@ (overlay-put overlay 'evaporate t) overlay)) -;; Add an overlay in the region, but avoid putting the font properties -;; on blank text at the start of the line, and the newline at the end, -;; to avoid ugliness. +;; Add face to the region, but avoid putting the font properties on +;; 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 " ")) - (let ((overlay (shr-make-overlay (point) (min (line-end-position) end)))) - (overlay-put overlay 'face type)) + (add-face-text-property (point) (min (line-end-position) end) type) (if (< (line-end-position) end) (forward-line 1) (goto-char end))))) @@ -678,10 +713,7 @@ (> (car (image-size image t)) 400)) (insert "\n")) (if (eq size 'original) - (let ((overlays (overlays-at (point)))) - (insert-sliced-image image (or alt "*") nil 20 1) - (dolist (overlay overlays) - (overlay-put overlay 'face 'default))) + (insert-sliced-image image (or alt "*") nil 20 1) (insert-image image (or alt "*"))) (put-text-property start (point) 'image-size size) (when (cond ((fboundp 'image-multi-frame-p) @@ -769,16 +801,13 @@ (apply #'shr-fontize-cont cont types) (shr-ensure-paragraph)) -(autoload 'widget-convert-button "wid-edit") - (defun shr-urlify (start url &optional title) - (widget-convert-button - 'url-link start (point) - :help-echo (if title (format "%s (%s)" url title) url) - :keymap shr-map - url) (shr-add-font start (point) 'shr-link) - (put-text-property start (point) 'shr-url url)) + (add-text-properties + start (point) + (list 'shr-url url + 'local-map shr-map + 'help-echo (if title (format "%s (%s)" url title) url)))) (defun shr-encode-url (url) "Encode URL." @@ -860,7 +889,7 @@ (when (and (< (setq column (current-column)) width) (< (setq column (shr-previous-newline-padding-width column)) width)) - (let ((overlay (shr-make-overlay (point) (1+ (point))))) + (let ((overlay (make-overlay (point) (1+ (point))))) (overlay-put overlay 'before-string (concat (mapconcat @@ -898,8 +927,7 @@ (while (< start end) (setq change (next-single-property-change start 'face nil end)) (when do-put - (put-text-property start change 'face - (nconc (list type color) old-props))) + (add-face-text-property start change (list type color))) (setq old-props (get-text-property change 'face)) (setq do-put (and (listp old-props) (not (memq type old-props)))) @@ -1172,10 +1200,9 @@ (defun shr-tag-span (cont) (let ((title (cdr (assq :title cont)))) (shr-generic cont) - (when title - (when shr-start - (let ((overlay (shr-make-overlay shr-start (point)))) - (overlay-put overlay 'help-echo title)))))) + (when (and title + shr-start) + (put-text-property shr-start (point) 'help-echo title)))) (defun shr-tag-h1 (cont) (shr-heading cont 'bold 'underline)) @@ -1341,19 +1368,10 @@ (insert shr-table-vertical-line "\n")) (dolist (column row) (goto-char start) - (let ((lines (nth 2 column)) - (overlay-lines (nth 3 column)) - overlay overlay-line) + (let ((lines (nth 2 column))) (dolist (line lines) - (setq overlay-line (pop overlay-lines)) (end-of-line) (insert line shr-table-vertical-line) - (dolist (overlay overlay-line) - (let ((o (shr-make-overlay (- (point) (nth 0 overlay) 1) - (- (point) (nth 1 overlay) 1))) - (properties (nth 2 overlay))) - (while properties - (overlay-put o (pop properties) (pop properties))))) (forward-line 1)) ;; Add blank lines at padding at the bottom of the TD, ;; possibly. @@ -1441,7 +1459,7 @@ (fgcolor (cdr (assq :fgcolor cont))) (style (cdr (assq :style cont))) (shr-stylesheet shr-stylesheet) - overlays actual-colors) + actual-colors) (when style (setq style (and (string-match "color" style) (shr-parse-style style)))) @@ -1489,7 +1507,7 @@ (list max (count-lines (point-min) (point-max)) (split-string (buffer-string) "\n") - (shr-collect-overlays) + nil (car actual-colors)) max))))) @@ -1502,29 +1520,6 @@ (forward-line 1)) max)) -(defun shr-collect-overlays () - (save-excursion - (goto-char (point-min)) - (let ((overlays nil)) - (while (not (eobp)) - (push (shr-overlays-in-region (point) (line-end-position)) - overlays) - (forward-line 1)) - (nreverse overlays)))) - -(defun shr-overlays-in-region (start end) - (let (result) - (dolist (overlay (overlays-in start end)) - (push (list (if (> start (overlay-start overlay)) - (- end start) - (- end (overlay-start overlay))) - (if (< end (overlay-end overlay)) - 0 - (- end (overlay-end overlay))) - (overlay-properties overlay)) - result)) - (nreverse result))) - (defun shr-pro-rate-columns (columns) (let ((total-percentage 0) (widths (make-vector (length columns) 0))) @@ -1570,6 +1565,23 @@ (shr-count (cdr row) 'th)))))) max)) +;; Emacs less than 24.3 +(unless (fboundp 'add-face-text-property) + (defun add-face-text-property (beg end face) + "Combine FACE BEG and END." + (let ((b beg)) + (while (< b end) + (let ((oldval (get-text-property b 'face))) + (put-text-property + b (setq b (next-single-property-change b 'face nil end)) + 'face (cond ((null oldval) + face) + ((and (consp oldval) + (not (keywordp (car oldval)))) + (cons face oldval)) + (t + (list face oldval))))))))) + (provide 'shr) ;; Local Variables: ------------------------------------------------------------ revno: 113013 committer: Dmitry Gutov <dgutov@yandex.ru> branch nick: trunk timestamp: Mon 2013-06-17 10:24:08 +0400 message: * lisp/emacs-lisp/package.el (package-load-descriptor): Do not call `emacs-lisp-mode', just use its syntax table. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-17 01:09:13 +0000 +++ lisp/ChangeLog 2013-06-17 06:24:08 +0000 @@ -1,3 +1,8 @@ +2013-06-17 Dmitry Gutov <dgutov@yandex.ru> + + * emacs-lisp/package.el (package-load-descriptor): Do not call + `emacs-lisp-mode', just use its syntax table. + 2013-06-17 Juanma Barranquero <lekktu@gmail.com> * progmodes/prog-mode.el (prog-prettify-install): Add `composition' to === modified file 'lisp/emacs-lisp/package.el' --- lisp/emacs-lisp/package.el 2013-06-15 15:36:11 +0000 +++ lisp/emacs-lisp/package.el 2013-06-17 06:24:08 +0000 @@ -419,11 +419,11 @@ (when (file-exists-p pkg-file) (with-temp-buffer (insert-file-contents pkg-file) - (emacs-lisp-mode) (goto-char (point-min)) - (let ((pkg-desc (package-process-define-package - (read (current-buffer)) pkg-file))) - (setf (package-desc-dir pkg-desc) pkg-dir)))))) + (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))))))) (defun package-load-all-descriptors () "Load descriptors for installed Emacs Lisp packages. ------------------------------------------------------------ Use --include-merged or -n0 to see merged revisions.