------------------------------------------------------------ revno: 117905 fixes bug: http://debbugs.gnu.org/18265 committer: Dmitry Gutov branch nick: trunk timestamp: Fri 2014-09-19 07:41:42 +0400 message: Fix bug#18265 * lisp/emacs-lisp/lisp.el (lisp-completion-at-point): Only calculate `table-etc' when `end' is non-nil. (lisp-completion-at-point): Move `end' back if it's after quote. If in comment or string, only complete when after backquote. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-09-19 03:28:31 +0000 +++ lisp/ChangeLog 2014-09-19 03:41:42 +0000 @@ -2,6 +2,9 @@ * emacs-lisp/lisp.el (lisp-completion-at-point): Only calculate `table-etc' when `end' is non-nil. + (lisp-completion-at-point): Move `end' back if it's after quote. + If in comment or string, only complete when after backquote. + (Bug#18265) 2014-09-19 Dmitry Gutov === modified file 'lisp/emacs-lisp/lisp.el' --- lisp/emacs-lisp/lisp.el 2014-09-19 03:28:31 +0000 +++ lisp/emacs-lisp/lisp.el 2014-09-19 03:41:42 +0000 @@ -957,12 +957,14 @@ (save-excursion (goto-char beg) (forward-sexp 1) + (skip-chars-backward "'") (when (>= (point) pos) (point))) (scan-error pos)))) ;; t if in function position. (funpos (eq (char-before beg) ?\())) - (when end + (when (and end (or (not (nth 8 (syntax-ppss))) + (eq (char-before beg) ?`))) (let ((table-etc (if (not funpos) ;; FIXME: We could look at the first element of the list and ------------------------------------------------------------ revno: 117904 committer: Dmitry Gutov branch nick: trunk timestamp: Fri 2014-09-19 07:28:31 +0400 message: * lisp/emacs-lisp/lisp.el (lisp-completion-at-point): Only calculate `table-etc' when `end' is non-nil. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-09-19 03:10:29 +0000 +++ lisp/ChangeLog 2014-09-19 03:28:31 +0000 @@ -1,5 +1,10 @@ 2014-09-19 Dmitry Gutov + * emacs-lisp/lisp.el (lisp-completion-at-point): Only calculate + `table-etc' when `end' is non-nil. + +2014-09-19 Dmitry Gutov + * emacs-lisp/lisp.el (lisp--expect-function-p) (lisp--form-quoted-p): New functions. (lisp-completion-at-point): Use them to see if we're completing a === modified file 'lisp/emacs-lisp/lisp.el' --- lisp/emacs-lisp/lisp.el 2014-09-19 03:10:29 +0000 +++ lisp/emacs-lisp/lisp.el 2014-09-19 03:28:31 +0000 @@ -960,104 +960,105 @@ (when (>= (point) pos) (point))) (scan-error pos)))) - (funpos (eq (char-before beg) ?\()) ;t if in function position. - (table-etc - (if (not funpos) - ;; FIXME: We could look at the first element of the list and - ;; use it to provide a more specific completion table in some - ;; cases. E.g. filter out keywords that are not understood by - ;; the macro/function being called. - (cond - ((lisp--expect-function-p beg) - (list nil obarray - :predicate #'fboundp - :company-doc-buffer #'lisp--company-doc-buffer - :company-docsig #'lisp--company-doc-string - :company-location #'lisp--company-location)) - ((lisp--form-quoted-p beg) - (list nil (completion-table-merge - ;; FIXME: Is this table useful for this case? - lisp--local-variables-completion-table - (apply-partially #'completion-table-with-predicate - obarray - ;; Don't include all symbols - ;; (bug#16646). - (lambda (sym) - (or (boundp sym) - (fboundp sym) - (symbol-plist sym))) - 'strict)) - :annotation-function - (lambda (str) (if (fboundp (intern-soft str)) " ")) - :company-doc-buffer #'lisp--company-doc-buffer - :company-docsig #'lisp--company-doc-string - :company-location #'lisp--company-location)) - (t - (list nil (completion-table-merge - lisp--local-variables-completion-table - (apply-partially #'completion-table-with-predicate - obarray - #'boundp - 'strict)) - :company-doc-buffer #'lisp--company-doc-buffer - :company-docsig #'lisp--company-doc-string - :company-location #'lisp--company-location))) - ;; Looks like a funcall position. Let's double check. - (save-excursion - (goto-char (1- beg)) - (let ((parent - (condition-case nil - (progn (up-list -1) (forward-char 1) - (let ((c (char-after))) - (if (eq c ?\() ?\( - (if (memq (char-syntax c) '(?w ?_)) - (read (current-buffer)))))) - (error nil)))) - (pcase parent - ;; FIXME: Rather than hardcode special cases here, - ;; we should use something like a symbol-property. - (`declare - (list t (mapcar (lambda (x) (symbol-name (car x))) - (delete-dups - ;; FIXME: We should include some - ;; docstring with each entry. - (append - macro-declarations-alist - defun-declarations-alist))))) - ((and (or `condition-case `condition-case-unless-debug) - (guard (save-excursion - (ignore-errors - (forward-sexp 2) - (< (point) beg))))) - (list t obarray - :predicate (lambda (sym) (get sym 'error-conditions)))) - ((and ?\( - (guard (save-excursion - (goto-char (1- beg)) - (up-list -1) - (forward-symbol -1) - (looking-at "\\_")))) - (list t obarray - :predicate #'boundp - :company-doc-buffer #'lisp--company-doc-buffer - :company-docsig #'lisp--company-doc-string - :company-location #'lisp--company-location)) - (_ (list nil obarray - :predicate #'fboundp - :company-doc-buffer #'lisp--company-doc-buffer - :company-docsig #'lisp--company-doc-string - :company-location #'lisp--company-location - )))))))) + ;; t if in function position. + (funpos (eq (char-before beg) ?\())) (when end - (let ((tail (if (null (car table-etc)) - (cdr table-etc) - (cons - (if (memq (char-syntax (or (char-after end) ?\s)) - '(?\s ?>)) - (cadr table-etc) - (apply-partially 'completion-table-with-terminator - " " (cadr table-etc))) - (cddr table-etc))))) - `(,beg ,end ,@tail)))))) + (let ((table-etc + (if (not funpos) + ;; FIXME: We could look at the first element of the list and + ;; use it to provide a more specific completion table in some + ;; cases. E.g. filter out keywords that are not understood by + ;; the macro/function being called. + (cond + ((lisp--expect-function-p beg) + (list nil obarray + :predicate #'fboundp + :company-doc-buffer #'lisp--company-doc-buffer + :company-docsig #'lisp--company-doc-string + :company-location #'lisp--company-location)) + ((lisp--form-quoted-p beg) + (list nil (completion-table-merge + ;; FIXME: Is this table useful for this case? + lisp--local-variables-completion-table + (apply-partially #'completion-table-with-predicate + obarray + ;; Don't include all symbols + ;; (bug#16646). + (lambda (sym) + (or (boundp sym) + (fboundp sym) + (symbol-plist sym))) + 'strict)) + :annotation-function + (lambda (str) (if (fboundp (intern-soft str)) " ")) + :company-doc-buffer #'lisp--company-doc-buffer + :company-docsig #'lisp--company-doc-string + :company-location #'lisp--company-location)) + (t + (list nil (completion-table-merge + lisp--local-variables-completion-table + (apply-partially #'completion-table-with-predicate + obarray + #'boundp + 'strict)) + :company-doc-buffer #'lisp--company-doc-buffer + :company-docsig #'lisp--company-doc-string + :company-location #'lisp--company-location))) + ;; Looks like a funcall position. Let's double check. + (save-excursion + (goto-char (1- beg)) + (let ((parent + (condition-case nil + (progn (up-list -1) (forward-char 1) + (let ((c (char-after))) + (if (eq c ?\() ?\( + (if (memq (char-syntax c) '(?w ?_)) + (read (current-buffer)))))) + (error nil)))) + (pcase parent + ;; FIXME: Rather than hardcode special cases here, + ;; we should use something like a symbol-property. + (`declare + (list t (mapcar (lambda (x) (symbol-name (car x))) + (delete-dups + ;; FIXME: We should include some + ;; docstring with each entry. + (append + macro-declarations-alist + defun-declarations-alist))))) + ((and (or `condition-case `condition-case-unless-debug) + (guard (save-excursion + (ignore-errors + (forward-sexp 2) + (< (point) beg))))) + (list t obarray + :predicate (lambda (sym) (get sym 'error-conditions)))) + ((and ?\( + (guard (save-excursion + (goto-char (1- beg)) + (up-list -1) + (forward-symbol -1) + (looking-at "\\_")))) + (list t obarray + :predicate #'boundp + :company-doc-buffer #'lisp--company-doc-buffer + :company-docsig #'lisp--company-doc-string + :company-location #'lisp--company-location)) + (_ (list nil obarray + :predicate #'fboundp + :company-doc-buffer #'lisp--company-doc-buffer + :company-docsig #'lisp--company-doc-string + :company-location #'lisp--company-location + )))))))) + (nconc (list beg end) + (if (null (car table-etc)) + (cdr table-etc) + (cons + (if (memq (char-syntax (or (char-after end) ?\s)) + '(?\s ?>)) + (cadr table-etc) + (apply-partially 'completion-table-with-terminator + " " (cadr table-etc))) + (cddr table-etc))))))))) ;;; lisp.el ends here ------------------------------------------------------------ revno: 117903 committer: Dmitry Gutov branch nick: trunk timestamp: Fri 2014-09-19 07:10:29 +0400 message: Make lisp-completion-at-point more discerning * lisp/emacs-lisp/lisp.el (lisp--expect-function-p) (lisp--form-quoted-p): New functions. (lisp-completion-at-point): Use them to see if we're completing a variable reference, a function name, or just any symbol. http://lists.gnu.org/archive/html/emacs-devel/2014-02/msg00229.html diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-09-18 19:18:34 +0000 +++ lisp/ChangeLog 2014-09-19 03:10:29 +0000 @@ -1,3 +1,11 @@ +2014-09-19 Dmitry Gutov + + * emacs-lisp/lisp.el (lisp--expect-function-p) + (lisp--form-quoted-p): New functions. + (lisp-completion-at-point): Use them to see if we're completing a + variable reference, a function name, or just any symbol. + http://lists.gnu.org/archive/html/emacs-devel/2014-02/msg00229.html + 2014-09-18 Ivan Kanis * net/shr.el, net/eww.el: Don't override `shr-width', but === modified file 'lisp/emacs-lisp/lisp.el' --- lisp/emacs-lisp/lisp.el 2014-07-04 02:00:54 +0000 +++ lisp/emacs-lisp/lisp.el 2014-09-19 03:10:29 +0000 @@ -848,6 +848,46 @@ (mapcar #'symbol-name (lisp--local-variables)))))) lastvars))))) +(defun lisp--expect-function-p (pos) + "Return non-nil if the symbol at point is expected to be a function." + (or + (and (eq (char-before pos) ?') + (eq (char-before (1- pos)) ?#)) + (save-excursion + (let ((parent (nth 1 (syntax-ppss pos)))) + (when parent + (goto-char parent) + (and + (looking-at (concat "(\\(cl-\\)?" + (regexp-opt '("declare-function" + "function" "defadvice" + "callf" "callf2" + "defsetf")) + "[ \t\r\n]+")) + (eq (match-end 0) pos))))))) + +(defun lisp--form-quoted-p (pos) + "Return non-nil if the form at POS is not evaluated. +It can be quoted, or be inside a quoted form." + ;; FIXME: Do some macro expansion maybe. + (save-excursion + (let ((state (syntax-ppss pos))) + (or (nth 8 state) ; Code inside strings usually isn't evaluated. + ;; FIXME: The 9th element is undocumented. + (let ((nesting (cons (point) (reverse (nth 9 state)))) + res) + (while (and nesting (not res)) + (goto-char (pop nesting)) + (cond + ((or (eq (char-after) ?\[) + (progn + (skip-chars-backward " ") + (memq (char-before) '(?' ?`)))) + (setq res t)) + ((eq (char-before) ?,) + (setq nesting nil)))) + res))))) + ;; FIXME: Support for Company brings in features which straddle eldoc. ;; We should consolidate this, so that major modes can provide all that ;; data all at once: @@ -927,22 +967,41 @@ ;; use it to provide a more specific completion table in some ;; cases. E.g. filter out keywords that are not understood by ;; the macro/function being called. - (list nil (completion-table-merge - lisp--local-variables-completion-table - (apply-partially #'completion-table-with-predicate - obarray - ;; Don't include all symbols - ;; (bug#16646). - (lambda (sym) - (or (boundp sym) - (fboundp sym) - (symbol-plist sym))) - 'strict)) + (cond + ((lisp--expect-function-p beg) + (list nil obarray + :predicate #'fboundp + :company-doc-buffer #'lisp--company-doc-buffer + :company-docsig #'lisp--company-doc-string + :company-location #'lisp--company-location)) + ((lisp--form-quoted-p beg) + (list nil (completion-table-merge + ;; FIXME: Is this table useful for this case? + lisp--local-variables-completion-table + (apply-partially #'completion-table-with-predicate + obarray + ;; Don't include all symbols + ;; (bug#16646). + (lambda (sym) + (or (boundp sym) + (fboundp sym) + (symbol-plist sym))) + 'strict)) :annotation-function (lambda (str) (if (fboundp (intern-soft str)) " ")) :company-doc-buffer #'lisp--company-doc-buffer :company-docsig #'lisp--company-doc-string - :company-location #'lisp--company-location) + :company-location #'lisp--company-location)) + (t + (list nil (completion-table-merge + lisp--local-variables-completion-table + (apply-partially #'completion-table-with-predicate + obarray + #'boundp + 'strict)) + :company-doc-buffer #'lisp--company-doc-buffer + :company-docsig #'lisp--company-doc-string + :company-location #'lisp--company-location))) ;; Looks like a funcall position. Let's double check. (save-excursion (goto-char (1- beg)) ------------------------------------------------------------ revno: 117902 author: Ivan Kanis committer: Lars Magne Ingebrigtsen branch nick: trunk timestamp: Thu 2014-09-18 21:18:34 +0200 message: Allow users to specify `shr-width' * net/shr.el, net/eww.el: Don't override `shr-width', but introduce a new variable `shr-internal-width'. This allows users to specify a width themselves. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-09-18 18:38:05 +0000 +++ lisp/ChangeLog 2014-09-18 19:18:34 +0000 @@ -1,3 +1,9 @@ +2014-09-18 Ivan Kanis + + * net/shr.el, net/eww.el: Don't override `shr-width', but + introduce a new variable `shr-internal-width'. This allows users + to specify a width themselves. + 2014-09-18 Lars Magne Ingebrigtsen * image-mode.el (image-toggle-display-image): If we have a === modified file 'lisp/net/eww.el' --- lisp/net/eww.el 2014-08-05 18:15:52 +0000 +++ lisp/net/eww.el 2014-09-18 19:18:34 +0000 @@ -270,7 +270,6 @@ (setq eww-current-dom document) (let ((inhibit-read-only t) (after-change-functions nil) - (shr-width nil) (shr-target-id (url-target (url-generic-parse-url url))) (shr-external-rendering-functions '((title . eww-tag-title) === modified file 'lisp/net/shr.el' --- lisp/net/shr.el 2014-08-28 01:59:29 +0000 +++ lisp/net/shr.el 2014-09-18 19:18:34 +0000 @@ -130,6 +130,7 @@ (defvar shr-start nil) (defvar shr-indentation 0) (defvar shr-inhibit-images nil) +(defvar shr-internal-width (or shr-width (1- (window-width)))) (defvar shr-list-mode nil) (defvar shr-content-cache nil) (defvar shr-kinsoku-shorten nil) @@ -197,7 +198,7 @@ (shr-state nil) (shr-start nil) (shr-base nil) - (shr-width (or shr-width (1- (window-width))))) + (shr-internal-width (or shr-width (1- (window-width))))) (shr-descend (shr-transform-dom dom)) (shr-remove-trailing-whitespace start (point)))) @@ -471,8 +472,8 @@ (insert elem) (setq shr-state nil) (let (found) - (while (and (> (current-column) shr-width) - (> shr-width 0) + (while (and (> (current-column) shr-internal-width) + (> shr-internal-width 0) (progn (setq found (shr-find-fill-point)) (not (eolp)))) @@ -486,10 +487,10 @@ (when (> shr-indentation 0) (shr-indent)) (end-of-line)) - (if (<= (current-column) shr-width) + (if (<= (current-column) shr-internal-width) (insert " ") ;; In case we couldn't get a valid break point (because of a - ;; word that's longer than `shr-width'), just break anyway. + ;; word that's longer than `shr-internal-width'), just break anyway. (insert "\n") (when (> shr-indentation 0) (shr-indent))))) @@ -497,7 +498,7 @@ (delete-char -1))))) (defun shr-find-fill-point () - (when (> (move-to-column shr-width) shr-width) + (when (> (move-to-column shr-internal-width) shr-internal-width) (backward-char 1)) (let ((bp (point)) failed) @@ -537,7 +538,7 @@ ;; so we look for the second best position. (while (and (progn (forward-char 1) - (<= (current-column) shr-width)) + (<= (current-column) shr-internal-width)) (progn (setq bp (point)) (shr-char-kinsoku-eol-p (following-char))))) @@ -1344,7 +1345,7 @@ (defun shr-tag-hr (_cont) (shr-ensure-newline) - (insert (make-string shr-width shr-hr-line) "\n")) + (insert (make-string shr-internal-width shr-hr-line) "\n")) (defun shr-tag-title (cont) (shr-heading cont 'bold 'underline)) @@ -1637,7 +1638,7 @@ (setq style (nconc (list (cons 'color fgcolor)) style))) (when style (setq shr-stylesheet (append style shr-stylesheet))) - (let ((shr-width width) + (let ((shr-internal-width width) (shr-indentation 0)) (shr-descend (cons 'td cont))) ;; Delete padding at the bottom of the TDs. @@ -1709,7 +1710,8 @@ (dotimes (i (length columns)) (aset widths i (max (truncate (* (aref columns i) total-percentage - (- shr-width (1+ (length columns))))) + (- shr-internal-width + (1+ (length columns))))) 10))) widths)) ------------------------------------------------------------ revno: 117901 committer: Lars Magne Ingebrigtsen branch nick: trunk timestamp: Thu 2014-09-18 20:38:05 +0200 message: * image-mode.el: Move defvars earlier to avoid a byte-compilation warning. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-09-18 18:34:59 +0000 +++ lisp/ChangeLog 2014-09-18 18:38:05 +0000 @@ -4,6 +4,8 @@ `fit-width' or a `fit-height', don't limit the size of the image to the window size, because that doesn't preserve the aspect ratio. + * image-mode.el: Move defvars earlier to avoid a byte-compilation + warning. 2014-09-17 Reuben Thomas === modified file 'lisp/image-mode.el' --- lisp/image-mode.el 2014-09-18 18:34:59 +0000 +++ lisp/image-mode.el 2014-09-18 18:38:05 +0000 @@ -49,6 +49,26 @@ "Special hook run when image data is requested in a new window. It is called with one argument, the initial WINPROPS.") +;; FIXME this doesn't seem mature yet. Document in manual when it is. +(defvar image-transform-resize nil + "The image resize operation. +Its value should be one of the following: + - nil, meaning no resizing. + - `fit-height', meaning to fit the image to the window height. + - `fit-width', meaning to fit the image to the window width. + - A number, which is a scale factor (the default size is 1).") + +(defvar image-transform-scale 1.0 + "The scale factor of the image being displayed.") + +(defvar image-transform-rotation 0.0 + "Rotation angle for the image in the current Image mode buffer.") + +(defvar image-transform-right-angle-fudge 0.0001 + "Snap distance to a multiple of a right angle. +There's no deep theory behind the default value, it should just +be somewhat larger than ImageMagick's MagickEpsilon.") + (defun image-mode-winprops (&optional window cleanup) "Return winprops of WINDOW. A winprops object has the shape (WINDOW . ALIST). @@ -905,26 +925,6 @@ ;; nil "image-transform" image-transform-minor-mode-map) -;; FIXME this doesn't seem mature yet. Document in manual when it is. -(defvar image-transform-resize nil - "The image resize operation. -Its value should be one of the following: - - nil, meaning no resizing. - - `fit-height', meaning to fit the image to the window height. - - `fit-width', meaning to fit the image to the window width. - - A number, which is a scale factor (the default size is 1).") - -(defvar image-transform-scale 1.0 - "The scale factor of the image being displayed.") - -(defvar image-transform-rotation 0.0 - "Rotation angle for the image in the current Image mode buffer.") - -(defvar image-transform-right-angle-fudge 0.0001 - "Snap distance to a multiple of a right angle. -There's no deep theory behind the default value, it should just -be somewhat larger than ImageMagick's MagickEpsilon.") - (defsubst image-transform-width (width height) "Return the bounding box width of a rotated WIDTH x HEIGHT rectangle. The rotation angle is the value of `image-transform-rotation' in degrees." ------------------------------------------------------------ revno: 117900 committer: Lars Magne Ingebrigtsen branch nick: trunk timestamp: Thu 2014-09-18 20:34:59 +0200 message: Preserve the aspect ratio when fitting to width/height * image-mode.el (image-toggle-display-image): If we have a `fit-width' or a `fit-height', don't limit the size of the image to the window size, because that doesn't preserve the aspect ratio. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-09-17 09:17:27 +0000 +++ lisp/ChangeLog 2014-09-18 18:34:59 +0000 @@ -1,3 +1,10 @@ +2014-09-18 Lars Magne Ingebrigtsen + + * image-mode.el (image-toggle-display-image): If we have a + `fit-width' or a `fit-height', don't limit the size of the image + to the window size, because that doesn't preserve the aspect + ratio. + 2014-09-17 Reuben Thomas * progmodes/js.el: Add interpreter-mode-alist support for various === modified file 'lisp/image-mode.el' --- lisp/image-mode.el 2014-08-12 14:16:45 +0000 +++ lisp/image-mode.el 2014-09-18 18:34:59 +0000 @@ -642,14 +642,19 @@ (string-make-unibyte (buffer-substring-no-properties (point-min) (point-max))) filename)) - (edges (window-inside-pixel-edges - (get-buffer-window (current-buffer)))) + ;; If we have a `fit-width' or a `fit-height', don't limit + ;; the size of the image to the window size. + (edges (and (null image-transform-resize) + (window-inside-pixel-edges + (get-buffer-window (current-buffer))))) (type (if (fboundp 'imagemagick-types) 'imagemagick (image-type file-or-data nil data-p))) - (image (create-image file-or-data type data-p - :max-width (- (nth 2 edges) (nth 0 edges)) - :max-height (- (nth 3 edges) (nth 1 edges)))) + (image (if (not edges) + (create-image file-or-data type data-p) + (create-image file-or-data type data-p + :max-width (- (nth 2 edges) (nth 0 edges)) + :max-height (- (nth 3 edges) (nth 1 edges))))) (inhibit-read-only t) (buffer-undo-list t) (modified (buffer-modified-p)) ------------------------------------------------------------ revno: 117899 committer: Dmitry Antipov branch nick: trunk timestamp: Thu 2014-09-18 15:34:24 +0400 message: More and more stack-allocated Lisp objects if USE_LOCAL_ALLOCATORS. * lisp.h (local_list4) [USE_LOCAL_ALLOCATORS]: New macro. [!USE_LOCAL_ALLOCATORS]: Fall back to regular list4. * frame.h (FRAME_PARAMETER): New macro. * dispnew.c (init_display): * fontset.c (Fset_fontset_font): * frame.c (x_default_parameter): * xfaces.c (set_font_frame_param, Finternal_merge_in_global_face): * xfns.c (x_default_scroll_bar_color_parameter) (x_default_font_parameter, x_create_tip_frame): Use it. * editfns.c (Fpropertize): Use local_cons. * process.c (status_message): Use build_local_string. * xfont.c (xfont_open): Use make_local_string. * xdisp.c (build_desired_tool_bar_string): Use local_list4. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2014-09-18 05:40:17 +0000 +++ src/ChangeLog 2014-09-18 11:34:24 +0000 @@ -1,3 +1,20 @@ +2014-09-18 Dmitry Antipov + + More and more stack-allocated Lisp objects if USE_LOCAL_ALLOCATORS. + * lisp.h (local_list4) [USE_LOCAL_ALLOCATORS]: New macro. + [!USE_LOCAL_ALLOCATORS]: Fall back to regular list4. + * frame.h (FRAME_PARAMETER): New macro. + * dispnew.c (init_display): + * fontset.c (Fset_fontset_font): + * frame.c (x_default_parameter): + * xfaces.c (set_font_frame_param, Finternal_merge_in_global_face): + * xfns.c (x_default_scroll_bar_color_parameter) + (x_default_font_parameter, x_create_tip_frame): Use it. + * editfns.c (Fpropertize): Use local_cons. + * process.c (status_message): Use build_local_string. + * xfont.c (xfont_open): Use make_local_string. + * xdisp.c (build_desired_tool_bar_string): Use local_list4. + 2014-09-18 Paul Eggert Port USE_LOCAL_ALLOCATORS code to clang 3.4 x86-64. === modified file 'src/dispnew.c' --- src/dispnew.c 2014-09-08 06:00:58 +0000 +++ src/dispnew.c 2014-09-18 11:34:24 +0000 @@ -6098,14 +6098,14 @@ /* Update frame parameters to reflect the new type. */ Fmodify_frame_parameters - (selected_frame, list1 (Fcons (Qtty_type, - Ftty_type (selected_frame)))); + (selected_frame, FRAME_PARAMETER (Qtty_type, + Ftty_type (selected_frame))); if (t->display_info.tty->name) Fmodify_frame_parameters (selected_frame, - list1 (Fcons (Qtty, build_string (t->display_info.tty->name)))); + FRAME_PARAMETER (Qtty, build_string (t->display_info.tty->name))); else - Fmodify_frame_parameters (selected_frame, list1 (Fcons (Qtty, Qnil))); + Fmodify_frame_parameters (selected_frame, FRAME_PARAMETER (Qtty, Qnil)); } { === modified file 'src/editfns.c' --- src/editfns.c 2014-09-15 14:53:23 +0000 +++ src/editfns.c 2014-09-18 11:34:24 +0000 @@ -3547,7 +3547,7 @@ string = Fcopy_sequence (args[0]); for (i = 1; i < nargs; i += 2) - properties = Fcons (args[i], Fcons (args[i + 1], properties)); + properties = local_cons (args[i], local_cons (args[i + 1], properties)); Fadd_text_properties (make_number (0), make_number (SCHARS (string)), === modified file 'src/fontset.c' --- src/fontset.c 2014-09-15 14:53:23 +0000 +++ src/fontset.c 2014-09-18 11:34:24 +0000 @@ -1598,7 +1598,7 @@ if (! NILP (font_object)) { update_auto_fontset_alist (font_object, fontset); - alist = list1 (Fcons (Qfont, Fcons (name, font_object))); + alist = FRAME_PARAMETER (Qfont, Fcons (name, font_object)); Fmodify_frame_parameters (fr, alist); } } === modified file 'src/frame.c' --- src/frame.c 2014-09-16 08:20:08 +0000 +++ src/frame.c 2014-09-18 11:34:24 +0000 @@ -4274,7 +4274,7 @@ tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type); if (EQ (tem, Qunbound)) tem = deflt; - x_set_frame_parameters (f, list1 (Fcons (prop, tem))); + x_set_frame_parameters (f, FRAME_PARAMETER (prop, tem)); return tem; } === modified file 'src/frame.h' --- src/frame.h 2014-09-11 19:44:25 +0000 +++ src/frame.h 2014-09-18 11:34:24 +0000 @@ -1060,6 +1060,11 @@ } \ } while (false) +/* Handy macro to construct an argument to Fmodify_frame_parameters. */ + +#define FRAME_PARAMETER(parameter, value) \ + local_list1 (scoped_cons (parameter, value)) + /* False means there are no visible garbaged frames. */ extern bool frame_garbaged; === modified file 'src/lisp.h' --- src/lisp.h 2014-09-18 05:40:17 +0000 +++ src/lisp.h 2014-09-18 11:34:24 +0000 @@ -4623,6 +4623,7 @@ # define local_list1(x) local_cons (x, Qnil) # define local_list2(x, y) local_cons (x, local_list1 (y)) # define local_list3(x, y, z) local_cons (x, local_list2 (y, z)) +# define local_list4(x, y, z, t) local_cons (x, local_list3 (y, z, t)) /* Return a function-scoped vector of length SIZE, with each element being INIT. */ @@ -4673,6 +4674,7 @@ # define local_list1(x) list1 (x) # define local_list2(x, y) list2 (x, y) # define local_list3(x, y, z) list3 (x, y, z) +# define local_list4(x, y, z, t) list4 (x, y, z, t) # define make_local_vector(size, init) Fmake_vector (make_number (size), init) # define make_local_string(data, nbytes) make_string (data, nbytes) # define build_local_string(data) build_string (data) === modified file 'src/process.c' --- src/process.c 2014-09-17 15:34:37 +0000 +++ src/process.c 2014-09-18 11:34:24 +0000 @@ -638,7 +638,7 @@ { string = Fnumber_to_string (make_number (code)); string2 = build_local_string ("\n"); - return concat3 (build_string ("failed with code "), + return concat3 (build_local_string ("failed with code "), string, string2); } else === modified file 'src/xdisp.c' --- src/xdisp.c 2014-09-16 11:43:49 +0000 +++ src/xdisp.c 2014-09-18 11:34:24 +0000 @@ -12061,7 +12061,7 @@ (f, Fmake_string (make_number (size_needed), make_number (' '))); else { - props = list4 (Qdisplay, Qnil, Qmenu_item, Qnil); + props = local_list4 (Qdisplay, Qnil, Qmenu_item, Qnil); Fremove_text_properties (make_number (0), make_number (size), props, f->desired_tool_bar_string); } @@ -12174,8 +12174,8 @@ the start of this item's properties in the tool-bar items vector. */ image = Fcons (Qimage, plist); - props = list4 (Qdisplay, image, - Qmenu_item, make_number (i * TOOL_BAR_ITEM_NSLOTS)); + props = local_list4 (Qdisplay, image, Qmenu_item, + make_number (i * TOOL_BAR_ITEM_NSLOTS)); /* Let the last image hide all remaining spaces in the tool bar string. The string can be longer than needed when we reuse a === modified file 'src/xfaces.c' --- src/xfaces.c 2014-09-07 07:04:01 +0000 +++ src/xfaces.c 2014-09-18 11:34:24 +0000 @@ -3398,7 +3398,7 @@ ASET (lface, LFACE_FONT_INDEX, font); } f->default_face_done_p = 0; - Fmodify_frame_parameters (frame, list1 (Fcons (Qfont, font))); + Fmodify_frame_parameters (frame, FRAME_PARAMETER (Qfont, font)); } } @@ -3787,18 +3787,18 @@ && newface->font) { Lisp_Object name = newface->font->props[FONT_NAME_INDEX]; - Fmodify_frame_parameters (frame, list1 (Fcons (Qfont, name))); + Fmodify_frame_parameters (frame, FRAME_PARAMETER (Qfont, name)); } if (STRINGP (gvec[LFACE_FOREGROUND_INDEX])) - Fmodify_frame_parameters (frame, - list1 (Fcons (Qforeground_color, - gvec[LFACE_FOREGROUND_INDEX]))); + Fmodify_frame_parameters + (frame, FRAME_PARAMETER (Qforeground_color, + gvec[LFACE_FOREGROUND_INDEX])); if (STRINGP (gvec[LFACE_BACKGROUND_INDEX])) - Fmodify_frame_parameters (frame, - list1 (Fcons (Qbackground_color, - gvec[LFACE_BACKGROUND_INDEX]))); + Fmodify_frame_parameters + (frame, FRAME_PARAMETER (Qbackground_color, + gvec[LFACE_BACKGROUND_INDEX])); } } === modified file 'src/xfns.c' --- src/xfns.c 2014-09-16 08:20:08 +0000 +++ src/xfns.c 2014-09-18 11:34:24 +0000 @@ -1595,7 +1595,7 @@ #endif /* not USE_TOOLKIT_SCROLL_BARS */ } - x_set_frame_parameters (f, list1 (Fcons (prop, tem))); + x_set_frame_parameters (f, FRAME_PARAMETER (prop, tem)); return tem; } @@ -2846,7 +2846,7 @@ { /* Remember the explicit font parameter, so we can re-apply it after we've applied the `default' face settings. */ - x_set_frame_parameters (f, list1 (Fcons (Qfont_param, font_param))); + x_set_frame_parameters (f, FRAME_PARAMETER (Qfont_param, font_param)); } /* This call will make X resources override any system font setting. */ @@ -5036,7 +5036,7 @@ /* Add `tooltip' frame parameter's default value. */ if (NILP (Fframe_parameter (frame, Qtooltip))) - Fmodify_frame_parameters (frame, list1 (Fcons (Qtooltip, Qt))); + Fmodify_frame_parameters (frame, FRAME_PARAMETER (Qtooltip, Qt)); /* FIXME - can this be done in a similar way to normal frames? http://lists.gnu.org/archive/html/emacs-devel/2007-10/msg00641.html */ @@ -5054,7 +5054,8 @@ disptype = intern ("color"); if (NILP (Fframe_parameter (frame, Qdisplay_type))) - Fmodify_frame_parameters (frame, list1 (Fcons (Qdisplay_type, disptype))); + Fmodify_frame_parameters + (frame, FRAME_PARAMETER (Qdisplay_type, disptype)); } /* Set up faces after all frame parameters are known. This call @@ -5073,7 +5074,7 @@ call2 (Qface_set_after_frame_default, frame, Qnil); if (!EQ (bg, Fframe_parameter (frame, Qbackground_color))) - Fmodify_frame_parameters (frame, list1 (Fcons (Qbackground_color, bg))); + Fmodify_frame_parameters (frame, FRAME_PARAMETER (Qbackground_color, bg)); } f->no_split = 1; === modified file 'src/xfont.c' --- src/xfont.c 2014-08-25 07:00:42 +0000 +++ src/xfont.c 2014-09-18 11:34:24 +0000 @@ -775,7 +775,7 @@ if (dashes >= 13) { len = xfont_decode_coding_xlfd (p0, -1, name); - fullname = Fdowncase (make_string (name, len)); + fullname = Fdowncase (make_local_string (name, len)); } XFree (p0); } ------------------------------------------------------------ revno: 117898 committer: Paul Eggert branch nick: trunk timestamp: Wed 2014-09-17 22:40:17 -0700 message: Port USE_LOCAL_ALLOCATORS code to clang 3.4 x86-64. Revert previous lisp.h change, and install the following instead. * lisp.h (USE_LOCAL_ALLOCATORS): Define only if __GNUC__ && !__clang__. This works with GCC and with clang and is safer for compilers we don't know about. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2014-09-18 01:03:40 +0000 +++ src/ChangeLog 2014-09-18 05:40:17 +0000 @@ -1,9 +1,9 @@ 2014-09-18 Paul Eggert Port USE_LOCAL_ALLOCATORS code to clang 3.4 x86-64. - * lisp.h (ALLOCA_FIXUP): New constant. - (LOCAL_ALLOCA): New macro. - (local_cons, make_local_vector, make_local_string): Use them. + * lisp.h (USE_LOCAL_ALLOCATORS): Define only if __GNUC__ && + !__clang__. This works with GCC and with clang and is safer for + compilers we don't know about. (local_cons): Rename parameter to make capture less likely. 2014-09-17 Samuel Bronson === modified file 'src/lisp.h' --- src/lisp.h 2014-09-18 01:03:40 +0000 +++ src/lisp.h 2014-09-18 05:40:17 +0000 @@ -4599,30 +4599,22 @@ # define scoped_list3(x, y, z) list3 (x, y, z) #endif -#if USE_STACK_LISP_OBJECTS && HAVE_STATEMENT_EXPRESSIONS - +/* Local allocators require both statement expressions and a + GCALIGNMENT-aligned alloca. clang's alloca isn't properly aligned + in some cases. In the absence of solid information, play it safe + for other non-GCC compilers. */ +#if (USE_STACK_LISP_OBJECTS && HAVE_STATEMENT_EXPRESSIONS \ + && __GNUC__ && !__clang__) # define USE_LOCAL_ALLOCATORS - -/* Alignment fixup needed for alloca. GCC aligns alloca properly already, - Clang sometimes doesn't, and play it safe for other random compilers. */ -# if __GNUC__ && !__clang__ -enum { ALLOCA_FIXUP = 0 }; -# else -enum { ALLOCA_FIXUP = GCALIGNMENT - 1 }; -# endif - -/* Declare a void * variable PTR and set it to a properly-aligned array of - N newly allocated bytes with function lifetime. */ -# define LOCAL_ALLOCA(ptr, n) \ - void *ptr = alloca ((n) + ALLOCA_FIXUP); \ - ptr = (void *) ((intptr_t) ptr_ & ~(ALLOCA_FIXUP)) +#endif + +#ifdef USE_LOCAL_ALLOCATORS /* Return a function-scoped cons whose car is X and cdr is Y. */ # define local_cons(x, y) \ ({ \ - LOCAL_ALLOCA (ptr_, sizeof (struct Lisp_Cons)); \ - struct Lisp_Cons *c_ = ptr_; \ + struct Lisp_Cons *c_ = alloca (sizeof (struct Lisp_Cons)); \ c_->car = (x); \ c_->u.cdr = (y); \ make_lisp_ptr (c_, Lisp_Cons); \ @@ -4640,9 +4632,9 @@ ptrdiff_t size_ = size; \ Lisp_Object init_ = init; \ Lisp_Object vec_; \ - if (size_ <= (MAX_ALLOCA - ALLOCA_FIXUP - header_size) / word_size) \ + if (size_ <= (MAX_ALLOCA - header_size) / word_size) \ { \ - LOCAL_ALLOCA (ptr_, size_ * word_size + header_size); \ + void *ptr_ = alloca (size_ * word_size + header_size); \ vec_ = local_vector_init (ptr_, size_, init_); \ } \ else \ @@ -4657,10 +4649,10 @@ char const *data_ = data; \ ptrdiff_t nbytes_ = nbytes; \ Lisp_Object string_; \ - if (nbytes_ \ - <= MAX_ALLOCA - ALLOCA_FIXUP - sizeof (struct Lisp_String) - 1) \ + if (nbytes_ <= MAX_ALLOCA - sizeof (struct Lisp_String) - 1) \ { \ - LOCAL_ALLOCA (ptr_, sizeof (struct Lisp_String) + 1 + bytes_); \ + struct Lisp_String *ptr_ \ + = alloca (sizeof (struct Lisp_String) + 1 + nbytes_); \ string_ = local_string_init (ptr_, data_, nbytes_); \ } \ else \