mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-13 16:38:14 +00:00
Merge from trunk.
This commit is contained in:
Paul Eggert
commit
d0672f86c9
@ -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'.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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>
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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)))
|
||||
|
||||
|
||||
331
lisp/progmodes/cfengine3.el
Normal file
331
lisp/progmodes/cfengine3.el
Normal file
@ -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
|
||||
@ -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.
|
||||
|
||||
@ -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.
|
||||
|
||||
23
src/eval.c
23
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. */
|
||||
|
||||
Loading…
Reference in New Issue
Block a user