Commit c0458e0b authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* lisp/subr.el (pop): Use `car-safe'.

* lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Remove hack
to detect unused `pop' return value.

* lisp/emacs-lisp/advice.el (defadvice): Add indent rule.

* lisp/international/mule-cmds.el: Require CL.
(find-coding-systems-for-charsets): Avoid add-to-list.
(sanitize-coding-system-list): New function, extracted from
select-safe-coding-system-interactively.
(select-safe-coding-system-interactively): Use it.
(read-input-method-name): Accept symbols for `default'.

* lisp/progmodes/python.el (python-nav-beginning-of-block): Remove unused
var `block-regexp'.
(python-nav--forward-sexp): Remove unused var `re-search-fn'.
(python-fill-string): Remove unused var `marker'.
(python-skeleton-add-menu-items): Remove unused var `items'.
parent 6c42fc3e
2013-09-05 Stefan Monnier <monnier@iro.umontreal.ca>
* subr.el (pop): Use `car-safe'.
* emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Remove hack
to detect unused `pop' return value.
* progmodes/python.el (python-nav-beginning-of-block): Remove unused
var `block-regexp'.
(python-nav--forward-sexp): Remove unused var `re-search-fn'.
(python-fill-string): Remove unused var `marker'.
(python-skeleton-add-menu-items): Remove unused var `items'.
* international/mule-cmds.el: Require CL.
(find-coding-systems-for-charsets): Avoid add-to-list.
(sanitize-coding-system-list): New function, extracted from
select-safe-coding-system-interactively.
(select-safe-coding-system-interactively): Use it.
(read-input-method-name): Accept symbols for `default'.
* emacs-lisp/advice.el (defadvice): Add indent rule.
2013-09-05 Daniel Hackney <dan@haxney.org> 2013-09-05 Daniel Hackney <dan@haxney.org>
* dired-x.el: * dired-x.el:
......
...@@ -3190,7 +3190,7 @@ See Info node `(elisp)Advising Functions' for comprehensive documentation. ...@@ -3190,7 +3190,7 @@ See Info node `(elisp)Advising Functions' for comprehensive documentation.
usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
[DOCSTRING] [INTERACTIVE-FORM] [DOCSTRING] [INTERACTIVE-FORM]
BODY...)" BODY...)"
(declare (doc-string 3) (declare (doc-string 3) (indent 2)
(debug (&define name ;; thing being advised. (debug (&define name ;; thing being advised.
(name ;; class is [&or "before" "around" "after" (name ;; class is [&or "before" "around" "after"
;; "activation" "deactivation"] ;; "activation" "deactivation"]
......
...@@ -533,18 +533,6 @@ ...@@ -533,18 +533,6 @@
((and for-effect (setq tmp (get fn 'side-effect-free)) ((and for-effect (setq tmp (get fn 'side-effect-free))
(or byte-compile-delete-errors (or byte-compile-delete-errors
(eq tmp 'error-free) (eq tmp 'error-free)
;; Detect the expansion of (pop foo).
;; There is no need to compile the call to `car' there.
(and (eq fn 'car)
(eq (car-safe (cadr form)) 'prog1)
(let ((var (cadr (cadr form)))
(last (nth 2 (cadr form))))
(and (symbolp var)
(null (nthcdr 3 (cadr form)))
(eq (car-safe last) 'setq)
(eq (cadr last) var)
(eq (car-safe (nth 2 last)) 'cdr)
(eq (cadr (nth 2 last)) var))))
(progn (progn
(byte-compile-warn "value returned from %s is unused" (byte-compile-warn "value returned from %s is unused"
(prin1-to-string form)) (prin1-to-string form))
......
...@@ -30,6 +30,8 @@ ...@@ -30,6 +30,8 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl-lib))
(defvar dos-codepage) (defvar dos-codepage)
(autoload 'widget-value "wid-edit") (autoload 'widget-value "wid-edit")
...@@ -548,7 +550,7 @@ Emacs, but is unlikely to be what you really want now." ...@@ -548,7 +550,7 @@ Emacs, but is unlikely to be what you really want now."
(coding-system-charset-list cs))) (coding-system-charset-list cs)))
(charsets charsets)) (charsets charsets))
(if (coding-system-get cs :ascii-compatible-p) (if (coding-system-get cs :ascii-compatible-p)
(add-to-list 'cs-charsets 'ascii)) (cl-pushnew 'ascii cs-charsets))
(if (catch 'ok (if (catch 'ok
(when cs-charsets (when cs-charsets
(while charsets (while charsets
...@@ -636,6 +638,36 @@ The meaning is the same as the argument ACCEPT-DEFAULT-P of the ...@@ -636,6 +638,36 @@ The meaning is the same as the argument ACCEPT-DEFAULT-P of the
function `select-safe-coding-system' (which see). This variable function `select-safe-coding-system' (which see). This variable
overrides that argument.") overrides that argument.")
(defun sanitize-coding-system-list (codings)
"Return a list of coding systems presumably more user-friendly than CODINGS."
;; Change each safe coding system to the corresponding
;; mime-charset name if it is also a coding system. Such a name
;; is more friendly to users.
(setq codings
(mapcar (lambda (cs)
(let ((mime-charset (coding-system-get cs 'mime-charset)))
(if (and mime-charset (coding-system-p mime-charset)
(coding-system-equal cs mime-charset))
mime-charset cs)))
codings))
;; Don't offer variations with locking shift, which you
;; basically never want.
(let (l)
(dolist (elt codings (setq codings (nreverse l)))
(unless (or (eq 'coding-category-iso-7-else
(coding-system-category elt))
(eq 'coding-category-iso-8-else
(coding-system-category elt)))
(push elt l))))
;; Remove raw-text, emacs-mule and no-conversion unless nothing
;; else is available.
(or (delq 'raw-text
(delq 'emacs-mule
(delq 'no-conversion (copy-sequence codings))))
codings))
(defun select-safe-coding-system-interactively (from to codings unsafe (defun select-safe-coding-system-interactively (from to codings unsafe
&optional rejected default) &optional rejected default)
"Select interactively a coding system for the region FROM ... TO. "Select interactively a coding system for the region FROM ... TO.
...@@ -667,35 +699,7 @@ DEFAULT is the coding system to use by default in the query." ...@@ -667,35 +699,7 @@ DEFAULT is the coding system to use by default in the query."
from to coding 11))))) from to coding 11)))))
unsafe))) unsafe)))
;; Change each safe coding system to the corresponding (setq codings (sanitize-coding-system-list codings))
;; mime-charset name if it is also a coding system. Such a name
;; is more friendly to users.
(let ((l codings)
mime-charset)
(while l
(setq mime-charset (coding-system-get (car l) :mime-charset))
(if (and mime-charset (coding-system-p mime-charset)
(coding-system-equal (car l) mime-charset))
(setcar l mime-charset))
(setq l (cdr l))))
;; Don't offer variations with locking shift, which you
;; basically never want.
(let (l)
(dolist (elt codings (setq codings (nreverse l)))
(unless (or (eq 'coding-category-iso-7-else
(coding-system-category elt))
(eq 'coding-category-iso-8-else
(coding-system-category elt)))
(push elt l))))
;; Remove raw-text, emacs-mule and no-conversion unless nothing
;; else is available.
(setq codings
(or (delq 'raw-text
(delq 'emacs-mule
(delq 'no-conversion codings)))
'(raw-text emacs-mule no-conversion)))
(let ((window-configuration (current-window-configuration)) (let ((window-configuration (current-window-configuration))
(bufname (buffer-name)) (bufname (buffer-name))
...@@ -1421,7 +1425,9 @@ The return value is a string." ...@@ -1421,7 +1425,9 @@ The return value is a string."
;; buffer local. ;; buffer local.
(input-method (completing-read prompt input-method-alist (input-method (completing-read prompt input-method-alist
nil t nil 'input-method-history nil t nil 'input-method-history
default))) (if (and default (symbolp default))
(symbol-name default)
default))))
(if (and input-method (symbolp input-method)) (if (and input-method (symbolp input-method))
(setq input-method (symbol-name input-method))) (setq input-method (symbol-name input-method)))
(if (> (length input-method) 0) (if (> (length input-method) 0)
......
...@@ -1327,9 +1327,7 @@ backward to previous statement." ...@@ -1327,9 +1327,7 @@ backward to previous statement."
(defun python-nav-beginning-of-block () (defun python-nav-beginning-of-block ()
"Move to start of current block." "Move to start of current block."
(interactive "^") (interactive "^")
(let ((starting-pos (point)) (let ((starting-pos (point)))
(block-regexp (python-rx
line-start (* whitespace) block-start)))
(if (progn (if (progn
(python-nav-beginning-of-statement) (python-nav-beginning-of-statement)
(looking-at (python-rx block-start))) (looking-at (python-rx block-start)))
...@@ -1422,9 +1420,6 @@ backwards." ...@@ -1422,9 +1420,6 @@ backwards."
(let* ((forward-p (if (> dir 0) (let* ((forward-p (if (> dir 0)
(and (setq dir 1) t) (and (setq dir 1) t)
(and (setq dir -1) nil))) (and (setq dir -1) nil)))
(re-search-fn (if forward-p
're-search-forward
're-search-backward))
(context-type (python-syntax-context-type))) (context-type (python-syntax-context-type)))
(cond (cond
((memq context-type '(string comment)) ((memq context-type '(string comment))
...@@ -2666,8 +2661,7 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." ...@@ -2666,8 +2661,7 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'."
(defun python-fill-string (&optional justify) (defun python-fill-string (&optional justify)
"String fill function for `python-fill-paragraph'. "String fill function for `python-fill-paragraph'.
JUSTIFY should be used (if applicable) as in `fill-paragraph'." JUSTIFY should be used (if applicable) as in `fill-paragraph'."
(let* ((marker (point-marker)) (let* ((str-start-pos
(str-start-pos
(set-marker (set-marker
(make-marker) (make-marker)
(or (python-syntax-context 'string) (or (python-syntax-context 'string)
...@@ -2733,7 +2727,7 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." ...@@ -2733,7 +2727,7 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'."
;; Again indent only if a newline is added. ;; Again indent only if a newline is added.
(indent-according-to-mode))))) t) (indent-according-to-mode))))) t)
(defun python-fill-decorator (&optional justify) (defun python-fill-decorator (&optional _justify)
"Decorator fill function for `python-fill-paragraph'. "Decorator fill function for `python-fill-paragraph'.
JUSTIFY should be used (if applicable) as in `fill-paragraph'." JUSTIFY should be used (if applicable) as in `fill-paragraph'."
t) t)
...@@ -2895,8 +2889,7 @@ The skeleton will be bound to python-skeleton-NAME." ...@@ -2895,8 +2889,7 @@ The skeleton will be bound to python-skeleton-NAME."
(defun python-skeleton-add-menu-items () (defun python-skeleton-add-menu-items ()
"Add menu items to Python->Skeletons menu." "Add menu items to Python->Skeletons menu."
(let ((skeletons (sort python-skeleton-available 'string<)) (let ((skeletons (sort python-skeleton-available 'string<)))
(items))
(dolist (skeleton skeletons) (dolist (skeleton skeletons)
(easy-menu-add-item (easy-menu-add-item
nil '("Python" "Skeletons") nil '("Python" "Skeletons")
...@@ -2984,7 +2977,7 @@ Runs COMMAND, a shell command, as if by `compile'. See ...@@ -2984,7 +2977,7 @@ Runs COMMAND, a shell command, as if by `compile'. See
(let ((process-environment (python-shell-calculate-process-environment)) (let ((process-environment (python-shell-calculate-process-environment))
(exec-path (python-shell-calculate-exec-path))) (exec-path (python-shell-calculate-exec-path)))
(compilation-start command nil (compilation-start command nil
(lambda (mode-name) (lambda (_modename)
(format python-check-buffer-name command))))) (format python-check-buffer-name command)))))
...@@ -3095,7 +3088,7 @@ It must be a function with two arguments: TYPE and NAME.") ...@@ -3095,7 +3088,7 @@ It must be a function with two arguments: TYPE and NAME.")
"Return imenu label for parent node using TYPE and NAME." "Return imenu label for parent node using TYPE and NAME."
(format "%s..." (python-imenu-format-item-label type name))) (format "%s..." (python-imenu-format-item-label type name)))
(defun python-imenu-format-parent-item-jump-label (type name) (defun python-imenu-format-parent-item-jump-label (type _name)
"Return imenu label for parent node jump using TYPE and NAME." "Return imenu label for parent node jump using TYPE and NAME."
(if (string= type "class") (if (string= type "class")
"*class definition*" "*class definition*"
...@@ -3209,7 +3202,7 @@ To this: ...@@ -3209,7 +3202,7 @@ To this:
(cons name (cdar pos)) (cons name (cdar pos))
(python-imenu-create-flat-index (cddr item) name)))))) (python-imenu-create-flat-index (cddr item) name))))))
(or alist (or alist
(let* ((fn (lambda (type name) name)) (let* ((fn (lambda (_type name) name))
(python-imenu-format-item-label-function fn) (python-imenu-format-item-label-function fn)
(python-imenu-format-parent-item-label-function fn) (python-imenu-format-parent-item-label-function fn)
(python-imenu-format-parent-item-jump-label-function fn)) (python-imenu-format-parent-item-jump-label-function fn))
...@@ -3614,7 +3607,7 @@ if that value is non-nil." ...@@ -3614,7 +3607,7 @@ if that value is non-nil."
(add-to-list 'hs-special-modes-alist (add-to-list 'hs-special-modes-alist
`(python-mode "^\\s-*\\(?:def\\|class\\)\\>" nil "#" `(python-mode "^\\s-*\\(?:def\\|class\\)\\>" nil "#"
,(lambda (arg) ,(lambda (_arg)
(python-nav-end-of-defun)) nil)) (python-nav-end-of-defun)) nil))
(set (make-local-variable 'mode-require-final-newline) t) (set (make-local-variable 'mode-require-final-newline) t)
......
...@@ -170,12 +170,16 @@ PLACE must be a generalized variable whose value is a list. ...@@ -170,12 +170,16 @@ PLACE must be a generalized variable whose value is a list.
If the value is nil, `pop' returns nil but does not actually If the value is nil, `pop' returns nil but does not actually
change the list." change the list."
(declare (debug (gv-place))) (declare (debug (gv-place)))
(list 'car ;; We use `car-safe' here instead of `car' because the behavior is the same
(if (symbolp place) ;; (if it's not a cons cell, the `cdr' would have signaled an error already),
;; So we can use `pop' in the bootstrap before `gv' can be used. ;; but `car-safe' is total, so the byte-compiler can safely remove it if the
(list 'prog1 place (list 'setq place (list 'cdr place))) ;; result is not used.
(gv-letplace (getter setter) place `(car-safe
`(prog1 ,getter ,(funcall setter `(cdr ,getter))))))) ,(if (symbolp place)
;; So we can use `pop' in the bootstrap before `gv' can be used.
(list 'prog1 place (list 'setq place (list 'cdr place)))
(gv-letplace (getter setter) place
`(prog1 ,getter ,(funcall setter `(cdr ,getter)))))))
(defmacro when (cond &rest body) (defmacro when (cond &rest body)
"If COND yields non-nil, do BODY, else return nil. "If COND yields non-nil, do BODY, else return nil.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment