procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

merge trunk

Browse source
This commit is contained in:
Kenichi Handa 2010-05-19 10:16:01 +09:00
commit 9ba3dd4898
8 changed files with 356 additions and 124 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
etc/NEWS
View file

@ -214,7 +214,9 @@ threads simultaneously.
** secrets.el is an implementation of the Secret Service API, an
interface to password managers like GNOME Keyring or KDE Wallet. The
Secret Service API requires D-Bus for communication.
Secret Service API requires D-Bus for communication. The command
`secrets-show-secrets' offers a buffer with a visualization of the
secrets.
* Incompatible Lisp Changes in Emacs 24.1

39
lisp/ChangeLog
View file

@ -4,6 +4,43 @@
composition-function-table only for combining characters (Mn, Mc,
Me).
2010-05-18 Jay Belanger <jay.p.belanger@gmail.com>
* calc/calc-trail.el (calc-trail-isearch-forward)
(calc-trail-isearch-backward): Ensure that the new window
point is set correctly.
2010-05-18 Stefan Monnier <monnier@iro.umontreal.ca>
* subr.el (read-quoted-char): Resolve modifiers after key
remapping (bug#6212).
2010-05-18 Michael Albinus <michael.albinus@gmx.de>
Add visualization code for secrets.
* net/secrets.el (secrets-mode): New major mode.
(secrets-show-secrets, secrets-show-collections)
(secrets-expand-collection, secrets-expand-item)
(secrets-tree-widget-after-toggle-function)
(secrets-tree-widget-show-password): New defuns.
2010-05-18 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/smie.el (smie-next-sexp): Break inf-loop at BOB.
(smie-backward-sexp, smie-forward-sexp): Remove boundary condition now
handled in smie-next-sexp.
(smie-indent-calculate): Provide a starting indentation (so the
recursion is well-founded ;-).
Fix handling of non-associative equal levels.
* emacs-lisp/smie.el (smie-prec2-levels): Choose distinct levels even
when it's not needed.
(smie-op-left, smie-op-right): New functions.
(smie-next-sexp): New function, extracted from smie-backward-sexp.
Better handle equal levels to distinguish the associative case from
the "multi-keyword construct" case.
(smie-backward-sexp, smie-forward-sexp): Use it.
2010-05-18 Juanma Barranquero <lekktu@gmail.com>
* progmodes/prolog.el (smie-indent-basic): Declare for byte-compiler.
@ -135,7 +172,7 @@
2010-05-13 Michael Albinus <michael.albinus@gmx.de>
* net/tramp.el (with-progress-reporter): Create reporter object
only when the message would be displayed. Handled nested calls.
only when the message would be displayed. Handle nested calls.
(tramp-handle-load, tramp-handle-file-local-copy)
(tramp-handle-insert-file-contents, tramp-handle-write-region)
(tramp-maybe-send-script, tramp-find-shell):

28
lisp/calc/calc-trail.el
View file

@ -108,20 +108,28 @@
(defun calc-trail-isearch-forward ()
(interactive)
(calc-with-trail-buffer
(save-window-excursion
(select-window (get-buffer-window (current-buffer)))
(let ((search-exit-char ?\r))
(isearch-forward)))
(calc-trail-here)))
(let ((win (get-buffer-window (current-buffer)))
pos)
(save-window-excursion
(select-window win)
(isearch-forward)
(setq pos (point)))
(goto-char pos)
(set-window-point win pos)
(calc-trail-here))))
(defun calc-trail-isearch-backward ()
(interactive)
(calc-with-trail-buffer
(save-window-excursion
(select-window (get-buffer-window (current-buffer)))
(let ((search-exit-char ?\r))
(isearch-backward)))
(calc-trail-here)))
(let ((win (get-buffer-window (current-buffer)))
pos)
(save-window-excursion
(select-window win)
(isearch-backward)
(setq pos (point)))
(goto-char pos)
(set-window-point win pos)
(calc-trail-here))))
(defun calc-trail-yank (arg)
(interactive "P")

214
lisp/emacs-lisp/smie.el
View file

@ -252,11 +252,23 @@ PREC2 is a table as returned by `smie-precs-precedence-table' or
(dolist (cst csts)
(unless (memq (car cst) rhvs)
(setq progress t)
;; We could give each var in a given iteration the same value,
;; but we can also give them arbitrarily different values.
;; Basically, these are vars between which there is no
;; constraint (neither equality nor inequality), so
;; anything will do.
;; We give them arbitrary values, which means that we
;; replace the "no constraint" case with either > or <
;; but not =. The reason we do that is so as to try and
;; distinguish associative operators (which will have
;; left = right).
(unless (caar cst)
(setcar (car cst) i)
(incf i))
(setq csts (delq cst csts))))
(unless progress
(error "Can't resolve the precedence table to precedence levels")))
(incf i))
(incf i 10))
;; Propagate equalities back to their source.
(dolist (eq (nreverse eqs))
(assert (null (caar eq)))
@ -278,6 +290,9 @@ PREC2 is a table as returned by `smie-precs-precedence-table' or
Each element is of the form (TOKEN LEFT-LEVEL RIGHT-LEVEL).
Parsing is done using an operator precedence parser.")
(defalias 'smie-op-left 'car)
(defalias 'smie-op-right 'cadr)
(defun smie-backward-token ()
;; FIXME: This may be an OK default but probably needs a hook.
(buffer-substring (point)
@ -292,6 +307,92 @@ Parsing is done using an operator precedence parser.")
(skip-syntax-forward "w_'"))
(point))))
(defun smie-associative-p (toklevels)
;; in "a + b + c" we want to stop at each +, but in
;; "if a then b else c" we don't want to stop at each keyword.
;; To distinguish the two cases, we made smie-prec2-levels choose
;; different levels for each part of "if a then b else c", so that
;; by checking if the left-level is equal to the right level, we can
;; figure out that it's an associative operator.
;; This is not 100% foolproof, tho, since a grammar like
;; (exp ("A" exp "C") ("A" exp "B" exp "C"))
;; will cause "B" to have equal left and right levels, even though
;; it is not an associative operator.
;; A better check would be the check the actual previous operator
;; against this one to see if it's the same, but we'd have to change
;; `levels' to keep a stack of operators rather than only levels.
(eq (smie-op-left toklevels) (smie-op-right toklevels)))
(defun smie-next-sexp (next-token next-sexp op-forw op-back halfsexp)
"Skip over one sexp.
NEXT-TOKEN is a function of no argument that moves forward by one
token (after skipping comments if needed) and returns it.
NEXT-SEXP is a lower-level function to skip one sexp.
OP-FORW is the accessor to the forward level of the level data.
OP-BACK is the accessor to the backward level of the level data.
HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the
first token we see is an operator, skip over its left-hand-side argument.
Possible return values:
(FORW-LEVEL POS TOKEN): we couldn't skip TOKEN because its back-level
is too high. FORW-LEVEL is the forw-level of TOKEN,
POS is its start position in the buffer.
(t POS TOKEN): same thing when we bump on the wrong side of a paren.
(nil POS TOKEN): we skipped over a paren-like pair.
nil: we skipped over an identifier, matched parentheses, ..."
(catch 'return
(let ((levels ()))
(while
(let* ((pos (point))
(token (funcall next-token))
(toklevels (cdr (assoc token smie-op-levels))))
(cond
((null toklevels)
(when (equal token "")
(condition-case err
(progn (goto-char pos) (funcall next-sexp 1) nil)
(scan-error (throw 'return (list t (caddr err)))))
(if (eq pos (point))
;; We did not move, so let's abort the loop.
(throw 'return (list t (point))))))
((null (funcall op-back toklevels))
;; A token like a paren-close.
(assert (funcall op-forw toklevels)) ;Otherwise, why mention it?
(push (funcall op-forw toklevels) levels))
(t
(while (and levels (< (funcall op-back toklevels) (car levels)))
(setq levels (cdr levels)))
(cond
((null levels)
(if (and halfsexp (funcall op-forw toklevels))
(push (funcall op-forw toklevels) levels)
(throw 'return
(prog1 (list (or (car toklevels) t) (point) token)
(goto-char pos)))))
(t
(if (and levels (= (funcall op-back toklevels) (car levels)))
(setq levels (cdr levels)))
(cond
((null levels)
(cond
((null (funcall op-forw toklevels))
(throw 'return (list nil (point) token)))
((smie-associative-p toklevels)
(throw 'return
(prog1 (list (or (car toklevels) t) (point) token)
(goto-char pos))))
;; We just found a match to the previously pending operator
;; but this new operator is still part of a larger RHS.
;; E.g. we're now looking at the "then" in
;; "if a then b else c". So we have to keep parsing the
;; rest of the construct.
(t (push (funcall op-forw toklevels) levels))))
(t
(if (funcall op-forw toklevels)
(push (funcall op-forw toklevels) levels))))))))
levels)
(setq halfsexp nil)))))
(defun smie-backward-sexp (&optional halfsexp)
"Skip over one sexp.
HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the
@ -303,55 +404,13 @@ Possible return values:
(t POS TOKEN): same thing but for an open-paren or the beginning of buffer.
(nil POS TOKEN): we skipped over a paren-like pair.
nil: we skipped over an identifier, matched parentheses, ..."
(if (bobp) (list t (point))
(catch 'return
(let ((levels ()))
(while
(let* ((pos (point))
(token (progn (forward-comment (- (point-max)))
(smie-backward-token)))
(toklevels (cdr (assoc token smie-op-levels))))
(smie-next-sexp
(lambda () (forward-comment (- (point-max))) (smie-backward-token))
(indirect-function 'backward-sexp)
(indirect-function 'smie-op-left)
(indirect-function 'smie-op-right)
halfsexp))
(cond
((null toklevels)
(if (equal token "")
(condition-case err
(progn (goto-char pos) (backward-sexp 1) nil)
(scan-error (throw 'return (list t (caddr err)))))))
((null (nth 1 toklevels))
;; A token like a paren-close.
(assert (nth 0 toklevels)) ;Otherwise, why mention it?
(push (nth 0 toklevels) levels))
(t
(while (and levels (< (nth 1 toklevels) (car levels)))
(setq levels (cdr levels)))
(cond
((null levels)
(if (and halfsexp (nth 0 toklevels))
(push (nth 0 toklevels) levels)
(throw 'return
(prog1 (list (or (car toklevels) t) (point) token)
(goto-char pos)))))
(t
(while (and levels (= (nth 1 toklevels) (car levels)))
(setq levels (cdr levels)))
(cond
((null levels)
(cond
((null (nth 0 toklevels))
(throw 'return (list nil (point) token)))
((eq (nth 0 toklevels) (nth 1 toklevels))
(throw 'return
(prog1 (list (or (car toklevels) t) (point) token)
(goto-char pos))))
(t (debug)))) ;Not sure yet what to do here.
(t
(if (nth 0 toklevels)
(push (nth 0 toklevels) levels))))))))
levels)
(setq halfsexp nil))))))
;; Mirror image, not used for indentation.
(defun smie-forward-sexp (&optional halfsexp)
"Skip over one sexp.
HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the
@ -363,53 +422,12 @@ Possible return values:
(t POS TOKEN): same thing but for an open-paren or the beginning of buffer.
(nil POS TOKEN): we skipped over a paren-like pair.
nil: we skipped over an identifier, matched parentheses, ..."
(if (eobp) (list t (point))
(catch 'return
(let ((levels ()))
(while
(let* ((pos (point))
(token (progn (forward-comment (point-max))
(smie-forward-token)))
(toklevels (cdr (assoc token smie-op-levels))))
(cond
((null toklevels)
(if (equal token "")
(condition-case err
(progn (goto-char pos) (forward-sexp 1) nil)
(scan-error (throw 'return (list t (caddr err)))))))
((null (nth 0 toklevels))
;; A token like a paren-close.
(assert (nth 1 toklevels)) ;Otherwise, why mention it?
(push (nth 1 toklevels) levels))
(t
(while (and levels (< (nth 0 toklevels) (car levels)))
(setq levels (cdr levels)))
(cond
((null levels)
(if (and halfsexp (nth 1 toklevels))
(push (nth 1 toklevels) levels)
(throw 'return
(prog1 (list (or (nth 1 toklevels) t) (point) token)
(goto-char pos)))))
(t
(while (and levels (= (nth 0 toklevels) (car levels)))
(setq levels (cdr levels)))
(cond
((null levels)
(cond
((null (nth 1 toklevels))
(throw 'return (list nil (point) token)))
((eq (nth 1 toklevels) (nth 0 toklevels))
(throw 'return
(prog1 (list (or (nth 1 toklevels) t) (point) token)
(goto-char pos))))
(t (debug)))) ;Not sure yet what to do here.
(t
(if (nth 1 toklevels)
(push (nth 1 toklevels) levels))))))))
levels)
(setq halfsexp nil))))))
(smie-next-sexp
(lambda () (forward-comment (point-max)) (smie-forward-token))
(indirect-function 'forward-sexp)
(indirect-function 'smie-op-right)
(indirect-function 'smie-op-left)
halfsexp))
(defun smie-backward-sexp-command (&optional n)
"Move backward through N logical elements."
@ -496,6 +514,10 @@ VIRTUAL can take two different non-nil values:
(and virtual
(if (eq virtual :hanging) (not (smie-indent-hanging-p)) (smie-bolp))
(current-column))
;; Start the file at column 0.
(save-excursion
(forward-comment (- (point-max)))
(if (bobp) 0))
;; Align close paren with opening paren.
(save-excursion
;; (forward-comment (point-max))

149
lisp/net/secrets.el
View file

@ -129,6 +129,9 @@
;; (secrets-search-items "session" :user "joe")
;; => ("my item" "another item")
;; Interactively, collections, items and their attributes could be
;; inspected by the command `secrets-show-secrets'.
;;; Code:
;; It has been tested with GNOME Keyring 2.29.92. An implementation
@ -148,6 +151,13 @@
(require 'dbus)
(declare-function tree-widget-set-theme "tree-widget")
(declare-function widget-create-child-and-convert "wid-edit")
(declare-function widget-default-value-set "wid-edit")
(declare-function widget-field-end "wid-edit")
(declare-function widget-member "wid-edit")
(defvar tree-widget-after-toggle-functions)
(defvar secrets-enabled nil
"Whether there is a daemon offering the Secret Service API.")
@ -665,6 +675,145 @@ If there is no such item, or the item doesn't own this attribute, return nil."
:session secrets-service item-path
secrets-interface-item "Delete")))))
;;; Visualization.
(define-derived-mode secrets-mode nil "Secrets"
"Major mode for presenting search results of a Xesam search.
In this mode, widgets represent the search results.
\\{secrets-mode-map}
Turning on Xesam mode runs the normal hook `xesam-mode-hook'. It
can be used to set `xesam-notify-function', which must a search
engine specific, widget :notify function to visualize xesam:url."
;; Keymap.
(setq secrets-mode-map (copy-keymap special-mode-map))
(set-keymap-parent secrets-mode-map widget-keymap)
(define-key secrets-mode-map "z" 'kill-this-buffer)
;; When we toggle, we must set temporary widgets.
(set (make-local-variable 'tree-widget-after-toggle-functions)
'(secrets-tree-widget-after-toggle-function))
(when (not (called-interactively-p 'interactive))
;; Initialize buffer.
(setq buffer-read-only t)
(let ((inhibit-read-only t))
(erase-buffer))))
;; It doesn't make sense to call it interactively.
(put 'secrets-mode 'disabled t)
;; The very first buffer created with `secrets-mode' does not have the
;; keymap etc. So we create a dummy buffer. Stupid.
(with-temp-buffer (secrets-mode))
;;;###autoload
(defun secrets-show-secrets ()
"Display a list of collections from the Secret Service API.
The collections are in tree view, that means they can be expanded
to the corresponding secret items, which could also be expanded
to their attributes."
(interactive)
;; Create the search buffer.
(with-current-buffer (get-buffer-create "*Secrets*")
(switch-to-buffer-other-window (current-buffer))
;; Inialize buffer with `secrets-mode'.
(secrets-mode)
(secrets-show-collections)))
(defun secrets-show-collections ()
"Show all available collections."
(let ((inhibit-read-only t)
(alias (secrets-get-alias "default")))
(erase-buffer)
(tree-widget-set-theme "folder")
(dolist (coll (secrets-list-collections))
(widget-create
`(tree-widget
:tag ,coll
:collection ,coll
:open nil
:sample-face bold
:expander secrets-expand-collection)))))
(defun secrets-expand-collection (widget)
"Expand items of collection shown as WIDGET."
(let ((coll (widget-get widget :collection)))
(mapcar
(lambda (item)
`(tree-widget
:tag ,item
:collection ,coll
:item ,item
:open nil
:sample-face bold
:expander secrets-expand-item))
(secrets-list-items coll))))
(defun secrets-expand-item (widget)
"Expand password and attributes of item shown as WIDGET."
(let* ((coll (widget-get widget :collection))
(item (widget-get widget :item))
(attributes (secrets-get-attributes coll item))
;; padding is needed to format attribute names.
(padding
(1+
(apply
'max
(cons
(length "password")
(mapcar
(lambda (attribute) (length (symbol-name (car attribute))))
attributes))))))
(cons
;; The password widget.
`(editable-field :tag "password"
:secret ?*
:value ,(secrets-get-secret coll item)
:sample-face widget-button-pressed
;; We specify :size in order to limit the field.
:size 0
:format ,(concat
"%{%t%}:"
(make-string (- padding (length "password")) ? )
"%v\n"))
(mapcar
(lambda (attribute)
(let ((name (symbol-name (car attribute)))
(value (cdr attribute)))
;; The attribute widget.
`(editable-field :tag ,name
:value ,value
:sample-face widget-documentation
;; We specify :size in order to limit the field.
:size 0
:format ,(concat
"%{%t%}:"
(make-string (- padding (length name)) ? )
"%v\n"))))
attributes))))
(defun secrets-tree-widget-after-toggle-function (widget &rest ignore)
"Add a temporary widget to show the password."
(dolist (child (widget-get widget :children))
(when (widget-member child :secret)
(goto-char (widget-field-end child))
(widget-insert " ")
(widget-create-child-and-convert
child 'push-button
:notify 'secrets-tree-widget-show-password
"Show password")))
(widget-setup))
(defun secrets-tree-widget-show-password (widget &rest ignore)
"Show password, and remove temporary widget."
(let ((parent (widget-get widget :parent)))
(widget-put parent :secret nil)
(widget-default-value-set parent (widget-get parent :value))
(widget-setup)))
;;; Initialization.
(when (dbus-ping :session secrets-service 100)
;; We must reset all variables, when there is a new instance of the

10
lisp/subr.el
View file

@ -1868,16 +1868,14 @@ any other non-digit terminates the character code and is then used as input."))
(if inhibit-quit (setq quit-flag nil)))
;; Translate TAB key into control-I ASCII character, and so on.
;; Note: `read-char' does it using the `ascii-character' property.
;; We could try and use read-key-sequence instead, but then C-q ESC
;; or C-q C-x might not return immediately since ESC or C-x might be
;; bound to some prefix in function-key-map or key-translation-map.
;; We should try and use read-key instead.
(let ((translation (lookup-key local-function-key-map (vector char))))
(if (arrayp translation)
(setq translated (aref translation 0))))
(setq translated
(if (integerp char)
(char-resolve-modifiers char)
char))
(let ((translation (lookup-key local-function-key-map (vector char))))
(if (arrayp translation)
(setq translated (aref translation 0))))
(cond ((null translated))
((not (integerp translated))
(setq unread-command-events (list char)

6
src/ChangeLog
View file

@ -1,3 +1,9 @@
2010-05-18 Chong Yidong <cyd@stupidchicken.com>
* character.c (Fstring, Funibyte_string): Use SAFE_ALLOCA to
prevent stack overflow if number of arguments is too large
(Bug#6214).
2010-05-18 Juanma Barranquero <lekktu@gmail.com>
* charset.c (load_charset_map_from_file): Don't call close after fclose.

30
src/character.c
View file

@ -961,10 +961,13 @@ usage: (string &rest CHARACTERS) */)
int n;
Lisp_Object *args;
{
int i;
unsigned char *buf = (unsigned char *) alloca (MAX_MULTIBYTE_LENGTH * n);
unsigned char *p = buf;
int c;
int i, c;
unsigned char *buf, *p;
Lisp_Object str;
USE_SAFE_ALLOCA;
SAFE_ALLOCA (buf, unsigned char *, MAX_MULTIBYTE_LENGTH * n);
p = buf;
for (i = 0; i < n; i++)
{
@ -973,7 +976,9 @@ usage: (string &rest CHARACTERS) */)
p += CHAR_STRING (c, p);
}
return make_string_from_bytes ((char *) buf, n, p - buf);
str = make_string_from_bytes ((char *) buf, n, p - buf);
SAFE_FREE ();
return str;
}
DEFUN ("unibyte-string", Funibyte_string, Sunibyte_string, 0, MANY, 0,
@ -983,10 +988,13 @@ usage: (unibyte-string &rest BYTES) */)
int n;
Lisp_Object *args;
{
int i;
unsigned char *buf = (unsigned char *) alloca (n);
unsigned char *p = buf;
unsigned c;
int i, c;
unsigned char *buf, *p;
Lisp_Object str;
USE_SAFE_ALLOCA;
SAFE_ALLOCA (buf, unsigned char *, n);
p = buf;
for (i = 0; i < n; i++)
{
@ -997,7 +1005,9 @@ usage: (unibyte-string &rest BYTES) */)
*p++ = c;
}
return make_string_from_bytes ((char *) buf, n, p - buf);
str = make_string_from_bytes ((char *) buf, n, p - buf);
SAFE_FREE ();
return str;
}
DEFUN ("char-resolve-modifiers", Fchar_resolve_modifiers,