Now on revision 112939. ------------------------------------------------------------ revno: 112939 committer: Leo Liu branch nick: trunk timestamp: Wed 2013-06-12 10:58:03 +0800 message: Fix last change to octave.el diff: === modified file 'lisp/progmodes/octave.el' --- lisp/progmodes/octave.el 2013-06-12 02:37:38 +0000 +++ lisp/progmodes/octave.el 2013-06-12 02:58:03 +0000 @@ -772,7 +772,7 @@ (inferior-octave-send-list-and-digest (list "more off;\n" (unless (equal inferior-octave-output-string ">> ") - "PS1 ('\\\\s> ');\n") + "PS1 ('\\s> ');\n") (when (and inferior-octave-startup-file (file-exists-p inferior-octave-startup-file)) (format "source ('%s');\n" inferior-octave-startup-file)))) ------------------------------------------------------------ revno: 112938 committer: Leo Liu branch nick: trunk timestamp: Wed 2013-06-12 10:37:38 +0800 message: * progmodes/octave.el (inferior-octave-startup) (inferior-octave-completion-table) (inferior-octave-track-window-width-change) (octave-eldoc-function-signatures, octave-help) (octave-find-definition): Use single quoted strings. (inferior-octave-startup-args): Change default value. (inferior-octave-startup): Do not hard code "-i" and "--no-line-editing". (inferior-octave-resync-dirs): Add optional arg NOERROR. (inferior-octave-directory-tracker): Use it. (octave-goto-function-definition): Robustify. (octave-help): Support highlighting operators in 'See also'. (octave-find-definition): Find subfunctions only in Octave mode. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-12 02:16:02 +0000 +++ lisp/ChangeLog 2013-06-12 02:37:38 +0000 @@ -1,3 +1,19 @@ +2013-06-12 Leo Liu + + * progmodes/octave.el (inferior-octave-startup) + (inferior-octave-completion-table) + (inferior-octave-track-window-width-change) + (octave-eldoc-function-signatures, octave-help) + (octave-find-definition): Use single quoted strings. + (inferior-octave-startup-args): Change default value. + (inferior-octave-startup): Do not hard code "-i" and + "--no-line-editing". + (inferior-octave-resync-dirs): Add optional arg NOERROR. + (inferior-octave-directory-tracker): Use it. + (octave-goto-function-definition): Robustify. + (octave-help): Support highlighting operators in 'See also'. + (octave-find-definition): Find subfunctions only in Octave mode. + 2013-06-12 Stefan Monnier * help-fns.el (help-fns--compiler-macro): If the handler function is === modified file 'lisp/progmodes/octave.el' --- lisp/progmodes/octave.el 2013-06-08 13:35:55 +0000 +++ lisp/progmodes/octave.el 2013-06-12 02:37:38 +0000 @@ -608,12 +608,13 @@ :group 'octave :version "24.4") -(defcustom inferior-octave-startup-args nil +(defcustom inferior-octave-startup-args '("-i" "--no-line-editing") "List of command line arguments for the inferior Octave process. For example, for suppressing the startup message and using `traditional' -mode, set this to (\"-q\" \"--traditional\")." +mode, include \"-q\" and \"--traditional\"." :type '(repeat string) - :group 'octave) + :group 'octave + :version "24.4") (defcustom inferior-octave-mode-hook nil "Hook to be run when Inferior Octave mode is started." @@ -723,13 +724,13 @@ (substring inferior-octave-buffer 1 -1) inferior-octave-buffer inferior-octave-program - (append (list "-i" "--no-line-editing") - ;; --no-gui is introduced in Octave > 3.7 - (when (zerop (process-file inferior-octave-program - nil nil nil - "--no-gui" "--help")) - (list "--no-gui")) - inferior-octave-startup-args)))) + (append + inferior-octave-startup-args + ;; --no-gui is introduced in Octave > 3.7 + (and (not (member "--no-gui" inferior-octave-startup-args)) + (zerop (process-file inferior-octave-program + nil nil nil "--no-gui" "--help")) + '("--no-gui")))))) (set-process-filter proc 'inferior-octave-output-digest) (setq inferior-octave-process proc inferior-octave-output-list nil @@ -759,10 +760,10 @@ (inferior-octave-send-list-and-digest (list "PS2\n")) (when (string-match "\\(PS2\\|ans\\) = *$" (car inferior-octave-output-list)) - (inferior-octave-send-list-and-digest (list "PS2 (\"> \");\n"))) + (inferior-octave-send-list-and-digest (list "PS2 ('> ');\n"))) (inferior-octave-send-list-and-digest - (list "disp(getenv(\"OCTAVE_SRCDIR\"))\n")) + (list "disp (getenv ('OCTAVE_SRCDIR'))\n")) (process-put proc 'octave-srcdir (unless (equal (car inferior-octave-output-list) "") (car inferior-octave-output-list))) @@ -771,19 +772,19 @@ (inferior-octave-send-list-and-digest (list "more off;\n" (unless (equal inferior-octave-output-string ">> ") - "PS1 (\"\\\\s> \");\n") + "PS1 ('\\\\s> ');\n") (when (and inferior-octave-startup-file (file-exists-p inferior-octave-startup-file)) - (format "source (\"%s\");\n" inferior-octave-startup-file)))) + (format "source ('%s');\n" inferior-octave-startup-file)))) (when inferior-octave-output-list (insert-before-markers (mapconcat 'identity inferior-octave-output-list "\n"))) ;; And finally, everything is back to normal. (set-process-filter proc 'comint-output-filter) - ;; Just in case, to be sure a cd in the startup file - ;; won't have detrimental effects. - (inferior-octave-resync-dirs) + ;; Just in case, to be sure a cd in the startup file won't have + ;; detrimental effects. + (with-demoted-errors (inferior-octave-resync-dirs)) ;; Generate a proper prompt, which is critical to ;; `comint-history-isearch-backward-regexp'. Bug#14433. (comint-send-string proc "\n"))) @@ -799,7 +800,7 @@ (unless (and (equal (car cache) command) (< (float-time) (+ 5 (cadr cache)))) (inferior-octave-send-list-and-digest - (list (concat "completion_matches (\"" command "\");\n"))) + (list (format "completion_matches ('%s');\n" command))) (setq cache (list command (float-time) (delete-consecutive-dups (sort inferior-octave-output-list 'string-lessp))))) @@ -898,8 +899,8 @@ "Tracks `cd' commands issued to the inferior Octave process. Use \\[inferior-octave-resync-dirs] to resync if Emacs gets confused." (when inferior-octave-directory-tracker-resync - (setq inferior-octave-directory-tracker-resync nil) - (inferior-octave-resync-dirs)) + (or (inferior-octave-resync-dirs 'noerror) + (setq inferior-octave-directory-tracker-resync nil))) (cond ((string-match "^[ \t]*cd[ \t;]*$" string) (cd "~")) @@ -911,13 +912,17 @@ (error-message-string err) (match-string 1 string))))))) -(defun inferior-octave-resync-dirs () +(defun inferior-octave-resync-dirs (&optional noerror) "Resync the buffer's idea of the current directory. This command queries the inferior Octave process about its current directory and makes this the current buffer's default directory." (interactive) (inferior-octave-send-list-and-digest '("disp (pwd ())\n")) - (cd (car inferior-octave-output-list))) + (condition-case err + (progn + (cd (car inferior-octave-output-list)) + t) + (error (unless noerror (signal (car err) (cdr err)))))) (defcustom inferior-octave-minimal-columns 80 "The minimal column width for the inferior Octave process." @@ -935,7 +940,7 @@ (when (and inferior-octave-process (process-live-p inferior-octave-process)) (inferior-octave-send-list-and-digest - (list (format "putenv(\"COLUMNS\", \"%s\");\n" width))))))) + (list (format "putenv ('COLUMNS', '%s');\n" width))))))) ;;; Miscellaneous useful functions @@ -989,7 +994,7 @@ (setq found t))) (unless found (goto-char orig)) found)))) - (pcase (file-name-extension (buffer-file-name)) + (pcase (and buffer-file-name (file-name-extension buffer-file-name)) (`"cc" (funcall search "\\_" end t) - (make-text-button (match-beginning 0) (match-end 0) + (while (re-search-forward + ;; Match operators and symbols. + "\\(?1:\\s.+?\\)\\(?:$\\|[,;]\\|\\s-\\)\\|\\_<\\(?1:\\(?:\\sw\\|\\s_\\)+\\)\\_>" + end t) + (make-text-button (match-beginning 1) (match-end 1) :type 'octave-help-function))))) (octave-help-mode))))) @@ -1716,12 +1722,13 @@ (interactive (list (octave-completing-read))) (require 'etags) (let ((orig (point))) - (if (octave-goto-function-definition fn) + (if (and (derived-mode-p 'octave-mode) + (octave-goto-function-definition fn)) (ring-insert find-tag-marker-ring (copy-marker orig)) (inferior-octave-send-list-and-digest ;; help NAME is more verbose (list (format "\ -if iskeyword(\"%s\") disp(\"`%s' is a keyword\") else which(\"%s\") endif\n" +if iskeyword('%s') disp('`%s'' is a keyword') else which('%s') endif\n" fn fn fn))) (let (line file) ;; Skip garbage lines such as @@ -1738,6 +1745,5 @@ (find-file file) (octave-goto-function-definition fn))))))) - (provide 'octave) ;;; octave.el ends here ------------------------------------------------------------ revno: 112937 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2013-06-11 22:16:02 -0400 message: * lisp/help-fns.el (help-fns--compiler-macro): If the handler function is named, then put a link to it. * lisp/help-mode.el (help-function-cmacro): Adjust regexp for cl-lib names. * lisp/emacs-lisp/cl-macs.el (cl--compiler-macro-typep): New function. (cl-typep): Use it. (cl-eval-when): Simplify debug spec. (cl-define-compiler-macro): Use eval-and-compile. Give a name to the compiler-macro function instead of setting `compiler-macro-file'. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-12 00:49:33 +0000 +++ lisp/ChangeLog 2013-06-12 02:16:02 +0000 @@ -1,4 +1,15 @@ 2013-06-12 Stefan Monnier + + * help-fns.el (help-fns--compiler-macro): If the handler function is + named, then put a link to it. + * help-mode.el (help-function-cmacro): Adjust regexp for cl-lib names. + * emacs-lisp/cl-macs.el (cl--compiler-macro-typep): New function. + (cl-typep): Use it. + (cl-eval-when): Simplify debug spec. + (cl-define-compiler-macro): Use eval-and-compile. Give a name to the + compiler-macro function instead of setting `compiler-macro-file'. + +2013-06-12 Stefan Monnier Daniel Hackney First part of Daniel Hackney's patch to package.el. === modified file 'lisp/emacs-lisp/cl-loaddefs.el' --- lisp/emacs-lisp/cl-loaddefs.el 2013-06-05 02:35:40 +0000 +++ lisp/emacs-lisp/cl-loaddefs.el 2013-06-12 02:16:02 +0000 @@ -267,7 +267,7 @@ ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp ;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*) -;;;;;; "cl-macs" "cl-macs.el" "80cb53f97b21adb6069c43c38a2e094d") +;;;;;; "cl-macs" "cl-macs.el" "fd824d987086eafec0b1cb2efa8312f4") ;;; Generated autoloads from cl-macs.el (autoload 'cl--compiler-macro-list* "cl-macs" "\ @@ -699,9 +699,10 @@ KEYWORD can be one of :conc-name, :constructor, :copier, :predicate, :type, :named, :initial-offset, :print-function, or :include. -Each SLOT may instead take the form (SLOT SLOT-OPTS...), where -SLOT-OPTS are keyword-value pairs for that slot. Currently, only -one keyword is supported, `:read-only'. If this has a non-nil +Each SLOT may instead take the form (SNAME SDEFAULT SOPTIONS...), where +SDEFAULT is the default value of that slot and SOPTIONS are keyword-value +pairs for that slot. +Currently, only one keyword is supported, `:read-only'. If this has a non-nil value, that slot cannot be set via `setf'. \(fn NAME SLOTS...)" nil t) @@ -724,6 +725,8 @@ \(fn OBJECT TYPE)" nil nil) +(eval-and-compile (put 'cl-typep 'compiler-macro #'cl--compiler-macro-typep)) + (autoload 'cl-check-type "cl-macs" "\ Verify that FORM is of type TYPE; signal an error if not. STRING is an optional description of the desired type. === modified file 'lisp/emacs-lisp/cl-macs.el' --- lisp/emacs-lisp/cl-macs.el 2013-06-05 02:35:40 +0000 +++ lisp/emacs-lisp/cl-macs.el 2013-06-12 02:16:02 +0000 @@ -584,7 +584,7 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. \(fn (WHEN...) BODY...)" - (declare (indent 1) (debug ((&rest &or "compile" "load" "eval") body))) + (declare (indent 1) (debug (sexp body))) (if (and (fboundp 'cl--compiling-file) (cl--compiling-file) (not cl--not-toplevel) (not (boundp 'for-effect))) ;Horrible kludge. (let ((comp (or (memq 'compile when) (memq :compile-toplevel when))) @@ -2276,9 +2276,10 @@ KEYWORD can be one of :conc-name, :constructor, :copier, :predicate, :type, :named, :initial-offset, :print-function, or :include. -Each SLOT may instead take the form (SLOT SLOT-OPTS...), where -SLOT-OPTS are keyword-value pairs for that slot. Currently, only -one keyword is supported, `:read-only'. If this has a non-nil +Each SLOT may instead take the form (SNAME SDEFAULT SOPTIONS...), where +SDEFAULT is the default value of that slot and SOPTIONS are keyword-value +pairs for that slot. +Currently, only one keyword is supported, `:read-only'. If this has a non-nil value, that slot cannot be set via `setf'. \(fn NAME SLOTS...)" @@ -2574,9 +2575,16 @@ (defun cl-typep (object type) ; See compiler macro below. "Check that OBJECT is of type TYPE. TYPE is a Common Lisp-style type specifier." + (declare (compiler-macro cl--compiler-macro-typep)) (let ((cl--object object)) ;; Yuck!! (eval (cl--make-type-test 'cl--object type)))) +(defun cl--compiler-macro-typep (form val type) + (if (macroexp-const-p type) + (macroexp-let2 macroexp-copyable-p temp val + (cl--make-type-test temp (cl--const-expr-val type))) + form)) + ;;;###autoload (defmacro cl-check-type (form type &optional string) "Verify that FORM is of type TYPE; signal an error if not. @@ -2635,19 +2643,13 @@ (let ((p args) (res nil)) (while (consp p) (push (pop p) res)) (setq args (nconc (nreverse res) (and p (list '&rest p))))) - `(cl-eval-when (compile load eval) - (put ',func 'compiler-macro - (cl-function (lambda ,(if (memq '&whole args) (delq '&whole args) - (cons '_cl-whole-arg args)) - ,@body))) - ;; This is so that describe-function can locate - ;; the macro definition. - (let ((file ,(or buffer-file-name - (and (boundp 'byte-compile-current-file) - (stringp byte-compile-current-file) - byte-compile-current-file)))) - (if file (put ',func 'compiler-macro-file - (purecopy (file-name-nondirectory file))))))) + (let ((fname (make-symbol (concat (symbol-name func) "--cmacro")))) + `(eval-and-compile + ;; Name the compiler-macro function, so that `symbol-file' can find it. + (cl-defun ,fname ,(if (memq '&whole args) (delq '&whole args) + (cons '_cl-whole-arg args)) + ,@body) + (put ',func 'compiler-macro #',fname)))) ;;;###autoload (defun cl-compiler-macroexpand (form) @@ -2773,12 +2775,6 @@ `(cl-getf (symbol-plist ,sym) ,prop ,def) `(get ,sym ,prop))) -(cl-define-compiler-macro cl-typep (&whole form val type) - (if (macroexp-const-p type) - (macroexp-let2 macroexp-copyable-p temp val - (cl--make-type-test temp (cl--const-expr-val type))) - form)) - (dolist (y '(cl-first cl-second cl-third cl-fourth cl-fifth cl-sixth cl-seventh cl-eighth cl-ninth cl-tenth === modified file 'lisp/help-fns.el' --- lisp/help-fns.el 2013-02-14 08:05:26 +0000 +++ lisp/help-fns.el 2013-06-12 02:16:02 +0000 @@ -435,14 +435,19 @@ (let ((handler (function-get function 'compiler-macro))) (when handler (insert "\nThis function has a compiler macro") - (let ((lib (get function 'compiler-macro-file))) - ;; FIXME: rather than look at the compiler-macro-file property, - ;; just look at `handler' itself. - (when (stringp lib) - (insert (format " in `%s'" lib)) - (save-excursion - (re-search-backward "`\\([^`']+\\)'" nil t) - (help-xref-button 1 'help-function-cmacro function lib)))) + (if (symbolp handler) + (progn + (insert (format " `%s'" handler)) + (save-excursion + (re-search-backward "`\\([^`']+\\)'" nil t) + (help-xref-button 1 'help-function handler))) + ;; FIXME: Obsolete since 24.4. + (let ((lib (get function 'compiler-macro-file))) + (when (stringp lib) + (insert (format " in `%s'" lib)) + (save-excursion + (re-search-backward "`\\([^`']+\\)'" nil t) + (help-xref-button 1 'help-function-cmacro function lib))))) (insert ".\n")))) (defun help-fns--signature (function doc real-def real-function) === modified file 'lisp/help-mode.el' --- lisp/help-mode.el 2013-01-11 23:08:55 +0000 +++ lisp/help-mode.el 2013-06-12 02:16:02 +0000 @@ -204,7 +204,7 @@ (message "Unable to find location in file")))) 'help-echo (purecopy "mouse-2, RET: find function's definition")) -(define-button-type 'help-function-cmacro +(define-button-type 'help-function-cmacro ; FIXME: Obsolete since 24.4. :supertype 'help-xref 'help-function (lambda (fun file) (setq file (locate-library file t)) @@ -213,7 +213,7 @@ (pop-to-buffer (find-file-noselect file)) (goto-char (point-min)) (if (re-search-forward - (format "^[ \t]*(define-compiler-macro[ \t]+%s" + (format "^[ \t]*(\\(cl-\\)?define-compiler-macro[ \t]+%s" (regexp-quote (symbol-name fun))) nil t) (forward-line 0) (message "Unable to find location in file"))) ------------------------------------------------------------ revno: 112936 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Wed 2013-06-12 01:38:23 +0000 message: lisp/gnus/eww.el (eww-convert-widgets): Make widgets from non-tabular layouts work, too (eww-tag-select): Implement . + 2013-06-10 Albert Krewinkel * sieve-manage.el (sieve-manage-open): work with STARTTLS: shorten === modified file 'lisp/gnus/eww.el' --- lisp/gnus/eww.el 2013-06-11 03:09:59 +0000 +++ lisp/gnus/eww.el 2013-06-12 01:38:23 +0000 @@ -88,7 +88,7 @@ (shr-external-rendering-functions '((form . eww-tag-form) (input . eww-tag-input) - (submit . eww-tag-submit)))) + (select . eww-tag-select)))) (shr-insert-document document) (eww-convert-widgets)) (goto-char (point-min)))) @@ -201,6 +201,7 @@ :notify 'eww-click-radio :name (cdr (assq :name cont)) :checkbox-value (cdr (assq :value cont)) + :checkbox-type type :eww-form eww-form (cdr (assq :checked cont)))) ((equal type "hidden") @@ -222,20 +223,43 @@ (when shr-final-table-render (nconc eww-form (list widget))) (apply 'widget-create widget)) - (put-text-property start (point) 'eww-widget widget))) + (put-text-property start (point) 'eww-widget widget) + (insert " "))) + +(defun eww-tag-select (cont) + (shr-ensure-paragraph) + (let ((menu (list 'menu-choice + :name (cdr (assq :name cont)) + :eww-form eww-form)) + (options nil) + (start (point))) + (dolist (elem cont) + (when (eq (car elem) 'option) + (when (cdr (assq :selected (cdr elem))) + (nconc menu (list :value + (cdr (assq :value (cdr elem)))))) + (push (list 'item + :value (cdr (assq :value (cdr elem))) + :tag (cdr (assq 'text (cdr elem)))) + options))) + (nconc menu options) + (apply 'widget-create menu) + (put-text-property start (point) 'eww-widget menu) + (shr-ensure-paragraph))) (defun eww-click-radio (widget &rest ignore) (let ((form (plist-get (cdr widget) :eww-form)) (name (plist-get (cdr widget) :name))) - (if (widget-value widget) - ;; Switch all the other radio buttons off. - (dolist (overlay (overlays-in (point-min) (point-max))) - (let ((field (plist-get (overlay-properties overlay) 'button))) - (when (and (eq (plist-get (cdr field) :eww-form) form) - (equal name (plist-get (cdr field) :name))) - (unless (eq field widget) - (widget-value-set field nil))))) - (widget-value-set widget t)) + (when (equal (plist-get (cdr widget) :type) "radio") + (if (widget-value widget) + ;; Switch all the other radio buttons off. + (dolist (overlay (overlays-in (point-min) (point-max))) + (let ((field (plist-get (overlay-properties overlay) 'button))) + (when (and (eq (plist-get (cdr field) :eww-form) form) + (equal name (plist-get (cdr field) :name))) + (unless (eq field widget) + (widget-value-set field nil))))) + (widget-value-set widget t))) (eww-fix-widget-keymap))) (defun eww-submit (widget &rest ignore) @@ -298,12 +322,17 @@ (defun eww-convert-widgets () (let ((start (point-min)) widget) + ;; Some widgets come from different buffers (rendered for tables), + ;; so we need to nix out the list of widgets and recreate them. + (setq widget-field-list nil + widget-field-new nil) (while (setq start (next-single-property-change start 'eww-widget)) (setq widget (get-text-property start 'eww-widget)) (goto-char start) (let ((end (next-single-property-change start 'eww-widget))) (dolist (overlay (overlays-in start end)) - (when (plist-get (overlay-properties overlay) 'button) + (when (or (plist-get (overlay-properties overlay) 'button) + (plist-get (overlay-properties overlay) 'field)) (delete-overlay overlay))) (delete-region start end)) (apply 'widget-create widget)) ------------------------------------------------------------ revno: 112935 committer: Xue Fuqiao branch nick: trunk timestamp: Wed 2013-06-12 09:12:59 +0800 message: * src/fileio.c (expand_file_name): Doc fix. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-06-11 18:34:06 +0000 +++ src/ChangeLog 2013-06-12 01:12:59 +0000 @@ -1,3 +1,7 @@ +2013-06-12 Xue Fuqiao + + * fileio.c (expand_file_name): Doc fix. + 2013-06-11 Paul Eggert Tickle glib by waiting for Emacs itself, not for process 0 (Bug#14569). === modified file 'src/fileio.c' --- src/fileio.c 2013-05-31 01:31:10 +0000 +++ src/fileio.c 2013-06-12 01:12:59 +0000 @@ -776,8 +776,9 @@ DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0, doc: /* Convert filename NAME to absolute, and canonicalize it. Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative -\(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing, -the current buffer's value of `default-directory' is used. +\(does not start with slash or tilde); both the directory name and +a directory's file name are accepted. If DEFAULT-DIRECTORY is nil or +missing, the current buffer's value of `default-directory' is used. NAME should be a string that is a valid file name for the underlying filesystem. File name components that are `.' are removed, and ------------------------------------------------------------ revno: 112934 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2013-06-11 20:49:33 -0400 message: First part of Daniel Hackney's patch to package.el. * lisp/emacs-lisp/package.el: Use defstruct. (package-desc): New, main struct. (package--bi-desc, package--ac-desc): New structs, used to describe the format in external files. (package-desc-vers): Replace with package-desc-version accessor. (package-desc-doc): Replace with package-desc-summary accessor. (package-activate-1): Remove `package' arg since the pkg-vec now includes the name. (define-package): Use package-desc-from-define. (package-unpack-single): Change file-name arg to be a symbol. (package--add-to-archive-contents): Use package-desc-create and new accessor functions to package--ac-desc. (package-buffer-info, package-tar-file-info): Return a package-desc. (package-install-from-buffer): Remove `type' argument. Change pkg-info arg to be a package-desc. (package-install-file): Adjust accordingly. Use \' to match EOS. (package--from-builtin): New function. (describe-package-1, package-menu--generate): Use it. (package--make-autoloads-and-compile): Change name arg to be a symbol. (package-generate-autoloads): Idem and return the name of the file. * lisp/emacs-lisp/package-x.el (package-upload-buffer-internal): Change pkg-info arg to be a package-desc. Use package-make-ac-desc. (package-upload-file): Use \' to match EOS. * lisp/finder.el (finder-compile-keywords): Use package-make-builtin. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-11 22:14:30 +0000 +++ lisp/ChangeLog 2013-06-12 00:49:33 +0000 @@ -1,3 +1,33 @@ +2013-06-12 Stefan Monnier + Daniel Hackney + + First part of Daniel Hackney's patch to package.el. + * emacs-lisp/package.el: Use defstruct. + (package-desc): New, main struct. + (package--bi-desc, package--ac-desc): New structs, used to describe the + format in external files. + (package-desc-vers): Replace with package-desc-version accessor. + (package-desc-doc): Replace with package-desc-summary accessor. + (package-activate-1): Remove `package' arg since the pkg-vec now + includes the name. + (define-package): Use package-desc-from-define. + (package-unpack-single): Change file-name arg to be a symbol. + (package--add-to-archive-contents): Use package-desc-create and new + accessor functions to package--ac-desc. + (package-buffer-info, package-tar-file-info): Return a package-desc. + (package-install-from-buffer): Remove `type' argument. Change pkg-info + arg to be a package-desc. + (package-install-file): Adjust accordingly. Use \' to match EOS. + (package--from-builtin): New function. + (describe-package-1, package-menu--generate): Use it. + (package--make-autoloads-and-compile): Change name arg to be a symbol. + (package-generate-autoloads): Idem and return the name of the file. + * emacs-lisp/package-x.el (package-upload-buffer-internal): + Change pkg-info arg to be a package-desc. + Use package-make-ac-desc. + (package-upload-file): Use \' to match EOS. + * finder.el (finder-compile-keywords): Use package-make-builtin. + 2013-06-11 Stefan Monnier * vc/vc.el (vc-deduce-fileset): Change error message. === modified file 'lisp/emacs-lisp/package-x.el' --- lisp/emacs-lisp/package-x.el 2013-01-01 09:11:05 +0000 +++ lisp/emacs-lisp/package-x.el 2013-06-12 00:49:33 +0000 @@ -162,9 +162,11 @@ description archive-url)) -(defun package-upload-buffer-internal (pkg-info extension &optional archive-url) +(declare-function lm-commentary "lisp-mnt" (&optional file)) + +(defun package-upload-buffer-internal (pkg-desc extension &optional archive-url) "Upload a package whose contents are in the current buffer. -PKG-INFO is the package info, see `package-buffer-info'. +PKG-DESC is the `package-desc'. EXTENSION is the file extension, a string. It can be either \"el\" or \"tar\". @@ -196,18 +198,18 @@ (error "Aborted"))) (save-excursion (save-restriction - (let* ((file-type (cond - ((equal extension "el") 'single) - ((equal extension "tar") 'tar) - (t (error "Unknown extension `%s'" extension)))) - (file-name (aref pkg-info 0)) - (pkg-name (intern file-name)) - (requires (aref pkg-info 1)) - (desc (if (string= (aref pkg-info 2) "") + (let* ((file-type (package-desc-kind pkg-desc)) + (pkg-name (package-desc-name pkg-desc)) + (requires (package-desc-reqs pkg-desc)) + (desc (if (eq (package-desc-summary pkg-desc) + package--default-summary) (read-string "Description of package: ") - (aref pkg-info 2))) - (pkg-version (aref pkg-info 3)) - (commentary (aref pkg-info 4)) + (package-desc-summary pkg-desc))) + (pkg-version (package-desc-version pkg-desc)) + (commentary + (pcase file-type + (`single (lm-commentary)) + (`tar nil))) ;; FIXME: Get it from the README file. (split-version (version-to-list pkg-version)) (pkg-buffer (current-buffer))) @@ -215,7 +217,8 @@ ;; from `package-archive-upload-base' otherwise. (let ((contents (or (package--archive-contents-from-url archive-url) (package--archive-contents-from-file))) - (new-desc (vector split-version requires desc file-type))) + (new-desc (package-make-ac-desc + split-version requires desc file-type))) (if (> (car contents) package-archive-version) (error "Unrecognized archive version %d" (car contents))) (let ((elt (assq pkg-name (cdr contents)))) @@ -232,6 +235,7 @@ ;; this and the package itself. For now we assume ELPA is ;; writable via file primitives. (let ((print-level nil) + (print-quoted t) (print-length nil)) (write-region (concat (pp-to-string contents) "\n") nil @@ -241,29 +245,29 @@ ;; If there is a commentary section, write it. (when commentary (write-region commentary nil - (expand-file-name - (concat (symbol-name pkg-name) "-readme.txt") - package-archive-upload-base))) + (expand-file-name + (concat (symbol-name pkg-name) "-readme.txt") + package-archive-upload-base))) (set-buffer pkg-buffer) (write-region (point-min) (point-max) (expand-file-name - (concat file-name "-" pkg-version "." extension) + (format "%s-%s.%s" pkg-name pkg-version extension) package-archive-upload-base) nil nil nil 'excl) ;; Write a news entry. (and package-update-news-on-upload archive-url - (package--update-news (concat file-name "." extension) + (package--update-news (format "%s.%s" pkg-name extension) pkg-version desc archive-url)) ;; special-case "package": write a second copy so that the ;; installer can easily find the latest version. - (if (string= file-name "package") + (if (eq pkg-name 'package) (write-region (point-min) (point-max) (expand-file-name - (concat file-name "." extension) + (format "%s.%s" pkg-name extension) package-archive-upload-base) nil nil nil 'ask)))))))) @@ -275,8 +279,8 @@ (save-excursion (save-restriction ;; Find the package in this buffer. - (let ((pkg-info (package-buffer-info))) - (package-upload-buffer-internal pkg-info "el"))))) + (let ((pkg-desc (package-buffer-info))) + (package-upload-buffer-internal pkg-desc "el"))))) (defun package-upload-file (file) "Upload the Emacs Lisp package FILE to the package archive. @@ -288,12 +292,13 @@ (interactive "fPackage file name: ") (with-temp-buffer (insert-file-contents-literally file) - (let ((info (cond - ((string-match "\\.tar$" file) (package-tar-file-info file)) - ((string-match "\\.el$" file) (package-buffer-info)) - (t (error "Unrecognized extension `%s'" - (file-name-extension file)))))) - (package-upload-buffer-internal info (file-name-extension file))))) + (let ((pkg-desc + (cond + ((string-match "\\.tar\\'" file) (package-tar-file-info file)) + ((string-match "\\.el\\'" file) (package-buffer-info)) + (t (error "Unrecognized extension `%s'" + (file-name-extension file)))))) + (package-upload-buffer-internal pkg-desc (file-name-extension file))))) (defun package-gnus-summary-upload () "Upload a package contained in the current *Article* buffer. === modified file 'lisp/emacs-lisp/package.el' --- lisp/emacs-lisp/package.el 2013-05-14 07:35:21 +0000 +++ lisp/emacs-lisp/package.el 2013-06-12 00:49:33 +0000 @@ -170,6 +170,8 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (require 'tabulated-list) (defgroup package nil @@ -262,11 +264,8 @@ ;; We don't prime the cache since it tends to get out of date. (defvar package-archive-contents nil "Cache of the contents of the Emacs Lisp Package Archive. -This is an alist mapping package names (symbols) to package -descriptor vectors. These are like the vectors for `package-alist' -but have extra entries: one which is 'tar for tar packages and -'single for single-file packages, and one which is the name of -the archive from which it came.") +This is an alist mapping package names (symbols) to +`package--desc' structures.") (put 'package-archive-contents 'risky-local-variable t) (defcustom package-user-dir (locate-user-emacs-file "elpa") @@ -297,6 +296,62 @@ :group 'package :version "24.1") +(defvar package--default-summary "No description available.") + +(cl-defstruct (package-desc + ;; Rename the default constructor from `make-package-desc'. + (:constructor package-desc-create) + ;; Has the same interface as the old `define-package', + ;; which is still used in the "foo-pkg.el" files. Extra + ;; options can be supported by adding additional keys. + (:constructor + package-desc-from-define + (name-string version-string &optional summary requirements + &key kind archive + &aux + (name (intern name-string)) + (version (version-to-list version-string)) + (reqs (mapcar #'(lambda (elt) + (list (car elt) + (version-to-list (cadr elt)))) + (if (eq 'quote (car requirements)) + (nth 1 requirements) + requirements)))))) + "Structure containing information about an individual package. + +Slots: + +`name' Name of the package, as a symbol. + +`version' Version of the package, as a version list. + +`summary' Short description of the package, typically taken from +the first line of the file. + +`reqs' Requirements of the package. A list of (PACKAGE +VERSION-LIST) naming the dependent package and the minimum +required version. + +`kind' The distribution format of the package. Currently, it is +either `single' or `tar'. + +`archive' The name of the archive (as a string) whence this +package came." + name + version + (summary package--default-summary) + reqs + kind + archive) + +;; Package descriptor format used in finder-inf.el and package--builtins. +(cl-defstruct (package--bi-desc + (:constructor package-make-builtin (version summary)) + (:type vector)) + version + reqs + summary) + ;; The value is precomputed in finder-inf.el, but don't load that ;; until it's needed (i.e. when `package-initialize' is called). (defvar package--builtins nil @@ -305,27 +360,14 @@ `finder-inf'; this is not done until it is needed, e.g. by the function `package-built-in-p'. -Each element has the form (PKG . DESC), where PKG is a package -name (a symbol) and DESC is a vector that describes the package. -The vector DESC has the form [VERSION-LIST REQS DOCSTRING]. - VERSION-LIST is a version list. - REQS is a list of packages required by the package, each - requirement having the form (NAME VL), where NAME is a string - and VL is a version list. - DOCSTRING is a brief description of the package.") +Each element has the form (PKG . PACKAGE-BI-DESC), where PKG is a package +name (a symbol) and DESC is a `package--bi-desc' structure.") (put 'package--builtins 'risky-local-variable t) (defvar package-alist nil "Alist of all packages available for activation. Each element has the form (PKG . DESC), where PKG is a package -name (a symbol) and DESC is a vector that describes the package. - -The vector DESC has the form [VERSION-LIST REQS DOCSTRING]. - VERSION-LIST is a version list. - REQS is a list of packages required by the package, each - requirement having the form (NAME VL) where NAME is a string - and VL is a version list. - DOCSTRING is a brief description of the package. +name (a symbol) and DESC is a `package-desc' structure. This variable is set automatically by `package-load-descriptor', called via `package-initialize'. To change which packages are @@ -339,7 +381,10 @@ (defvar package-obsolete-alist nil "Representation of obsolete packages. Like `package-alist', but maps package name to a second alist. -The inner alist is keyed by version.") +The inner alist is keyed by version. + +Each element of the list is (NAME . VERSION-ALIST), where each +entry in VERSION-ALIST is (VERSION-LIST . PACKAGE-DESC).") (put 'package-obsolete-alist 'risky-local-variable t) (defun package-version-join (vlist) @@ -430,26 +475,16 @@ ;; Actually load the descriptor: (package-load-descriptor dir subdir)))) -(defsubst package-desc-vers (desc) - "Extract version from a package description vector." - (aref desc 0)) - -(defsubst package-desc-reqs (desc) - "Extract requirements from a package description vector." - (aref desc 1)) - -(defsubst package-desc-doc (desc) - "Extract doc string from a package description vector." - (aref desc 2)) - -(defsubst package-desc-kind (desc) - "Extract the kind of download from an archive package description vector." - (aref desc 3)) +(define-obsolete-function-alias 'package-desc-vers 'package-desc-version "24.4") + +(define-obsolete-function-alias 'package-desc-doc 'package-desc-summary "24.4") + (defun package--dir (name version) + ;; FIXME: Keep this as a field in the package-desc. "Return the directory where a package is installed, or nil if none. -NAME and VERSION are both strings." - (let* ((subdir (concat name "-" version)) +NAME is a symbol and VERSION is a string." + (let* ((subdir (format "%s-%s" name version)) (dir-list (cons package-user-dir package-directory-list)) pkg-dir) (while dir-list @@ -460,9 +495,9 @@ (setq dir-list (cdr dir-list))))) pkg-dir)) -(defun package-activate-1 (package pkg-vec) - (let* ((name (symbol-name package)) - (version-str (package-version-join (package-desc-vers pkg-vec))) +(defun package-activate-1 (pkg-desc) + (let* ((name (package-desc-name pkg-desc)) + (version-str (package-version-join (package-desc-version pkg-desc))) (pkg-dir (package--dir name version-str))) (unless pkg-dir (error "Internal error: unable to find directory for `%s-%s'" @@ -475,8 +510,8 @@ (push pkg-dir Info-directory-list)) ;; Add to load path, add autoloads, and activate the package. (push pkg-dir load-path) - (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) - (push package package-activated-list) + (load (expand-file-name (format "%s-autoloads" name) pkg-dir) nil t) + (push name package-activated-list) ;; Don't return nil. t)) @@ -489,7 +524,12 @@ (version-list-<= min-version (version-to-list emacs-version)) (let ((elt (assq package package--builtins))) (and elt (version-list-<= min-version - (package-desc-vers (cdr elt))))))) + (package--bi-desc-version (cdr elt))))))) + +(defun package--from-builtin (bi-desc) + (package-desc-create :name (pop bi-desc) + :version (package--bi-desc-version bi-desc) + :summary (package--bi-desc-summary bi-desc))) ;; This function goes ahead and activates a newer version of a package ;; if an older one was already activated. This is not ideal; we'd at @@ -504,7 +544,7 @@ available-version found) ;; Check if PACKAGE is available in `package-alist'. (when pkg-vec - (setq available-version (package-desc-vers pkg-vec) + (setq available-version (package-desc-version pkg-vec) found (version-list-<= min-version available-version))) (cond ;; If no such package is found, maybe it's built-in. @@ -525,7 +565,7 @@ Required package `%s-%s' is unavailable" package (car fail) (package-version-join (cadr fail))) ;; If all goes well, activate the package itself. - (package-activate-1 package pkg-vec))))))) + (package-activate-1 pkg-vec))))))) (defun package-mark-obsolete (package pkg-vec) "Put package on the obsolete list, if not already there." @@ -533,11 +573,11 @@ (if elt ;; If this obsolete version does not exist in the list, update ;; it the list. - (unless (assoc (package-desc-vers pkg-vec) (cdr elt)) - (setcdr elt (cons (cons (package-desc-vers pkg-vec) pkg-vec) + (unless (assoc (package-desc-version pkg-vec) (cdr elt)) + (setcdr elt (cons (cons (package-desc-version pkg-vec) pkg-vec) (cdr elt)))) ;; Make a new association. - (push (cons package (list (cons (package-desc-vers pkg-vec) + (push (cons package (list (cons (package-desc-version pkg-vec) pkg-vec))) package-obsolete-alist)))) @@ -555,21 +595,17 @@ EXTRA-PROPERTIES is currently unused." (let* ((name (intern name-string)) (version (version-to-list version-string)) - (new-pkg-desc - (cons name - (vector version - (mapcar - (lambda (elt) - (list (car elt) - (version-to-list (car (cdr elt))))) - requirements) - docstring))) + (new-pkg-desc (cons name + (package-desc-from-define name-string + version-string + docstring + requirements))) (old-pkg (assq name package-alist))) (cond ;; If there's no old package, just add this to `package-alist'. ((null old-pkg) (push new-pkg-desc package-alist)) - ((version-list-< (package-desc-vers (cdr old-pkg)) version) + ((version-list-< (package-desc-version (cdr old-pkg)) version) ;; Remove the old package and declare it obsolete. (package-mark-obsolete name (cdr old-pkg)) (setq package-alist (cons new-pkg-desc @@ -577,7 +613,7 @@ ;; You can have two packages with the same version, e.g. one in ;; the system package directory and one in your private ;; directory. We just let the first one win. - ((not (version-list-= (package-desc-vers (cdr old-pkg)) version)) + ((not (version-list-= (package-desc-version (cdr old-pkg)) version)) ;; The package is born obsolete. (package-mark-obsolete name (cdr new-pkg-desc)))))) @@ -603,14 +639,15 @@ (defun package-generate-autoloads (name pkg-dir) (require 'autoload) ;Load before we let-bind generated-autoload-file! - (let* ((auto-name (concat name "-autoloads.el")) + (let* ((auto-name (format "%s-autoloads.el" name)) ;;(ignore-name (concat name "-pkg.el")) (generated-autoload-file (expand-file-name auto-name pkg-dir)) (version-control 'never)) (package-autoload-ensure-default-file generated-autoload-file) (update-directory-autoloads pkg-dir) (let ((buf (find-buffer-visiting generated-autoload-file))) - (when buf (kill-buffer buf))))) + (when buf (kill-buffer buf))) + auto-name)) (defvar tar-parse-info) (declare-function tar-untar-buffer "tar-mode" ()) @@ -644,57 +681,62 @@ ;; FIXME: should we delete PKG-DIR if it exists? (let* ((default-directory (file-name-as-directory package-user-dir))) (package-untar-buffer dirname) - (package--make-autoloads-and-compile name pkg-dir)))) + (package--make-autoloads-and-compile package pkg-dir)))) (defun package--make-autoloads-and-compile (name pkg-dir) "Generate autoloads and do byte-compilation for package named NAME. PKG-DIR is the name of the package directory." - (package-generate-autoloads name pkg-dir) - (let ((load-path (cons pkg-dir load-path))) + (let ((auto-name (package-generate-autoloads name pkg-dir)) + (load-path (cons pkg-dir load-path))) ;; We must load the autoloads file before byte compiling, in ;; case there are magic cookies to set up non-trivial paths. - (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) + (load auto-name nil t) + ;; FIXME: Compilation should be done as a separate, optional, step. + ;; E.g. for multi-package installs, we should first install all packages + ;; and then compile them. (byte-recompile-directory pkg-dir 0 t))) (defun package--write-file-no-coding (file-name) (let ((buffer-file-coding-system 'no-conversion)) (write-region (point-min) (point-max) file-name))) -(defun package-unpack-single (file-name version desc requires) +(defun package-unpack-single (name version desc requires) "Install the contents of the current buffer as a package." - ;; Special case "package". - (if (string= file-name "package") + ;; Special case "package". FIXME: Should this still be supported? + (if (eq name 'package) (package--write-file-no-coding - (expand-file-name (concat file-name ".el") package-user-dir)) - (let* ((pkg-dir (expand-file-name (concat file-name "-" + (expand-file-name (format "%s.el" name) package-user-dir)) + (let* ((pkg-dir (expand-file-name (format "%s-%s" name (package-version-join (version-to-list version))) package-user-dir)) - (el-file (expand-file-name (concat file-name ".el") pkg-dir)) - (pkg-file (expand-file-name (concat file-name "-pkg.el") pkg-dir))) + (el-file (expand-file-name (format "%s.el" name) pkg-dir)) + (pkg-file (expand-file-name (format "%s-pkg.el" name) pkg-dir))) (make-directory pkg-dir t) (package--write-file-no-coding el-file) (let ((print-level nil) + (print-quoted t) (print-length nil)) (write-region (concat (prin1-to-string (list 'define-package - file-name + (symbol-name name) version desc - (list 'quote - ;; Turn version lists into string form. - (mapcar - (lambda (elt) - (list (car elt) - (package-version-join (cadr elt)))) - requires)))) + (when requires ;Don't bother quoting nil. + (list 'quote + ;; Turn version lists into string form. + (mapcar + (lambda (elt) + (list (car elt) + (package-version-join (cadr elt)))) + requires))))) "\n") nil pkg-file nil nil nil 'excl)) - (package--make-autoloads-and-compile file-name pkg-dir)))) + (package--make-autoloads-and-compile name pkg-dir)))) (defmacro package--with-work-buffer (location file &rest body) "Run BODY in a buffer containing the contents of FILE at LOCATION. @@ -744,7 +786,7 @@ (let ((location (package-archive-base name)) (file (concat (symbol-name name) "-" version ".el"))) (package--with-work-buffer location file - (package-unpack-single (symbol-name name) version desc requires)))) + (package-unpack-single name version desc requires)))) (defun package-download-tar (name version) "Download and install a tar package." @@ -762,7 +804,7 @@ (let ((pkg-desc (assq package package-alist))) (if pkg-desc (version-list-<= min-version - (package-desc-vers (cdr pkg-desc))) + (package-desc-version (cdr pkg-desc))) ;; Also check built-in packages. (package-built-in-p package min-version)))) @@ -785,7 +827,7 @@ (unless (package-installed-p next-pkg next-version) ;; A package is required, but not installed. It might also be ;; blocked via `package-load-list'. - (let ((pkg-desc (assq next-pkg package-archive-contents)) + (let ((pkg-desc (cdr (assq next-pkg package-archive-contents))) hold) (when (setq hold (assq next-pkg package-load-list)) (setq hold (cadr hold)) @@ -805,17 +847,17 @@ (symbol-name next-pkg) (package-version-join next-version))) (unless (version-list-<= next-version - (package-desc-vers (cdr pkg-desc))) + (package-desc-version pkg-desc)) (error "Need package `%s-%s', but only %s is available" (symbol-name next-pkg) (package-version-join next-version) - (package-version-join (package-desc-vers (cdr pkg-desc))))) + (package-version-join (package-desc-version pkg-desc)))) ;; Move to front, so it gets installed early enough (bug#14082). (setq package-list (cons next-pkg (delq next-pkg package-list))) (setq package-list (package-compute-transaction package-list (package-desc-reqs - (cdr pkg-desc)))))))) + pkg-desc))))))) package-list) (defun package-read-from-string (str) @@ -867,13 +909,29 @@ (dolist (package contents) (package--add-to-archive-contents package archive))))) +;; Package descriptor objects used inside the "archive-contents" file. +;; Changing this defstruct implies changing the format of the +;; "archive-contents" files. +(cl-defstruct (package--ac-desc + (:constructor package-make-ac-desc (version reqs summary kind)) + (:copier nil) + (:type vector)) + version reqs summary kind) + (defun package--add-to-archive-contents (package archive) "Add the PACKAGE from the given ARCHIVE if necessary. -Also, add the originating archive to the end of the package vector." - (let* ((name (car package)) - (version (package-desc-vers (cdr package))) - (entry (cons name - (vconcat (cdr package) (vector archive)))) +PACKAGE should have the form (NAME . PACKAGE--AC-DESC). +Also, add the originating archive to the `package-desc' structure." + (let* ((name (car package)) + (pkg-desc + (package-desc-create + :name name + :version (package--ac-desc-version (cdr package)) + :reqs (package--ac-desc-reqs (cdr package)) + :summary (package--ac-desc-summary (cdr package)) + :kind (package--ac-desc-kind (cdr package)) + :archive archive)) + (entry (cons name pkg-desc)) (existing-package (assq name package-archive-contents)) (pinned-to-archive (assoc name package-pinned-packages))) (cond ((and pinned-to-archive @@ -881,9 +939,9 @@ (not (equal (cdr pinned-to-archive) archive))) nil) ((not existing-package) - (add-to-list 'package-archive-contents entry)) - ((version-list-< (package-desc-vers (cdr existing-package)) - version) + (push entry package-archive-contents)) + ((version-list-< (package-desc-version (cdr existing-package)) + (package-desc-version pkg-desc)) ;; Replace the entry with this one. (setq package-archive-contents (cons entry @@ -902,14 +960,14 @@ ;; `package-load-list', download the held version. (hold (cadr (assq elt package-load-list))) (v-string (or (and (stringp hold) hold) - (package-version-join (package-desc-vers desc)))) + (package-version-join (package-desc-version desc)))) (kind (package-desc-kind desc))) (cond ((eq kind 'tar) (package-download-tar elt v-string)) ((eq kind 'single) (package-download-single elt v-string - (package-desc-doc desc) + (package-desc-summary desc) (package-desc-reqs desc))) (t (error "Unknown package kind: %s" (symbol-name kind)))) @@ -961,17 +1019,7 @@ (error nil)))) (defun package-buffer-info () - "Return a vector describing the package in the current buffer. -The vector has the form - - [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY] - -FILENAME is the file name, a string, sans the \".el\" extension. -REQUIRES is a list of requirements, each requirement having the - form (NAME VER); NAME is a string and VER is a version list. -DESCRIPTION is the package description, a string. -VERSION is the version, a string. -COMMENTARY is the commentary section, a string, or nil if none. + "Return a `package-desc' describing the package in the current buffer. If the buffer does not contain a conforming package, signal an error. If there is a package, narrow the buffer to the file's @@ -990,25 +1038,18 @@ (require 'lisp-mnt) ;; Use some headers we've invented to drive the process. (let* ((requires-str (lm-header "package-requires")) - (requires (if requires-str - (package-read-from-string requires-str))) ;; Prefer Package-Version; if defined, the package author ;; probably wants us to use it. Otherwise try Version. (pkg-version (or (package-strip-rcs-id (lm-header "package-version")) - (package-strip-rcs-id (lm-header "version")))) - (commentary (lm-commentary))) + (package-strip-rcs-id (lm-header "version"))))) (unless pkg-version (error "Package lacks a \"Version\" or \"Package-Version\" header")) - ;; Turn string version numbers into list form. - (setq requires - (mapcar - (lambda (elt) - (list (car elt) - (version-to-list (car (cdr elt))))) - requires)) - (vector file-name requires desc pkg-version commentary)))) + (package-desc-from-define + file-name pkg-version desc + (if requires-str (package-read-from-string requires-str)) + :kind 'single)))) (defun package-tar-file-info (file) "Find package information for a tar file. @@ -1025,67 +1066,46 @@ (pkg-def-contents (shell-command-to-string ;; Requires GNU tar. (concat "tar -xOf " file " " - pkg-name "-" pkg-version "/" pkg-name "-pkg.el"))) (pkg-def-parsed (package-read-from-string pkg-def-contents))) (unless (eq (car pkg-def-parsed) 'define-package) (error "No `define-package' sexp is present in `%s-pkg.el'" pkg-name)) - (let ((name-str (nth 1 pkg-def-parsed)) - (version-string (nth 2 pkg-def-parsed)) - (docstring (nth 3 pkg-def-parsed)) - (requires (nth 4 pkg-def-parsed)) - (readme (shell-command-to-string - ;; Requires GNU tar. - (concat "tar -xOf " file " " - pkg-name "-" pkg-version "/README")))) - (unless (equal pkg-version version-string) + (let ((pkg-desc + (apply #'package-desc-from-define (append (cdr pkg-def-parsed) + '(:kind tar))))) + (unless (equal pkg-version + (package-version-join (package-desc-version pkg-desc))) (error "Package has inconsistent versions")) - (unless (equal pkg-name name-str) + (unless (equal pkg-name (symbol-name (package-desc-name pkg-desc))) (error "Package has inconsistent names")) - ;; Kind of a hack. - (if (string-match ": Not found in archive" readme) - (setq readme nil)) - ;; Turn string version numbers into list form. - (if (eq (car requires) 'quote) - (setq requires (car (cdr requires)))) - (setq requires - (mapcar (lambda (elt) - (list (car elt) - (version-to-list (cadr elt)))) - requires)) - (vector pkg-name requires docstring version-string readme))))) + pkg-desc)))) + ;;;###autoload -(defun package-install-from-buffer (pkg-info type) +(defun package-install-from-buffer (pkg-desc) "Install a package from the current buffer. When called interactively, the current buffer is assumed to be a single .el file that follows the packaging guidelines; see info node `(elisp)Packaging'. -When called from Lisp, PKG-INFO is a vector describing the -information, of the type returned by `package-buffer-info'; and -TYPE is the package type (either `single' or `tar')." - (interactive (list (package-buffer-info) 'single)) +When called from Lisp, PKG-DESC is a `package-desc' describing the +information)." + (interactive (list (package-buffer-info))) (save-excursion (save-restriction - (let* ((file-name (aref pkg-info 0)) - (requires (aref pkg-info 1)) - (desc (if (string= (aref pkg-info 2) "") - "No description available." - (aref pkg-info 2))) - (pkg-version (aref pkg-info 3))) + (let* ((name (package-desc-name pkg-desc)) + (requires (package-desc-reqs pkg-desc)) + (desc (package-desc-summary pkg-desc)) + (pkg-version (package-desc-version pkg-desc))) ;; Download and install the dependencies. (let ((transaction (package-compute-transaction nil requires))) (package-download-transaction transaction)) ;; Install the package itself. - (cond - ((eq type 'single) - (package-unpack-single file-name pkg-version desc requires)) - ((eq type 'tar) - (package-unpack (intern file-name) pkg-version)) - (t - (error "Unknown type: %s" (symbol-name type)))) + (pcase (package-desc-kind pkg-desc) + (`single (package-unpack-single name pkg-version desc requires)) + (`tar (package-unpack name pkg-version)) + (type (error "Unknown type: %S" type))) ;; Try to activate it. (package-initialize))))) @@ -1097,10 +1117,10 @@ (with-temp-buffer (insert-file-contents-literally file) (cond - ((string-match "\\.el$" file) - (package-install-from-buffer (package-buffer-info) 'single)) - ((string-match "\\.tar$" file) - (package-install-from-buffer (package-tar-file-info file) 'tar)) + ((string-match "\\.el\\'" file) + (package-install-from-buffer (package-buffer-info))) + ((string-match "\\.tar\\'" file) + (package-install-from-buffer (package-tar-file-info file))) (t (error "Unrecognized extension `%s'" (file-name-extension file)))))) (defun package-delete (name version) @@ -1118,7 +1138,7 @@ (defun package-archive-base (name) "Return the archive containing the package NAME." (let ((desc (cdr (assq (intern-soft name) package-archive-contents)))) - (cdr (assoc (aref desc (- (length desc) 1)) package-archives)))) + (cdr (assoc (package-desc-archive desc) package-archives)))) (defun package--download-one-archive (archive file) "Retrieve an archive file FILE from ARCHIVE, and cache it. @@ -1163,7 +1183,7 @@ (package-read-all-archive-contents) (unless no-activate (dolist (elt package-alist) - (package-activate (car elt) (package-desc-vers (cdr elt))))) + (package-activate (car elt) (package-desc-version (cdr elt))))) (setq package--initialized t)) @@ -1210,22 +1230,22 @@ (cond ;; Loaded packages are in `package-alist'. ((setq desc (cdr (assq package package-alist))) - (setq version (package-version-join (package-desc-vers desc))) + (setq version (package-version-join (package-desc-version desc))) (if (setq pkg-dir (package--dir package-name version)) (insert "an installed package.\n\n") ;; This normally does not happen. (insert "a deleted package.\n\n"))) ;; Available packages are in `package-archive-contents'. ((setq desc (cdr (assq package package-archive-contents))) - (setq version (package-version-join (package-desc-vers desc)) - archive (aref desc (- (length desc) 1)) + (setq version (package-version-join (package-desc-version desc)) + archive (package-desc-archive desc) installable t) (if built-in (insert "a built-in package.\n\n") (insert "an uninstalled package.\n\n"))) (built-in - (setq desc (cdr built-in) - version (package-version-join (package-desc-vers desc))) + (setq desc (package--from-builtin built-in) + version (package-version-join (package-desc-version desc))) (insert "a built-in package.\n\n")) (t (insert "an orphan package.\n\n"))) @@ -1246,7 +1266,8 @@ (insert "'."))) (installable (if built-in - (insert (propertize "Built-in." 'font-lock-face 'font-lock-builtin-face) + (insert (propertize "Built-in." + 'font-lock-face 'font-lock-builtin-face) " Alternate version available") (insert "Available")) (insert " from " archive) @@ -1261,7 +1282,8 @@ 'package-symbol package 'action 'package-install-button-action))) (built-in - (insert (propertize "Built-in." 'font-lock-face 'font-lock-builtin-face))) + (insert (propertize "Built-in." + 'font-lock-face 'font-lock-builtin-face))) (t (insert "Deleted."))) (insert "\n") (and version (> (length version) 0) @@ -1286,7 +1308,7 @@ (help-insert-xref-button text 'help-package name)) (insert "\n"))) (insert " " (propertize "Summary" 'font-lock-face 'bold) - ": " (if desc (package-desc-doc desc)) "\n\n") + ": " (if desc (package-desc-summary desc)) "\n\n") (if built-in ;; For built-in packages, insert the commentary. @@ -1418,10 +1440,10 @@ package PACKAGE with descriptor DESC, add one. The alist is keyed with cons cells (PACKAGE . VERSION-LIST), where PACKAGE is a symbol and VERSION-LIST is a version list." - `(let* ((version (package-desc-vers ,desc)) + `(let* ((version (package-desc-version ,desc)) (key (cons ,package version))) (unless (assoc key ,listname) - (push (list key ,status (package-desc-doc ,desc)) ,listname)))) + (push (list key ,status (package-desc-summary ,desc)) ,listname)))) (defun package-menu--generate (remember-pos packages) "Populate the Package Menu. @@ -1444,7 +1466,7 @@ (setq name (car elt)) (when (and (not (eq name 'emacs)) ; Hide the `emacs' package. (or (eq packages t) (memq name packages))) - (package--push name (cdr elt) "built-in" info-list))) + (package--push name (package--from-builtin elt) "built-in" info-list))) ;; Available and disabled packages: (dolist (elt package-archive-contents) === modified file 'lisp/finder.el' --- lisp/finder.el 2013-04-19 08:42:34 +0000 +++ lisp/finder.el 2013-06-12 00:49:33 +0000 @@ -206,7 +206,8 @@ (setq version (ignore-errors (version-to-list version))) (setq entry (assq package package--builtins)) (cond ((null entry) - (push (cons package (vector version nil summary)) + (push (cons package + (package-make-builtin version summary)) package--builtins)) ((eq base-name package) (setq desc (cdr entry)) ------------------------------------------------------------ revno: 112933 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2013-06-11 18:14:30 -0400 message: * lisp/vc/vc.el (vc-deduce-fileset): Change error message. (vc-read-backend): New function. (vc-next-action): Use it. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-11 21:53:40 +0000 +++ lisp/ChangeLog 2013-06-11 22:14:30 +0000 @@ -1,5 +1,9 @@ 2013-06-11 Stefan Monnier + * vc/vc.el (vc-deduce-fileset): Change error message. + (vc-read-backend): New function. + (vc-next-action): Use it. + * subr.el (function-arity): Remove (mistakenly added) (bug#14590). * progmodes/prolog.el (prolog-make-keywords-regexp): Remove. === modified file 'lisp/vc/vc.el' --- lisp/vc/vc.el 2013-04-24 07:52:00 +0000 +++ lisp/vc/vc.el 2013-06-11 22:14:30 +0000 @@ -115,10 +115,10 @@ ;; Return non-nil if FILE is registered in this backend. Both this ;; function as well as `state' should be careful to fail gracefully ;; in the event that the backend executable is absent. It is -;; preferable that this function's body is autoloaded, that way only +;; preferable that this function's *body* is autoloaded, that way only ;; calling vc-registered does not cause the backend to be loaded ;; (all the vc-FOO-registered functions are called to try to find -;; the controlling backend for FILE. +;; the controlling backend for FILE). ;; ;; * state (file) ;; @@ -233,6 +233,7 @@ ;; The implementation should pass the value of vc-register-switches ;; to the backend command. (Note: in older versions of VC, this ;; command took a single file argument and not a list.) +;; The REV argument is a historical leftover and is never used. ;; ;; - init-revision (file) ;; @@ -999,7 +1000,7 @@ nil) (list (vc-backend-for-registration (buffer-file-name)) (list buffer-file-name)))) - (t (error "No fileset is available here"))))) + (t (error "File is not under version control"))))) (defun vc-dired-deduce-fileset () (let ((backend (vc-responsible-backend default-directory))) @@ -1041,6 +1042,11 @@ (eq p q) (and (member p '(edited added removed)) (member q '(edited added removed))))) +(defun vc-read-backend (prompt) + (intern + (completing-read prompt (mapcar 'symbol-name vc-handled-backends) + nil 'require-match))) + ;; Here's the major entry point. ;;;###autoload @@ -1099,8 +1105,9 @@ ((or (eq state 'up-to-date) (and verbose (eq state 'needs-update))) (cond (verbose - ;; go to a different revision + ;; Go to a different revision. (let* ((revision + ;; FIXME: Provide completion. (read-string "Branch, revision, or backend to move to: ")) (revision-downcase (downcase revision))) (if (member @@ -1161,15 +1168,10 @@ (message "No files remain to be committed") (if (not verbose) (vc-checkin ready-for-commit backend) - (let* ((revision (read-string "New revision or backend: ")) - (revision-downcase (downcase revision))) - (if (member - revision-downcase - (mapcar (lambda (arg) (downcase (symbol-name arg))) - vc-handled-backends)) - (let ((vsym (intern revision-downcase))) - (dolist (file files) (vc-transfer-file file vsym))) - (vc-checkin ready-for-commit backend revision))))))) + (let ((new-backend (vc-read-backend "New backend: "))) + (if new-backend + (dolist (file files) + (vc-transfer-file file new-backend)))))))) ;; locked by somebody else (locking VCSes only) ((stringp state) ;; In the old days, we computed the revision once and used it on ------------------------------------------------------------ revno: 112932 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=14590 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2013-06-11 17:53:40 -0400 message: * lisp/subr.el (function-arity): Remove (mistakenly added). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-11 21:38:35 +0000 +++ lisp/ChangeLog 2013-06-11 21:53:40 +0000 @@ -1,5 +1,7 @@ 2013-06-11 Stefan Monnier + * subr.el (function-arity): Remove (mistakenly added) (bug#14590). + * progmodes/prolog.el (prolog-make-keywords-regexp): Remove. (prolog-font-lock-keywords): Use regexp-opt instead. Don't manually highlight strings. === modified file 'lisp/subr.el' --- lisp/subr.el 2013-06-11 16:51:12 +0000 +++ lisp/subr.el 2013-06-11 21:53:40 +0000 @@ -4234,32 +4234,6 @@ (declare (obsolete called-interactively-p "23.2")) (called-interactively-p 'interactive)) -(defun function-arity (f &optional num) - "Return the (MIN . MAX) arity of F. -If the maximum arity is infinite, MAX is `many'. -F can be a function or a macro. -If NUM is non-nil, return non-nil iff F can be called with NUM args." - (if (symbolp f) (setq f (indirect-function f))) - (if (eq (car-safe f) 'macro) (setq f (cdr f))) - (let ((res - (if (subrp f) - (let ((x (subr-arity f))) - (if (eq (cdr x) 'unevalled) (cons (car x) 'many))) - (let* ((args (if (consp f) (cadr f) (aref f 0))) - (max (length args)) - (opt (memq '&optional args)) - (rest (memq '&rest args)) - (min (- max (length opt)))) - (if opt - (cons min (if rest 'many (1- max))) - (if rest - (cons (- max (length rest)) 'many) - (cons min max))))))) - (if (not num) - res - (and (>= num (car res)) - (or (eq 'many (cdr res)) (<= num (cdr res))))))) - (defun set-temporary-overlay-map (map &optional keep-pred) "Set MAP as a temporary keymap taking precedence over most other keymaps. Note that this does NOT take precedence over the \"overriding\" maps ------------------------------------------------------------ revno: 112931 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2013-06-11 17:38:35 -0400 message: * lisp/progmodes/prolog.el (prolog-make-keywords-regexp): Remove. (prolog-font-lock-keywords): Use regexp-opt instead. Don't manually highlight strings. (prolog-mode-variables): Simplify comment-start-skip. (prolog-consult-compile): Use display-buffer. Remove unused old-filter. diff: === modified file 'etc/NEWS' --- etc/NEWS 2013-06-07 03:23:57 +0000 +++ etc/NEWS 2013-06-11 21:38:35 +0000 @@ -445,6 +445,7 @@ *** `minibuffer-completion-contents' *** `isearch-nonincremental-exit-minibuffer' *** `isearch-filter-visible' +*** `generic-make-keywords-list' ** `with-wrapper-hook' is obsoleted by `add-function'. The few hooks that used with-wrapper-hook are replaced as follows: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-11 21:26:00 +0000 +++ lisp/ChangeLog 2013-06-11 21:38:35 +0000 @@ -1,5 +1,11 @@ 2013-06-11 Stefan Monnier + * progmodes/prolog.el (prolog-make-keywords-regexp): Remove. + (prolog-font-lock-keywords): Use regexp-opt instead. + Don't manually highlight strings. + (prolog-mode-variables): Simplify comment-start-skip. + (prolog-consult-compile): Use display-buffer. Remove unused old-filter. + * emacs-lisp/generic.el (generic--normalise-comments) (generic-set-comment-syntax, generic-set-comment-vars): New functions. (generic-mode-set-comments): Use them. === modified file 'lisp/progmodes/prolog.el' --- lisp/progmodes/prolog.el 2013-05-21 07:25:14 +0000 +++ lisp/progmodes/prolog.el 2013-06-11 21:38:35 +0000 @@ -1149,11 +1149,7 @@ (set (make-local-variable 'comment-start) "%") (set (make-local-variable 'comment-end) "") (set (make-local-variable 'comment-add) 1) - (set (make-local-variable 'comment-start-skip) - ;; This complex regexp makes sure that comments cannot start - ;; inside quoted atoms or strings - (format "^\\(\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\)\\(/\\*+ *\\|%%+ *\\)" - prolog-quoted-atom-regexp prolog-string-regexp)) + (set (make-local-variable 'comment-start-skip) "\\(?:/\\*+ *\\|%%+ *\\)") (set (make-local-variable 'parens-require-spaces) nil) ;; Initialize Prolog system specific variables (dolist (var '(prolog-keywords prolog-types prolog-mode-specificators @@ -1739,8 +1735,7 @@ (real-file buffer-file-name) (command-string (prolog-build-prolog-command compilep file real-file first-line)) - (process (get-process "prolog")) - (old-filter (process-filter process))) + (process (get-process "prolog"))) (with-current-buffer buffer (delete-region (point-min) (point-max)) ;; FIXME: Wasn't this supposed to use prolog-inferior-mode? @@ -1759,8 +1754,7 @@ 'prolog-parse-sicstus-compilation-errors)) (setq buffer-read-only nil) (insert command-string "\n")) - (save-selected-window - (pop-to-buffer buffer)) + (display-buffer buffer) (setq prolog-process-flag t prolog-consult-compile-output "" prolog-consult-compile-first-line (if first-line (1- first-line) 0) @@ -1954,20 +1948,6 @@ ;;------------------------------------------------------------------- ;; Auxiliary functions -(defun prolog-make-keywords-regexp (keywords &optional protect) - "Create regexp from the list of strings KEYWORDS. -If PROTECT is non-nil, surround the result regexp by word breaks." - (let ((regexp - (if (fboundp 'regexp-opt) - ;; Emacs 20 - ;; Avoid compile warnings under earlier versions by using eval - (eval '(regexp-opt keywords)) - ;; Older Emacsen - (concat (mapconcat 'regexp-quote keywords "\\|"))) - )) - (if protect - (concat "\\<\\(" regexp "\\)\\>") - regexp))) (defun prolog-font-lock-object-matcher (bound) "Find SICStus objects method name for font lock. @@ -2084,20 +2064,16 @@ (if (eq prolog-system 'mercury) (concat "\\<\\(" - (prolog-make-keywords-regexp prolog-keywords-i) + (regexp-opt prolog-keywords-i) "\\|" - (prolog-make-keywords-regexp + (regexp-opt prolog-determinism-specificators-i) "\\)\\>") (concat "^[?:]- *\\(" - (prolog-make-keywords-regexp prolog-keywords-i) + (regexp-opt prolog-keywords-i) "\\)\\>")) 1 prolog-builtin-face)) - (quoted_atom (list prolog-quoted-atom-regexp - 2 'font-lock-string-face 'append)) - (string (list prolog-string-regexp - 1 'font-lock-string-face 'append)) ;; SICStus specific patterns (sicstus-object-methods (if (eq prolog-system 'sicstus) @@ -2107,17 +2083,17 @@ (types (if (eq prolog-system 'mercury) (list - (prolog-make-keywords-regexp prolog-types-i t) + (regexp-opt prolog-types-i 'words) 0 'font-lock-type-face))) (modes (if (eq prolog-system 'mercury) (list - (prolog-make-keywords-regexp prolog-mode-specificators-i t) + (regexp-opt prolog-mode-specificators-i 'words) 0 'font-lock-constant-face))) (directives (if (eq prolog-system 'mercury) (list - (prolog-make-keywords-regexp prolog-directives-i t) + (regexp-opt prolog-directives-i 'words) 0 'prolog-warning-face))) ;; Inferior mode specific patterns (prompt @@ -2211,8 +2187,6 @@ (list head-predicates head-predicates-1 - quoted_atom - string variables important-elements important-elements-1 ------------------------------------------------------------ revno: 112930 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2013-06-11 17:26:00 -0400 message: * lisp/emacs-lisp/generic.el (generic--normalise-comments) (generic-set-comment-syntax, generic-set-comment-vars): New functions. (generic-mode-set-comments): Use them. (generic-bracket-support): Use setq-local. (generic-make-keywords-list): Declare obsolete. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-11 18:00:27 +0000 +++ lisp/ChangeLog 2013-06-11 21:26:00 +0000 @@ -1,3 +1,11 @@ +2013-06-11 Stefan Monnier + + * emacs-lisp/generic.el (generic--normalise-comments) + (generic-set-comment-syntax, generic-set-comment-vars): New functions. + (generic-mode-set-comments): Use them. + (generic-bracket-support): Use setq-local. + (generic-make-keywords-list): Declare obsolete. + 2013-06-11 Glenn Morris * emacs-lisp/lisp-mode.el (lisp-mode-variables): === modified file 'lisp/emacs-lisp/generic.el' --- lisp/emacs-lisp/generic.el 2013-01-01 09:11:05 +0000 +++ lisp/emacs-lisp/generic.el 2013-06-11 21:26:00 +0000 @@ -93,6 +93,8 @@ ;;; Code: +(eval-when-compile (require 'pcase)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Internal Variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -224,18 +226,11 @@ (funcall (intern mode))) ;;; Comment Functionality -(defun generic-mode-set-comments (comment-list) - "Set up comment functionality for generic mode." - (let ((st (make-syntax-table)) - (chars nil) - (comstyles)) - (make-local-variable 'comment-start) - (make-local-variable 'comment-start-skip) - (make-local-variable 'comment-end) - ;; Go through all the comments +(defun generic--normalise-comments (comment-list) + (let ((normalized '())) (dolist (start comment-list) - (let (end (comstyle "")) + (let (end) ;; Normalize (when (consp start) (setq end (cdr start)) @@ -244,58 +239,79 @@ (cond ((characterp end) (setq end (char-to-string end))) ((zerop (length end)) (setq end "\n"))) - - ;; Setup the vars for `comment-region' - (if comment-start - ;; We have already setup a comment-style, so use style b - (progn - (setq comstyle "b") - (setq comment-start-skip - (concat comment-start-skip "\\|" (regexp-quote start) "+\\s-*"))) - ;; First comment-style - (setq comment-start start) - (setq comment-end (if (string-equal end "\n") "" end)) - (setq comment-start-skip (concat (regexp-quote start) "+\\s-*"))) - - ;; Reuse comstyles if necessary - (setq comstyle + (push (cons start end) normalized))) + (nreverse normalized))) + +(defun generic-set-comment-syntax (st comment-list) + "Set up comment functionality for generic mode." + (let ((chars nil) + (comstyles) + (comstyle "") + (comment-start nil)) + + ;; Go through all the comments. + (pcase-dolist (`(,start . ,end) comment-list) + (let ((comstyle + ;; Reuse comstyles if necessary. (or (cdr (assoc start comstyles)) (cdr (assoc end comstyles)) - comstyle)) + ;; Otherwise, use a style not yet in use. + (if (not (rassoc "" comstyles)) "") + (if (not (rassoc "b" comstyles)) "b") + "c"))) (push (cons start comstyle) comstyles) (push (cons end comstyle) comstyles) - ;; Setup the syntax table + ;; Setup the syntax table. (if (= (length start) 1) - (modify-syntax-entry (string-to-char start) + (modify-syntax-entry (aref start 0) (concat "< " comstyle) st) - (let ((c0 (elt start 0)) (c1 (elt start 1))) - ;; Store the relevant info but don't update yet + (let ((c0 (aref start 0)) (c1 (aref start 1))) + ;; Store the relevant info but don't update yet. (push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars) (push (cons c1 (concat (cdr (assoc c1 chars)) (concat "2" comstyle))) chars))) (if (= (length end) 1) - (modify-syntax-entry (string-to-char end) + (modify-syntax-entry (aref end 0) (concat ">" comstyle) st) - (let ((c0 (elt end 0)) (c1 (elt end 1))) - ;; Store the relevant info but don't update yet + (let ((c0 (aref end 0)) (c1 (aref end 1))) + ;; Store the relevant info but don't update yet. (push (cons c0 (concat (cdr (assoc c0 chars)) (concat "3" comstyle))) chars) (push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars))))) ;; Process the chars that were part of a 2-char comment marker + (with-syntax-table st ;For `char-syntax'. (dolist (cs (nreverse chars)) (modify-syntax-entry (car cs) (concat (char-to-string (char-syntax (car cs))) " " (cdr cs)) - st)) + st))))) + +(defun generic-set-comment-vars (comment-list) + (when comment-list + (setq-local comment-start (caar comment-list)) + (setq-local comment-end + (let ((end (cdar comment-list))) + (if (string-equal end "\n") "" end))) + (setq-local comment-start-skip + (concat (regexp-opt (mapcar #'car comment-list)) + "+[ \t]*")) + (setq-local comment-end-skip + (concat "[ \t]*" (regexp-opt (mapcar #'cdr comment-list)))))) + +(defun generic-mode-set-comments (comment-list) + "Set up comment functionality for generic mode." + (let ((st (make-syntax-table)) + (comment-list (generic--normalise-comments comment-list))) + (generic-set-comment-syntax st comment-list) + (generic-set-comment-vars comment-list) (set-syntax-table st))) (defun generic-bracket-support () "Imenu support for [KEYWORD] constructs found in INF, INI and Samba files." - (setq imenu-generic-expression - '((nil "^\\[\\(.*\\)\\]" 1)) - imenu-case-fold-search t)) + (setq-local imenu-generic-expression '((nil "^\\[\\(.*\\)\\]" 1))) + (setq-local imenu-case-fold-search t)) ;;;###autoload (defun generic-make-keywords-list (keyword-list face &optional prefix suffix) @@ -306,6 +322,7 @@ PREFIX and SUFFIX. Then it returns a construct based on this regular expression that can be used as an element of `font-lock-keywords'." + (declare (obsolete regexp-opt "24.4")) (unless (listp keyword-list) (error "Keywords argument must be a list of strings")) (list (concat prefix "\\_<" ------------------------------------------------------------ revno: 112929 fixes bug: http://debbugs.gnu.org/14569 committer: Paul Eggert branch nick: trunk timestamp: Tue 2013-06-11 11:34:06 -0700 message: Tickle glib by waiting for Emacs itself, not for process 0. * process.c (init_process_emacs) [HAVE_GLIB && !WINDOWSNT]: Wait for self, not for 0. This can't hurt on GNU or similar system, and may help with Cygwin. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-06-11 04:15:49 +0000 +++ src/ChangeLog 2013-06-11 18:34:06 +0000 @@ -1,5 +1,10 @@ 2013-06-11 Paul Eggert + Tickle glib by waiting for Emacs itself, not for process 0 (Bug#14569). + * process.c (init_process_emacs) [HAVE_GLIB && !WINDOWSNT]: + Wait for self, not for 0. This can't hurt on GNU or similar + system, and may help with Cygwin. + * keyboard.c: Don't use PROP (...) as an lvalue. (parse_tool_bar_item) [!USE_GTK && !HAVE_NS]: Use set_prop (A, B), not PROP (A) = B. === modified file 'src/process.c' --- src/process.c 2013-06-08 18:13:24 +0000 +++ src/process.c 2013-06-11 18:34:06 +0000 @@ -7068,9 +7068,10 @@ #endif { #if defined HAVE_GLIB && !defined WINDOWSNT - /* Tickle glib's child-handling code so that it initializes its + /* Tickle glib's child-handling code. Ask glib to wait for Emacs itself; + this should always fail, but is enough to initialize glib's private SIGCHLD handler. */ - g_source_unref (g_child_watch_source_new (0)); + g_source_unref (g_child_watch_source_new (getpid ())); #endif catch_child_signal (); } ------------------------------------------------------------ revno: 112928 fixes bug: http://debbugs.gnu.org/14569 committer: Paul Eggert branch nick: trunk timestamp: Tue 2013-06-11 11:05:05 -0700 message: --without-all should imply --with-file-notification=no. * configure.ac (with_file_notification): Default to $with_features. diff: === modified file 'ChangeLog' --- ChangeLog 2013-06-10 14:58:52 +0000 +++ ChangeLog 2013-06-11 18:05:05 +0000 @@ -1,3 +1,8 @@ +2013-06-11 Paul Eggert + + --without-all should imply --with-file-notification=no. (Bug#14569) + * configure.ac (with_file_notification): Default to $with_features. + 2013-06-09 Paul Eggert Merge from gnulib, incorporating: === modified file 'configure.ac' --- configure.ac 2013-06-08 18:13:24 +0000 +++ configure.ac 2013-06-11 18:05:05 +0000 @@ -216,7 +216,7 @@ esac with_file_notification=$val ], - [with_file_notification=yes]) + [with_file_notification=$with_features]) ## For the times when you want to build Emacs but don't have ## a suitable makeinfo, and can live without the manuals. ------------------------------------------------------------ revno: 112927 committer: Glenn Morris branch nick: trunk timestamp: Tue 2013-06-11 14:00:27 -0400 message: lisp-mode font-lock fox for bug#14574 * lisp/emacs-lisp/lisp-mode.el (lisp-mode-variables): Prettify after setting font-lock-defaults. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-11 16:51:12 +0000 +++ lisp/ChangeLog 2013-06-11 18:00:27 +0000 @@ -1,3 +1,8 @@ +2013-06-11 Glenn Morris + + * emacs-lisp/lisp-mode.el (lisp-mode-variables): + Prettify after setting font-lock-defaults. (Bug#14574) + 2013-06-11 Juanma Barranquero * replace.el (query-replace, occur-read-regexp-defaults-function) === modified file 'lisp/emacs-lisp/lisp-mode.el' --- lisp/emacs-lisp/lisp-mode.el 2013-06-05 17:48:50 +0000 +++ lisp/emacs-lisp/lisp-mode.el 2013-06-11 18:00:27 +0000 @@ -223,7 +223,6 @@ (setq-local imenu-generic-expression lisp-imenu-generic-expression) (setq-local multibyte-syntax-as-symbol t) (setq-local syntax-begin-function 'beginning-of-defun) - (prog-prettify-install lisp--prettify-symbols-alist) (setq font-lock-defaults `((lisp-font-lock-keywords lisp-font-lock-keywords-1 @@ -231,7 +230,8 @@ nil ,keywords-case-insensitive nil nil (font-lock-mark-block-function . mark-defun) (font-lock-syntactic-face-function - . lisp-font-lock-syntactic-face-function)))) + . lisp-font-lock-syntactic-face-function))) + (prog-prettify-install lisp--prettify-symbols-alist)) (defun lisp-outline-level () "Lisp mode `outline-level' function." ------------------------------------------------------------ revno: 112926 committer: Juanma Barranquero branch nick: trunk timestamp: Tue 2013-06-11 18:51:12 +0200 message: Fix typos. * lisp/replace.el (query-replace, occur-read-regexp-defaults-function) (replace-search): * lisp/subr.el (declare-function, number-sequence, local-set-key) (substitute-key-definition, locate-user-emacs-file) (with-silent-modifications, split-string, eval-after-load): Fix typos, remove unneeded backslashes and reflow some docstrings. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-11 12:51:18 +0000 +++ lisp/ChangeLog 2013-06-11 16:51:12 +0000 @@ -1,3 +1,12 @@ +2013-06-11 Juanma Barranquero + + * replace.el (query-replace, occur-read-regexp-defaults-function) + (replace-search): + * subr.el (declare-function, number-sequence, local-set-key) + (substitute-key-definition, locate-user-emacs-file) + (with-silent-modifications, split-string, eval-after-load): + Fix typos, remove unneeded backslashes and reflow some docstrings. + 2013-06-11 Stefan Monnier * international/mule-conf.el (file-coding-system-alist): Use utf-8 as === modified file 'lisp/ChangeLog.2' --- lisp/ChangeLog.2 2013-01-01 09:11:05 +0000 +++ lisp/ChangeLog.2 2013-06-11 16:51:12 +0000 @@ -777,7 +777,7 @@ 1987-12-21 Richard Stallman (rms@frosted-flakes) - * window.el (split-widow-{vertically,horizontally}): + * window.el (split-window-{vertically,horizontally}): Make the arg optional. 1987-12-09 Richard Stallman (rms@frosted-flakes) @@ -1392,7 +1392,7 @@ * shell.el: Minor doc fixes. * rmail.el (rmail-get-new-mail): - Handle errors competently. (Don't attempt to + Handle errors competently. (Don't attempt to handle them, rather than botching the job) * rmail.el (rmail-insert-inbox-text): @@ -3032,7 +3032,7 @@ Rename "kill" -> "delete" for both function-names and documentation. - Define C-d as Buffer-menu-delete-backwards. (also in ebuff-menu) + Define C-d as Buffer-menu-delete-backwards (also in ebuff-menu). Save space: Merge buffer-menu-{execute,do-saves,do-kills}. === modified file 'lisp/replace.el' --- lisp/replace.el 2013-05-30 23:29:42 +0000 +++ lisp/replace.el 2013-06-11 16:51:12 +0000 @@ -246,7 +246,7 @@ FROM-STRING has no uppercase letters. Replacement transfers the case pattern of the old text to the new text, if `case-replace' and `case-fold-search' are non-nil and FROM-STRING has no uppercase -letters. \(Transferring the case pattern means that if the old text +letters. (Transferring the case pattern means that if the old text matched is all caps, or capitalized, then its replacement is upcased or capitalized.) @@ -1175,8 +1175,8 @@ For example, to check for occurrence of symbol at point use - \(setq occur-read-regexp-defaults-function - 'find-tag-default-as-regexp\).") + (setq occur-read-regexp-defaults-function + 'find-tag-default-as-regexp).") (defun occur-read-regexp-defaults () "Return the latest regexp from `regexp-history'. @@ -1874,7 +1874,7 @@ (defun replace-search (search-string limit regexp-flag delimited-flag case-fold-search) - "Search for the next occurence of SEARCH-STRING to replace." + "Search for the next occurrence of SEARCH-STRING to replace." ;; Let-bind global isearch-* variables to values used ;; to search the next replacement. These let-bindings ;; should be effective both at the time of calling === modified file 'lisp/subr.el' --- lisp/subr.el 2013-06-05 14:57:45 +0000 +++ lisp/subr.el 2013-06-11 16:51:12 +0000 @@ -41,11 +41,11 @@ (defmacro declare-function (_fn _file &optional _arglist _fileonly) "Tell the byte-compiler that function FN is defined, in FILE. -Optional ARGLIST is the argument list used by the function. The -FILE argument is not used by the byte-compiler, but by the +Optional ARGLIST is the argument list used by the function. +The FILE argument is not used by the byte-compiler, but by the `check-declare' package, which checks that FILE contains a -definition for FN. ARGLIST is used by both the byte-compiler and -`check-declare' to check for consistency. +definition for FN. ARGLIST is used by both the byte-compiler +and `check-declare' to check for consistency. FILE can be either a Lisp file (in which case the \".el\" extension is optional), or a C file. C files are expanded @@ -396,9 +396,9 @@ (defun number-sequence (from &optional to inc) "Return a sequence of numbers from FROM to TO (both inclusive) as a list. INC is the increment used between numbers in the sequence and defaults to 1. -So, the Nth element of the list is \(+ FROM \(* N INC)) where N counts from +So, the Nth element of the list is (+ FROM (* N INC)) where N counts from zero. TO is only included if there is an N for which TO = FROM + N * INC. -If TO is nil or numerically equal to FROM, return \(FROM). +If TO is nil or numerically equal to FROM, return (FROM). If INC is positive and TO is less than FROM, or INC is negative and TO is larger than FROM, return nil. If INC is zero and TO is neither nil nor numerically equal to @@ -408,11 +408,11 @@ Nevertheless, FROM, TO and INC can be integer or float. However, floating point arithmetic is inexact. For instance, depending on the machine, it may quite well happen that -\(number-sequence 0.4 0.6 0.2) returns the one element list \(0.4), -whereas \(number-sequence 0.4 0.8 0.2) returns a list with three +\(number-sequence 0.4 0.6 0.2) returns the one element list (0.4), +whereas (number-sequence 0.4 0.8 0.2) returns a list with three elements. Thus, if some of the arguments are floats and one wants to make sure that TO is included, one may have to explicitly write -TO as \(+ FROM \(* N INC)) or use a variable whose value was +TO as (+ FROM (* N INC)) or use a variable whose value was computed with this exact expression. Alternatively, you can, of course, also replace TO with a slightly larger value \(or a slightly more negative value if INC is negative)." @@ -784,8 +784,8 @@ of characters or event types, and non-ASCII characters with codes above 127 (such as ISO Latin-1) can be included if you use a vector. -The binding goes in the current buffer's local map, -which in most cases is shared with all other buffers in the same major mode." +The binding goes in the current buffer's local map, which in most +cases is shared with all other buffers in the same major mode." (interactive "KSet key locally: \nCSet key %s locally to command: ") (let ((map (current-local-map))) (or map @@ -821,7 +821,7 @@ If you don't specify OLDMAP, you can usually get the same results in a cleaner way with command remapping, like this: - \(define-key KEYMAP [remap OLDDEF] NEWDEF) + (define-key KEYMAP [remap OLDDEF] NEWDEF) \n(fn OLDDEF NEWDEF KEYMAP &optional OLDMAP)" ;; Don't document PREFIX in the doc string because we don't want to ;; advertise it. It's meant for recursive calls only. Here's its @@ -2540,7 +2540,7 @@ (defun locate-user-emacs-file (new-name &optional old-name) "Return an absolute per-user Emacs-specific file name. If NEW-NAME exists in `user-emacs-directory', return it. -Else If OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME. +Else if OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME. Else return NEW-NAME in `user-emacs-directory', creating the directory if it does not exist." (convert-standard-filename @@ -3231,7 +3231,7 @@ This macro will run BODY normally, but doesn't count its buffer modifications as being buffer modifications. This affects things -like buffer-modified-p, checking whether the file is locked by +like `buffer-modified-p', checking whether the file is locked by someone else, running buffer modification hooks, and other things of that nature. @@ -3536,7 +3536,7 @@ `split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and OMIT-NULLS is forced to t. -If OMIT-NULLS is t, zero-length substrings are omitted from the list \(so +If OMIT-NULLS is t, zero-length substrings are omitted from the list (so that for the default value of SEPARATORS leading and trailing whitespace are effectively trimmed). If nil, all zero-length substrings are retained, which correctly parses CSV format, for example. @@ -3733,18 +3733,18 @@ If a matching file is loaded again, FORM will be evaluated again. If FILE is a string, it may be either an absolute or a relative file -name, and may have an extension \(e.g. \".el\") or may lack one, and +name, and may have an extension (e.g. \".el\") or may lack one, and additionally may or may not have an extension denoting a compressed -format \(e.g. \".gz\"). +format (e.g. \".gz\"). When FILE is absolute, this first converts it to a true name by chasing -symbolic links. Only a file of this name \(see next paragraph regarding +symbolic links. Only a file of this name (see next paragraph regarding extensions) will trigger the evaluation of FORM. When FILE is relative, a file whose absolute true name ends in FILE will trigger evaluation. When FILE lacks an extension, a file name with any extension will trigger evaluation. Otherwise, its extension must match FILE's. A further -extension for a compressed format \(e.g. \".gz\") on FILE will not affect +extension for a compressed format (e.g. \".gz\") on FILE will not affect this name matching. Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM === modified file 'src/ChangeLog.3' --- src/ChangeLog.3 2013-01-01 09:11:05 +0000 +++ src/ChangeLog.3 2013-06-11 16:51:12 +0000 @@ -15447,7 +15447,7 @@ * xterm.c (XTread_socket_hook): For X11, on map and unmap events check the window manager hints for iconification status. - * xterm.c (x_make_widow_icon): For X11, just request + * xterm.c (x_make_window_icon): For X11, just request iconification of the window manager. 1989-05-08 Richard Stallman (rms@sugar-bombs.ai.mit.edu) ------------------------------------------------------------ revno: 112925 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2013-06-11 08:51:18 -0400 message: * lisp/international/mule-conf.el (file-coding-system-alist): Use utf-8 as default for Elisp files. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-11 06:36:06 +0000 +++ lisp/ChangeLog 2013-06-11 12:51:18 +0000 @@ -1,3 +1,8 @@ +2013-06-11 Stefan Monnier + + * international/mule-conf.el (file-coding-system-alist): Use utf-8 as + default for Elisp files. + 2013-06-11 Glenn Morris * vc/log-view.el (log-view-mode-map): Inherit from special-mode-map, === modified file 'lisp/international/mule-conf.el' --- lisp/international/mule-conf.el 2013-01-01 09:11:05 +0000 +++ lisp/international/mule-conf.el 2013-06-11 12:51:18 +0000 @@ -1508,6 +1508,7 @@ (setq file-coding-system-alist (mapcar (lambda (arg) (cons (purecopy (car arg)) (cdr arg))) '(("\\.elc\\'" . utf-8-emacs) + ("\\.el\\'" . utf-8) ("\\.utf\\(-8\\)?\\'" . utf-8) ("\\.xml\\'" . xml-find-file-coding-system) ;; We use raw-text for reading loaddefs.el so that if it ------------------------------------------------------------ revno: 112924 committer: Xue Fuqiao branch nick: trunk timestamp: Tue 2013-06-11 19:37:56 +0800 message: Make the example more intuitive. * doc/lispref/files.texi (File Name Expansion): Make the example more intuitive. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2013-06-10 20:26:20 +0000 +++ doc/lispref/ChangeLog 2013-06-11 11:37:56 +0000 @@ -1,3 +1,8 @@ +2013-06-11 Xue Fuqiao + + * files.texi (File Name Expansion): Make the example more + intuitive. + 2013-06-10 Paul Eggert Documentation fix for 'ls' and hard links. === modified file 'doc/lispref/files.texi' --- doc/lispref/files.texi 2013-06-10 20:26:20 +0000 +++ doc/lispref/files.texi 2013-06-11 11:37:56 +0000 @@ -2105,10 +2105,6 @@ (expand-file-name "foo" "/usr/spool/") @result{} "/usr/spool/foo" @end group -@group -(expand-file-name "$HOME/foo") - @result{} "/xcssun/users/rms/lewis/$HOME/foo" -@end group @end example If the part of the combined file name before the first slash is @@ -2142,7 +2138,14 @@ @file{/../} is interpreted exactly the same as @file{/}. Note that @code{expand-file-name} does @emph{not} expand environment -variables; only @code{substitute-in-file-name} does that. +variables; only @code{substitute-in-file-name} does that: + +@example +@group +(expand-file-name "$HOME/foo") + @result{} "/xcssun/users/rms/lewis/$HOME/foo" +@end group +@end example Note also that @code{expand-file-name} does not follow symbolic links at any level. This results in a difference between the way ------------------------------------------------------------ revno: 112923 author: Albert Krewinkel committer: Katsumi Yamaoka branch nick: trunk timestamp: Tue 2013-06-11 07:32:25 +0000 message: lisp/gnus/sievel-manage.el: fully support STARTTLS, fix bit rot * Make sieve-manage-open work with STARTTLS: shorten stream managing functions by using open-protocol-stream to do most of the work. Has the nice benefit of enabling STARTTLS. * Remove unneeded functions and options: the following functions and options are neither in the API, nor called by any other function, so they are deleted: - sieve-manage-network-p - sieve-manage-network-open - sieve-manage-starttls-p - sieve-manage-starttls-open - sieve-manage-forward - sieve-manage-streams - sieve-manage-stream-alist The options could not be applied in a meaningful way anymore; they didn't happen to have much effect before. * Cosmetic changes and code clean-up * Enable Multibyte for SieveManage buffers: The parser won't properly handle umlauts and line endings unless multibyte is turned on in the process buffer. * Wait for capabilities after STARTTLS: following RFC5804, the server sends new capabilities after successfully establishing a TLS connection with the client. The client should update the cached list of capabilities, but we just ignore the answer for now. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2013-06-11 03:09:59 +0000 +++ lisp/gnus/ChangeLog 2013-06-11 07:32:25 +0000 @@ -1,3 +1,21 @@ +2013-06-10 Albert Krewinkel + + * sieve-manage.el (sieve-manage-open): work with STARTTLS: shorten + stream managing functions by using open-protocol-stream to do most of + the work. Has the nice benefit of enabling STARTTLS. + Wait for capabilities after STARTTLS: following RFC5804, the server + sends new capabilities after successfully establishing a TLS connection + with the client. The client should update the cached list of + capabilities, but we just ignore the answer for now. + (sieve-manage-network-p, sieve-manage-network-open) + (sieve-manage-starttls-p, sieve-manage-starttls-open) + (sieve-manage-forward, sieve-manage-streams) + (sieve-manage-stream-alist): Remove unneeded functions neither in the + API, nor called by any other function. + Enable Multibyte for SieveManage buffers: The parser won't properly + handle umlauts and line endings unless multibyte is turned on in the + process buffer. + 2013-06-11 Lars Magne Ingebrigtsen * eww.el (eww-tag-input): Support password fields. === modified file 'lisp/gnus/sieve-manage.el' --- lisp/gnus/sieve-manage.el 2013-04-27 23:57:29 +0000 +++ lisp/gnus/sieve-manage.el 2013-06-11 07:32:25 +0000 @@ -3,6 +3,7 @@ ;; Copyright (C) 2001-2013 Free Software Foundation, Inc. ;; Author: Simon Josefsson +;; Albert Krewinkel ;; This file is part of GNU Emacs. @@ -66,6 +67,7 @@ ;; 2001-10-31 Committed to Oort Gnus. ;; 2002-07-27 Added DELETESCRIPT. Suggested by Ned Ludd. ;; 2002-08-03 Use SASL library. +;; 2013-06-05 Enabled STARTTLS support, fixed bit rot. ;;; Code: @@ -82,7 +84,6 @@ (require 'sasl) (require 'starttls)) (autoload 'sasl-find-mechanism "sasl") -(autoload 'starttls-open-stream "starttls") (autoload 'auth-source-search "auth-source") ;; User customizable variables: @@ -107,23 +108,6 @@ :type 'string :group 'sieve-manage) -(defcustom sieve-manage-streams '(network starttls shell) - "Priority of streams to consider when opening connection to server." - :group 'sieve-manage) - -(defcustom sieve-manage-stream-alist - '((network sieve-manage-network-p sieve-manage-network-open) - (shell sieve-manage-shell-p sieve-manage-shell-open) - (starttls sieve-manage-starttls-p sieve-manage-starttls-open)) - "Definition of network streams. - -\(NAME CHECK OPEN) - -NAME names the stream, CHECK is a function returning non-nil if the -server support the stream and OPEN is a function for opening the -stream." - :group 'sieve-manage) - (defcustom sieve-manage-authenticators '(digest-md5 cram-md5 scram-md5 @@ -156,8 +140,7 @@ :group 'sieve-manage) (defcustom sieve-manage-default-stream 'network - "Default stream type to use for `sieve-manage'. -Must be a name of a stream in `sieve-manage-stream-alist'." + "Default stream type to use for `sieve-manage'." :version "24.1" :type 'symbol :group 'sieve-manage) @@ -185,17 +168,21 @@ (defvar sieve-manage-capability nil) ;; Internal utility functions - -(defmacro sieve-manage-disable-multibyte () - "Enable multibyte in the current buffer." - (unless (featurep 'xemacs) - '(set-buffer-multibyte nil))) +(defun sieve-manage-make-process-buffer () + (with-current-buffer + (generate-new-buffer (format " *sieve %s:%s*" + sieve-manage-server + sieve-manage-port)) + (mapc 'make-local-variable sieve-manage-local-variables) + (mm-enable-multibyte) + (buffer-disable-undo) + (current-buffer))) (defun sieve-manage-erase (&optional p buffer) (let ((buffer (or buffer (current-buffer)))) (and sieve-manage-log (with-current-buffer (get-buffer-create sieve-manage-log) - (sieve-manage-disable-multibyte) + (mm-enable-multibyte) (buffer-disable-undo) (goto-char (point-max)) (insert-buffer-substring buffer (with-current-buffer buffer @@ -204,71 +191,32 @@ (point-max))))))) (delete-region (point-min) (or p (point-max)))) -(defun sieve-manage-open-1 (buffer) +(defun sieve-manage-open-server (server port &optional stream buffer) + "Open network connection to SERVER on PORT. +Return the buffer associated with the connection." (with-current-buffer buffer (sieve-manage-erase) - (setq sieve-manage-state 'initial - sieve-manage-process - (condition-case () - (funcall (nth 2 (assq sieve-manage-stream - sieve-manage-stream-alist)) - "sieve" buffer sieve-manage-server sieve-manage-port) - ((error quit) nil))) - (when sieve-manage-process - (while (and (eq sieve-manage-state 'initial) - (memq (process-status sieve-manage-process) '(open run))) - (message "Waiting for response from %s..." sieve-manage-server) - (accept-process-output sieve-manage-process 1)) - (message "Waiting for response from %s...done" sieve-manage-server) - (and (memq (process-status sieve-manage-process) '(open run)) - sieve-manage-process)))) - -;; Streams - -(defun sieve-manage-network-p (buffer) - t) - -(defun sieve-manage-network-open (name buffer server port) - (let* ((port (or port sieve-manage-default-port)) - (coding-system-for-read sieve-manage-coding-system-for-read) - (coding-system-for-write sieve-manage-coding-system-for-write) - (process (open-network-stream name buffer server port))) - (when process - (while (and (memq (process-status process) '(open run)) - (set-buffer buffer) ;; XXX "blue moon" nntp.el bug - (goto-char (point-min)) - (not (sieve-manage-parse-greeting-1))) - (accept-process-output process 1) - (sit-for 1)) - (sieve-manage-erase nil buffer) - (when (memq (process-status process) '(open run)) - process)))) - -(defun sieve-manage-starttls-p (buffer) - (condition-case () - (progn - (require 'starttls) - (call-process "starttls")) - (error nil))) - -(defun sieve-manage-starttls-open (name buffer server port) - (let* ((port (or port sieve-manage-default-port)) - (coding-system-for-read sieve-manage-coding-system-for-read) - (coding-system-for-write sieve-manage-coding-system-for-write) - (process (starttls-open-stream name buffer server port)) - done) - (when process - (while (and (memq (process-status process) '(open run)) - (set-buffer buffer) ;; XXX "blue moon" nntp.el bug - (goto-char (point-min)) - (not (sieve-manage-parse-greeting-1))) - (accept-process-output process 1) - (sit-for 1)) - (sieve-manage-erase nil buffer) - (sieve-manage-send "STARTTLS") - (starttls-negotiate process)) - (when (memq (process-status process) '(open run)) - process))) + (setq sieve-manage-state 'initial) + (destructuring-bind (proc . props) + (open-protocol-stream + "SIEVE" buffer server port + :type stream + :capability-command "CAPABILITY\r\n" + :end-of-command "^\\(OK\\|NO\\).*\n" + :success "^OK.*\n" + :return-list t + :starttls-function + '(lambda (capabilities) + (when (string-match "\\bSTARTTLS\\b" capabilities) + "STARTTLS\r\n"))) + (setq sieve-manage-process proc) + (setq sieve-manage-capability + (sieve-manage-parse-capability (getf props :capabilities))) + ;; Ignore new capabilities issues after successful STARTTLS + (when (and (memq stream '(nil network starttls)) + (eq (getf props :type) 'tls)) + (sieve-manage-drop-next-answer)) + (current-buffer)))) ;; Authenticators (defun sieve-sasl-auth (buffer mech) @@ -396,63 +344,33 @@ If nil, chooses the best stream the server is capable of. Optional argument BUFFER is buffer (buffer, or string naming buffer) to work in." - (or port (setq port sieve-manage-default-port)) - (setq buffer (or buffer (format " *sieve* %s:%s" server port))) - (with-current-buffer (get-buffer-create buffer) - (mapc 'make-local-variable sieve-manage-local-variables) - (sieve-manage-disable-multibyte) - (buffer-disable-undo) - (setq sieve-manage-server (or server sieve-manage-server)) - (setq sieve-manage-port port) - (setq sieve-manage-stream (or stream sieve-manage-stream)) + (setq sieve-manage-port (or port sieve-manage-default-port)) + (with-current-buffer (or buffer (sieve-manage-make-process-buffer)) + (setq sieve-manage-server (or server + sieve-manage-server) + sieve-manage-stream (or stream + sieve-manage-stream + sieve-manage-default-stream) + sieve-manage-auth (or auth + sieve-manage-auth)) (message "sieve: Connecting to %s..." sieve-manage-server) - (if (let ((sieve-manage-stream - (or sieve-manage-stream sieve-manage-default-stream))) - (sieve-manage-open-1 buffer)) - ;; Choose stream. - (let (stream-changed) - (message "sieve: Connecting to %s...done" sieve-manage-server) - (when (null sieve-manage-stream) - (let ((streams sieve-manage-streams)) - (while (setq stream (pop streams)) - (if (funcall (nth 1 (assq stream - sieve-manage-stream-alist)) buffer) - (setq stream-changed - (not (eq (or sieve-manage-stream - sieve-manage-default-stream) - stream)) - sieve-manage-stream stream - streams nil))) - (unless sieve-manage-stream - (error "Couldn't figure out a stream for server")))) - (when stream-changed - (message "sieve: Reconnecting with stream `%s'..." - sieve-manage-stream) - (sieve-manage-close buffer) - (if (sieve-manage-open-1 buffer) - (message "sieve: Reconnecting with stream `%s'...done" - sieve-manage-stream) - (message "sieve: Reconnecting with stream `%s'...failed" - sieve-manage-stream)) - (setq sieve-manage-capability nil)) - (if (sieve-manage-opened buffer) - ;; Choose authenticator - (when (and (null sieve-manage-auth) - (not (eq sieve-manage-state 'auth))) - (let ((auths sieve-manage-authenticators)) - (while (setq auth (pop auths)) - (if (funcall (nth 1 (assq - auth - sieve-manage-authenticator-alist)) - buffer) - (setq sieve-manage-auth auth - auths nil))) - (unless sieve-manage-auth - (error "Couldn't figure out authenticator for server")))))) - (message "sieve: Connecting to %s...failed" sieve-manage-server)) - (when (sieve-manage-opened buffer) + (sieve-manage-open-server sieve-manage-server + sieve-manage-port + sieve-manage-stream + (current-buffer)) + (when (sieve-manage-opened (current-buffer)) + ;; Choose authenticator + (when (and (null sieve-manage-auth) + (not (eq sieve-manage-state 'auth))) + (dolist (auth sieve-manage-authenticators) + (when (funcall (nth 1 (assq auth sieve-manage-authenticator-alist)) + buffer) + (setq sieve-manage-auth auth) + (return))) + (unless sieve-manage-auth + (error "Couldn't figure out authenticator for server"))) (sieve-manage-erase) - buffer))) + (current-buffer)))) (defun sieve-manage-authenticate (&optional buffer) "Authenticate on server in BUFFER. @@ -544,12 +462,22 @@ ;; Protocol parsing routines +(defun sieve-manage-wait-for-answer () + (let ((pattern "^\\(OK\\|NO\\).*\n") + pos) + (while (not pos) + (setq pos (search-forward-regexp pattern nil t)) + (goto-char (point-min)) + (sleep-for 0 50)) + pos)) + +(defun sieve-manage-drop-next-answer () + (sieve-manage-wait-for-answer) + (sieve-manage-erase)) + (defun sieve-manage-ok-p (rsp) (string= (downcase (or (car-safe rsp) "")) "ok")) -(defsubst sieve-manage-forward () - (or (eobp) (forward-char))) - (defun sieve-manage-is-okno () (when (looking-at (concat "^\\(OK\\|NO\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?" @@ -571,21 +499,15 @@ (sieve-manage-erase) rsp)) -(defun sieve-manage-parse-capability-1 () - "Accept a managesieve greeting." - (let (str) - (while (setq str (sieve-manage-is-string)) - (if (eq (char-after) ? ) - (progn - (sieve-manage-forward) - (push (list str (sieve-manage-is-string)) - sieve-manage-capability)) - (push (list str) sieve-manage-capability)) - (forward-line))) - (when (re-search-forward (concat "^OK.*" sieve-manage-server-eol) nil t) - (setq sieve-manage-state 'nonauth))) - -(defalias 'sieve-manage-parse-greeting-1 'sieve-manage-parse-capability-1) +(defun sieve-manage-parse-capability (str) + "Parse managesieve capability string `STR'. +Set variable `sieve-manage-capability' to " + (let ((capas (remove-if #'null + (mapcar #'split-string-and-unquote + (split-string str "\n"))))) + (when (string= "OK" (caar (last capas))) + (setq sieve-manage-state 'nonauth)) + capas)) (defun sieve-manage-is-string () (cond ((looking-at "\"\\([^\"]+\\)\"") @@ -639,7 +561,7 @@ (setq cmdstr (concat cmdstr sieve-manage-client-eol)) (and sieve-manage-log (with-current-buffer (get-buffer-create sieve-manage-log) - (sieve-manage-disable-multibyte) + (mm-enable-multibyte) (buffer-disable-undo) (goto-char (point-max)) (insert cmdstr))) ------------------------------------------------------------ revno: 112922 committer: Glenn Morris branch nick: trunk timestamp: Mon 2013-06-10 23:42:15 -0700 message: * doc/emacs/maintaining.texi (VC Directory Commands): Copyedit. (Branches): Put back milder version of pre 2013-06-07 text. diff: === modified file 'doc/emacs/ChangeLog' --- doc/emacs/ChangeLog 2013-06-07 14:00:27 +0000 +++ doc/emacs/ChangeLog 2013-06-11 06:42:15 +0000 @@ -1,7 +1,11 @@ +2013-06-11 Glenn Morris + + * maintaining.texi (VC Directory Commands): Copyedit. + (Branches): Put back milder version of pre 2013-06-07 text. + 2013-06-07 Xue Fuqiao - * maintaining.texi (Branches): Remove text copied from other - sources. + * maintaining.texi (Branches): Remove text copied from other sources. 2013-06-05 Alan Mackenzie === modified file 'doc/emacs/maintaining.texi' --- doc/emacs/maintaining.texi 2013-06-07 14:00:27 +0000 +++ doc/emacs/maintaining.texi 2013-06-11 06:42:15 +0000 @@ -1204,7 +1204,7 @@ @item x Hide files with @samp{up-to-date} status (@code{vc-dir-hide-up-to-date}). With a prefix argument, hide items -that are in state of item at point from display. +whose state is that of the item at point. @end table @findex vc-dir-mark @@ -1267,7 +1267,10 @@ @cindex branch (version control) One use of version control is to support multiple independent lines -of development, which are called @dfn{branches}. +of development, which are called @dfn{branches}. Amongst other +things, branches can be used for maintaining separate ``stable'' and +``development'' versions of a program, and for developing unrelated +features in isolation from one another. VC's support for branch operations is currently fairly limited. For decentralized version control systems, it provides commands for