diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 87de0957574..780ec1001ff 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,9 @@
2011-07-01 Paul Eggert <eggert@cs.ucla.edu>
+ Time-stamp simplifications and fixes.
+ These improve accuracy slightly, and future-proof the code
+ against some potential changes to current-time format.
+
* woman.el (woman-decode-buffer, WoMan-log-end): Log fractional secs
by using time-since and float-time.
@@ -25,6 +29,27 @@
* emacs-lisp/benchmark.el (benchmark-elapse):
* allout-widgets.el (allout-elapsed-time-seconds): Use float-time.
+2011-07-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * window.el (bury-buffer): Don't iconify the only frame.
+ (switch-to-buffer): Revert to Emacs<23 behavior, i.e. do not fallback
+ to pop-to-buffer. Use pop-to-buffer-same-frame if you don't like that.
+
+2011-07-01 Chong Yidong <cyd@stupidchicken.com>
+
+ * eshell/em-smart.el (eshell-smart-display-navigate-list):
+ Add mouse-yank-primary.
+
+2011-07-01 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * progmodes/cfengine3.el: New file to support CFEngine 3.x.
+
+2011-07-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/find-func.el (find-library--load-name): New fun.
+ (find-library-name): Use it to find relative load names when provided
+ absolute file name (bug#8803).
+
2011-06-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
* textmodes/flyspell.el (flyspell-word): Consider words that
@@ -41,7 +66,7 @@
* progmodes/cc-guess.el: New file.
- * progmodes/cc-langs.el (c-mode-menu): Added "Style..." submenu.
+ * progmodes/cc-langs.el (c-mode-menu): Add "Style..." submenu.
* progmodes/cc-styles.el (cc-choose-style-for-mode): New function
derived from `c-basic-common-init'.
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 9c4a3e9832c..0194af2e3a8 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -141,6 +141,15 @@ See the functions `find-function' and `find-variable'."
(dolist (suffix (get-load-suffixes) (nreverse suffixes))
(unless (string-match "elc" suffix) (push suffix suffixes)))))
+(defun find-library--load-name (library)
+ (let ((name library))
+ (dolist (dir load-path)
+ (let ((rel (file-relative-name library dir)))
+ (if (and (not (string-match "\\`\\.\\./" rel))
+ (< (length rel) (length name)))
+ (setq name rel))))
+ (unless (equal name library) name)))
+
(defun find-library-name (library)
"Return the absolute file name of the Emacs Lisp source of LIBRARY.
LIBRARY should be a string (the name of the library)."
@@ -148,13 +157,23 @@ LIBRARY should be a string (the name of the library)."
;; the same name.
(if (string-match "\\.el\\(c\\(\\..*\\)?\\)\\'" library)
(setq library (replace-match "" t t library)))
- (or
+ (or
(locate-file library
(or find-function-source-path load-path)
(find-library-suffixes))
(locate-file library
(or find-function-source-path load-path)
load-file-rep-suffixes)
+ (when (file-name-absolute-p library)
+ (let ((rel (find-library--load-name library)))
+ (when rel
+ (or
+ (locate-file rel
+ (or find-function-source-path load-path)
+ (find-library-suffixes))
+ (locate-file rel
+ (or find-function-source-path load-path)
+ load-file-rep-suffixes)))))
(error "Can't find library %s" library)))
(defvar find-function-C-source-directory
diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el
index f08fec8f8fa..259072d9750 100644
--- a/lisp/eshell/em-smart.el
+++ b/lisp/eshell/em-smart.el
@@ -120,6 +120,7 @@ only if that output can be presented in its entirely in the Eshell window."
(defcustom eshell-smart-display-navigate-list
'(insert-parentheses
mouse-yank-at-click
+ mouse-yank-primary
mouse-yank-secondary
yank-pop
yank-rectangle
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 88ba910912e..7d1e7ed7198 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -3,7 +3,24 @@
* nntp.el (nntp-record-command):
* gnus-util.el (gnus-message-with-timestamp-1):
Use format-time-string rather than decoding time stamps by hand.
- This is simpler and insulates the code from changes to time formats.
+ This is simpler and insulates the code from potential changes to
+ current-time format.
+
+2011-07-01 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-draft.el (gnus-draft-clear-marks): Mark deleted articles as read.
+
+2011-07-01 Daiki Ueno <ueno@unixuser.org>
+
+ * plstore.el (plstore-select-keys, plstore-encrypt-to): New variable.
+ (plstore-save): Support public key encryption.
+ (plstore--init-from-buffer): New function.
+ (plstore-open): Use it; fix error when opening a non-existent file.
+ (plstore-revert): Use plstore--init-from-buffer.
+
+2011-07-01 Daiki Ueno <ueno@unixuser.org>
+
+ * auth-source.el (auth-source-backend): Fix :initarg for data slot.
2011-06-30 Katsumi Yamaoka <yamaoka@jpl.org>
diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el
index 9391bf23d37..9d62d6a81c4 100644
--- a/lisp/gnus/auth-source.el
+++ b/lisp/gnus/auth-source.el
@@ -116,7 +116,7 @@ let-binding."
:type t
:custom string
:documentation "The backend protocol.")
- (data :initarg :arg
+ (data :initarg :data
:initform nil
:documentation "Internal backend data.")
(create-function :initarg :create-function
diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el
index 1709b1c4a05..a2a4cd3e07d 100644
--- a/lisp/gnus/gnus-draft.el
+++ b/lisp/gnus/gnus-draft.el
@@ -325,10 +325,18 @@ If DONT-POP is nil, display the buffer after setting it up."
(error "The draft %s is under edit" file)))))
(defun gnus-draft-clear-marks ()
- (setq gnus-newsgroup-reads nil
- gnus-newsgroup-marked nil
- gnus-newsgroup-unreads
- (gnus-uncompress-range (gnus-active gnus-newsgroup-name))))
+ (setq gnus-newsgroup-marked nil
+ gnus-newsgroup-unreads (gnus-uncompress-range
+ (gnus-active gnus-newsgroup-name)))
+ ;; Mark articles except for deleted ones as unread.
+ (let (rest)
+ (dolist (article gnus-newsgroup-reads)
+ (when (and (consp article)
+ (eq (cdr article) gnus-canceled-mark))
+ (push article rest)
+ (setq gnus-newsgroup-unreads
+ (delq (car article) gnus-newsgroup-unreads))))
+ (setq gnus-newsgroup-reads (nreverse rest))))
(provide 'gnus-draft)
diff --git a/lisp/gnus/plstore.el b/lisp/gnus/plstore.el
index 392437d1dea..360388d002e 100644
--- a/lisp/gnus/plstore.el
+++ b/lisp/gnus/plstore.el
@@ -44,6 +44,40 @@
(require 'epg)
+(defgroup plstore nil
+ "Searchable, partially encrypted, persistent plist store"
+ :version "24.1"
+ :group 'files)
+
+(defcustom plstore-select-keys 'silent
+ "Control whether or not to pop up the key selection dialog.
+
+If t, always asks user to select recipients.
+If nil, query user only when `plstore-encrypt-to' is not set.
+If neither t nor nil, doesn't ask user. In this case, symmetric
+encryption is used."
+ :type '(choice (const :tag "Ask always" t)
+ (const :tag "Ask when recipients are not set" nil)
+ (const :tag "Don't ask" silent))
+ :group 'plstore)
+
+(defvar plstore-encrypt-to nil
+ "*Recipient(s) used for encrypting secret entries.
+May either be a string or a list of strings.")
+
+(put 'plstore-encrypt-to 'safe-local-variable
+ (lambda (val)
+ (or (stringp val)
+ (and (listp val)
+ (catch 'safe
+ (mapc (lambda (elt)
+ (unless (stringp elt)
+ (throw 'safe nil)))
+ val)
+ t)))))
+
+(put 'plstore-encrypt-to 'permanent-local t)
+
(defvar plstore-cache-passphrase-for-symmetric-encryption nil)
(defvar plstore-passphrase-alist nil)
@@ -107,35 +141,39 @@
(defun plstore-get-file (this)
(buffer-file-name (plstore--get-buffer this)))
+(defun plstore--init-from-buffer (plstore)
+ (goto-char (point-min))
+ (when (looking-at ";;; public entries")
+ (forward-line)
+ (plstore--set-alist plstore (read (point-marker)))
+ (forward-sexp)
+ (forward-char)
+ (when (looking-at ";;; secret entries")
+ (forward-line)
+ (plstore--set-encrypted-data plstore (read (point-marker))))
+ (plstore--merge-secret plstore)))
+
;;;###autoload
(defun plstore-open (file)
"Create a plstore instance associated with FILE."
- (let ((store (vector
- (find-file-noselect file)
- nil ;plist (plist)
- nil ;encrypted data (string)
- nil ;secret plist (plist)
- nil ;merged plist (plist)
- )))
- (plstore-revert store)
- store))
+ (with-current-buffer (find-file-noselect file)
+ ;; make the buffer invisible from user
+ (rename-buffer (format " plstore %s" (buffer-file-name)))
+ (let ((store (vector
+ (current-buffer)
+ nil ;plist (plist)
+ nil ;encrypted data (string)
+ nil ;secret plist (plist)
+ nil ;merged plist (plist)
+ )))
+ (plstore--init-from-buffer store)
+ store)))
(defun plstore-revert (plstore)
"Replace current data in PLSTORE with the file on disk."
(with-current-buffer (plstore--get-buffer plstore)
(revert-buffer t t)
- ;; make the buffer invisible from user
- (rename-buffer (format " plstore %s" (buffer-file-name)))
- (goto-char (point-min))
- (when (looking-at ";;; public entries\n")
- (forward-line)
- (plstore--set-alist plstore (read (point-marker)))
- (forward-sexp)
- (forward-char)
- (when (looking-at ";;; secret entries\n")
- (forward-line)
- (plstore--set-encrypted-data plstore (read (point-marker))))
- (plstore--merge-secret plstore))))
+ (plstore--init-from-buffer plstore)))
(defun plstore-close (plstore)
"Destroy a plstore instance PLSTORE."
@@ -304,20 +342,37 @@ SECRET-KEYS is a plist containing secret data."
"Save the contents of PLSTORE associated with a FILE."
(with-current-buffer (plstore--get-buffer plstore)
(erase-buffer)
- (insert ";;; public entries\n" (pp-to-string (plstore--get-alist plstore)))
+ (insert ";;; public entries -*- mode: emacs-lisp -*- \n"
+ (pp-to-string (plstore--get-alist plstore)))
(if (plstore--get-secret-alist plstore)
(let ((context (epg-make-context 'OpenPGP))
(pp-escape-newlines nil)
+ (recipients
+ (cond
+ ((listp plstore-encrypt-to) plstore-encrypt-to)
+ ((stringp plstore-encrypt-to) (list plstore-encrypt-to))))
cipher)
(epg-context-set-armor context t)
(epg-context-set-passphrase-callback
context
(cons #'plstore-passphrase-callback-function
plstore))
- (setq cipher (epg-encrypt-string context
- (pp-to-string
- (plstore--get-secret-alist plstore))
- nil))
+ (setq cipher (epg-encrypt-string
+ context
+ (pp-to-string
+ (plstore--get-secret-alist plstore))
+ (if (or (eq plstore-select-keys t)
+ (and (null plstore-select-keys)
+ (not (local-variable-p 'plstore-encrypt-to
+ (current-buffer)))))
+ (epa-select-keys
+ context
+ "Select recipents for encryption.
+If no one is selected, symmetric encryption will be performed. "
+ recipients)
+ (if plstore-encrypt-to
+ (epg-list-keys context recipients)))))
+ (goto-char (point-max))
(insert ";;; secret entries\n" (pp-to-string cipher))))
(save-buffer)))
diff --git a/lisp/progmodes/cfengine3.el b/lisp/progmodes/cfengine3.el
new file mode 100644
index 00000000000..68a4286657c
--- /dev/null
+++ b/lisp/progmodes/cfengine3.el
@@ -0,0 +1,331 @@
+;;; cfengine3.el --- mode for editing Cfengine 3 files
+
+;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+
+;; Author: Ted Zlatanov <tzz@lifelogs.com>
+;; Keywords: languages
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Supports only cfengine 3, unlike the older cfengine.el which
+;; supports 1.x and 2.x.
+
+;; Possible customization for auto-mode selection:
+
+;; (push '(("^cfagent.conf\\'" . cfengine3-mode)) auto-mode-alist)
+;; (push '(("^cf\\." . cfengine3-mode)) auto-mode-alist)
+;; (push '(("\\.cf\\'" . cfengine3-mode)) auto-mode-alist)
+
+;;; Code:
+
+(defgroup cfengine3 ()
+ "Editing CFEngine 3 files."
+ :group 'languages)
+
+(defcustom cfengine3-indent 2
+ "*Size of a CFEngine 3 indentation step in columns."
+ :group 'cfengine3
+ :type 'integer)
+
+(eval-and-compile
+ (defconst cfengine3-defuns
+ (mapcar
+ 'symbol-name
+ '(bundle body))
+ "List of the CFEngine 3.x defun headings.")
+
+ (defconst cfengine3-defuns-regex
+ (regexp-opt cfengine3-defuns t)
+ "Regex to match the CFEngine 3.x defuns.")
+
+ (defconst cfengine3-class-selector-regex "\\([[:alnum:]_().&|!]+\\)::")
+
+ (defconst cfengine3-category-regex "\\([[:alnum:]_]+\\):")
+
+ (defconst cfengine3-vartypes
+ (mapcar
+ 'symbol-name
+ '(string int real slist ilist rlist irange rrange counter))
+ "List of the CFEngine 3.x variable types."))
+
+(defvar cfengine3-font-lock-keywords
+ `(
+ (,(concat "^[ \t]*" cfengine3-class-selector-regex)
+ 1 font-lock-keyword-face)
+ (,(concat "^[ \t]*" cfengine3-category-regex)
+ 1 font-lock-builtin-face)
+ ;; Variables, including scope, e.g. module.var
+ ("[@$](\\([[:alnum:]_.]+\\))" 1 font-lock-variable-name-face)
+ ("[@$]{\\([[:alnum:]_.]+\\)}" 1 font-lock-variable-name-face)
+ ;; Variable definitions.
+ ("\\<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face)
+
+ ;; CFEngine 3.x faces
+ ;; defuns
+ (,(concat "\\<" cfengine3-defuns-regex "\\>"
+ "[ \t]+\\<\\([[:alnum:]_]+\\)\\>"
+ "[ \t]+\\<\\([[:alnum:]_]+\\)\\((\\([^)]*\\))\\)?")
+ (1 font-lock-builtin-face)
+ (2 font-lock-constant-name-face)
+ (3 font-lock-function-name-face)
+ (5 font-lock-variable-name-face))
+ ;; variable types
+ (,(concat "\\<" (eval-when-compile (regexp-opt cfengine3-vartypes t)) "\\>")
+ 1 font-lock-type-face)))
+
+(defun cfengine3-beginning-of-defun ()
+ "`beginning-of-defun' function for Cfengine 3 mode.
+Treats body/bundle blocks as defuns."
+ (unless (<= (current-column) (current-indentation))
+ (end-of-line))
+ (if (re-search-backward (concat "^[ \t]*" cfengine3-defuns-regex "\\>") nil t)
+ (beginning-of-line)
+ (goto-char (point-min)))
+ t)
+
+(defun cfengine3-end-of-defun ()
+ "`end-of-defun' function for Cfengine 3 mode.
+Treats body/bundle blocks as defuns."
+ (end-of-line)
+ (if (re-search-forward (concat "^[ \t]*" cfengine3-defuns-regex "\\>") nil t)
+ (beginning-of-line)
+ (goto-char (point-max)))
+ t)
+
+(defun cfengine3-indent-line ()
+ "Indent a line in Cfengine mode.
+Intended as the value of `indent-line-function'."
+ (let ((pos (- (point-max) (point)))
+ parse)
+ (save-restriction
+ (narrow-to-defun)
+ (back-to-indentation)
+ (setq parse (parse-partial-sexp (point-min) (point)))
+ (message "%S" parse)
+ (cond
+ ;; body/bundle blocks start at 0
+ ((looking-at (concat cfengine3-defuns-regex "\\>"))
+ (indent-line-to 0))
+ ;; categories are indented one step
+ ((looking-at (concat cfengine3-category-regex "[ \t]*$"))
+ (indent-line-to cfengine3-indent))
+ ;; class selectors are indented two steps
+ ((looking-at (concat cfengine3-class-selector-regex "[ \t]*$"))
+ (indent-line-to (* 2 cfengine3-indent)))
+ ;; Outdent leading close brackets one step.
+ ((or (eq ?\} (char-after))
+ (eq ?\) (char-after)))
+ (condition-case ()
+ (indent-line-to (save-excursion
+ (forward-char)
+ (backward-sexp)
+ (current-column)))
+ (error nil)))
+ ;; inside a string and it starts before this line
+ ((and (nth 3 parse)
+ (< (nth 8 parse) (save-excursion (beginning-of-line) (point))))
+ (indent-line-to 0))
+ ;; inside a defun, but not a nested list (depth is 1)
+ ((= 1 (nth 0 parse))
+ (indent-line-to (* (+ 2 (nth 0 parse)) cfengine3-indent)))
+ ;; Inside brackets/parens: indent to start column of non-comment
+ ;; token on line following open bracket or by one step from open
+ ;; bracket's column.
+ ((condition-case ()
+ (progn (indent-line-to (save-excursion
+ (backward-up-list)
+ (forward-char)
+ (skip-chars-forward " \t")
+ (cond
+ ((looking-at "[^\n#]")
+ (current-column))
+ ((looking-at "[^\n#]")
+ (current-column))
+ (t
+ (skip-chars-backward " \t")
+ (+ (current-column) -1
+ cfengine3-indent)))))
+ t)
+ (error nil)))
+ ;; Else don't indent.
+ (t (indent-line-to 0))))
+ ;; If initial point was within line's indentation,
+ ;; position after the indentation. Else stay at same point in text.
+ (if (> (- (point-max) pos) (point))
+ (goto-char (- (point-max) pos)))))
+
+;; (defvar cfengine3-smie-grammar
+;; (smie-prec2->grammar
+;; (smie-merge-prec2s
+;; (smie-bnf->prec2
+;; '((token)
+;; (decls (decls "body" decls)
+;; (decls "bundle" decls))
+;; (insts (token ":" insts)))
+;; '((assoc "body" "bundle")))
+;; (smie-precs->prec2
+;; '((right ":")
+;; (right "::")
+;; (assoc ";")
+;; (assoc ",")
+;; (right "=>"))))))
+
+;; (defun cfengine3-smie-rules (kind token)
+;; (pcase (cons kind token)
+;; (`(:elem . basic) 2)
+;; (`(:list-intro . ,(or `"body" `"bundle")) t)
+;; (`(:after . ":") 2)
+;; (`(:after . "::") 2)))
+
+;; (defun cfengine3-show-all-tokens ()
+;; (interactive)
+;; (goto-char (point-min))
+;; (while (not (eobp))
+;; (let* ((p (point))
+;; (token (funcall smie-forward-token-function)))
+;; (delete-region p (point))
+;; (insert-before-markers token)
+;; (forward-char))))
+
+;; (defun cfengine3-line-classes ()
+;; (interactive)
+;; (save-excursion
+;; (beginning-of-line)
+;; (let* ((todo (buffer-substring (point)
+;; (save-excursion (end-of-line) (point))))
+;; (original (concat (loop for c across todo
+;; collect (char-syntax c)))))
+;; (format "%s\n%s" original todo))))
+
+;; (defun cfengine3-show-all-classes ()
+;; (interactive)
+;; (goto-char (point-min))
+;; (while (not (eobp))
+;; (let ((repl (cfengine3-line-classes)))
+;; (kill-line)
+;; (insert repl)
+;; (insert "\n"))))
+
+;; specification: blocks
+;; blocks: block | blocks block;
+;; block: bundle typeid blockid bundlebody
+;; | bundle typeid blockid usearglist bundlebody
+;; | body typeid blockid bodybody
+;; | body typeid blockid usearglist bodybody;
+
+;; typeid: id
+;; blockid: id
+;; usearglist: '(' aitems ')';
+;; aitems: aitem | aitem ',' aitems |;
+;; aitem: id
+
+;; bundlebody: '{' statements '}'
+;; statements: statement | statements statement;
+;; statement: category | classpromises;
+
+;; bodybody: '{' bodyattribs '}'
+;; bodyattribs: bodyattrib | bodyattribs bodyattrib;
+;; bodyattrib: class | selections;
+;; selections: selection | selections selection;
+;; selection: id ASSIGN rval ';' ;
+
+;; classpromises: classpromise | classpromises classpromise;
+;; classpromise: class | promises;
+;; promises: promise | promises promise;
+;; category: CATEGORY
+;; promise: promiser ARROW rval constraints ';' | promiser constraints ';';
+;; constraints: constraint | constraints ',' constraint |;
+;; constraint: id ASSIGN rval;
+;; class: CLASS
+;; id: ID
+;; rval: ID | QSTRING | NAKEDVAR | list | usefunction
+;; list: '{' litems '}' ;
+;; litems: litem | litem ',' litems |;
+;; litem: ID | QSTRING | NAKEDVAR | list | usefunction
+
+;; functionid: ID | NAKEDVAR
+;; promiser: QSTRING
+;; usefunction: functionid givearglist
+;; givearglist: '(' gaitems ')'
+;; gaitems: gaitem | gaitems ',' gaitem |;
+;; gaitem: ID | QSTRING | NAKEDVAR | list | usefunction
+
+;; # from lexer:
+
+;; bundle: "bundle"
+;; body: "body"
+;; COMMENT #[^\n]*
+;; NAKEDVAR [$@][(][a-zA-Z0-9_\200-\377.]+[)]|[$@][{][a-zA-Z0-9_\200-\377.]+[}]
+;; ID: [a-zA-Z0-9_\200-\377]+
+;; ASSIGN: "=>"
+;; ARROW: "->"
+;; QSTRING: \"((\\\")|[^"])*\"|\'((\\\')|[^'])*\'|`[^`]*`
+;; CLASS: [.|&!()a-zA-Z0-9_\200-\377]+::
+;; CATEGORY: [a-zA-Z_]+:
+
+;;;###autoload
+(define-derived-mode cfengine3-mode prog-mode "CFEngine3"
+ "Major mode for editing cfengine input.
+There are no special keybindings by default.
+
+Action blocks are treated as defuns, i.e. \\[beginning-of-defun] moves
+to the action header."
+ (modify-syntax-entry ?# "<" cfengine3-mode-syntax-table)
+ (modify-syntax-entry ?\n ">#" cfengine3-mode-syntax-table)
+ (modify-syntax-entry ?\" "\"" cfengine3-mode-syntax-table)
+ ;; variable substitution:
+ (modify-syntax-entry ?$ "." cfengine3-mode-syntax-table)
+ ;; Doze path separators:
+ (modify-syntax-entry ?\\ "." cfengine3-mode-syntax-table)
+ ;; Otherwise, syntax defaults seem OK to give reasonable word
+ ;; movement.
+
+ ;; (smie-setup cfengine3-smie-grammar #'cfengine3-smie-rules)
+ ;; ;; :forward-token #'cfengine3-smie-forward-token
+ ;; ;; :backward-token #'cfengine3-smie-backward-token)
+ ;; (set (make-local-variable 'smie-indent-basic) 'cfengine3-indent)
+
+ (set (make-local-variable 'parens-require-spaces) nil)
+ (set (make-local-variable 'comment-start) "# ")
+ (set (make-local-variable 'comment-start-skip)
+ "\\(\\(?:^\\|[^\\\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*")
+ (set (make-local-variable 'indent-line-function) #'cfengine3-indent-line)
+ (setq font-lock-defaults
+ '(cfengine3-font-lock-keywords nil nil nil beginning-of-defun))
+ ;; Fixme: set the args of functions in evaluated classes to string
+ ;; syntax, and then obey syntax properties.
+ (set (make-local-variable 'syntax-propertize-function)
+ ;; In the main syntax-table, \ is marked as a punctuation, because
+ ;; of its use in DOS-style directory separators. Here we try to
+ ;; recognize the cases where \ is used as an escape inside strings.
+ (syntax-propertize-rules ("\\(\\(?:\\\\\\)+\\)\"" (1 "\\"))))
+
+ ;; use defuns as the essential syntax block
+ (set (make-local-variable 'beginning-of-defun-function)
+ #'cfengine3-beginning-of-defun)
+ (set (make-local-variable 'end-of-defun-function)
+ #'cfengine3-end-of-defun)
+
+ ;; Like Lisp mode. Without this, we lose with, say,
+ ;; `backward-up-list' when there's an unbalanced quote in a
+ ;; preceding comment.
+ (set (make-local-variable 'parse-sexp-ignore-comments) t))
+
+(provide 'cfengine3)
+
+;;; cfengine3.el ends here
diff --git a/lisp/window.el b/lisp/window.el
index 15e603bc6c9..49698ff8bb7 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -2802,7 +2802,9 @@ displayed there."
((or buffer-or-name (not (eq buffer (window-buffer)))))
((not (window-dedicated-p))
(switch-to-prev-buffer nil 'bury))
- ((frame-root-window-p (selected-window))
+ ((and (frame-root-window-p (selected-window))
+ ;; Don't iconify if it's the only frame.
+ (not (eq (next-frame nil 0) (selected-frame))))
(iconify-frame (window-frame (selected-window))))
((window-deletable-p)
(delete-window)))
@@ -5944,20 +5946,18 @@ functions should call `pop-to-buffer-same-window' instead."
(interactive
(list (read-buffer-to-switch "Switch to buffer: ")))
(let ((buffer (window-normalize-buffer-to-switch-to buffer-or-name)))
- (if (and (or (window-minibuffer-p) (eq (window-dedicated-p) t))
- (not (eq buffer (window-buffer))))
- ;; Cannot switch to another buffer in a minibuffer or strongly
- ;; dedicated window that does not show the buffer already. Call
- ;; `pop-to-buffer' instead.
- (pop-to-buffer buffer 'same-window norecord)
- (unless (eq buffer (window-buffer))
- ;; I'm not sure why we should NOT call `set-window-buffer' here,
- ;; but let's keep things as they are (otherwise we could always
- ;; call `pop-to-buffer-same-window' here).
- (set-window-buffer nil buffer))
- (unless norecord
- (select-window (selected-window)))
- (set-buffer buffer))))
+ (cond
+ ;; Don't call set-window-buffer if it's not needed since it
+ ;; might signal an error (e.g. if the window is dedicated).
+ ((eq buffer (window-buffer)) nil)
+ ((window-minibuffer-p)
+ (error "Cannot switch buffers in minibuffer window"))
+ ((eq (window-dedicated-p) t)
+ (error "Cannot switch buffers in a dedicated window"))
+ (t (set-window-buffer nil buffer)))
+ (unless norecord
+ (select-window (selected-window)))
+ (set-buffer buffer)))
(defun switch-to-buffer-same-frame (buffer-or-name &optional norecord)
"Switch to buffer BUFFER-OR-NAME in a window on the selected frame.
diff --git a/src/ChangeLog b/src/ChangeLog
index dc51a2633ac..85cf1d2a255 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,13 @@
+2011-07-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ * eval.c (struct backtrace): Simplify and port the data structure.
+ Do not assume that "int nargs : BITS_PER_INT - 2;" produces a
+ signed bit field, as this assumption is not portable and it makes
+ Emacs crash when compiled with Sun C 5.8 on sparc. Do not use
+ "char debug_on_exit : 1" as this is not portable either; instead,
+ use the portable "unsigned int debug_on_exit : 1". Remove unused
+ member evalargs. Remove obsolete comments about cc bombing out.
+
2011-06-30 Jan Djärv <jan.h.d@swipnet.se>
* xsettings.c: Include glib-object.h, gio/gio.h if HAVE_GSETTINGS.
diff --git a/src/eval.c b/src/eval.c
index 6ca8eacb100..cb8b4f3ea07 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -32,25 +32,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "xterm.h"
#endif
-/* This definition is duplicated in alloc.c and keyboard.c. */
-/* Putting it in lisp.h makes cc bomb out! */
-
struct backtrace
{
struct backtrace *next;
Lisp_Object *function;
Lisp_Object *args; /* Points to vector of args. */
-#define NARGS_BITS (BITS_PER_INT - 2)
- /* Let's not use size_t because we want to allow negative values (for
- UNEVALLED). Also let's steal 2 bits so we save a word (or more for
- alignment). In any case I doubt Emacs would survive a function call with
- more than 500M arguments. */
- int nargs : NARGS_BITS; /* Length of vector.
- If nargs is UNEVALLED, args points
- to slot holding list of unevalled args. */
- char evalargs : 1;
+ ptrdiff_t nargs; /* Length of vector. */
/* Nonzero means call value of debugger when done with this operation. */
- char debug_on_exit : 1;
+ unsigned int debug_on_exit : 1;
};
static struct backtrace *backtrace_list;
@@ -2291,7 +2280,6 @@ eval_sub (Lisp_Object form)
backtrace.function = &original_fun; /* This also protects them from gc. */
backtrace.args = &original_args;
backtrace.nargs = UNEVALLED;
- backtrace.evalargs = 1;
backtrace.debug_on_exit = 0;
if (debug_on_next_call)
@@ -2325,10 +2313,7 @@ eval_sub (Lisp_Object form)
xsignal2 (Qwrong_number_of_arguments, original_fun, numargs);
else if (XSUBR (fun)->max_args == UNEVALLED)
- {
- backtrace.evalargs = 0;
- val = (XSUBR (fun)->function.aUNEVALLED) (args_left);
- }
+ val = (XSUBR (fun)->function.aUNEVALLED) (args_left);
else if (XSUBR (fun)->max_args == MANY)
{
/* Pass a vector of evaluated arguments. */
@@ -2984,7 +2969,6 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
backtrace.function = &args[0];
backtrace.args = &args[1];
backtrace.nargs = nargs - 1;
- backtrace.evalargs = 0;
backtrace.debug_on_exit = 0;
if (debug_on_next_call)
@@ -3141,7 +3125,6 @@ apply_lambda (Lisp_Object fun, Lisp_Object args)
backtrace_list->args = arg_vector;
backtrace_list->nargs = i;
- backtrace_list->evalargs = 0;
tem = funcall_lambda (fun, numargs, arg_vector);
/* Do the debug-on-exit now, while arg_vector still exists. */