Now on revision 114075. ------------------------------------------------------------ revno: 114075 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2013-08-29 17:00:18 -0400 message: * lisp/textmodes/css-mode.el: Use SMIE. (css-smie-grammar): New var. (css-smie--forward-token, css-smie--backward-token) (css-smie-rules): New functions. (css-mode): Use them. (css-navigation-syntax-table): Remove var. (css-backward-sexp, css-forward-sexp, css-indent-calculate-virtual) (css-indent-calculate, css-indent-line): Remove functions. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-08-29 19:18:16 +0000 +++ lisp/ChangeLog 2013-08-29 21:00:18 +0000 @@ -1,5 +1,32 @@ 2013-08-29 Stefan Monnier + * textmodes/css-mode.el: Use SMIE. + (css-smie-grammar): New var. + (css-smie--forward-token, css-smie--backward-token) + (css-smie-rules): New functions. + (css-mode): Use them. + (css-navigation-syntax-table): Remove var. + (css-backward-sexp, css-forward-sexp, css-indent-calculate-virtual) + (css-indent-calculate, css-indent-line): Remove functions. + + Misc changes to reduce use of `(lambda...); and other cleanups. + * cus-edit.el: Use lexical-binding. + (customize-push-and-save, customize-apropos) + (custom-buffer-create-internal): Use closures. + * progmodes/bat-mode.el (bat-mode-syntax-table): "..." are strings. + * progmodes/ada-xref.el: Use setq. + * net/tramp.el (with-tramp-progress-reporter): Avoid setq. + * dframe.el: Use lexical-binding. + (dframe-frame-mode): Fix calling convention for hooks. Use a closure. + * speedbar.el (speedbar-frame-mode): Adjust call accordingly. + * descr-text.el: Use lexical-binding. + (describe-text-widget, describe-text-sexp, describe-property-list): + Use closures. + * comint.el (comint-history-isearch-push-state): Use a closure. + * calculator.el: Use lexical-binding. + (calculator-number-to-string): Make it work with lexical-binding. + (calculator-funcall): Same and use cl-letf. + * emacs-lisp/lisp.el (lisp--company-doc-buffer) (lisp--company-doc-string, lisp--company-location): New functions. (lisp-completion-at-point): Use them to improve Company support. === modified file 'lisp/textmodes/css-mode.el' --- lisp/textmodes/css-mode.el 2013-01-02 16:13:04 +0000 +++ lisp/textmodes/css-mode.el 2013-08-29 21:00:18 +0000 @@ -263,6 +263,48 @@ (defvar css-font-lock-defaults '(css-font-lock-keywords nil t)) +(defcustom css-indent-offset 4 + "Basic size of one indentation step." + :version "22.2" + :type 'integer) + +(require 'smie) + +(defconst css-smie-grammar + (smie-prec2->grammar + (smie-precs->prec2 '((assoc ";") (assoc ",") (left ":"))))) + +(defun css-smie--forward-token () + (cond + ((and (eq (char-before) ?\}) + ;; FIXME: If the next char is not whitespace, what should we do? + (or (memq (char-after) '(?\s ?\t ?\n)) + (looking-at comment-start-skip))) + (if (memq (char-after) '(?\s ?\t ?\n)) + (forward-char 1) (forward-comment 1)) + ";") + ((progn (forward-comment (point-max)) + (looking-at "[;,:]")) + (forward-char 1) (match-string 0)) + (t (smie-default-forward-token)))) + +(defun css-smie--backward-token () + (let ((pos (point))) + (forward-comment (- (point))) + (cond + ;; FIXME: If the next char is not whitespace, what should we do? + ((and (eq (char-before) ?\}) (> pos (point))) ";") + ((memq (char-before) '(?\; ?\, ?\:)) + (forward-char -1) (string (char-after))) + (t (smie-default-backward-token))))) + +(defun css-smie-rules (kind token) + (pcase (cons kind token) + (`(:elem . basic) css-indent-offset) + (`(:elem . arg) 0) + (`(:before . "{") (if (smie-rule-hanging-p) + (smie-rule-parent 0))))) + ;;;###autoload (define-derived-mode css-mode fundamental-mode "CSS" "Major mode to edit Cascading Style Sheets." @@ -271,11 +313,13 @@ (setq-local comment-start-skip "/\\*+[ \t]*") (setq-local comment-end "*/") (setq-local comment-end-skip "[ \t]*\\*+/") - (setq-local forward-sexp-function 'css-forward-sexp) (setq-local parse-sexp-ignore-comments t) (setq-local indent-line-function 'css-indent-line) (setq-local fill-paragraph-function 'css-fill-paragraph) (setq-local add-log-current-defun-function #'css-current-defun-name) + (smie-setup css-smie-grammar #'css-smie-rules + :forward-token #'css-smie--forward-token + :backward-token #'css-smie--backward-token) (when css-electric-keys (let ((fc (make-char-table 'auto-fill-chars))) (set-char-table-parent fc auto-fill-chars) @@ -355,132 +399,6 @@ ;; Don't use the default filling code. t))))))) -;;; Navigation and indentation. - -(defconst css-navigation-syntax-table - (let ((st (make-syntax-table css-mode-syntax-table))) - (map-char-table (lambda (c v) - ;; Turn punctuation (code = 1) into symbol (code = 1). - (if (eq (car-safe v) 1) - (set-char-table-range st c (cons 3 (cdr v))))) - st) - st)) - -(defun css-backward-sexp (n) - (let ((forward-sexp-function nil)) - (if (< n 0) (css-forward-sexp (- n)) - (while (> n 0) - (setq n (1- n)) - (forward-comment (- (point-max))) - (if (not (eq (char-before) ?\;)) - (backward-sexp 1) - (while (progn (backward-sexp 1) - (save-excursion - (forward-comment (- (point-max))) - ;; FIXME: We should also skip punctuation. - (not (or (bobp) (memq (char-before) '(?\; ?\{)))))))))))) - -(defun css-forward-sexp (n) - (let ((forward-sexp-function nil)) - (if (< n 0) (css-backward-sexp (- n)) - (while (> n 0) - (setq n (1- n)) - (forward-comment (point-max)) - (if (not (eq (char-after) ?\;)) - (forward-sexp 1) - (while (progn (forward-sexp 1) - (save-excursion - (forward-comment (point-max)) - ;; FIXME: We should also skip punctuation. - (not (memq (char-after) '(?\; ?\}))))))))))) - -(defun css-indent-calculate-virtual () - (if (or (save-excursion (skip-chars-backward " \t") (bolp)) - (if (looking-at "\\s(") - (save-excursion - (forward-char 1) (skip-chars-forward " \t") - (not (or (eolp) (looking-at comment-start-skip)))))) - (current-column) - (css-indent-calculate))) - -(defcustom css-indent-offset 4 - "Basic size of one indentation step." - :version "22.2" - :type 'integer - :group 'css) - -(defun css-indent-calculate () - (let ((ppss (syntax-ppss)) - pos) - (with-syntax-table css-navigation-syntax-table - (save-excursion - (cond - ;; Inside a string. - ((nth 3 ppss) 'noindent) - ;; Inside a comment. - ((nth 4 ppss) - (setq pos (point)) - (forward-line -1) - (skip-chars-forward " \t") - (if (>= (nth 8 ppss) (point)) - (progn - (goto-char (nth 8 ppss)) - (if (eq (char-after pos) ?*) - (forward-char 1) - (if (not (looking-at comment-start-skip)) - (error "Internal css-mode error") - (goto-char (match-end 0)))) - (current-column)) - (if (and (eq (char-after pos) ?*) (eq (char-after) ?*)) - (current-column) - ;; 'noindent - (current-column) - ))) - ;; In normal code. - (t - (or - (when (looking-at "\\s)") - (forward-char 1) - (backward-sexp 1) - (css-indent-calculate-virtual)) - (when (looking-at comment-start-skip) - (forward-comment (point-max)) - (css-indent-calculate)) - (when (save-excursion (forward-comment (- (point-max))) - (setq pos (point)) - (eq (char-syntax (preceding-char)) ?\()) - (goto-char (1- pos)) - (if (not (looking-at "\\s([ \t]*")) - (error "Internal css-mode error") - (if (or (memq (char-after (match-end 0)) '(?\n nil)) - (save-excursion (goto-char (match-end 0)) - (looking-at comment-start-skip))) - (+ (css-indent-calculate-virtual) css-indent-offset) - (progn (goto-char (match-end 0)) (current-column))))) - (progn - (css-backward-sexp 1) - (if (looking-at "\\s(") - (css-indent-calculate) - (css-indent-calculate-virtual)))))))))) - - -(defun css-indent-line () - "Indent current line according to CSS indentation rules." - (interactive) - (let* ((savep (point)) - (forward-sexp-function nil) - (indent (condition-case nil - (save-excursion - (forward-line 0) - (skip-chars-forward " \t") - (if (>= (point) savep) (setq savep nil)) - (css-indent-calculate)) - (error nil)))) - (if (not (numberp indent)) 'noindent - (if savep - (save-excursion (indent-line-to indent)) - (indent-line-to indent))))) - (defun css-current-defun-name () "Return the name of the CSS section at point, or nil." (save-excursion ------------------------------------------------------------ revno: 114074 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2013-08-29 15:55:58 -0400 message: Misc changes to reduce use of `(lambda...); and other cleanups. * lisp/cus-edit.el: Use lexical-binding. (customize-push-and-save, customize-apropos) (custom-buffer-create-internal): Use closures. * lisp/progmodes/bat-mode.el (bat-mode-syntax-table): "..." are strings. * lisp/progmodes/ada-xref.el: Use setq. * lisp/net/tramp.el (with-tramp-progress-reporter): Avoid setq. * lisp/dframe.el: Use lexical-binding. (dframe-frame-mode): Fix calling convention for hooks. Use a closure. * lisp/speedbar.el (speedbar-frame-mode): Adjust call accordingly. * lisp/descr-text.el: Use lexical-binding. (describe-text-widget, describe-text-sexp, describe-property-list): Use closures. * lisp/comint.el (comint-history-isearch-push-state): Use a closure. * lisp/calculator.el: Use lexical-binding. (calculator-number-to-string): Make it work with lexical-binding. (calculator-funcall): Same and use cl-letf. diff: === modified file 'lisp/avoid.el' --- lisp/avoid.el 2013-01-01 09:11:05 +0000 +++ lisp/avoid.el 2013-08-29 19:55:58 +0000 @@ -41,9 +41,9 @@ ;; ;; (if (eq window-system 'x) ;; (mouse-avoidance-set-pointer-shape -;; (eval (nth (random 4) -;; '(x-pointer-man x-pointer-spider -;; x-pointer-gobbler x-pointer-gumby))))) +;; (nth (random 4) +;; (list x-pointer-man x-pointer-spider +;; x-pointer-gobbler x-pointer-gumby)))) ;; ;; For completely random pointer shape, replace the setq above with: ;; (setq x-pointer-shape (mouse-avoidance-random-shape)) === modified file 'lisp/calculator.el' --- lisp/calculator.el 2013-08-10 15:17:29 +0000 +++ lisp/calculator.el 2013-08-29 19:55:58 +0000 @@ -1,4 +1,4 @@ -;;; calculator.el --- a [not so] simple calculator for Emacs +;;; calculator.el --- a [not so] simple calculator for Emacs -*- lexical-binding: t -*- ;; Copyright (C) 1998, 2000-2013 Free Software Foundation, Inc. @@ -131,8 +131,8 @@ be the name of a one-argument function, a string is used with a single argument and an expression will be evaluated with the variable `num' bound to whatever should be displayed. If it is a function symbol, it -should be able to handle special symbol arguments, currently 'left and -'right which will be sent by special keys to modify display parameters +should be able to handle special symbol arguments, currently `left' and +`right' which will be sent by special keys to modify display parameters associated with the displayer function (for example to change the number of digits displayed). @@ -241,6 +241,8 @@ ;;;===================================================================== ;;; Code: +(eval-when-compile (require 'cl-lib)) + ;;;--------------------------------------------------------------------- ;;; Variables @@ -1124,11 +1126,10 @@ (format calculator-displayer num)) ((symbolp calculator-displayer) (funcall calculator-displayer num)) - ((and (consp calculator-displayer) - (eq 'std (car calculator-displayer))) + ((eq 'std (car-safe calculator-displayer)) (calculator-standard-displayer num (cadr calculator-displayer))) ((listp calculator-displayer) - (eval calculator-displayer)) + (eval calculator-displayer `((num. ,num)))) (t (prin1-to-string num t)))) ;; operators are printed here (t (prin1-to-string (nth 1 num) t)))) @@ -1273,29 +1274,24 @@ ;; smaller than calculator-epsilon (1e-15). I don't think this is ;; necessary now. (if (symbolp f) - (cond ((and X Y) (funcall f X Y)) - (X (funcall f X)) - (t (funcall f))) + (cond ((and X Y) (funcall f X Y)) + (X (funcall f X)) + (t (funcall f))) ;; f is an expression - (let* ((__f__ f) ; so we can get this value below... - (TX (calculator-truncate X)) + (let* ((TX (calculator-truncate X)) (TY (and Y (calculator-truncate Y))) (DX (if calculator-deg (/ (* X pi) 180) X)) - (L calculator-saved-list) - (Fbound (fboundp 'F)) - (Fsave (and Fbound (symbol-function 'F))) - (Dbound (fboundp 'D)) - (Dsave (and Dbound (symbol-function 'D)))) - ;; a shortened version of flet - (fset 'F (function - (lambda (&optional x y) - (calculator-funcall __f__ x y)))) - (fset 'D (function - (lambda (x) - (if calculator-deg (/ (* x 180) float-pi) x)))) - (unwind-protect (eval f) - (if Fbound (fset 'F Fsave) (fmakunbound 'F)) - (if Dbound (fset 'D Dsave) (fmakunbound 'D))))) + (L calculator-saved-list)) + (cl-letf (((symbol-function 'F) + (lambda (&optional x y) (calculator-funcall f x y))) + ((symbol-function 'D) + (lambda (x) (if calculator-deg (/ (* x 180) float-pi) x)))) + (eval f `((X . ,X) + (Y . ,X) + (TX . ,TX) + (TY . ,TY) + (DX . ,DX) + (L . ,L)))))) (error 0))) ;;;--------------------------------------------------------------------- === modified file 'lisp/comint.el' --- lisp/comint.el 2013-08-08 19:22:58 +0000 +++ lisp/comint.el 2013-08-29 19:55:58 +0000 @@ -1562,8 +1562,9 @@ "Save a function restoring the state of input history search. Save `comint-input-ring-index' to the additional state parameter in the search status stack." - `(lambda (cmd) - (comint-history-isearch-pop-state cmd ,comint-input-ring-index))) + (let ((index comint-input-ring-index)) + (lambda (cmd) + (comint-history-isearch-pop-state cmd index)))) (defun comint-history-isearch-pop-state (_cmd hist-pos) "Restore the input history search state. === modified file 'lisp/cus-edit.el' --- lisp/cus-edit.el 2013-06-20 11:29:30 +0000 +++ lisp/cus-edit.el 2013-08-29 19:55:58 +0000 @@ -1,4 +1,4 @@ -;;; cus-edit.el --- tools for customizing Emacs and Lisp packages +;;; cus-edit.el --- tools for customizing Emacs and Lisp packages -*- lexical-binding:t -*- ;; ;; Copyright (C) 1996-1997, 1999-2013 Free Software Foundation, Inc. ;; @@ -1057,8 +1057,8 @@ (let ((coding-system-for-read nil)) (customize-save-variable list-var (eval list-var))) (add-hook 'after-init-hook - `(lambda () - (customize-push-and-save ',list-var ',elts))))) + (lambda () + (customize-push-and-save list-var elts))))) ;;;###autoload (defun customize () @@ -1415,6 +1415,7 @@ "*Customize Saved*")))) (declare-function apropos-parse-pattern "apropos" (pattern)) +(defvar apropos-regexp) ;;;###autoload (defun customize-apropos (pattern &optional type) @@ -1431,23 +1432,23 @@ (require 'apropos) (unless (memq type '(nil options faces groups)) (error "Invalid setting type %s" (symbol-name type))) - (apropos-parse-pattern pattern) + (apropos-parse-pattern pattern) ;Sets apropos-regexp by side-effect: Yuck! (let (found) (mapatoms - `(lambda (symbol) - (when (string-match-p apropos-regexp (symbol-name symbol)) - ,(if (memq type '(nil groups)) - '(if (get symbol 'custom-group) - (push (list symbol 'custom-group) found))) - ,(if (memq type '(nil faces)) - '(if (custom-facep symbol) - (push (list symbol 'custom-face) found))) - ,(if (memq type '(nil options)) - `(if (and (boundp symbol) - (eq (indirect-variable symbol) symbol) - (or (get symbol 'saved-value) - (custom-variable-p symbol))) - (push (list symbol 'custom-variable) found)))))) + (lambda (symbol) + (when (string-match-p apropos-regexp (symbol-name symbol)) + (if (memq type '(nil groups)) + (if (get symbol 'custom-group) + (push (list symbol 'custom-group) found))) + (if (memq type '(nil faces)) + (if (custom-facep symbol) + (push (list symbol 'custom-face) found))) + (if (memq type '(nil options)) + (if (and (boundp symbol) + (eq (indirect-variable symbol) symbol) + (or (get symbol 'saved-value) + (custom-variable-p symbol))) + (push (list symbol 'custom-variable) found)))))) (unless found (error "No customizable %s matching %s" (symbol-name type) pattern)) (custom-buffer-create @@ -1621,8 +1622,8 @@ (widget-create 'editable-field :size 40 :help-echo echo - :action `(lambda (widget &optional event) - (customize-apropos (split-string (widget-value widget))))))) + :action (lambda (widget &optional _event) + (customize-apropos (split-string (widget-value widget))))))) (widget-insert " ") (widget-create-child-and-convert search-widget 'push-button === modified file 'lisp/descr-text.el' --- lisp/descr-text.el 2013-05-09 02:44:12 +0000 +++ lisp/descr-text.el 2013-08-29 19:55:58 +0000 @@ -1,4 +1,4 @@ -;;; descr-text.el --- describe text mode +;;; descr-text.el --- describe text mode -*- lexical-binding:t -*- ;; Copyright (C) 1994-1996, 2001-2013 Free Software Foundation, Inc. @@ -23,7 +23,7 @@ ;;; Commentary: -;;; Describe-Text Mode. +;; Describe-Text Mode. ;;; Code: @@ -36,8 +36,7 @@ "Insert text to describe WIDGET in the current buffer." (insert-text-button (symbol-name (if (symbolp widget) widget (car widget))) - 'action `(lambda (&rest ignore) - (widget-browse ',widget)) + 'action (lambda (&rest _ignore) (widget-browse widget)) 'help-echo "mouse-2, RET: browse this widget") (insert " ") (insert-text-button @@ -55,10 +54,10 @@ (<= (length pp) (- (window-width) (current-column)))) (insert pp) (insert-text-button - "[Show]" 'action `(lambda (&rest ignore) - (with-output-to-temp-buffer - "*Pp Eval Output*" - (princ ',pp))) + "[Show]" 'action (lambda (&rest _ignore) + (with-output-to-temp-buffer + "*Pp Eval Output*" + (princ pp))) 'help-echo "mouse-2, RET: pretty print value in another buffer")))) (defun describe-property-list (properties) @@ -81,8 +80,8 @@ (cond ((eq key 'category) (insert-text-button (symbol-name value) - 'action `(lambda (&rest ignore) - (describe-text-category ',value)) + 'action (lambda (&rest _ignore) + (describe-text-category value)) 'follow-link t 'help-echo "mouse-2, RET: describe this category")) ((memq key '(face font-lock-face mouse-face)) @@ -663,7 +662,7 @@ ((and (< char 32) (not (memq char '(9 10)))) 'escape-glyph))))) (if face (list (list "hardcoded face" - `(insert-text-button + `(insert-text-button ;FIXME: Wrap in lambda! ,(symbol-name face) 'type 'help-face 'help-args '(,face)))))) === modified file 'lisp/dframe.el' --- lisp/dframe.el 2013-05-22 03:13:56 +0000 +++ lisp/dframe.el 2013-08-29 19:55:58 +0000 @@ -1,4 +1,4 @@ -;;; dframe --- dedicate frame support modes +;;; dframe --- dedicate frame support modes -*- lexical-binding:t -*- ;; Copyright (C) 1996-2013 Free Software Foundation, Inc. @@ -259,9 +259,15 @@ FRAME-NAME is the name of the frame to create. LOCAL-MODE-FN is the function used to call this one. PARAMETERS are frame parameters to apply to this dframe. -DELETE-HOOK are hooks to run when deleting a frame. -POPUP-HOOK are hooks to run before showing a frame. -CREATE-HOOK are hooks to run after creating a frame." +DELETE-HOOK is a hook to run when deleting a frame. +POPUP-HOOK is a hook to run before showing a frame. +CREATE-HOOK is a hook to run after creating a frame." + (let ((conv-hook (lambda (val) + (let ((sym (make-symbol "hook"))) + (set sym val) sym)))) + (if (consp delete-hook) (setq delete-hook (funcall conv-hook delete-hook))) + (if (consp create-hook) (setq create-hook (funcall conv-hook create-hook))) + (if (consp popup-hook) (setq popup-hook (funcall conv-hook popup-hook)))) ;; toggle frame on and off. (if (not arg) (if (dframe-live-p (symbol-value frame-var)) (setq arg -1) (setq arg 1))) @@ -270,7 +276,7 @@ ;; turn the frame off on neg number (if (and (numberp arg) (< arg 0)) (progn - (run-hooks 'delete-hook) + (run-hooks delete-hook) (if (and (symbol-value frame-var) (frame-live-p (symbol-value frame-var))) (progn @@ -279,7 +285,7 @@ (set frame-var nil)) ;; Set this as our currently attached frame (setq dframe-attached-frame (selected-frame)) - (run-hooks 'popup-hook) + (run-hooks popup-hook) ;; Updated the buffer passed in to contain all the hacks needed ;; to make it work well in a dedicated window. (with-current-buffer (symbol-value buffer-var) @@ -331,15 +337,15 @@ (setq temp-buffer-show-function 'dframe-temp-buffer-show-function) ;; If this buffer is killed, we must make sure that we destroy ;; the frame the dedicated window is in. - (add-hook 'kill-buffer-hook `(lambda () - (let ((skilling (boundp 'skilling))) - (if skilling - nil - (if dframe-controlled - (progn - (funcall dframe-controlled -1) - (setq ,buffer-var nil) - ))))) + (add-hook 'kill-buffer-hook (lambda () + (let ((skilling (boundp 'skilling))) + (if skilling + nil + (if dframe-controlled + (progn + (funcall dframe-controlled -1) + (set buffer-var nil) + ))))) t t) ) ;; Get the frame to work in @@ -396,7 +402,7 @@ (switch-to-buffer (symbol-value buffer-var)) (set-window-dedicated-p (selected-window) t)) ;; Run hooks (like reposition) - (run-hooks 'create-hook) + (run-hooks create-hook) ;; Frame name (if (and (or (null window-system) (eq window-system 'pc)) (fboundp 'set-frame-name)) @@ -602,7 +608,7 @@ If the selected frame is not in the symbol FRAME-VAR, then FRAME-VAR frame is selected. If the FRAME-VAR is active, then select the attached frame. If FRAME-VAR is nil, ACTIVATOR is called to -created it. HOOK is an optional argument of hooks to run when +created it. HOOK is an optional hook to run when selecting FRAME-VAR." (interactive) (if (eq (selected-frame) (symbol-value frame-var)) @@ -616,7 +622,7 @@ ) (other-frame 0) ;; If updates are off, then refresh the frame (they want it now...) - (run-hooks 'hook)) + (run-hooks hook)) (defun dframe-close-frame () === modified file 'lisp/emacs-lisp/eldoc.el' --- lisp/emacs-lisp/eldoc.el 2013-03-18 09:16:15 +0000 +++ lisp/emacs-lisp/eldoc.el 2013-08-29 19:55:58 +0000 @@ -185,6 +185,7 @@ (add-hook 'post-self-insert-hook prn-info nil t) (remove-hook 'post-self-insert-hook prn-info t)))) +;; FIXME: This changes Emacs's behavior when the file is loaded! (add-hook 'eval-expression-minibuffer-setup-hook 'eldoc-post-insert-mode) ;;;###autoload @@ -487,11 +488,11 @@ (defun eldoc-beginning-of-sexp () (let ((parse-sexp-ignore-comments t) (num-skipped-sexps 0)) - (condition-case err + (condition-case _ (progn ;; First account for the case the point is directly over a ;; beginning of a nested sexp. - (condition-case err + (condition-case _ (let ((p (point))) (forward-sexp -1) (forward-sexp 1) @@ -518,7 +519,7 @@ (let ((defn (and (fboundp fsym) (symbol-function fsym)))) (and (symbolp defn) - (condition-case err + (condition-case _ (setq defn (indirect-function fsym)) (error (setq defn nil)))) defn)) === modified file 'lisp/net/tramp.el' --- lisp/net/tramp.el 2013-08-26 13:17:22 +0000 +++ lisp/net/tramp.el 2013-08-29 19:55:58 +0000 @@ -1654,24 +1654,27 @@ If LEVEL does not fit for visible messages, there are only traces without a visible progress reporter." (declare (indent 3) (debug t)) - `(let ((result "failed") - pr tm) + `(progn (tramp-message ,vec ,level "%s..." ,message) - ;; We start a pulsing progress reporter after 3 seconds. Feature - ;; introduced in Emacs 24.1. - (when (and tramp-message-show-message - ;; Display only when there is a minimum level. - (<= ,level (min tramp-verbose 3))) - (ignore-errors - (setq pr (tramp-compat-funcall 'make-progress-reporter ,message) - tm (when pr - (run-at-time 3 0.1 'tramp-progress-reporter-update pr))))) - (unwind-protect - ;; Execute the body. - (prog1 (progn ,@body) (setq result "done")) - ;; Stop progress reporter. - (if tm (tramp-compat-funcall 'cancel-timer tm)) - (tramp-message ,vec ,level "%s...%s" ,message result)))) + (let ((result "failed") + (tm + ;; We start a pulsing progress reporter after 3 seconds. Feature + ;; introduced in Emacs 24.1. + (when (and tramp-message-show-message + ;; Display only when there is a minimum level. + (<= ,level (min tramp-verbose 3))) + (ignore-errors + (let ((pr (tramp-compat-funcall + #'make-progress-reporter ,message))) + (when pr + (run-at-time 3 0.1 + #'tramp-progress-reporter-update pr))))))) + (unwind-protect + ;; Execute the body. + (prog1 (progn ,@body) (setq result "done")) + ;; Stop progress reporter. + (if tm (tramp-compat-funcall 'cancel-timer tm)) + (tramp-message ,vec ,level "%s...%s" ,message result))))) (tramp-compat-font-lock-add-keywords 'emacs-lisp-mode '("\\")) === modified file 'lisp/progmodes/ada-xref.el' --- lisp/progmodes/ada-xref.el 2013-08-09 21:22:44 +0000 +++ lisp/progmodes/ada-xref.el 2013-08-29 19:55:58 +0000 @@ -342,9 +342,9 @@ ) (kill-buffer nil)))) - (set 'ada-xref-runtime-library-specs-path + (setq ada-xref-runtime-library-specs-path (reverse ada-xref-runtime-library-specs-path)) - (set 'ada-xref-runtime-library-ali-path + (setq ada-xref-runtime-library-ali-path (reverse ada-xref-runtime-library-ali-path)) )) @@ -582,8 +582,8 @@ (while dirs (if (file-directory-p (car dirs)) - (set 'list (append list (file-name-all-completions string (car dirs))))) - (set 'dirs (cdr dirs))) + (setq list (append list (file-name-all-completions string (car dirs))))) + (setq dirs (cdr dirs))) (cond ((equal flag 'lambda) (assoc string list)) (flag @@ -702,11 +702,11 @@ ((file-exists-p first-choice) ;; filename.adp - (set 'selected first-choice)) + (setq selected first-choice)) ((= (length prj-files) 1) ;; Exactly one project file was found in the current directory - (set 'selected (car prj-files))) + (setq selected (car prj-files))) ((and (> (length prj-files) 1) (not no-user-question)) ;; multiple project files in current directory, ask the user @@ -732,7 +732,7 @@ (> choice (length prj-files))) (setq choice (string-to-number (read-from-minibuffer "Enter No. of your choice: ")))) - (set 'selected (nth (1- choice) prj-files)))) + (setq selected (nth (1- choice) prj-files)))) ((= (length prj-files) 0) ;; No project file in the current directory; ask user @@ -742,7 +742,7 @@ (concat "project file [" ada-last-prj-file "]:") nil ada-last-prj-file)) (unless (string= ada-last-prj-file "") - (set 'selected ada-last-prj-file)))) + (setq selected ada-last-prj-file)))) ))) (or selected "default.adp") @@ -792,9 +792,9 @@ (setq prj-file (expand-file-name prj-file)) (if (string= (file-name-extension prj-file) "gpr") - (set 'project (ada-gnat-parse-gpr project prj-file)) + (setq project (ada-gnat-parse-gpr project prj-file)) - (set 'project (ada-parse-prj-file-1 prj-file project)) + (setq project (ada-parse-prj-file-1 prj-file project)) ) ;; Store the project properties @@ -842,7 +842,7 @@ (substitute-in-file-name (match-string 2))))) ((string= (match-string 1) "build_dir") - (set 'project + (setq project (plist-put project 'build_dir (file-name-as-directory (match-string 2))))) @@ -884,7 +884,7 @@ (t ;; any other field in the file is just copied - (set 'project (plist-put project + (setq project (plist-put project (intern (match-string 1)) (match-string 2)))))) @@ -900,21 +900,21 @@ (let ((sep (plist-get project 'ada_project_path_sep))) (setq ada_project_path (reverse ada_project_path)) (setq ada_project_path (mapconcat 'identity ada_project_path sep)) - (set 'project (plist-put project 'ada_project_path ada_project_path)) + (setq project (plist-put project 'ada_project_path ada_project_path)) ;; env var needed now for ada-gnat-parse-gpr (setenv "ADA_PROJECT_PATH" ada_project_path))) - (if debug_post_cmd (set 'project (plist-put project 'debug_post_cmd (reverse debug_post_cmd)))) - (if debug_pre_cmd (set 'project (plist-put project 'debug_pre_cmd (reverse debug_pre_cmd)))) - (if casing (set 'project (plist-put project 'casing (reverse casing)))) - (if check_cmd (set 'project (plist-put project 'check_cmd (reverse check_cmd)))) - (if comp_cmd (set 'project (plist-put project 'comp_cmd (reverse comp_cmd)))) - (if make_cmd (set 'project (plist-put project 'make_cmd (reverse make_cmd)))) - (if run_cmd (set 'project (plist-put project 'run_cmd (reverse run_cmd)))) + (if debug_post_cmd (setq project (plist-put project 'debug_post_cmd (reverse debug_post_cmd)))) + (if debug_pre_cmd (setq project (plist-put project 'debug_pre_cmd (reverse debug_pre_cmd)))) + (if casing (setq project (plist-put project 'casing (reverse casing)))) + (if check_cmd (setq project (plist-put project 'check_cmd (reverse check_cmd)))) + (if comp_cmd (setq project (plist-put project 'comp_cmd (reverse comp_cmd)))) + (if make_cmd (setq project (plist-put project 'make_cmd (reverse make_cmd)))) + (if run_cmd (setq project (plist-put project 'run_cmd (reverse run_cmd)))) (if gpr_file (progn - (set 'project (ada-gnat-parse-gpr project gpr_file)) + (setq project (ada-gnat-parse-gpr project gpr_file)) ;; append Ada source and object directories to others from Emacs project file (setq src_dir (append (plist-get project 'src_dir) src_dir)) (setq obj_dir (append (plist-get project 'obj_dir) obj_dir)) @@ -930,8 +930,8 @@ (ada-initialize-runtime-library (or (ada-xref-get-project-field 'cross_prefix) "")) ;;) - (if obj_dir (set 'project (plist-put project 'obj_dir (reverse obj_dir)))) - (if src_dir (set 'project (plist-put project 'src_dir (reverse src_dir)))) + (if obj_dir (setq project (plist-put project 'obj_dir (reverse obj_dir)))) + (if src_dir (setq project (plist-put project 'src_dir (reverse src_dir)))) project )) @@ -1052,9 +1052,9 @@ (if old-contents (progn (goto-char 1) - (set 'buffer-read-only nil) + (setq buffer-read-only nil) (insert old-contents) - (set 'buffer-read-only t) + (setq buffer-read-only t) (goto-char (point-max))))) ) ) @@ -1194,9 +1194,9 @@ (objects (getenv "ADA_OBJECTS_PATH")) (build-dir (ada-xref-get-project-field 'build_dir))) (if include - (set 'include (concat path-separator include))) + (setq include (concat path-separator include))) (if objects - (set 'objects (concat path-separator objects))) + (setq objects (concat path-separator objects))) (cons (concat "ADA_INCLUDE_PATH=" (mapconcat (lambda(x) (expand-file-name x build-dir)) @@ -1303,7 +1303,7 @@ ;; Guess the command if it wasn't specified (if (not command) - (set 'command (list (file-name-sans-extension (buffer-name))))) + (setq command (list (file-name-sans-extension (buffer-name))))) ;; Modify the command to run remotely (setq command (ada-remote (mapconcat 'identity command @@ -1316,7 +1316,7 @@ ;; Run the command (with-current-buffer (get-buffer-create "*run*") - (set 'buffer-read-only nil) + (setq buffer-read-only nil) (erase-buffer) (start-process "run" (current-buffer) shell-file-name @@ -1352,7 +1352,7 @@ ;; If the command was not given in the project file, start a bare gdb (if (not cmd) - (set 'cmd (concat ada-prj-default-debugger + (setq cmd (concat ada-prj-default-debugger " " (or executable-name (file-name-sans-extension (buffer-file-name)))))) @@ -1368,18 +1368,18 @@ ;; chance to fully manage it. Then it works fine with Enlightenment ;; as well (let ((frame (make-frame '((visibility . nil))))) - (set 'cmd (concat + (setq cmd (concat cmd " --editor-window=" (cdr (assoc 'outer-window-id (frame-parameters frame))))) (select-frame frame))) ;; Add a -fullname switch ;; Use the remote machine - (set 'cmd (ada-remote (concat cmd " -fullname "))) + (setq cmd (ada-remote (concat cmd " -fullname "))) ;; Ask for confirmation if required (if (or arg ada-xref-confirm-compile) - (set 'cmd (read-from-minibuffer "enter command to debug: " cmd))) + (setq cmd (read-from-minibuffer "enter command to debug: " cmd))) (let ((old-comint-exec (symbol-function 'comint-exec))) @@ -1387,13 +1387,13 @@ ;; FIXME: This is evil but luckily a nop under Emacs-21.3.50 ! -stef (fset 'gud-gdb-massage-args (lambda (_file args) args)) - (set 'pre-cmd (mapconcat 'identity pre-cmd ada-command-separator)) + (setq pre-cmd (mapconcat 'identity pre-cmd ada-command-separator)) (if (not (equal pre-cmd "")) (setq pre-cmd (concat pre-cmd ada-command-separator))) - (set 'post-cmd (mapconcat 'identity post-cmd "\n")) + (setq post-cmd (mapconcat 'identity post-cmd "\n")) (if post-cmd - (set 'post-cmd (concat post-cmd "\n"))) + (setq post-cmd (concat post-cmd "\n"))) ;; Temporarily replaces the definition of `comint-exec' so that we @@ -1403,7 +1403,7 @@ `(lambda (buffer name command startfile switches) (let (compilation-buffer-name-function) (save-excursion - (set 'compilation-buffer-name-function + (setq compilation-buffer-name-function (lambda(x) (buffer-name buffer))) (compile (ada-quote-cmd (concat ,pre-cmd @@ -1498,12 +1498,12 @@ "Search for FILE in DIR-LIST." (let (found) (while (and (not found) dir-list) - (set 'found (concat (file-name-as-directory (car dir-list)) + (setq found (concat (file-name-as-directory (car dir-list)) (file-name-nondirectory file))) (unless (file-exists-p found) - (set 'found nil)) - (set 'dir-list (cdr dir-list))) + (setq found nil)) + (setq dir-list (cdr dir-list))) found)) (defun ada-find-ali-file-in-dir (file) @@ -1558,11 +1558,11 @@ (while specs (if (string-match (concat (regexp-quote (car specs)) "$") file) - (set 'is-spec t)) - (set 'specs (cdr specs))))) + (setq is-spec t)) + (setq specs (cdr specs))))) (if is-spec - (set 'ali-file-name + (setq ali-file-name (ada-find-ali-file-in-dir (concat (file-name-base (ada-other-file-name)) ".ali")))) @@ -1589,8 +1589,8 @@ (while (and (not ali-file-name) (string-match "^\\(.*\\)[.-][^.-]*" parent-name)) - (set 'parent-name (match-string 1 parent-name)) - (set 'ali-file-name (ada-find-ali-file-in-dir + (setq parent-name (match-string 1 parent-name)) + (setq ali-file-name (ada-find-ali-file-in-dir (concat parent-name ".ali"))) ) ali-file-name))) @@ -1686,18 +1686,18 @@ (if (and (= (char-before) ?\") (= (char-after (+ (length (match-string 0)) (point))) ?\")) (forward-char -1)) - (set 'identifier (regexp-quote (concat "\"" (match-string 0) "\"")))) + (setq identifier (regexp-quote (concat "\"" (match-string 0) "\"")))) (if (ada-in-string-p) (error "Inside string or character constant")) (if (looking-at (concat ada-keywords "[^a-zA-Z_]")) (error "No cross-reference available for reserved keyword")) (if (looking-at "[a-zA-Z0-9_]+") - (set 'identifier (match-string 0)) + (setq identifier (match-string 0)) (error "No identifier around"))) ;; Build the identlist - (set 'identlist (ada-make-identlist)) + (setq identlist (ada-make-identlist)) (ada-set-name identlist (downcase identifier)) (ada-set-line identlist (number-to-string (count-lines 1 (point)))) @@ -1725,7 +1725,7 @@ (concat "^X [0-9]+ " (file-name-nondirectory (ada-file-of identlist))) nil t) (let ((bound (save-excursion (re-search-forward "^X " nil t)))) - (set 'declaration-found + (setq declaration-found (re-search-forward (concat "^" (ada-line-of identlist) "." (ada-column-of identlist) @@ -1743,7 +1743,7 @@ ;; Since we already know the number of the file, search for a direct ;; reference to it (goto-char (point-min)) - (set 'declaration-found t) + (setq declaration-found t) (ada-set-ali-index identlist (number-to-string (ada-find-file-number-in-ali @@ -1771,7 +1771,7 @@ ;; If still not found, then either the declaration is unknown ;; or the source file has been modified since the ali file was ;; created - (set 'declaration-found nil) + (setq declaration-found nil) ) ) @@ -1786,7 +1786,7 @@ (beginning-of-line)) (unless (looking-at (concat "[0-9]+.[0-9]+[ *]" (ada-name-of identlist) "[ <{=\(\[]")) - (set 'declaration-found nil)))) + (setq declaration-found nil)))) ;; Still no success ! The ali file must be too old, and we need to ;; use a basic algorithm based on guesses. Note that this only happens @@ -1794,7 +1794,7 @@ ;; automatically (unless declaration-found (if (ada-xref-find-in-modified-ali identlist) - (set 'declaration-found t) + (setq declaration-found t) ;; No more idea to find the declaration. Give up (progn (kill-buffer ali-buffer) @@ -1814,7 +1814,7 @@ (forward-line 1) (beginning-of-line) (while (looking-at "^\\.\\(.*\\)") - (set 'current-line (concat current-line (match-string 1))) + (setq current-line (concat current-line (match-string 1))) (forward-line 1)) ) @@ -1860,7 +1860,7 @@ (goto-char (point-max)) (while (re-search-backward my-regexp nil t) (save-excursion - (set 'line-ali (count-lines 1 (point))) + (setq line-ali (count-lines 1 (point))) (beginning-of-line) ;; have a look at the line and column numbers (if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]") @@ -1948,7 +1948,7 @@ ;; Get all the possible locations (string-match "^\\([0-9]+\\)[a-zA-Z+*]\\([0-9]+\\)[ *]" ali-line) - (set 'locations (list (list (match-string 1 ali-line) ;; line + (setq locations (list (list (match-string 1 ali-line) ;; line (match-string 2 ali-line) ;; column (ada-declare-file-of identlist)))) (while (string-match "\\([0-9]+\\)[bc]\\(<[^>]+>\\)?\\([0-9]+\\)" @@ -1968,16 +1968,16 @@ (goto-char (point-min)) (re-search-forward "^D \\([a-zA-Z0-9_.-]+\\)" nil t (string-to-number file-number)) - (set 'file (match-string 1)) + (setq file (match-string 1)) ) ;; Else get the nearest file - (set 'file (ada-declare-file-of identlist))) + (setq file (ada-declare-file-of identlist))) - (set 'locations (append locations (list (list line col file))))) + (setq locations (append locations (list (list line col file))))) ;; Add the specs at the end again, so that from the last body we go to ;; the specs - (set 'locations (append locations (list (car locations)))) + (setq locations (append locations (list (car locations)))) ;; Find the new location we want to go to. ;; If we are on none of the locations listed, we simply go to the specs. @@ -1996,10 +1996,10 @@ col (nth 1 locations) file (nth 2 locations) locations nil) - (set 'locations (cdr locations)))) + (setq locations (cdr locations)))) ;; Find the file in the source path - (set 'file (ada-get-ada-file-name file (ada-file-of identlist))) + (setq file (ada-get-ada-file-name file (ada-file-of identlist))) ;; Kill the .ali buffer (kill-buffer (current-buffer)) @@ -2044,10 +2044,10 @@ " " (shell-quote-argument (file-name-as-directory (car dirs))) "*.ali"))) - (set 'dirs (cdr dirs))) + (setq dirs (cdr dirs))) ;; Now parse the output - (set 'case-fold-search t) + (setq case-fold-search t) (goto-char (point-min)) (while (re-search-forward regexp nil t) (save-excursion @@ -2058,12 +2058,12 @@ (setq line (match-string 1) column (match-string 2)) (re-search-backward "^X [0-9]+ \\(.*\\)$") - (set 'file (list (match-string 1) line column)) + (setq file (list (match-string 1) line column)) ;; There could be duplicate choices, because of the structure ;; of the .ali files (unless (member file list) - (set 'list (append list (list file)))))))) + (setq list (append list (list file)))))))) ;; Current buffer is still "*grep*" (kill-buffer "*grep*") @@ -2078,7 +2078,7 @@ ;; Only one choice => Do the cross-reference ((= (length list) 1) - (set 'file (ada-find-src-file-in-dir (caar list))) + (setq file (ada-find-src-file-in-dir (caar list))) (if file (ada-xref-change-buffer file (string-to-number (nth 1 (car list))) @@ -2117,10 +2117,10 @@ (string-to-number (read-from-minibuffer "Enter No. of your choice: ")))) ) - (set 'choice (1- choice)) + (setq choice (1- choice)) (kill-buffer "*choice list*") - (set 'file (ada-find-src-file-in-dir (car (nth choice list)))) + (setq file (ada-find-src-file-in-dir (car (nth choice list)))) (if file (ada-xref-change-buffer file (string-to-number (nth 1 (nth choice list))) @@ -2144,7 +2144,7 @@ (if ada-xref-other-buffer (if other-frame (find-file-other-frame file) - (set 'declaration-buffer (find-file-noselect file)) + (setq declaration-buffer (find-file-noselect file)) (set-buffer declaration-buffer) (switch-to-buffer-other-window declaration-buffer) ) === modified file 'lisp/progmodes/bat-mode.el' --- lisp/progmodes/bat-mode.el 2013-08-07 22:53:18 +0000 +++ lisp/progmodes/bat-mode.el 2013-08-29 19:55:58 +0000 @@ -120,6 +120,7 @@ (defvar bat-mode-syntax-table (let ((table (make-syntax-table))) (modify-syntax-entry ?\n ">" table) + (modify-syntax-entry ?\" "\"" table) ;; Beware: `w' should not be used for non-alphabetic chars. (modify-syntax-entry ?~ "_" table) (modify-syntax-entry ?% "." table) === modified file 'lisp/speedbar.el' --- lisp/speedbar.el 2013-08-05 14:26:57 +0000 +++ lisp/speedbar.el 2013-08-29 19:55:58 +0000 @@ -1007,9 +1007,9 @@ ;; with the selected frame. (list 'parent (selected-frame))) speedbar-frame-parameters) - speedbar-before-delete-hook - speedbar-before-popup-hook - speedbar-after-create-hook) + 'speedbar-before-delete-hook + 'speedbar-before-popup-hook + 'speedbar-after-create-hook) ;; Start up the timer (if (not speedbar-frame) (speedbar-set-timer nil) ------------------------------------------------------------ revno: 114073 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2013-08-29 15:20:42 -0400 message: * admin/notes/elpa: Update to the new Git setup. diff: === modified file 'admin/notes/elpa' --- admin/notes/elpa 2011-03-11 22:53:47 +0000 +++ admin/notes/elpa 2013-08-29 19:20:42 +0000 @@ -1,24 +1,21 @@ NOTES ON THE EMACS PACKAGE ARCHIVE -The GNU Emacs package archive, at elpa.gnu.org, is managed using a Bzr -branch named "elpa", hosted on Savannah. To check it out: +The GNU Emacs package archive, at elpa.gnu.org, is managed using a Git +repository named "elpa", hosted on Savannah. To check it out: - bzr branch bzr+ssh://USER@bzr.savannah.gnu.org/emacs/elpa elpa + git clone git://bzr.sv.gnu.org/emacs/elpa cd elpa - echo "public_branch = bzr+ssh://USER@bzr.savannah.gnu.org/emacs/elpa" >> .bzr/branch/branch.conf - bzr bind bzr+ssh://USERNAME@bzr.savannah.gnu.org/emacs/elpa + git remote set-url --push origin git+ssh://bzr.sv.gnu.org/srv/git/emacs/elpa [create task branch for edits, etc.] -Changes to this branch propagate to elpa.gnu.org in a semi-manual way. -There exists a copy of the elpa branch on that machine. Someone with -access logs in, pulls the latest changes from Savannah, and runs a -"deployment" script. This script (which is itself kept in the Bzr -branch) generates the content visible at http://elpa.gnu.org/packages. +Changes to this branch propagate to elpa.gnu.org via a "deployment" script run +daily. This script (which is kept in elpa/admin/update-archive.sh) generates +the content visible at http://elpa.gnu.org/packages. -The reason we set things up this way, instead of using the package -upload commands in package-x.el, is to let Emacs hackers conveniently -edit the contents of the "elpa" branch. (In particular, multi-file -packages are stored on the branch in source form, not as tarfiles.) +A new package is released as soon as the "version number" of that package is +changed. So you can use `elpa' to work on a package without fear of releasing +those changes prematurely. And once the code is ready, just bump the +version number to make a new release of the package. It is easy to use the elpa branch to deploy a "local" copy of the package archive. For details, see the README file in the elpa branch. ------------------------------------------------------------ revno: 114072 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2013-08-29 15:18:16 -0400 message: * lisp/emacs-lisp/lisp.el (lisp--company-doc-buffer) (lisp--company-doc-string, lisp--company-location): New functions. (lisp-completion-at-point): Use them to improve Company support. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-08-29 18:06:46 +0000 +++ lisp/ChangeLog 2013-08-29 19:18:16 +0000 @@ -1,5 +1,9 @@ 2013-08-29 Stefan Monnier + * emacs-lisp/lisp.el (lisp--company-doc-buffer) + (lisp--company-doc-string, lisp--company-location): New functions. + (lisp-completion-at-point): Use them to improve Company support. + * progmodes/ruby-mode.el (ruby-smie-grammar): Add rule for formal params of lambda expressions. (ruby-smie--implicit-semi-p): Refine rule (bug#15208). === modified file 'lisp/emacs-lisp/lisp.el' --- lisp/emacs-lisp/lisp.el 2013-06-13 16:44:26 +0000 +++ lisp/emacs-lisp/lisp.el 2013-08-29 19:18:16 +0000 @@ -752,6 +752,57 @@ (mapcar #'symbol-name (lisp--local-variables)))))) lastvars))))) +;; 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: +;; - a function to extract "the reference at point" (may be more complex +;; than a mere string, to distinguish various namespaces). +;; - a function to jump to such a reference. +;; - a function to show the signature/interface of such a reference. +;; - a function to build a help-buffer about that reference. +;; FIXME: Those functions should also be used by the normal completion code in +;; the *Completions* buffer. + +(defun lisp--company-doc-buffer (str) + (let ((symbol (intern-soft str))) + ;; FIXME: we really don't want to "display-buffer and then undo it". + (save-window-excursion + ;; Make sure we don't display it in another frame, otherwise + ;; save-window-excursion won't be able to undo it. + (let ((display-buffer-overriding-action + '(nil . ((inhibit-switch-frame . t))))) + (ignore-errors + (cond + ((fboundp symbol) (describe-function symbol)) + ((boundp symbol) (describe-variable symbol)) + ((featurep symbol) (describe-package symbol)) + ((facep symbol) (describe-face symbol)) + (t (signal 'user-error nil))) + (help-buffer)))))) + +(defun lisp--company-doc-string (str) + (let* ((symbol (intern-soft str)) + (doc (if (fboundp symbol) + (documentation symbol t) + (documentation-property symbol 'variable-documentation t)))) + (and (stringp doc) + (string-match ".*$" doc) + (match-string 0 doc)))) + +(declare-function find-library-name "find-func" (library)) + +(defun lisp--company-location (str) + (let ((sym (intern-soft str))) + (cond + ((fboundp sym) (find-definition-noselect sym nil)) + ((boundp sym) (find-definition-noselect sym 'defvar)) + ((featurep sym) + (require 'find-func) + (cons (find-file-noselect (find-library-name + (symbol-name sym))) + 0)) + ((facep sym) (find-definition-noselect sym 'defface))))) + (defun lisp-completion-at-point (&optional _predicate) "Function used for `completion-at-point-functions' in `emacs-lisp-mode'." (with-syntax-table emacs-lisp-mode-syntax-table @@ -783,7 +834,10 @@ lisp--local-variables-completion-table obarray) ;Could be anything. :annotation-function - (lambda (str) (if (fboundp (intern-soft str)) " "))) + (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) ;; Looks like a funcall position. Let's double check. (save-excursion (goto-char (1- beg)) @@ -800,10 +854,12 @@ ;; we should use something like a symbol-property. (`declare (list t (mapcar (lambda (x) (symbol-name (car x))) - (delete-dups - (append - macro-declarations-alist - defun-declarations-alist))))) + (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 @@ -811,7 +867,12 @@ (< (point) beg))))) (list t obarray :predicate (lambda (sym) (get sym 'error-conditions)))) - (_ (list nil obarray #'fboundp)))))))) + (_ (list nil obarray + :predicate #'fboundp + :company-doc-buffer #'lisp--company-doc-buffer + :company-docsig #'lisp--company-doc-string + :company-location #'lisp--company-location + )))))))) (when end (let ((tail (if (null (car table-etc)) (cdr table-etc) ------------------------------------------------------------ revno: 114071 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=15208 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2013-08-29 14:06:46 -0400 message: * lisp/progmodes/ruby-mode.el (ruby-smie-grammar): Add rule for formal params of lambda expressions. (ruby-smie--implicit-semi-p): Refine rule. (ruby-smie--opening-pipe-p): New function. (ruby-smie--forward-token, ruby-smie--backward-token): Handle Ruby symbols and matched |...| for formal params. (ruby-smie-rules): Don't let the formal params of a "do" prevent it from being treated as hanging. Handle "rescue". diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-08-29 17:26:48 +0000 +++ lisp/ChangeLog 2013-08-29 18:06:46 +0000 @@ -1,3 +1,14 @@ +2013-08-29 Stefan Monnier + + * progmodes/ruby-mode.el (ruby-smie-grammar): Add rule for formal + params of lambda expressions. + (ruby-smie--implicit-semi-p): Refine rule (bug#15208). + (ruby-smie--opening-pipe-p): New function. + (ruby-smie--forward-token, ruby-smie--backward-token): Handle Ruby + symbols and matched |...| for formal params. + (ruby-smie-rules): Don't let the formal params of a "do" prevent it + from being treated as hanging. Handle "rescue". + 2013-08-29 Glenn Morris * progmodes/cc-engine.el (c-pull-open-brace): === modified file 'lisp/progmodes/ruby-mode.el' --- lisp/progmodes/ruby-mode.el 2013-07-16 19:16:51 +0000 +++ lisp/progmodes/ruby-mode.el 2013-08-29 18:06:46 +0000 @@ -254,11 +254,13 @@ ("for" for-body "end") ("[" expseq "]") ("{" hashvals "}") + ("{" insts "}") ("while" insts "end") ("until" insts "end") ("unless" insts "end") ("if" if-body "end") ("case" cases "end")) + (formal-params ("opening-|" exp "|")) (for-body (for-head ";" insts)) (for-head (id "in" exp)) (cases (exp "then" insts) ;; FIXME: Ruby also allows (exp ":" insts). @@ -285,10 +287,20 @@ (save-excursion (skip-chars-backward " \t") (not (or (bolp) - (memq (char-before) '(?\; ?- ?+ ?* ?/ ?:)) + (and (memq (char-before) '(?\; ?- ?+ ?* ?/ ?: ?.)) + ;; Make sure it's not the end of a regexp. + (not (eq (car (syntax-after (1- (point)))) 7))) (and (memq (char-before) '(?\? ?=)) - (not (memq (char-syntax (char-before (1- (point)))) - '(?w ?_)))))))) + (let ((tok (ruby-smie--backward-token))) + (or (equal tok "?") + (string-match "\\`\\s." tok)))))))) + +(defun ruby-smie--opening-pipe-p () + (save-excursion + (if (eq ?| (char-before)) (forward-char -1)) + (skip-chars-backward " \t\n") + (or (eq ?\{ (char-before)) + (looking-back "\\_ branch nick: trunk timestamp: Thu 2013-08-29 13:26:48 -0400 message: * lisp/progmodes/cc-engine.el (c-pull-open-brace): Move definition before use. Ref: http://lists.gnu.org/archive/html/emacs-devel/2013-08/msg00773.html diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-08-29 03:49:10 +0000 +++ lisp/ChangeLog 2013-08-29 17:26:48 +0000 @@ -1,3 +1,8 @@ +2013-08-29 Glenn Morris + + * progmodes/cc-engine.el (c-pull-open-brace): + Move definition before use. + 2013-08-29 Stefan Monnier * emacs-lisp/cl-macs.el (cl-defsubst): Make it clear that args === modified file 'lisp/progmodes/cc-engine.el' --- lisp/progmodes/cc-engine.el 2013-08-25 21:06:07 +0000 +++ lisp/progmodes/cc-engine.el 2013-08-29 17:26:48 +0000 @@ -6479,6 +6479,15 @@ (c-go-list-forward) t))) +(defmacro c-pull-open-brace (ps) + ;; Pull the next open brace from PS (which has the form of paren-state), + ;; skipping over any brace pairs. Returns NIL when PS is exhausted. + `(progn + (while (consp (car ,ps)) + (setq ,ps (cdr ,ps))) + (prog1 (car ,ps) + (setq ,ps (cdr ,ps))))) + (defun c-back-over-member-initializers () ;; Test whether we are in a C++ member initializer list, and if so, go back ;; to the introducing ":", returning the position of the opening paren of @@ -8403,15 +8412,6 @@ (back-to-indentation) (vector (point) open-paren-pos)))))) -(defmacro c-pull-open-brace (ps) - ;; Pull the next open brace from PS (which has the form of paren-state), - ;; skipping over any brace pairs. Returns NIL when PS is exhausted. - `(progn - (while (consp (car ,ps)) - (setq ,ps (cdr ,ps))) - (prog1 (car ,ps) - (setq ,ps (cdr ,ps))))) - (defun c-most-enclosing-decl-block (paren-state) ;; Return the buffer position of the most enclosing decl-block brace (in the ;; sense of c-looking-at-decl-block) in the PAREN-STATE structure, or nil if ------------------------------------------------------------ revno: 114069 committer: Dmitry Antipov branch nick: trunk timestamp: Thu 2013-08-29 20:36:54 +0400 message: * intervals.c (set_point_from_marker): New function. * editfns.c (Fgoto_char): * process.c (Finternal_default_process_filter): * window.c (select_window_1): Use it. * buffer.h (set_point_from_marker): Add prototype. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-08-29 15:32:04 +0000 +++ src/ChangeLog 2013-08-29 16:36:54 +0000 @@ -1,3 +1,11 @@ +2013-08-29 Dmitry Antipov + + * intervals.c (set_point_from_marker): New function. + * editfns.c (Fgoto_char): + * process.c (Finternal_default_process_filter): + * window.c (select_window_1): Use it. + * buffer.h (set_point_from_marker): Add prototype. + 2013-08-29 Eli Zaretskii * w32.c (term_winsock): Call release_listen_threads before calling === modified file 'src/buffer.h' --- src/buffer.h 2013-08-27 18:47:55 +0000 +++ src/buffer.h 2013-08-29 16:36:54 +0000 @@ -249,6 +249,7 @@ extern void set_point_both (ptrdiff_t, ptrdiff_t); extern void temp_set_point_both (struct buffer *, ptrdiff_t, ptrdiff_t); +extern void set_point_from_marker (Lisp_Object); extern void enlarge_buffer_text (struct buffer *, ptrdiff_t); === modified file 'src/editfns.c' --- src/editfns.c 2013-08-27 18:47:55 +0000 +++ src/editfns.c 2013-08-29 16:36:54 +0000 @@ -233,26 +233,12 @@ The return value is POSITION. */) (register Lisp_Object position) { - ptrdiff_t pos; - - if (MARKERP (position) - && current_buffer == XMARKER (position)->buffer) - { - pos = marker_position (position); - if (pos < BEGV) - SET_PT_BOTH (BEGV, BEGV_BYTE); - else if (pos > ZV) - SET_PT_BOTH (ZV, ZV_BYTE); - else - SET_PT_BOTH (pos, marker_byte_position (position)); - - return position; - } - - CHECK_NUMBER_COERCE_MARKER (position); - - pos = clip_to_bounds (BEGV, XINT (position), ZV); - SET_PT (pos); + if (MARKERP (position)) + set_point_from_marker (position); + else if (INTEGERP (position)) + SET_PT (clip_to_bounds (BEGV, XINT (position), ZV)); + else + wrong_type_argument (Qinteger_or_marker_p, position); return position; } === modified file 'src/intervals.c' --- src/intervals.c 2013-06-30 15:14:45 +0000 +++ src/intervals.c 2013-08-29 16:36:54 +0000 @@ -1821,6 +1821,18 @@ set_point_both (charpos, buf_charpos_to_bytepos (current_buffer, charpos)); } +/* Set PT from MARKER's clipped position. */ + +void +set_point_from_marker (Lisp_Object marker) +{ + if (XMARKER (marker)->buffer != current_buffer) + error ("Marker points into wrong buffer"); + set_point_both + (clip_to_bounds (BEGV, marker_position (marker), ZV), + clip_to_bounds (BEGV_BYTE, marker_byte_position (marker), ZV_BYTE)); +} + /* If there's an invisible character at position POS + TEST_OFFS in the current buffer, and the invisible property has a `stickiness' such that inserting a character at position POS would inherit the property it, === modified file 'src/process.c' --- src/process.c 2013-08-27 19:36:28 +0000 +++ src/process.c 2013-08-29 16:36:54 +0000 @@ -5178,15 +5178,10 @@ bset_read_only (current_buffer, Qnil); - /* Insert new output into buffer - at the current end-of-output marker, - thus preserving logical ordering of input and output. */ + /* Insert new output into buffer at the current end-of-output + marker, thus preserving logical ordering of input and output. */ if (XMARKER (p->mark)->buffer) - SET_PT_BOTH (clip_to_bounds (BEGV, - marker_position (p->mark), ZV), - clip_to_bounds (BEGV_BYTE, - marker_byte_position (p->mark), - ZV_BYTE)); + set_point_from_marker (p->mark); else SET_PT_BOTH (ZV, ZV_BYTE); before = PT; === modified file 'src/window.c' --- src/window.c 2013-08-27 03:52:21 +0000 +++ src/window.c 2013-08-29 16:36:54 +0000 @@ -549,15 +549,7 @@ than one window. It also matters when redisplay_window has altered point after scrolling, because it makes the change only in the window. */ - { - register ptrdiff_t new_point = marker_position (XWINDOW (window)->pointm); - if (new_point < BEGV) - SET_PT (BEGV); - else if (new_point > ZV) - SET_PT (ZV); - else - SET_PT (new_point); - } + set_point_from_marker (XWINDOW (window)->pointm); } DEFUN ("select-window", Fselect_window, Sselect_window, 1, 2, 0, ------------------------------------------------------------ revno: 114068 fixes bug: http://debbugs.gnu.org/14333 committer: Eli Zaretskii branch nick: trunk timestamp: Thu 2013-08-29 18:32:04 +0300 message: A possible fix for bug #14333 with hanging at exit on MS-Windows. src/w32.c (term_winsock): Call release_listen_threads before calling WSACleanup. (_sys_wait_accept): Wait for accept event in a loop with a finite timeout, instead of waiting indefinitely. Will hopefully avoid hanging during exit because WSACleanup deadlocks waiting for the event object to be released. src/w32proc.c (release_listen_threads): New function, signals all the reader threads that listen for connections to stop waiting. src/w32.h (release_listen_threads): Add prototype. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-08-29 15:28:45 +0000 +++ src/ChangeLog 2013-08-29 15:32:04 +0000 @@ -1,3 +1,17 @@ +2013-08-29 Eli Zaretskii + + * w32.c (term_winsock): Call release_listen_threads before calling + WSACleanup. + (_sys_wait_accept): Wait for accept event in a loop with a finite + timeout, instead of waiting indefinitely. Will hopefully avoid + hanging during exit because WSACleanup deadlocks waiting for the + event object to be released. (Bug#14333) + + * w32proc.c (release_listen_threads): New function, signals all + the reader threads that listen for connections to stop waiting. + + * w32.h (release_listen_threads): Add prototype. + 2013-08-29 Dmitry Antipov * alloc.c (Fmake_marker, build_marker): Zero need_adjustment === modified file 'src/w32.c' --- src/w32.c 2013-08-27 18:47:55 +0000 +++ src/w32.c 2013-08-29 15:32:04 +0000 @@ -6092,6 +6092,7 @@ { if (winsock_lib != NULL && winsock_inuse == 0) { + release_listen_threads (); /* Not sure what would cause WSAENETDOWN, or even if it can happen after WSAStartup returns successfully, but it seems reasonable to allow unloading winsock anyway in that case. */ @@ -7076,7 +7077,12 @@ rc = pfn_WSAEventSelect (SOCK_HANDLE (fd), hEv, FD_ACCEPT); if (rc != SOCKET_ERROR) { - rc = WaitForSingleObject (hEv, INFINITE); + do { + rc = WaitForSingleObject (hEv, 500); + Sleep (5); + } while (rc == WAIT_TIMEOUT + && cp->status != STATUS_READ_ERROR + && cp->char_avail); pfn_WSAEventSelect (SOCK_HANDLE (fd), NULL, 0); if (rc == WAIT_OBJECT_0) cp->status = STATUS_READ_SUCCEEDED; === modified file 'src/w32.h' --- src/w32.h 2013-07-07 18:00:14 +0000 +++ src/w32.h 2013-08-29 15:32:04 +0000 @@ -163,6 +163,7 @@ /* Return the string resource associated with KEY of type TYPE. */ extern LPBYTE w32_get_resource (char * key, LPDWORD type); +extern void release_listen_threads (void); extern void init_ntproc (int); extern void term_ntproc (int); extern void globals_of_w32 (void); === modified file 'src/w32proc.c' --- src/w32proc.c 2013-08-27 18:47:55 +0000 +++ src/w32proc.c 2013-08-29 15:32:04 +0000 @@ -990,6 +990,18 @@ return NULL; } +void +release_listen_threads (void) +{ + int i; + + for (i = child_proc_count - 1; i >= 0; i--) + { + if (CHILD_ACTIVE (&child_procs[i]) + && (fd_info[child_procs[i].fd].flags & FILE_LISTEN)) + child_procs[i].status = STATUS_READ_ERROR; + } +} /* Thread proc for child process and socket reader threads. Each thread is normally blocked until woken by select() to check for input by ------------------------------------------------------------ revno: 114067 committer: Dmitry Antipov branch nick: trunk timestamp: Thu 2013-08-29 19:28:45 +0400 message: * lisp.h (XSETMARKER): Remove unused macro (it doesn't work anyway because XMISCTYPE is a function and can't be an lvalue). diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-08-29 11:22:28 +0000 +++ src/ChangeLog 2013-08-29 15:28:45 +0000 @@ -2,6 +2,8 @@ * alloc.c (Fmake_marker, build_marker): Zero need_adjustment field of new marker (for sanity and safety). + * lisp.h (XSETMARKER): Remove unused macro (it doesn't work + anyway because XMISCTYPE is a function and can't be an lvalue). 2013-08-29 Dmitry Antipov === modified file 'src/lisp.h' --- src/lisp.h 2013-08-29 07:03:18 +0000 +++ src/lisp.h 2013-08-29 15:28:45 +0000 @@ -866,11 +866,7 @@ #define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String)) #define XSETSYMBOL(a, b) ((a) = make_lisp_ptr (b, Lisp_Symbol)) #define XSETFLOAT(a, b) ((a) = make_lisp_ptr (b, Lisp_Float)) - -/* Misc types. */ - #define XSETMISC(a, b) ((a) = make_lisp_ptr (b, Lisp_Misc)) -#define XSETMARKER(a, b) (XSETMISC (a, b), XMISCTYPE (a) = Lisp_Misc_Marker) /* Pseudovector types. */ ------------------------------------------------------------ revno: 114066 committer: Dmitry Antipov branch nick: trunk timestamp: Thu 2013-08-29 15:22:28 +0400 message: * alloc.c (Fmake_marker, build_marker): Zero need_adjustment field of new marker (for sanity and safety). diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-08-29 07:27:27 +0000 +++ src/ChangeLog 2013-08-29 11:22:28 +0000 @@ -1,5 +1,10 @@ 2013-08-29 Dmitry Antipov + * alloc.c (Fmake_marker, build_marker): Zero need_adjustment + field of new marker (for sanity and safety). + +2013-08-29 Dmitry Antipov + * xterm.c (x_clear_area): Lost 7th arg because it is always False. (x_after_update_window_line, x_scroll_bar_create): (x_scroll_bar_set_handle, XTset_vertical_scroll_bar): === modified file 'src/alloc.c' --- src/alloc.c 2013-08-27 18:47:55 +0000 +++ src/alloc.c 2013-08-29 11:22:28 +0000 @@ -3479,6 +3479,7 @@ p->charpos = 0; p->next = NULL; p->insertion_type = 0; + p->need_adjustment = 0; return val; } @@ -3503,6 +3504,7 @@ m->charpos = charpos; m->bytepos = bytepos; m->insertion_type = 0; + m->need_adjustment = 0; m->next = BUF_MARKERS (buf); BUF_MARKERS (buf) = m; return obj; ------------------------------------------------------------ revno: 114065 committer: Dmitry Antipov branch nick: trunk timestamp: Thu 2013-08-29 11:27:27 +0400 message: * xterm.c (x_clear_area): Lost 7th arg because it is always False. (x_after_update_window_line, x_scroll_bar_create): (x_scroll_bar_set_handle, XTset_vertical_scroll_bar): (handle_one_xevent, x_clear_frame_area): * gtkutil.c (xg_clear_under_internal_border, xg_update_scrollbar_pos): * xfns.c (x_set_menu_bar_lines, x_set_tool_bar_lines): Adjust users. * xterm.h (x_clear_area): Adjust prototype. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-08-29 07:03:18 +0000 +++ src/ChangeLog 2013-08-29 07:27:27 +0000 @@ -1,5 +1,15 @@ 2013-08-29 Dmitry Antipov + * xterm.c (x_clear_area): Lost 7th arg because it is always False. + (x_after_update_window_line, x_scroll_bar_create): + (x_scroll_bar_set_handle, XTset_vertical_scroll_bar): + (handle_one_xevent, x_clear_frame_area): + * gtkutil.c (xg_clear_under_internal_border, xg_update_scrollbar_pos): + * xfns.c (x_set_menu_bar_lines, x_set_tool_bar_lines): Adjust users. + * xterm.h (x_clear_area): Adjust prototype. + +2013-08-29 Dmitry Antipov + Hook scanning and indentation functions to find_newline. This helps to avoid duplicated code and renders more respect to newline cache. * lisp.h (scan_newline): Prefer ptrdiff_t to EMACS_INT. === modified file 'src/gtkutil.c' --- src/gtkutil.c 2013-08-27 18:47:55 +0000 +++ src/gtkutil.c 2013-08-29 07:27:27 +0000 @@ -872,29 +872,23 @@ if (FRAME_INTERNAL_BORDER_WIDTH (f) > 0) { GtkWidget *wfixed = f->output_data.x->edit_widget; + gtk_widget_queue_draw (wfixed); gdk_window_process_all_updates (); - x_clear_area (FRAME_X_DISPLAY (f), - FRAME_X_WINDOW (f), - 0, 0, - FRAME_PIXEL_WIDTH (f), - FRAME_INTERNAL_BORDER_WIDTH (f), 0); - x_clear_area (FRAME_X_DISPLAY (f), - FRAME_X_WINDOW (f), - 0, 0, - FRAME_INTERNAL_BORDER_WIDTH (f), - FRAME_PIXEL_HEIGHT (f), 0); - x_clear_area (FRAME_X_DISPLAY (f), - FRAME_X_WINDOW (f), - 0, FRAME_PIXEL_HEIGHT (f) - FRAME_INTERNAL_BORDER_WIDTH (f), - FRAME_PIXEL_WIDTH (f), - FRAME_INTERNAL_BORDER_WIDTH (f), 0); - x_clear_area (FRAME_X_DISPLAY (f), - FRAME_X_WINDOW (f), - FRAME_PIXEL_WIDTH (f) - FRAME_INTERNAL_BORDER_WIDTH (f), - 0, - FRAME_INTERNAL_BORDER_WIDTH (f), - FRAME_PIXEL_HEIGHT (f), 0); + + x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), 0, 0, + FRAME_PIXEL_WIDTH (f), FRAME_INTERNAL_BORDER_WIDTH (f)); + + x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), 0, 0, + FRAME_INTERNAL_BORDER_WIDTH (f), FRAME_PIXEL_HEIGHT (f)); + + x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), 0, + FRAME_PIXEL_HEIGHT (f) - FRAME_INTERNAL_BORDER_WIDTH (f), + FRAME_PIXEL_WIDTH (f), FRAME_INTERNAL_BORDER_WIDTH (f)); + + x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + FRAME_PIXEL_WIDTH (f) - FRAME_INTERNAL_BORDER_WIDTH (f), + 0, FRAME_INTERNAL_BORDER_WIDTH (f), FRAME_PIXEL_HEIGHT (f)); } } @@ -3751,14 +3745,11 @@ gtk_widget_queue_draw (wfixed); gdk_window_process_all_updates (); if (oldx != -1 && oldw > 0 && oldh > 0) - { - /* Clear under old scroll bar position. This must be done after - the gtk_widget_queue_draw and gdk_window_process_all_updates - above. */ - x_clear_area (FRAME_X_DISPLAY (f), - FRAME_X_WINDOW (f), - oldx, oldy, oldw, oldh, 0); - } + /* Clear under old scroll bar position. This must be done after + the gtk_widget_queue_draw and gdk_window_process_all_updates + above. */ + x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + oldx, oldy, oldw, oldh); /* GTK does not redraw until the main loop is entered again, but if there are no X events pending we will not enter it. So we sync === modified file 'src/xfns.c' --- src/xfns.c 2013-08-13 08:58:15 +0000 +++ src/xfns.c 2013-08-29 07:27:27 +0000 @@ -1186,7 +1186,7 @@ block_input (); x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), - 0, y, width, height, False); + 0, y, width, height); unblock_input (); } @@ -1197,7 +1197,7 @@ block_input (); x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), - 0, y, width, height, False); + 0, y, width, height); unblock_input (); } @@ -1295,8 +1295,8 @@ if (height > 0 && width > 0) { block_input (); - x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), - 0, y, width, height, False); + x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + 0, y, width, height); unblock_input (); } === modified file 'src/xterm.c' --- src/xterm.c 2013-08-28 11:00:03 +0000 +++ src/xterm.c 2013-08-29 07:27:27 +0000 @@ -698,10 +698,10 @@ block_input (); x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), - 0, y, width, height, False); + 0, y, width, height); x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), FRAME_PIXEL_WIDTH (f) - width, - y, width, height, False); + y, width, height); unblock_input (); } } @@ -2968,10 +2968,10 @@ If they are <= 0, this is probably an error. */ void -x_clear_area (Display *dpy, Window window, int x, int y, int width, int height, int exposures) +x_clear_area (Display *dpy, Window window, int x, int y, int width, int height) { eassert (width > 0 && height > 0); - XClearArea (dpy, window, x, y, width, height, exposures); + XClearArea (dpy, window, x, y, width, height, False); } @@ -4927,8 +4927,7 @@ this case, no clear_frame is generated to reduce flickering. */ if (width > 0 && height > 0) x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), - left, top, width, - window_box_height (w), False); + left, top, width, window_box_height (w)); window = XCreateWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), /* Position and size of scroll bar. */ @@ -5064,11 +5063,9 @@ zero-height areas; that means "clear to end of window." */ if (start > 0) x_clear_area (FRAME_X_DISPLAY (f), w, - /* x, y, width, height, and exposures. */ VERTICAL_SCROLL_BAR_LEFT_BORDER, VERTICAL_SCROLL_BAR_TOP_BORDER, - inside_width, start, - False); + inside_width, start); /* Change to proper foreground color if one is specified. */ if (f->output_data.x->scroll_bar_foreground_pixel != -1) @@ -5091,12 +5088,9 @@ clear zero-height areas; that means "clear to end of window." */ if (end < inside_height) x_clear_area (FRAME_X_DISPLAY (f), w, - /* x, y, width, height, and exposures. */ VERTICAL_SCROLL_BAR_LEFT_BORDER, VERTICAL_SCROLL_BAR_TOP_BORDER + end, - inside_width, inside_height - end, - False); - + inside_width, inside_height - end); } unblock_input (); @@ -5189,11 +5183,11 @@ #ifdef USE_TOOLKIT_SCROLL_BARS if (fringe_extended_p) x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), - sb_left, top, sb_width, height, False); + sb_left, top, sb_width, height); else #endif x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), - left, top, width, height, False); + left, top, width, height); unblock_input (); } @@ -5228,10 +5222,10 @@ { if (fringe_extended_p) x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), - sb_left, top, sb_width, height, False); + sb_left, top, sb_width, height); else x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), - left, top, width, height, False); + left, top, width, height); } #ifdef USE_GTK xg_update_scrollbar_pos (f, @@ -5255,12 +5249,10 @@ if (VERTICAL_SCROLL_BAR_WIDTH_TRIM) { x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), - left, top, VERTICAL_SCROLL_BAR_WIDTH_TRIM, - height, False); + left, top, VERTICAL_SCROLL_BAR_WIDTH_TRIM, height); x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), left + width - VERTICAL_SCROLL_BAR_WIDTH_TRIM, - top, VERTICAL_SCROLL_BAR_WIDTH_TRIM, - height, False); + top, VERTICAL_SCROLL_BAR_WIDTH_TRIM, height); } /* Clear areas not covered by the scroll bar because it's not as @@ -5274,11 +5266,10 @@ { if (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (w)) x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), - left + area_width - rest, top, - rest, height, False); + left + area_width - rest, top, rest, height); else x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), - left, top, rest, height, False); + left, top, rest, height); } } @@ -6122,11 +6113,10 @@ { #ifdef USE_GTK /* This seems to be needed for GTK 2.6. */ - x_clear_area (event.xexpose.display, - event.xexpose.window, - event.xexpose.x, event.xexpose.y, - event.xexpose.width, event.xexpose.height, - FALSE); + x_clear_area (event.xexpose.display, + event.xexpose.window, + event.xexpose.x, event.xexpose.y, + event.xexpose.width, event.xexpose.height); #endif if (!FRAME_VISIBLE_P (f)) { @@ -7349,8 +7339,7 @@ static void x_clear_frame_area (struct frame *f, int x, int y, int width, int height) { - x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), - x, y, width, height, False); + x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), x, y, width, height); #ifdef USE_GTK /* Must queue a redraw, because scroll bars might have been cleared. */ if (FRAME_GTK_WIDGET (f)) === modified file 'src/xterm.h' --- src/xterm.h 2013-08-27 04:23:54 +0000 +++ src/xterm.h 2013-08-29 07:27:27 +0000 @@ -968,7 +968,7 @@ #endif extern bool x_alloc_nearest_color (struct frame *, Colormap, XColor *); extern void x_query_color (struct frame *f, XColor *); -extern void x_clear_area (Display *, Window, int, int, int, int, int); +extern void x_clear_area (Display *, Window, int, int, int, int); #if defined HAVE_MENUS && !defined USE_X_TOOLKIT && !defined USE_GTK extern void x_mouse_leave (struct x_display_info *); #endif ------------------------------------------------------------ revno: 114064 committer: Dmitry Antipov branch nick: trunk timestamp: Thu 2013-08-29 11:03:18 +0400 message: Hook scanning and indentation functions to find_newline. This helps to avoid duplicated code and renders more respect to newline cache. * lisp.h (scan_newline): Prefer ptrdiff_t to EMACS_INT. * cmds.c (Fforward_line): * indent.c (scan_for_column, Fcurrent_indentation, indented_beyond_p): Use find_newline and avoid unnecessary point movements. * search.c (scan_newline): Implement on top of find_newline. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-08-28 18:27:26 +0000 +++ src/ChangeLog 2013-08-29 07:03:18 +0000 @@ -1,3 +1,13 @@ +2013-08-29 Dmitry Antipov + + Hook scanning and indentation functions to find_newline. This helps + to avoid duplicated code and renders more respect to newline cache. + * lisp.h (scan_newline): Prefer ptrdiff_t to EMACS_INT. + * cmds.c (Fforward_line): + * indent.c (scan_for_column, Fcurrent_indentation, indented_beyond_p): + Use find_newline and avoid unnecessary point movements. + * search.c (scan_newline): Implement on top of find_newline. + 2013-08-28 Stefan Monnier * eval.c (Ffuncall): Fix handling of ((lambda ..) ..) in lexically === modified file 'src/cmds.c' --- src/cmds.c 2013-08-13 14:09:12 +0000 +++ src/cmds.c 2013-08-29 07:03:18 +0000 @@ -121,9 +121,7 @@ successfully moved (for the return value). */) (Lisp_Object n) { - ptrdiff_t opoint = PT, opoint_byte = PT_BYTE; - ptrdiff_t pos, pos_byte; - EMACS_INT count, shortage; + ptrdiff_t opoint = PT, pos, pos_byte, shortage, count; if (NILP (n)) count = 1; @@ -134,16 +132,12 @@ } if (count <= 0) - shortage = scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, count - 1, 1); + pos = find_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, count - 1, + &shortage, &pos_byte, 1); else - shortage = scan_newline (PT, PT_BYTE, ZV, ZV_BYTE, count, 1); + pos = find_newline (PT, PT_BYTE, ZV, ZV_BYTE, count, + &shortage, &pos_byte, 1); - /* Since scan_newline does TEMP_SET_PT_BOTH, - and we want to set PT "for real", - go back to the old point and then come back here. */ - pos = PT; - pos_byte = PT_BYTE; - TEMP_SET_PT_BOTH (opoint, opoint_byte); SET_PT_BOTH (pos, pos_byte); if (shortage > 0 === modified file 'src/indent.c' --- src/indent.c 2013-08-06 06:53:09 +0000 +++ src/indent.c 2013-08-29 07:03:18 +0000 @@ -510,15 +510,10 @@ register ptrdiff_t col = 0, prev_col = 0; EMACS_INT goal = goalcol ? *goalcol : MOST_POSITIVE_FIXNUM; ptrdiff_t end = endpos ? *endpos : PT; - ptrdiff_t scan, scan_byte; - ptrdiff_t next_boundary; - { - ptrdiff_t opoint = PT, opoint_byte = PT_BYTE; - scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -1, 1); - scan = PT, scan_byte = PT_BYTE; - SET_PT_BOTH (opoint, opoint_byte); + ptrdiff_t scan, scan_byte, next_boundary; + + scan = find_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -1, NULL, &scan_byte, 1); next_boundary = scan; - } window = Fget_buffer_window (Fcurrent_buffer (), Qnil); w = ! NILP (window) ? XWINDOW (window) : NULL; @@ -835,14 +830,10 @@ following any initial whitespace. */) (void) { - Lisp_Object val; - ptrdiff_t opoint = PT, opoint_byte = PT_BYTE; - - scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -1, 1); - - XSETFASTINT (val, position_indentation (PT_BYTE)); - SET_PT_BOTH (opoint, opoint_byte); - return val; + ptrdiff_t posbyte; + + find_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -1, NULL, &posbyte, 1); + return make_number (position_indentation (posbyte)); } static ptrdiff_t @@ -935,16 +926,13 @@ bool indented_beyond_p (ptrdiff_t pos, ptrdiff_t pos_byte, EMACS_INT column) { - ptrdiff_t val; - ptrdiff_t opoint = PT, opoint_byte = PT_BYTE; - - SET_PT_BOTH (pos, pos_byte); - while (PT > BEGV && FETCH_BYTE (PT_BYTE) == '\n') - scan_newline (PT - 1, PT_BYTE - 1, BEGV, BEGV_BYTE, -1, 0); - - val = position_indentation (PT_BYTE); - SET_PT_BOTH (opoint, opoint_byte); - return val >= column; + while (pos > BEGV && FETCH_BYTE (pos_byte) == '\n') + { + DEC_BOTH (pos, pos_byte); + pos = find_newline (pos, pos_byte, BEGV, BEGV_BYTE, + -1, NULL, &pos_byte, 0); + } + return position_indentation (pos_byte) >= column; } DEFUN ("move-to-column", Fmove_to_column, Smove_to_column, 1, 2, === modified file 'src/lisp.h' --- src/lisp.h 2013-08-27 03:52:21 +0000 +++ src/lisp.h 2013-08-29 07:03:18 +0000 @@ -3834,8 +3834,8 @@ ptrdiff_t, ptrdiff_t, Lisp_Object); extern ptrdiff_t find_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t *, ptrdiff_t *, bool); -extern EMACS_INT scan_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, - EMACS_INT, bool); +extern ptrdiff_t scan_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, + ptrdiff_t, bool); extern ptrdiff_t find_newline_no_quit (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t *); extern ptrdiff_t find_before_next_newline (ptrdiff_t, ptrdiff_t, === modified file 'src/search.c' --- src/search.c 2013-08-06 06:53:09 +0000 +++ src/search.c 2013-08-29 07:03:18 +0000 @@ -859,88 +859,20 @@ If ALLOW_QUIT, set immediate_quit. That's good to do except in special cases. */ -EMACS_INT +ptrdiff_t scan_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t limit, ptrdiff_t limit_byte, - EMACS_INT count, bool allow_quit) + ptrdiff_t count, bool allow_quit) { - int direction = ((count > 0) ? 1 : -1); - - unsigned char *cursor; - unsigned char *base; - - ptrdiff_t ceiling; - unsigned char *ceiling_addr; - - bool old_immediate_quit = immediate_quit; - - if (allow_quit) - immediate_quit++; - - if (count > 0) - { - while (start_byte < limit_byte) - { - ceiling = BUFFER_CEILING_OF (start_byte); - ceiling = min (limit_byte - 1, ceiling); - ceiling_addr = BYTE_POS_ADDR (ceiling) + 1; - base = (cursor = BYTE_POS_ADDR (start_byte)); - - do - { - unsigned char *nl = memchr (cursor, '\n', ceiling_addr - cursor); - if (! nl) - break; - if (--count == 0) - { - immediate_quit = old_immediate_quit; - start_byte += nl - base + 1; - start = BYTE_TO_CHAR (start_byte); - TEMP_SET_PT_BOTH (start, start_byte); - return 0; - } - cursor = nl + 1; - } - while (cursor < ceiling_addr); - - start_byte += ceiling_addr - base; - } - } + ptrdiff_t charpos, bytepos, shortage; + + charpos = find_newline (start, start_byte, limit, limit_byte, + count, &shortage, &bytepos, allow_quit); + if (shortage) + TEMP_SET_PT_BOTH (limit, limit_byte); else - { - while (start_byte > limit_byte) - { - ceiling = BUFFER_FLOOR_OF (start_byte - 1); - ceiling = max (limit_byte, ceiling); - ceiling_addr = BYTE_POS_ADDR (ceiling); - base = (cursor = BYTE_POS_ADDR (start_byte - 1) + 1); - while (1) - { - unsigned char *nl = memrchr (ceiling_addr, '\n', - cursor - ceiling_addr); - if (! nl) - break; - - if (++count == 0) - { - immediate_quit = old_immediate_quit; - /* Return the position AFTER the match we found. */ - start_byte += nl - base + 1; - start = BYTE_TO_CHAR (start_byte); - TEMP_SET_PT_BOTH (start, start_byte); - return 0; - } - - cursor = nl; - } - start_byte += ceiling_addr - base; - } - } - - TEMP_SET_PT_BOTH (limit, limit_byte); - immediate_quit = old_immediate_quit; - - return count * direction; + TEMP_SET_PT_BOTH (charpos, bytepos); + return shortage; } /* Like find_newline, but doesn't allow QUITting and doesn't return ------------------------------------------------------------ revno: 114063 committer: Stefan Monnier branch nick: trunk timestamp: Wed 2013-08-28 23:49:10 -0400 message: * lisp/emacs-lisp/cl-macs.el (cl-defsubst): Make it clear that args are immutable. Don't use `unsafe' any more. (cl--defsubst-expand): Don't substitute at the same time as keeping a residual unused let-binding. Don't use `unsafe' any more. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-08-29 03:21:33 +0000 +++ lisp/ChangeLog 2013-08-29 03:49:10 +0000 @@ -1,3 +1,10 @@ +2013-08-29 Stefan Monnier + + * emacs-lisp/cl-macs.el (cl-defsubst): Make it clear that args + are immutable. Don't use `unsafe' any more. + (cl--defsubst-expand): Don't substitute at the same time as keeping + a residual unused let-binding. Don't use `unsafe' any more. + 2013-08-29 Glenn Morris * calendar/cal-china.el (calendar-chinese-year-cache): === modified file 'lisp/emacs-lisp/cl-macs.el' --- lisp/emacs-lisp/cl-macs.el 2013-08-13 02:30:52 +0000 +++ lisp/emacs-lisp/cl-macs.el 2013-08-29 03:49:10 +0000 @@ -2693,15 +2693,16 @@ ;;;###autoload (defmacro cl-defsubst (name args &rest body) "Define NAME as a function. -Like `defun', except the function is automatically declared `inline', +Like `defun', except the function is automatically declared `inline' and +the arguments are immutable. ARGLIST allows full Common Lisp conventions, and BODY is implicitly surrounded by (cl-block NAME ...). +The function's arguments should be treated as immutable. \(fn NAME ARGLIST [DOCSTRING] BODY...)" (declare (debug cl-defun) (indent 2)) (let* ((argns (cl--arglist-args args)) (p argns) - (pbody (cons 'progn body)) - (unsafe (not (cl--safe-expr-p pbody)))) + (pbody (cons 'progn body))) (while (and p (eq (cl--expr-contains args (car p)) 1)) (pop p)) `(progn ,(if p nil ; give up if defaults refer to earlier args @@ -2717,10 +2718,10 @@ ;; does not pay attention to the argvs (and ;; cl-expr-access-order itself is also too naive). nil - ,(and (memq '&key args) 'cl-whole) ,unsafe ,@argns))) + ,(and (memq '&key args) 'cl-whole) nil ,@argns))) (cl-defun ,name ,args ,@body)))) -(defun cl--defsubst-expand (argns body simple whole unsafe &rest argvs) +(defun cl--defsubst-expand (argns body simple whole _unsafe &rest argvs) (if (and whole (not (cl--safe-expr-p (cons 'progn argvs)))) whole (if (cl--simple-exprs-p argvs) (setq simple t)) (let* ((substs ()) @@ -2728,7 +2729,7 @@ (cl-mapcar (lambda (argn argv) (if (or simple (macroexp-const-p argv)) (progn (push (cons argn argv) substs) - (and unsafe (list argn argv))) + nil) (list argn argv))) argns argvs)))) ;; FIXME: `sublis/subst' will happily substitute the symbol