diff options
| author | Joakim Verona | 2010-06-23 13:19:18 +0200 |
|---|---|---|
| committer | Joakim Verona | 2010-06-23 13:19:18 +0200 |
| commit | ff982c322045ced3480f3a36fcf05acaf84547c1 (patch) | |
| tree | 4efe998261ff6d0f8752ebeeb84938e6a7b6effc /lisp | |
| parent | 14d0b57c0e88c730d676197f923a18d6b926b6ed (diff) | |
| parent | 04c23739823fecd98cbc06ad627b36e5bd8e482e (diff) | |
| download | emacs-ff982c322045ced3480f3a36fcf05acaf84547c1.tar.gz emacs-ff982c322045ced3480f3a36fcf05acaf84547c1.zip | |
erge and a readme
Diffstat (limited to 'lisp')
39 files changed, 2384 insertions, 237 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f1c83da671a..8836a3866ff 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,192 @@ | |||
| 1 | 2010-06-22 Glenn Morris <rgm@gnu.org> | ||
| 2 | |||
| 3 | * textmodes/texinfmt.el (texinfo-format-region) | ||
| 4 | (texinfo-raise-lower-sections, texinfo-format-separate-node) | ||
| 5 | (texinfo-itemize-item, texinfo-multitable-item, texinfo-alias) | ||
| 6 | (texinfo-format-option, texinfo-noindent): | ||
| 7 | Use line-beginning-position and line-end-position. | ||
| 8 | |||
| 9 | * calc/calc-aent.el, calc/calc-ext.el, calc/calc-lang.el: | ||
| 10 | * calc/calc-store.el, calc/calc-units.el, calc/calc.el: | ||
| 11 | * calc/calccomp.el: Add explicit utf-8 coding cookies to files with | ||
| 12 | utf-8 characters. | ||
| 13 | |||
| 14 | 2010-06-21 Karl Fogel <kfogel@red-bean.com> | ||
| 15 | |||
| 16 | * simple.el (compose-mail): Fix doc string to refer to | ||
| 17 | `compose-mail-user-agent-warnings', instead of to the | ||
| 18 | nonexistent `compose-mail-check-user-agent'. | ||
| 19 | |||
| 20 | 2010-06-21 Alan Mackenzie <bug-cc-mode@gnu.org> | ||
| 21 | |||
| 22 | Fix an indentation bug: | ||
| 23 | |||
| 24 | * progmodes/cc-mode.el (c-common-init): Initialise c-new-BEG/END. | ||
| 25 | (c-neutralize-syntax-in-and-mark-CPP): c-new-BEG/END: Take account | ||
| 26 | of existing values. | ||
| 27 | |||
| 28 | * progmodes/cc-engine.el (c-clear-<-pair-props-if-match-after) | ||
| 29 | (c-clear->-pair-props-if-match-before): now return t when they've | ||
| 30 | cleared properties, nil otherwise. | ||
| 31 | (c-before-change-check-<>-operators): Set c-new-beg/end correctly | ||
| 32 | by taking account of the existing value. | ||
| 33 | |||
| 34 | * progmodes/cc-defs.el | ||
| 35 | (c-clear-char-property-with-value-function): Fix this to clear the | ||
| 36 | property rather than overwriting it with nil. | ||
| 37 | |||
| 38 | 2010-06-20 Chong Yidong <cyd@stupidchicken.com> | ||
| 39 | |||
| 40 | * emacs-lisp/package.el (package-print-package): Add link to | ||
| 41 | package description via describe-package. | ||
| 42 | (describe-package-1): List package requirements. Add button to | ||
| 43 | perform installation. | ||
| 44 | (package-menu-describe-package): New command. | ||
| 45 | |||
| 46 | * help-mode.el (help-package): New button type. | ||
| 47 | |||
| 48 | 2010-06-19 Chong Yidong <cyd@stupidchicken.com> | ||
| 49 | |||
| 50 | * emacs-lisp/package.el: Move package-list-packages binding to | ||
| 51 | menu-bar.el. | ||
| 52 | (describe-package, describe-package-1, package--dir): New funs. | ||
| 53 | (package-activate-1): Use package--dir. | ||
| 54 | |||
| 55 | * emacs-lisp/package-x.el (gnus-article-buffer): Require package. | ||
| 56 | |||
| 57 | * help-mode.el (help-package-def): New button type. | ||
| 58 | |||
| 59 | * menu-bar.el: Move package-list-packages binding here from | ||
| 60 | package.el. | ||
| 61 | |||
| 62 | 2010-06-19 Gustav Hållberg <gustav@gmail.com> (tiny change) | ||
| 63 | |||
| 64 | * descr-text.el (describe-char): Avoid trailing whitespace. (Bug#6423) | ||
| 65 | |||
| 66 | 2010-06-18 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 67 | |||
| 68 | * emacs-lisp/edebug.el (edebug-read-list): | ||
| 69 | Phase out old-style backquotes. | ||
| 70 | |||
| 71 | 2010-06-17 Juri Linkov <juri@jurta.org> | ||
| 72 | |||
| 73 | * help-mode.el (help-mode): Set buffer-local variable | ||
| 74 | revert-buffer-function to help-mode-revert-buffer. | ||
| 75 | (help-mode-revert-buffer): New function. | ||
| 76 | |||
| 77 | * info.el (Info-revert-find-node): Check for major-mode Info-mode | ||
| 78 | before popping to "*info*" (like in other Info functions). | ||
| 79 | Keep buffer-name in old-buffer-name. Keep Info-history-forward in | ||
| 80 | old-history-forward. Pop to old-buffer-name or "*info*" to | ||
| 81 | recreate the killed buffer. Set Info-history-forward from | ||
| 82 | old-history-forward. | ||
| 83 | (Info-breadcrumbs-depth): Add :group and :version. | ||
| 84 | |||
| 85 | 2010-06-17 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 86 | |||
| 87 | * emacs-lisp/package.el (package-menu-mode-map): Add a menu. | ||
| 88 | |||
| 89 | 2010-06-17 Agustín Martín <agustin.martin@hispalinux.es> | ||
| 90 | |||
| 91 | * ispell.el (ispell-aspell-find-dictionary): Fix regexp for | ||
| 92 | languages like Portuguese with pt_{BR,PT} and no plain pt. | ||
| 93 | |||
| 94 | 2010-06-17 Juanma Barranquero <lekktu@gmail.com> | ||
| 95 | |||
| 96 | * emacs-lisp/package.el (package-menu-mode-map): | ||
| 97 | Move initialization into declaration. | ||
| 98 | |||
| 99 | * menu-bar.el (menu-bar-options-menu): Fix typo in menu entry. | ||
| 100 | |||
| 101 | 2010-06-17 Chong Yidong <cyd@stupidchicken.com> | ||
| 102 | |||
| 103 | * emacs-lisp/package.el (package-archive-base): Point to | ||
| 104 | elpa.gnu.org. | ||
| 105 | (package-enable, package-load-list): New defcustoms. | ||
| 106 | (package-user-dir, package-directory-list): Turn into defcustoms. | ||
| 107 | Don't include package-user-dir in package-directory-list. | ||
| 108 | (package--builtins-base): Don't include Emacs as a "package". | ||
| 109 | (package-subdirectory-regexp): New var. | ||
| 110 | (package-load-all-descriptors, package-compute-transaction) | ||
| 111 | (package-download-transaction): Obey package-load-list. | ||
| 112 | (package-activate-1): Rename from package-do-activate. | ||
| 113 | (package-list-packages-internal): Check package-load-list. | ||
| 114 | (package-load-descriptor, package-generate-autoloads) | ||
| 115 | (package-unpack, package-unpack-single) | ||
| 116 | (package--read-archive-file, package-delete): Use | ||
| 117 | expand-file-name. | ||
| 118 | |||
| 119 | * emacs-lisp/package-x.el: New file. Package uploading | ||
| 120 | functionality split out from package.el. | ||
| 121 | |||
| 122 | * startup.el (command-line): Load packages after reading init | ||
| 123 | file. | ||
| 124 | |||
| 125 | 2010-06-17 Tom Tromey <tromey@redhat.com> | ||
| 126 | |||
| 127 | * emacs-lisp/package.el: New file. | ||
| 128 | |||
| 129 | 2010-06-17 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 130 | |||
| 131 | * emacs-lisp/macroexp.el (macroexpand-all-1): Put back special | ||
| 132 | handling for `lambda' (misunderstanding). | ||
| 133 | |||
| 134 | 2010-06-16 Jay Belanger <jay.p.belanger@gmail.com> | ||
| 135 | |||
| 136 | * calc/calc-poly.el: (math-accum-factors): Make sure that | ||
| 137 | constants aren't distributed after they are factored out. | ||
| 138 | |||
| 139 | 2010-06-16 Juri Linkov <juri@jurta.org> | ||
| 140 | |||
| 141 | * facemenu.el (list-colors-display): Call `pop-to-buffer' before | ||
| 142 | `list-colors-print'. (Bug#6332) | ||
| 143 | |||
| 144 | 2010-06-16 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 145 | |||
| 146 | * emacs-lisp/macroexp.el (macroexpand-all-1): Don't handle `lambda' | ||
| 147 | specially, since it's a macro. Fix up wrong hint passed to maybe-cons. | ||
| 148 | |||
| 149 | * font-lock.el (font-lock-major-mode): Rename from | ||
| 150 | font-lock-mode-major-mode to distinguish it from | ||
| 151 | global-font-lock-mode's own font-lock-mode-major-mode (bug#6135). | ||
| 152 | (font-lock-set-defaults): | ||
| 153 | * font-core.el (font-lock-default-function): Adjust users. | ||
| 154 | (font-lock-mode): Don't set it at all. | ||
| 155 | |||
| 156 | 2010-06-16 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 157 | |||
| 158 | * vc-annotate.el (vc-annotate): Use vc-read-revision. | ||
| 159 | |||
| 160 | 2010-06-16 Glenn Morris <rgm@gnu.org> | ||
| 161 | |||
| 162 | * calendar/appt.el (appt-time-msg-list): Doc fix. | ||
| 163 | (appt-check): Let-bind appt-warn-time. | ||
| 164 | (appt-add): Make the 3rd argument optional. | ||
| 165 | Simplify argument names. Doc fix. Check for integer WARNTIME. | ||
| 166 | Only add WARNTIME to the output list if non-nil. | ||
| 167 | |||
| 168 | 2010-06-16 Ivan Kanis <apple@kanis.eu> | ||
| 169 | |||
| 170 | * calendar/appt.el (appt-check): Let the 3rd element of | ||
| 171 | appt-time-msg-list specify the warning time. | ||
| 172 | (appt-add): Add new argument with the warning time. (Bug#5176) | ||
| 173 | |||
| 174 | 2010-06-16 Bob Rogers <rogers-emacs@rgrjr.dyndns.org> (tiny change) | ||
| 175 | |||
| 176 | * vc-svn.el (vc-svn-after-dir-status): Fix regexp for Subversions | ||
| 177 | older than version 1.6. (Bug#6361) | ||
| 178 | |||
| 179 | 2010-06-16 Helmut Eller <eller.helmut@gmail.com> | ||
| 180 | |||
| 181 | * emacs-lisp/cl-macs.el (destructuring-bind): Bind `bind-enquote', | ||
| 182 | used by cl-do-arglist. (Bug#6408) | ||
| 183 | |||
| 184 | 2010-06-16 Agustín Martín <agustin.martin@hispalinux.es> | ||
| 185 | |||
| 186 | * ispell.el (ispell-dictionary-base-alist): Fix | ||
| 187 | portuguese casechars/not-casechars for missing 'çÇ'. | ||
| 188 | Suggested by Rolando Pereira (bug#6434). | ||
| 189 | |||
| 1 | 2010-06-15 Juanma Barranquero <lekktu@gmail.com> | 190 | 2010-06-15 Juanma Barranquero <lekktu@gmail.com> |
| 2 | 191 | ||
| 3 | * facemenu.el (list-colors-sort): Doc fix. | 192 | * facemenu.el (list-colors-sort): Doc fix. |
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index 77a02b58c73..30f15f04905 100644 --- a/lisp/calc/calc-aent.el +++ b/lisp/calc/calc-aent.el | |||
| @@ -1,7 +1,7 @@ | |||
| 1 | ;;; calc-aent.el --- algebraic entry functions for Calc | 1 | ;;; calc-aent.el --- algebraic entry functions for Calc |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, | 3 | ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 2005, |
| 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. | 4 | ;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
| 5 | 5 | ||
| 6 | ;; Author: Dave Gillespie <daveg@synaptics.com> | 6 | ;; Author: Dave Gillespie <daveg@synaptics.com> |
| 7 | ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> | 7 | ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> |
| @@ -609,9 +609,9 @@ in Calc algebraic input.") | |||
| 609 | (setq math-exp-str (math-remove-percentsigns math-exp-str))) | 609 | (setq math-exp-str (math-remove-percentsigns math-exp-str))) |
| 610 | (if calc-language-input-filter | 610 | (if calc-language-input-filter |
| 611 | (setq math-exp-str (funcall calc-language-input-filter math-exp-str))) | 611 | (setq math-exp-str (funcall calc-language-input-filter math-exp-str))) |
| 612 | (while (setq math-exp-token | 612 | (while (setq math-exp-token |
| 613 | (string-match "\\.\\.\\([^.]\\|.[^.]\\)" math-exp-str)) | 613 | (string-match "\\.\\.\\([^.]\\|.[^.]\\)" math-exp-str)) |
| 614 | (setq math-exp-str | 614 | (setq math-exp-str |
| 615 | (concat (substring math-exp-str 0 math-exp-token) "\\dots" | 615 | (concat (substring math-exp-str 0 math-exp-token) "\\dots" |
| 616 | (substring math-exp-str (+ math-exp-token 2))))) | 616 | (substring math-exp-str (+ math-exp-token 2))))) |
| 617 | (math-build-parse-table) | 617 | (math-build-parse-table) |
| @@ -712,7 +712,7 @@ in Calc algebraic input.") | |||
| 712 | (math-read-token))) | 712 | (math-read-token))) |
| 713 | ((and (memq ch calc-user-token-chars) | 713 | ((and (memq ch calc-user-token-chars) |
| 714 | (let ((case-fold-search nil)) | 714 | (let ((case-fold-search nil)) |
| 715 | (eq (string-match | 715 | (eq (string-match |
| 716 | calc-user-tokens math-exp-str math-exp-pos) | 716 | calc-user-tokens math-exp-str math-exp-pos) |
| 717 | math-exp-pos))) | 717 | math-exp-pos))) |
| 718 | (setq math-exp-token 'punc | 718 | (setq math-exp-token 'punc |
| @@ -722,7 +722,7 @@ in Calc algebraic input.") | |||
| 722 | (and (>= ch ?A) (<= ch ?Z)) | 722 | (and (>= ch ?A) (<= ch ?Z)) |
| 723 | (and (>= ch ?α) (<= ch ?ω)) | 723 | (and (>= ch ?α) (<= ch ?ω)) |
| 724 | (and (>= ch ?Α) (<= ch ?Ω))) | 724 | (and (>= ch ?Α) (<= ch ?Ω))) |
| 725 | (string-match | 725 | (string-match |
| 726 | (cond | 726 | (cond |
| 727 | ((and (memq calc-language calc-lang-allow-underscores) | 727 | ((and (memq calc-language calc-lang-allow-underscores) |
| 728 | (memq calc-language calc-lang-allow-percentsigns)) | 728 | (memq calc-language calc-lang-allow-percentsigns)) |
| @@ -745,7 +745,7 @@ in Calc algebraic input.") | |||
| 745 | (eq (string-match "_\\.?[0-9]" math-exp-str math-exp-pos) | 745 | (eq (string-match "_\\.?[0-9]" math-exp-str math-exp-pos) |
| 746 | math-exp-pos) | 746 | math-exp-pos) |
| 747 | (or (eq math-exp-pos 0) | 747 | (or (eq math-exp-pos 0) |
| 748 | (and (not (memq calc-language | 748 | (and (not (memq calc-language |
| 749 | calc-lang-allow-underscores)) | 749 | calc-lang-allow-underscores)) |
| 750 | (eq (string-match "[^])}\"a-zA-Zα-ωΑ-Ω0-9'$]_" | 750 | (eq (string-match "[^])}\"a-zA-Zα-ωΑ-Ω0-9'$]_" |
| 751 | math-exp-str (1- math-exp-pos)) | 751 | math-exp-str (1- math-exp-pos)) |
| @@ -757,7 +757,7 @@ in Calc algebraic input.") | |||
| 757 | (setq math-exp-token 'number | 757 | (setq math-exp-token 'number |
| 758 | math-expr-data (math-match-substring math-exp-str 0) | 758 | math-expr-data (math-match-substring math-exp-str 0) |
| 759 | math-exp-pos (match-end 0))) | 759 | math-exp-pos (match-end 0))) |
| 760 | ((and (setq adfn | 760 | ((and (setq adfn |
| 761 | (assq ch (get calc-language 'math-lang-read-symbol))) | 761 | (assq ch (get calc-language 'math-lang-read-symbol))) |
| 762 | (eval (nth 1 adfn))) | 762 | (eval (nth 1 adfn))) |
| 763 | (eval (nth 2 adfn))) | 763 | (eval (nth 2 adfn))) |
| @@ -810,8 +810,8 @@ in Calc algebraic input.") | |||
| 810 | 810 | ||
| 811 | (defun math-read-expr-level (exp-prec &optional exp-term) | 811 | (defun math-read-expr-level (exp-prec &optional exp-term) |
| 812 | (let* ((math-expr-opers (math-expr-ops)) | 812 | (let* ((math-expr-opers (math-expr-ops)) |
| 813 | (x (math-read-factor)) | 813 | (x (math-read-factor)) |
| 814 | (first t) | 814 | (first t) |
| 815 | op op2) | 815 | op op2) |
| 816 | (while (and (or (and calc-user-parse-table | 816 | (while (and (or (and calc-user-parse-table |
| 817 | (setq op (calc-check-user-syntax x exp-prec)) | 817 | (setq op (calc-check-user-syntax x exp-prec)) |
| @@ -832,8 +832,8 @@ in Calc algebraic input.") | |||
| 832 | (memq math-exp-token '(symbol number dollar hash)) | 832 | (memq math-exp-token '(symbol number dollar hash)) |
| 833 | (equal math-expr-data "(") | 833 | (equal math-expr-data "(") |
| 834 | (and (equal math-expr-data "[") | 834 | (and (equal math-expr-data "[") |
| 835 | (not (equal | 835 | (not (equal |
| 836 | (get calc-language | 836 | (get calc-language |
| 837 | 'math-function-open) "[")) | 837 | 'math-function-open) "[")) |
| 838 | (not (and math-exp-keep-spaces | 838 | (not (and math-exp-keep-spaces |
| 839 | (eq (car-safe x) 'vec))))) | 839 | (eq (car-safe x) 'vec))))) |
| @@ -1141,8 +1141,8 @@ If the current Calc language does not use placeholders, return nil." | |||
| 1141 | (eq math-exp-token 'end))) | 1141 | (eq math-exp-token 'end))) |
| 1142 | (throw 'syntax "Expected `)'")) | 1142 | (throw 'syntax "Expected `)'")) |
| 1143 | (math-read-token) | 1143 | (math-read-token) |
| 1144 | (if (and (memq calc-language | 1144 | (if (and (memq calc-language |
| 1145 | calc-lang-parens-are-subscripts) | 1145 | calc-lang-parens-are-subscripts) |
| 1146 | args | 1146 | args |
| 1147 | (require 'calc-ext) | 1147 | (require 'calc-ext) |
| 1148 | (let ((calc-matrix-mode 'scalar)) | 1148 | (let ((calc-matrix-mode 'scalar)) |
| @@ -1184,7 +1184,7 @@ If the current Calc language does not use placeholders, return nil." | |||
| 1184 | (substring (symbol-name (cdr v)) | 1184 | (substring (symbol-name (cdr v)) |
| 1185 | 4)) | 1185 | 4)) |
| 1186 | (cdr v)))))) | 1186 | (cdr v)))))) |
| 1187 | (while (and (memq calc-language | 1187 | (while (and (memq calc-language |
| 1188 | calc-lang-brackets-are-subscripts) | 1188 | calc-lang-brackets-are-subscripts) |
| 1189 | (equal math-expr-data "[")) | 1189 | (equal math-expr-data "[")) |
| 1190 | (math-read-token) | 1190 | (math-read-token) |
| @@ -1284,6 +1284,7 @@ If the current Calc language does not use placeholders, return nil." | |||
| 1284 | (provide 'calc-aent) | 1284 | (provide 'calc-aent) |
| 1285 | 1285 | ||
| 1286 | ;; Local variables: | 1286 | ;; Local variables: |
| 1287 | ;; coding: utf-8 | ||
| 1287 | ;; generated-autoload-file: "calc-loaddefs.el" | 1288 | ;; generated-autoload-file: "calc-loaddefs.el" |
| 1288 | ;; End: | 1289 | ;; End: |
| 1289 | 1290 | ||
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 17dc9293237..18e63655ecf 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el | |||
| @@ -1,7 +1,7 @@ | |||
| 1 | ;;; calc-ext.el --- various extension functions for Calc | 1 | ;;; calc-ext.el --- various extension functions for Calc |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, | 3 | ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 2005, |
| 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. | 4 | ;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
| 5 | 5 | ||
| 6 | ;; Author: David Gillespie <daveg@synaptics.com> | 6 | ;; Author: David Gillespie <daveg@synaptics.com> |
| 7 | ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> | 7 | ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> |
| @@ -960,7 +960,7 @@ math-read-brackets math-reduce-cols math-reduce-vec math-transpose) | |||
| 960 | 960 | ||
| 961 | ("calc-yank" calc-alg-edit calc-clean-newlines | 961 | ("calc-yank" calc-alg-edit calc-clean-newlines |
| 962 | calc-do-grab-rectangle calc-do-grab-region calc-finish-stack-edit | 962 | calc-do-grab-rectangle calc-do-grab-region calc-finish-stack-edit |
| 963 | calc-copy-to-register calc-insert-register | 963 | calc-copy-to-register calc-insert-register |
| 964 | calc-append-to-register calc-prepend-to-register | 964 | calc-append-to-register calc-prepend-to-register |
| 965 | calc-force-refresh calc-locate-cursor-element calc-show-edit-buffer) | 965 | calc-force-refresh calc-locate-cursor-element calc-show-edit-buffer) |
| 966 | 966 | ||
| @@ -989,7 +989,7 @@ calc-floor calc-idiv calc-increment calc-mant-part calc-max calc-min | |||
| 989 | calc-round calc-scale-float calc-sign calc-trunc calc-xpon-part) | 989 | calc-round calc-scale-float calc-sign calc-trunc calc-xpon-part) |
| 990 | 990 | ||
| 991 | ("calc-bin" calc-and calc-binary-radix calc-clip calc-twos-complement-mode | 991 | ("calc-bin" calc-and calc-binary-radix calc-clip calc-twos-complement-mode |
| 992 | calc-decimal-radix calc-diff calc-hex-radix calc-leading-zeros | 992 | calc-decimal-radix calc-diff calc-hex-radix calc-leading-zeros |
| 993 | calc-lshift-arith calc-lshift-binary calc-not calc-octal-radix calc-or calc-radix | 993 | calc-lshift-arith calc-lshift-binary calc-not calc-octal-radix calc-or calc-radix |
| 994 | calc-rotate-binary calc-rshift-arith calc-rshift-binary calc-word-size | 994 | calc-rotate-binary calc-rshift-arith calc-rshift-binary calc-word-size |
| 995 | calc-xor) | 995 | calc-xor) |
| @@ -1415,7 +1415,7 @@ calc-kill calc-kill-region calc-yank)))) | |||
| 1415 | (with-current-buffer calc-main-buffer | 1415 | (with-current-buffer calc-main-buffer |
| 1416 | calc-option-flag) | 1416 | calc-option-flag) |
| 1417 | calc-option-flag)) | 1417 | calc-option-flag)) |
| 1418 | (msg | 1418 | (msg |
| 1419 | (cond | 1419 | (cond |
| 1420 | ((and opt-flag hyp-flag) "Option Inverse Hyperbolic...") | 1420 | ((and opt-flag hyp-flag) "Option Inverse Hyperbolic...") |
| 1421 | (hyp-flag "Inverse Hyperbolic...") | 1421 | (hyp-flag "Inverse Hyperbolic...") |
| @@ -1505,8 +1505,8 @@ calc-kill calc-kill-region calc-yank)))) | |||
| 1505 | (with-current-buffer calc-main-buffer | 1505 | (with-current-buffer calc-main-buffer |
| 1506 | calc-option-flag) | 1506 | calc-option-flag) |
| 1507 | calc-option-flag)) | 1507 | calc-option-flag)) |
| 1508 | (msg | 1508 | (msg |
| 1509 | (cond | 1509 | (cond |
| 1510 | ((and opt-flag inv-flag) "Option Inverse Hyperbolic...") | 1510 | ((and opt-flag inv-flag) "Option Inverse Hyperbolic...") |
| 1511 | (opt-flag "Option Hyperbolic...") | 1511 | (opt-flag "Option Hyperbolic...") |
| 1512 | (inv-flag "Inverse Hyperbolic...") | 1512 | (inv-flag "Inverse Hyperbolic...") |
| @@ -1537,8 +1537,8 @@ calc-kill calc-kill-region calc-yank)))) | |||
| 1537 | (with-current-buffer calc-main-buffer | 1537 | (with-current-buffer calc-main-buffer |
| 1538 | calc-hyperbolic-flag) | 1538 | calc-hyperbolic-flag) |
| 1539 | calc-hyperbolic-flag)) | 1539 | calc-hyperbolic-flag)) |
| 1540 | (msg | 1540 | (msg |
| 1541 | (cond | 1541 | (cond |
| 1542 | ((and hyp-flag inv-flag) "Option Inverse Hyperbolic...") | 1542 | ((and hyp-flag inv-flag) "Option Inverse Hyperbolic...") |
| 1543 | (hyp-flag "Option Hyperbolic...") | 1543 | (hyp-flag "Option Hyperbolic...") |
| 1544 | (inv-flag "Option Inverse...") | 1544 | (inv-flag "Option Inverse...") |
| @@ -1702,8 +1702,8 @@ calc-kill calc-kill-region calc-yank)))) | |||
| 1702 | (defun calc-execute-extended-command (n) | 1702 | (defun calc-execute-extended-command (n) |
| 1703 | (interactive "P") | 1703 | (interactive "P") |
| 1704 | (let* ((prompt (concat (calc-num-prefix-name n) "M-x ")) | 1704 | (let* ((prompt (concat (calc-num-prefix-name n) "M-x ")) |
| 1705 | (cmd (intern | 1705 | (cmd (intern |
| 1706 | (completing-read prompt obarray 'commandp t "calc-" | 1706 | (completing-read prompt obarray 'commandp t "calc-" |
| 1707 | 'calc-extended-command-history)))) | 1707 | 'calc-extended-command-history)))) |
| 1708 | (setq prefix-arg n) | 1708 | (setq prefix-arg n) |
| 1709 | (command-execute cmd))) | 1709 | (command-execute cmd))) |
| @@ -3500,5 +3500,9 @@ A key may contain additional specs for Inverse, Hyperbolic, and Inv+Hyp.") | |||
| 3500 | 3500 | ||
| 3501 | (provide 'calc-ext) | 3501 | (provide 'calc-ext) |
| 3502 | 3502 | ||
| 3503 | ;; Local variables: | ||
| 3504 | ;; coding: utf-8 | ||
| 3505 | ;; End: | ||
| 3506 | |||
| 3503 | ;; arch-tag: 1814ba7f-a390-49dc-9e25-a5adc205e97e | 3507 | ;; arch-tag: 1814ba7f-a390-49dc-9e25-a5adc205e97e |
| 3504 | ;;; calc-ext.el ends here | 3508 | ;;; calc-ext.el ends here |
diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el index 0ebf1a18fef..f461c47aafd 100644 --- a/lisp/calc/calc-lang.el +++ b/lisp/calc/calc-lang.el | |||
| @@ -1,7 +1,7 @@ | |||
| 1 | ;;; calc-lang.el --- calc language functions | 1 | ;;; calc-lang.el --- calc language functions |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, | 3 | ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 2005, |
| 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. | 4 | ;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
| 5 | 5 | ||
| 6 | ;; Author: David Gillespie <daveg@synaptics.com> | 6 | ;; Author: David Gillespie <daveg@synaptics.com> |
| 7 | ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> | 7 | ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> |
| @@ -335,7 +335,7 @@ | |||
| 335 | (add-to-list 'calc-lang-allow-underscores 'fortran) | 335 | (add-to-list 'calc-lang-allow-underscores 'fortran) |
| 336 | (add-to-list 'calc-lang-parens-are-subscripts 'fortran) | 336 | (add-to-list 'calc-lang-parens-are-subscripts 'fortran) |
| 337 | 337 | ||
| 338 | ;; The next few variables are local to math-read-exprs in calc-aent.el | 338 | ;; The next few variables are local to math-read-exprs in calc-aent.el |
| 339 | ;; and math-read-expr in calc-ext.el, but are set in functions they call. | 339 | ;; and math-read-expr in calc-ext.el, but are set in functions they call. |
| 340 | 340 | ||
| 341 | (defvar math-exp-token) | 341 | (defvar math-exp-token) |
| @@ -379,12 +379,12 @@ | |||
| 379 | ((= n 1) | 379 | ((= n 1) |
| 380 | (message "TeX language mode with \\hbox{func}(\\hbox{var})")) | 380 | (message "TeX language mode with \\hbox{func}(\\hbox{var})")) |
| 381 | ((> n 1) | 381 | ((> n 1) |
| 382 | (message | 382 | (message |
| 383 | "TeX language mode with \\hbox{func}(\\hbox{var}) and multiline matrices")) | 383 | "TeX language mode with \\hbox{func}(\\hbox{var}) and multiline matrices")) |
| 384 | ((= n -1) | 384 | ((= n -1) |
| 385 | (message "TeX language mode with \\func(\\hbox{var})")) | 385 | (message "TeX language mode with \\func(\\hbox{var})")) |
| 386 | ((< n -1) | 386 | ((< n -1) |
| 387 | (message | 387 | (message |
| 388 | "TeX language mode with \\func(\\hbox{var}) and multiline matrices"))))) | 388 | "TeX language mode with \\func(\\hbox{var}) and multiline matrices"))))) |
| 389 | 389 | ||
| 390 | (defun calc-latex-language (n) | 390 | (defun calc-latex-language (n) |
| @@ -399,12 +399,12 @@ | |||
| 399 | ((= n 1) | 399 | ((= n 1) |
| 400 | (message "LaTeX language mode with \\text{func}(\\text{var})")) | 400 | (message "LaTeX language mode with \\text{func}(\\text{var})")) |
| 401 | ((> n 1) | 401 | ((> n 1) |
| 402 | (message | 402 | (message |
| 403 | "LaTeX language mode with \\text{func}(\\text{var}) and multiline matrices")) | 403 | "LaTeX language mode with \\text{func}(\\text{var}) and multiline matrices")) |
| 404 | ((= n -1) | 404 | ((= n -1) |
| 405 | (message "LaTeX language mode with \\func(\\text{var})")) | 405 | (message "LaTeX language mode with \\func(\\text{var})")) |
| 406 | ((< n -1) | 406 | ((< n -1) |
| 407 | (message | 407 | (message |
| 408 | "LaTeX language mode with \\func(\\text{var}) and multiline matrices"))))) | 408 | "LaTeX language mode with \\func(\\text{var}) and multiline matrices"))))) |
| 409 | 409 | ||
| 410 | (put 'tex 'math-lang-name "TeX") | 410 | (put 'tex 'math-lang-name "TeX") |
| @@ -498,7 +498,7 @@ | |||
| 498 | (intv . math-compose-tex-intv))) | 498 | (intv . math-compose-tex-intv))) |
| 499 | 499 | ||
| 500 | (put 'tex 'math-variable-table | 500 | (put 'tex 'math-variable-table |
| 501 | '( | 501 | '( |
| 502 | ;; The Greek letters | 502 | ;; The Greek letters |
| 503 | ( \\alpha . var-alpha ) | 503 | ( \\alpha . var-alpha ) |
| 504 | ( \\beta . var-beta ) | 504 | ( \\beta . var-beta ) |
| @@ -630,7 +630,7 @@ | |||
| 630 | 630 | ||
| 631 | (defun math-compose-tex-matrix (a &optional ltx) | 631 | (defun math-compose-tex-matrix (a &optional ltx) |
| 632 | (if (cdr a) | 632 | (if (cdr a) |
| 633 | (cons (append (math-compose-vector (cdr (car a)) " & " 0) | 633 | (cons (append (math-compose-vector (cdr (car a)) " & " 0) |
| 634 | (if ltx '(" \\\\ ") '(" \\cr "))) | 634 | (if ltx '(" \\\\ ") '(" \\cr "))) |
| 635 | (math-compose-tex-matrix (cdr a) ltx)) | 635 | (math-compose-tex-matrix (cdr a) ltx)) |
| 636 | (list (math-compose-vector (cdr (car a)) " & " 0)))) | 636 | (list (math-compose-vector (cdr (car a)) " & " 0)))) |
| @@ -722,7 +722,7 @@ | |||
| 722 | (setq left "{" right "}")) | 722 | (setq left "{" right "}")) |
| 723 | (t (setq left calc-function-open | 723 | (t (setq left calc-function-open |
| 724 | right calc-function-close))) | 724 | right calc-function-close))) |
| 725 | (list 'horiz func | 725 | (list 'horiz func |
| 726 | left | 726 | left |
| 727 | (math-compose-vector (cdr a) ", " 0) | 727 | (math-compose-vector (cdr a) ", " 0) |
| 728 | right))) | 728 | right))) |
| @@ -866,7 +866,7 @@ | |||
| 866 | (and right | 866 | (and right |
| 867 | (setq math-exp-str (copy-sequence math-exp-str)) | 867 | (setq math-exp-str (copy-sequence math-exp-str)) |
| 868 | (aset math-exp-str right ?\])))))))))) | 868 | (aset math-exp-str right ?\])))))))))) |
| 869 | 869 | ||
| 870 | (defun math-latex-parse-frac (f val) | 870 | (defun math-latex-parse-frac (f val) |
| 871 | (let (numer denom) | 871 | (let (numer denom) |
| 872 | (setq numer (car (math-read-expr-list))) | 872 | (setq numer (car (math-read-expr-list))) |
| @@ -988,7 +988,7 @@ | |||
| 988 | (cdr (math-transpose a))) | 988 | (cdr (math-transpose a))) |
| 989 | '("}"))))) | 989 | '("}"))))) |
| 990 | 990 | ||
| 991 | (put 'eqn 'math-var-formatter | 991 | (put 'eqn 'math-var-formatter |
| 992 | (function | 992 | (function |
| 993 | (lambda (a prec) | 993 | (lambda (a prec) |
| 994 | (let (v) | 994 | (let (v) |
| @@ -1011,7 +1011,7 @@ | |||
| 1011 | (intern (substring (symbol-name (nth 2 a)) 0 -1)))) | 1011 | (intern (substring (symbol-name (nth 2 a)) 0 -1)))) |
| 1012 | prec) | 1012 | prec) |
| 1013 | (symbol-name (nth 1 a)))))))) | 1013 | (symbol-name (nth 1 a)))))))) |
| 1014 | 1014 | ||
| 1015 | (defconst math-eqn-special-funcs | 1015 | (defconst math-eqn-special-funcs |
| 1016 | '( calcFunc-log | 1016 | '( calcFunc-log |
| 1017 | calcFunc-ln calcFunc-exp | 1017 | calcFunc-ln calcFunc-exp |
| @@ -1022,7 +1022,7 @@ | |||
| 1022 | calcFunc-arcsin calcFunc-arccos calcFunc-arctan | 1022 | calcFunc-arcsin calcFunc-arccos calcFunc-arctan |
| 1023 | calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh)) | 1023 | calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh)) |
| 1024 | 1024 | ||
| 1025 | (put 'eqn 'math-func-formatter | 1025 | (put 'eqn 'math-func-formatter |
| 1026 | (function | 1026 | (function |
| 1027 | (lambda (func a) | 1027 | (lambda (func a) |
| 1028 | (let (left right) | 1028 | (let (left right) |
| @@ -1035,8 +1035,8 @@ | |||
| 1035 | (not (math-tex-expr-is-flat (nth 1 a)))) | 1035 | (not (math-tex-expr-is-flat (nth 1 a)))) |
| 1036 | (setq left "{left ( " | 1036 | (setq left "{left ( " |
| 1037 | right " right )}")) | 1037 | right " right )}")) |
| 1038 | 1038 | ||
| 1039 | ((and | 1039 | ((and |
| 1040 | (memq (car a) math-eqn-special-funcs) | 1040 | (memq (car a) math-eqn-special-funcs) |
| 1041 | (= (length a) 2) | 1041 | (= (length a) 2) |
| 1042 | (or (Math-realp (nth 1 a)) | 1042 | (or (Math-realp (nth 1 a)) |
| @@ -1069,7 +1069,7 @@ | |||
| 1069 | ("above" punc ","))) | 1069 | ("above" punc ","))) |
| 1070 | 1070 | ||
| 1071 | (put 'eqn 'math-lang-adjust-words | 1071 | (put 'eqn 'math-lang-adjust-words |
| 1072 | (function | 1072 | (function |
| 1073 | (lambda () | 1073 | (lambda () |
| 1074 | (let ((code (assoc math-expr-data math-eqn-ignore-words))) | 1074 | (let ((code (assoc math-expr-data math-eqn-ignore-words))) |
| 1075 | (cond ((null code)) | 1075 | (cond ((null code)) |
| @@ -1189,21 +1189,21 @@ | |||
| 1189 | ( Gamma . var-gamma))) | 1189 | ( Gamma . var-gamma))) |
| 1190 | 1190 | ||
| 1191 | (put 'yacas 'math-parse-table | 1191 | (put 'yacas 'math-parse-table |
| 1192 | '((("Deriv(" 0 ")" 0) | 1192 | '((("Deriv(" 0 ")" 0) |
| 1193 | calcFunc-deriv (var ArgB var-ArgB) (var ArgA var-ArgA)) | 1193 | calcFunc-deriv (var ArgB var-ArgB) (var ArgA var-ArgA)) |
| 1194 | (("D(" 0 ")" 0) | 1194 | (("D(" 0 ")" 0) |
| 1195 | calcFunc-deriv (var ArgB var-ArgB) (var ArgA var-ArgA)) | 1195 | calcFunc-deriv (var ArgB var-ArgB) (var ArgA var-ArgA)) |
| 1196 | (("Integrate(" 0 ")" 0) | 1196 | (("Integrate(" 0 ")" 0) |
| 1197 | calcFunc-integ (var ArgB var-ArgB)(var ArgA var-ArgA)) | 1197 | calcFunc-integ (var ArgB var-ArgB)(var ArgA var-ArgA)) |
| 1198 | (("Integrate(" 0 "," 0 "," 0 ")" 0) | 1198 | (("Integrate(" 0 "," 0 "," 0 ")" 0) |
| 1199 | calcFunc-integ (var ArgD var-ArgD) (var ArgA var-ArgA) | 1199 | calcFunc-integ (var ArgD var-ArgD) (var ArgA var-ArgA) |
| 1200 | (var ArgB var-ArgB) (var ArgC var-ArgC)) | 1200 | (var ArgB var-ArgB) (var ArgC var-ArgC)) |
| 1201 | (("Subst(" 0 "," 0 ")" 0) | 1201 | (("Subst(" 0 "," 0 ")" 0) |
| 1202 | calcFunc-subst (var ArgC var-ArgC) (var ArgA var-ArgA) | 1202 | calcFunc-subst (var ArgC var-ArgC) (var ArgA var-ArgA) |
| 1203 | (var ArgB var-ArgB)) | 1203 | (var ArgB var-ArgB)) |
| 1204 | (("Taylor(" 0 "," 0 "," 0 ")" 0) | 1204 | (("Taylor(" 0 "," 0 "," 0 ")" 0) |
| 1205 | calcFunc-taylor (var ArgD var-ArgD) | 1205 | calcFunc-taylor (var ArgD var-ArgD) |
| 1206 | (calcFunc-eq (var ArgA var-ArgA) (var ArgB var-ArgB)) | 1206 | (calcFunc-eq (var ArgA var-ArgA) (var ArgB var-ArgB)) |
| 1207 | (var ArgC var-ArgC)))) | 1207 | (var ArgC var-ArgC)))) |
| 1208 | 1208 | ||
| 1209 | (put 'yacas 'math-oper-table | 1209 | (put 'yacas 'math-oper-table |
| @@ -1356,7 +1356,7 @@ | |||
| 1356 | (math-compose-expr (nth 2 a) -1) | 1356 | (math-compose-expr (nth 2 a) -1) |
| 1357 | (if (not (nth 3 a)) | 1357 | (if (not (nth 3 a)) |
| 1358 | ")" | 1358 | ")" |
| 1359 | (concat | 1359 | (concat |
| 1360 | "," | 1360 | "," |
| 1361 | (math-compose-expr (nth 3 a) -1) | 1361 | (math-compose-expr (nth 3 a) -1) |
| 1362 | "," | 1362 | "," |
| @@ -1393,7 +1393,7 @@ | |||
| 1393 | '(("+" + 100 100) | 1393 | '(("+" + 100 100) |
| 1394 | ("-" - 100 134) | 1394 | ("-" - 100 134) |
| 1395 | ("*" * 120 120) | 1395 | ("*" * 120 120) |
| 1396 | ("." * 130 129) | 1396 | ("." * 130 129) |
| 1397 | ("/" / 120 120) | 1397 | ("/" / 120 120) |
| 1398 | ("u-" neg -1 180) | 1398 | ("u-" neg -1 180) |
| 1399 | ("u+" ident -1 180) | 1399 | ("u+" ident -1 180) |
| @@ -1494,9 +1494,9 @@ | |||
| 1494 | (nth 3 args)))) | 1494 | (nth 3 args)))) |
| 1495 | 1495 | ||
| 1496 | (put 'maxima 'math-parse-table | 1496 | (put 'maxima 'math-parse-table |
| 1497 | '((("if" 0 "then" 0 "else" 0) | 1497 | '((("if" 0 "then" 0 "else" 0) |
| 1498 | calcFunc-if | 1498 | calcFunc-if |
| 1499 | (var ArgA var-ArgA) | 1499 | (var ArgA var-ArgA) |
| 1500 | (var ArgB var-ArgB) | 1500 | (var ArgB var-ArgB) |
| 1501 | (var ArgC var-ArgC)))) | 1501 | (var ArgC var-ArgC)))) |
| 1502 | 1502 | ||
| @@ -1572,7 +1572,7 @@ | |||
| 1572 | (lambda (a) | 1572 | (lambda (a) |
| 1573 | (list 'horiz | 1573 | (list 'horiz |
| 1574 | "matrix(" | 1574 | "matrix(" |
| 1575 | (math-compose-vector (cdr a) | 1575 | (math-compose-vector (cdr a) |
| 1576 | (concat math-comp-comma " ") | 1576 | (concat math-comp-comma " ") |
| 1577 | math-comp-vector-prec) | 1577 | math-comp-vector-prec) |
| 1578 | ")")))) | 1578 | ")")))) |
| @@ -1734,7 +1734,7 @@ order to Calc's." | |||
| 1734 | (nth 0 args)))) | 1734 | (nth 0 args)))) |
| 1735 | 1735 | ||
| 1736 | (put 'giac 'math-parse-table | 1736 | (put 'giac 'math-parse-table |
| 1737 | '((("set" 0) | 1737 | '((("set" 0) |
| 1738 | calcFunc-rdup | 1738 | calcFunc-rdup |
| 1739 | (var ArgA var-ArgA)))) | 1739 | (var ArgA var-ArgA)))) |
| 1740 | 1740 | ||
| @@ -1748,7 +1748,7 @@ order to Calc's." | |||
| 1748 | "Compose the arguments to a Calc function in reverse order. | 1748 | "Compose the arguments to a Calc function in reverse order. |
| 1749 | This is used for various language modes which have functions in reverse | 1749 | This is used for various language modes which have functions in reverse |
| 1750 | order to Calc's." | 1750 | order to Calc's." |
| 1751 | (list 'horiz (nth 1 fn) | 1751 | (list 'horiz (nth 1 fn) |
| 1752 | "(" | 1752 | "(" |
| 1753 | (math-compose-expr (nth 2 a) 0) | 1753 | (math-compose-expr (nth 2 a) 0) |
| 1754 | "," | 1754 | "," |
| @@ -1770,7 +1770,7 @@ order to Calc's." | |||
| 1770 | (list 'horiz | 1770 | (list 'horiz |
| 1771 | (math-compose-expr (nth 1 a) 1000) | 1771 | (math-compose-expr (nth 1 a) 1000) |
| 1772 | "[" | 1772 | "[" |
| 1773 | (math-compose-expr | 1773 | (math-compose-expr |
| 1774 | (calc-normalize (list '- (nth 2 a) 1)) 0) | 1774 | (calc-normalize (list '- (nth 2 a) 1)) 0) |
| 1775 | "]"))))) | 1775 | "]"))))) |
| 1776 | 1776 | ||
| @@ -2001,7 +2001,7 @@ order to Calc's." | |||
| 2001 | (list 'horiz | 2001 | (list 'horiz |
| 2002 | "matrix(" | 2002 | "matrix(" |
| 2003 | math-comp-left-bracket | 2003 | math-comp-left-bracket |
| 2004 | (math-compose-vector (cdr a) | 2004 | (math-compose-vector (cdr a) |
| 2005 | (concat math-comp-comma " ") | 2005 | (concat math-comp-comma " ") |
| 2006 | math-comp-vector-prec) | 2006 | math-comp-vector-prec) |
| 2007 | math-comp-right-bracket | 2007 | math-comp-right-bracket |
| @@ -2044,9 +2044,9 @@ order to Calc's." | |||
| 2044 | (defvar math-read-big-baseline) | 2044 | (defvar math-read-big-baseline) |
| 2045 | (defvar math-read-big-h2) | 2045 | (defvar math-read-big-h2) |
| 2046 | 2046 | ||
| 2047 | ;; The variables math-rb-h1, math-rb-h2, math-rb-v1 and math-rb-v2 | 2047 | ;; The variables math-rb-h1, math-rb-h2, math-rb-v1 and math-rb-v2 |
| 2048 | ;; are local to math-read-big-rec, but are used by math-read-big-char, | 2048 | ;; are local to math-read-big-rec, but are used by math-read-big-char, |
| 2049 | ;; math-read-big-emptyp and math-read-big-balance which are called by | 2049 | ;; math-read-big-emptyp and math-read-big-balance which are called by |
| 2050 | ;; math-read-big-rec. | 2050 | ;; math-read-big-rec. |
| 2051 | ;; math-rb-h2 is also local to math-read-big-bigp in calc-ext.el, | 2051 | ;; math-rb-h2 is also local to math-read-big-bigp in calc-ext.el, |
| 2052 | ;; which calls math-read-big-balance. | 2052 | ;; which calls math-read-big-balance. |
| @@ -2055,40 +2055,40 @@ order to Calc's." | |||
| 2055 | (defvar math-rb-v1) | 2055 | (defvar math-rb-v1) |
| 2056 | (defvar math-rb-v2) | 2056 | (defvar math-rb-v2) |
| 2057 | 2057 | ||
| 2058 | (defun math-read-big-rec (math-rb-h1 math-rb-v1 math-rb-h2 math-rb-v2 | 2058 | (defun math-read-big-rec (math-rb-h1 math-rb-v1 math-rb-h2 math-rb-v2 |
| 2059 | &optional baseline prec short) | 2059 | &optional baseline prec short) |
| 2060 | (or prec (setq prec 0)) | 2060 | (or prec (setq prec 0)) |
| 2061 | 2061 | ||
| 2062 | ;; Clip whitespace above or below. | 2062 | ;; Clip whitespace above or below. |
| 2063 | (while (and (< math-rb-v1 math-rb-v2) | 2063 | (while (and (< math-rb-v1 math-rb-v2) |
| 2064 | (math-read-big-emptyp math-rb-h1 math-rb-v1 math-rb-h2 (1+ math-rb-v1))) | 2064 | (math-read-big-emptyp math-rb-h1 math-rb-v1 math-rb-h2 (1+ math-rb-v1))) |
| 2065 | (setq math-rb-v1 (1+ math-rb-v1))) | 2065 | (setq math-rb-v1 (1+ math-rb-v1))) |
| 2066 | (while (and (< math-rb-v1 math-rb-v2) | 2066 | (while (and (< math-rb-v1 math-rb-v2) |
| 2067 | (math-read-big-emptyp math-rb-h1 (1- math-rb-v2) math-rb-h2 math-rb-v2)) | 2067 | (math-read-big-emptyp math-rb-h1 (1- math-rb-v2) math-rb-h2 math-rb-v2)) |
| 2068 | (setq math-rb-v2 (1- math-rb-v2))) | 2068 | (setq math-rb-v2 (1- math-rb-v2))) |
| 2069 | 2069 | ||
| 2070 | ;; If formula is a single line high, normal parser can handle it. | 2070 | ;; If formula is a single line high, normal parser can handle it. |
| 2071 | (if (<= math-rb-v2 (1+ math-rb-v1)) | 2071 | (if (<= math-rb-v2 (1+ math-rb-v1)) |
| 2072 | (if (or (<= math-rb-v2 math-rb-v1) | 2072 | (if (or (<= math-rb-v2 math-rb-v1) |
| 2073 | (> math-rb-h1 (length (setq math-rb-v2 | 2073 | (> math-rb-h1 (length (setq math-rb-v2 |
| 2074 | (nth math-rb-v1 math-read-big-lines))))) | 2074 | (nth math-rb-v1 math-read-big-lines))))) |
| 2075 | (math-read-big-error math-rb-h1 math-rb-v1) | 2075 | (math-read-big-error math-rb-h1 math-rb-v1) |
| 2076 | (setq math-read-big-baseline math-rb-v1 | 2076 | (setq math-read-big-baseline math-rb-v1 |
| 2077 | math-read-big-h2 math-rb-h2 | 2077 | math-read-big-h2 math-rb-h2 |
| 2078 | math-rb-v2 (nth math-rb-v1 math-read-big-lines) | 2078 | math-rb-v2 (nth math-rb-v1 math-read-big-lines) |
| 2079 | math-rb-h2 (math-read-expr | 2079 | math-rb-h2 (math-read-expr |
| 2080 | (substring math-rb-v2 math-rb-h1 | 2080 | (substring math-rb-v2 math-rb-h1 |
| 2081 | (min math-rb-h2 (length math-rb-v2))))) | 2081 | (min math-rb-h2 (length math-rb-v2))))) |
| 2082 | (if (eq (car-safe math-rb-h2) 'error) | 2082 | (if (eq (car-safe math-rb-h2) 'error) |
| 2083 | (math-read-big-error (+ math-rb-h1 (nth 1 math-rb-h2)) | 2083 | (math-read-big-error (+ math-rb-h1 (nth 1 math-rb-h2)) |
| 2084 | math-rb-v1 (nth 2 math-rb-h2)) | 2084 | math-rb-v1 (nth 2 math-rb-h2)) |
| 2085 | math-rb-h2)) | 2085 | math-rb-h2)) |
| 2086 | 2086 | ||
| 2087 | ;; Clip whitespace at left or right. | 2087 | ;; Clip whitespace at left or right. |
| 2088 | (while (and (< math-rb-h1 math-rb-h2) | 2088 | (while (and (< math-rb-h1 math-rb-h2) |
| 2089 | (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) math-rb-v2)) | 2089 | (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) math-rb-v2)) |
| 2090 | (setq math-rb-h1 (1+ math-rb-h1))) | 2090 | (setq math-rb-h1 (1+ math-rb-h1))) |
| 2091 | (while (and (< math-rb-h1 math-rb-h2) | 2091 | (while (and (< math-rb-h1 math-rb-h2) |
| 2092 | (math-read-big-emptyp (1- math-rb-h2) math-rb-v1 math-rb-h2 math-rb-v2)) | 2092 | (math-read-big-emptyp (1- math-rb-h2) math-rb-v1 math-rb-h2 math-rb-v2)) |
| 2093 | (setq math-rb-h2 (1- math-rb-h2))) | 2093 | (setq math-rb-h2 (1- math-rb-h2))) |
| 2094 | 2094 | ||
| @@ -2107,7 +2107,7 @@ order to Calc's." | |||
| 2107 | (/= (aref line math-rb-h1) ?\ ) | 2107 | (/= (aref line math-rb-h1) ?\ ) |
| 2108 | (if (and (= (aref line math-rb-h1) ?\-) | 2108 | (if (and (= (aref line math-rb-h1) ?\-) |
| 2109 | ;; Make sure it's not a minus sign. | 2109 | ;; Make sure it's not a minus sign. |
| 2110 | (or (and (< (1+ math-rb-h1) len) | 2110 | (or (and (< (1+ math-rb-h1) len) |
| 2111 | (= (aref line (1+ math-rb-h1)) ?\-)) | 2111 | (= (aref line (1+ math-rb-h1)) ?\-)) |
| 2112 | (/= (math-read-big-char math-rb-h1 (1- v)) ?\ ) | 2112 | (/= (math-read-big-char math-rb-h1 (1- v)) ?\ ) |
| 2113 | (/= (math-read-big-char math-rb-h1 (1+ v)) ?\ ))) | 2113 | (/= (math-read-big-char math-rb-h1 (1+ v)) ?\ ))) |
| @@ -2166,7 +2166,7 @@ order to Calc's." | |||
| 2166 | ;; Binomial coefficient. | 2166 | ;; Binomial coefficient. |
| 2167 | ((and (= other-char ?\() | 2167 | ((and (= other-char ?\() |
| 2168 | (= (math-read-big-char (1+ math-rb-h1) v) ?\ ) | 2168 | (= (math-read-big-char (1+ math-rb-h1) v) ?\ ) |
| 2169 | (= (string-match "( *)" (nth v math-read-big-lines) | 2169 | (= (string-match "( *)" (nth v math-read-big-lines) |
| 2170 | math-rb-h1) math-rb-h1)) | 2170 | math-rb-h1) math-rb-h1)) |
| 2171 | (setq h (match-end 0)) | 2171 | (setq h (match-end 0)) |
| 2172 | (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t) | 2172 | (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t) |
| @@ -2180,7 +2180,7 @@ order to Calc's." | |||
| 2180 | 2180 | ||
| 2181 | ;; Minus sign. | 2181 | ;; Minus sign. |
| 2182 | ((= other-char ?\-) | 2182 | ((= other-char ?\-) |
| 2183 | (setq p (list 'neg (math-read-big-rec (1+ math-rb-h1) math-rb-v1 | 2183 | (setq p (list 'neg (math-read-big-rec (1+ math-rb-h1) math-rb-v1 |
| 2184 | math-rb-h2 math-rb-v2 v 250 t)) | 2184 | math-rb-h2 math-rb-v2 v 250 t)) |
| 2185 | v math-read-big-baseline | 2185 | v math-read-big-baseline |
| 2186 | h math-read-big-h2)) | 2186 | h math-read-big-h2)) |
| @@ -2199,10 +2199,10 @@ order to Calc's." | |||
| 2199 | (if (= sep ?\]) | 2199 | (if (= sep ?\]) |
| 2200 | (math-read-big-error (1- h) v "Expected `)'")) | 2200 | (math-read-big-error (1- h) v "Expected `)'")) |
| 2201 | (if (= sep ?\)) | 2201 | (if (= sep ?\)) |
| 2202 | (setq p (math-read-big-rec | 2202 | (setq p (math-read-big-rec |
| 2203 | (1+ math-rb-h1) math-rb-v1 (1- h) math-rb-v2 v)) | 2203 | (1+ math-rb-h1) math-rb-v1 (1- h) math-rb-v2 v)) |
| 2204 | (setq hmid (math-read-big-balance h v "(") | 2204 | (setq hmid (math-read-big-balance h v "(") |
| 2205 | p (list p | 2205 | p (list p |
| 2206 | (math-read-big-rec h math-rb-v1 (1- hmid) math-rb-v2 v)) | 2206 | (math-read-big-rec h math-rb-v1 (1- hmid) math-rb-v2 v)) |
| 2207 | h hmid) | 2207 | h hmid) |
| 2208 | (cond ((= sep ?\.) | 2208 | (cond ((= sep ?\.) |
| @@ -2347,7 +2347,7 @@ order to Calc's." | |||
| 2347 | (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t) | 2347 | (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t) |
| 2348 | (math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t))) | 2348 | (math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t))) |
| 2349 | 2349 | ||
| 2350 | ;; Now left term is bounded by math-rb-h1, math-rb-v1, h, math-rb-v2; | 2350 | ;; Now left term is bounded by math-rb-h1, math-rb-v1, h, math-rb-v2; |
| 2351 | ;; baseline = v. | 2351 | ;; baseline = v. |
| 2352 | (if baseline | 2352 | (if baseline |
| 2353 | (or (= v baseline) | 2353 | (or (= v baseline) |
| @@ -2389,12 +2389,12 @@ order to Calc's." | |||
| 2389 | (cond ((eq (nth 3 widest) -1) | 2389 | (cond ((eq (nth 3 widest) -1) |
| 2390 | (setq p (list (nth 1 widest) p))) | 2390 | (setq p (list (nth 1 widest) p))) |
| 2391 | ((equal (car widest) "?") | 2391 | ((equal (car widest) "?") |
| 2392 | (let ((y (math-read-big-rec h math-rb-v1 math-rb-h2 | 2392 | (let ((y (math-read-big-rec h math-rb-v1 math-rb-h2 |
| 2393 | math-rb-v2 baseline nil t))) | 2393 | math-rb-v2 baseline nil t))) |
| 2394 | (or (= (math-read-big-char math-read-big-h2 baseline) ?\:) | 2394 | (or (= (math-read-big-char math-read-big-h2 baseline) ?\:) |
| 2395 | (math-read-big-error math-read-big-h2 baseline "Expected `:'")) | 2395 | (math-read-big-error math-read-big-h2 baseline "Expected `:'")) |
| 2396 | (setq p (list (nth 1 widest) p y | 2396 | (setq p (list (nth 1 widest) p y |
| 2397 | (math-read-big-rec | 2397 | (math-read-big-rec |
| 2398 | (1+ math-read-big-h2) math-rb-v1 math-rb-h2 math-rb-v2 | 2398 | (1+ math-read-big-h2) math-rb-v1 math-rb-h2 math-rb-v2 |
| 2399 | baseline (nth 3 widest) t)) | 2399 | baseline (nth 3 widest) t)) |
| 2400 | h math-read-big-h2))) | 2400 | h math-read-big-h2))) |
| @@ -2483,5 +2483,9 @@ order to Calc's." | |||
| 2483 | 2483 | ||
| 2484 | (provide 'calc-lang) | 2484 | (provide 'calc-lang) |
| 2485 | 2485 | ||
| 2486 | ;; Local variables: | ||
| 2487 | ;; coding: utf-8 | ||
| 2488 | ;; End: | ||
| 2489 | |||
| 2486 | ;; arch-tag: 483bfe15-f290-4fef-bb7d-ce65be687f2e | 2490 | ;; arch-tag: 483bfe15-f290-4fef-bb7d-ce65be687f2e |
| 2487 | ;;; calc-lang.el ends here | 2491 | ;;; calc-lang.el ends here |
diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el index a994ace6fb6..f268a032d14 100644 --- a/lisp/calc/calc-poly.el +++ b/lisp/calc/calc-poly.el | |||
| @@ -663,7 +663,7 @@ | |||
| 663 | (cons 'vec (cons (nth 1 facs) (cons (list 'vec fac pow) | 663 | (cons 'vec (cons (nth 1 facs) (cons (list 'vec fac pow) |
| 664 | (cdr (cdr facs))))) | 664 | (cdr (cdr facs))))) |
| 665 | (cons 'vec (cons (list 'vec fac pow) (cdr facs)))))))) | 665 | (cons 'vec (cons (list 'vec fac pow) (cdr facs)))))))) |
| 666 | (math-mul (math-pow fac pow) facs))) | 666 | (math-mul (math-pow fac pow) (math-factor-protect facs)))) |
| 667 | 667 | ||
| 668 | (defun math-factor-poly-coefs (p &optional square-free) ; uses "x" | 668 | (defun math-factor-poly-coefs (p &optional square-free) ; uses "x" |
| 669 | (let (t1 t2 temp) | 669 | (let (t1 t2 temp) |
diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el index 8f73e71b0f9..b82ed08c557 100644 --- a/lisp/calc/calc-store.el +++ b/lisp/calc/calc-store.el | |||
| @@ -1,7 +1,7 @@ | |||
| 1 | ;;; calc-store.el --- value storage functions for Calc | 1 | ;;; calc-store.el --- value storage functions for Calc |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, | 3 | ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 2005, |
| 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. | 4 | ;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
| 5 | 5 | ||
| 6 | ;; Author: David Gillespie <daveg@synaptics.com> | 6 | ;; Author: David Gillespie <daveg@synaptics.com> |
| 7 | ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> | 7 | ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> |
| @@ -197,8 +197,8 @@ | |||
| 197 | (minibuffer-completion-predicate | 197 | (minibuffer-completion-predicate |
| 198 | (lambda (x) (boundp (intern (concat "var-" x))))) | 198 | (lambda (x) (boundp (intern (concat "var-" x))))) |
| 199 | (minibuffer-completion-confirm t)) | 199 | (minibuffer-completion-confirm t)) |
| 200 | (read-from-minibuffer | 200 | (read-from-minibuffer |
| 201 | prompt nil calc-var-name-map nil | 201 | prompt nil calc-var-name-map nil |
| 202 | 'calc-read-var-name-history))))) | 202 | 'calc-read-var-name-history))))) |
| 203 | (setq calc-aborted-prefix "") | 203 | (setq calc-aborted-prefix "") |
| 204 | (and (not (equal var "var-")) | 204 | (and (not (equal var "var-")) |
| @@ -677,5 +677,9 @@ | |||
| 677 | 677 | ||
| 678 | (provide 'calc-store) | 678 | (provide 'calc-store) |
| 679 | 679 | ||
| 680 | ;; Local variables: | ||
| 681 | ;; coding: utf-8 | ||
| 682 | ;; End: | ||
| 683 | |||
| 680 | ;; arch-tag: 2fbfec82-a521-42ca-bcd8-4f254ae6313e | 684 | ;; arch-tag: 2fbfec82-a521-42ca-bcd8-4f254ae6313e |
| 681 | ;;; calc-store.el ends here | 685 | ;;; calc-store.el ends here |
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index 6881db3fb12..a88e87dffbc 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el | |||
| @@ -1,7 +1,7 @@ | |||
| 1 | ;;; calc-units.el --- unit conversion functions for Calc | 1 | ;;; calc-units.el --- unit conversion functions for Calc |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, | 3 | ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 2005, |
| 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. | 4 | ;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
| 5 | 5 | ||
| 6 | ;; Author: David Gillespie <daveg@synaptics.com> | 6 | ;; Author: David Gillespie <daveg@synaptics.com> |
| 7 | ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> | 7 | ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> |
| @@ -323,7 +323,7 @@ that the combined units table will be rebuilt.") | |||
| 323 | ( ?c (^ 10 -2) "Centi" ) | 323 | ( ?c (^ 10 -2) "Centi" ) |
| 324 | ( ?m (^ 10 -3) "Milli" ) | 324 | ( ?m (^ 10 -3) "Milli" ) |
| 325 | ( ?u (^ 10 -6) "Micro" ) | 325 | ( ?u (^ 10 -6) "Micro" ) |
| 326 | ( ?μ (^ 10 -6) "Micro" ) | 326 | ( ?μ (^ 10 -6) "Micro" ) |
| 327 | ( ?n (^ 10 -9) "Nano" ) | 327 | ( ?n (^ 10 -9) "Nano" ) |
| 328 | ( ?p (^ 10 -12) "Pico" ) | 328 | ( ?p (^ 10 -12) "Pico" ) |
| 329 | ( ?f (^ 10 -15) "Femto" ) | 329 | ( ?f (^ 10 -15) "Femto" ) |
| @@ -1548,5 +1548,9 @@ If EXPR is nil, return nil." | |||
| 1548 | 1548 | ||
| 1549 | (provide 'calc-units) | 1549 | (provide 'calc-units) |
| 1550 | 1550 | ||
| 1551 | ;; Local variables: | ||
| 1552 | ;; coding: utf-8 | ||
| 1553 | ;; End: | ||
| 1554 | |||
| 1551 | ;; arch-tag: e993314f-3adc-4191-be61-4ef8874881c4 | 1555 | ;; arch-tag: e993314f-3adc-4191-be61-4ef8874881c4 |
| 1552 | ;;; calc-units.el ends here | 1556 | ;;; calc-units.el ends here |
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 587e376245b..7ea371dd16e 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el | |||
| @@ -419,7 +419,7 @@ in normal mode." | |||
| 419 | :group 'calc | 419 | :group 'calc |
| 420 | :type 'boolean) | 420 | :type 'boolean) |
| 421 | 421 | ||
| 422 | (defcustom calc-undo-length | 422 | (defcustom calc-undo-length |
| 423 | 100 | 423 | 100 |
| 424 | "The number of undo steps that will be preserved when Calc is quit." | 424 | "The number of undo steps that will be preserved when Calc is quit." |
| 425 | :group 'calc | 425 | :group 'calc |
| @@ -1233,7 +1233,7 @@ the trail buffer." | |||
| 1233 | ;; Eventually, prompt user with a list of buffers using embedded mode. | 1233 | ;; Eventually, prompt user with a list of buffers using embedded mode. |
| 1234 | (when (and | 1234 | (when (and |
| 1235 | info-list | 1235 | info-list |
| 1236 | (yes-or-no-p | 1236 | (yes-or-no-p |
| 1237 | (concat "This Calc stack is being used for embedded mode. Kill anyway?"))) | 1237 | (concat "This Calc stack is being used for embedded mode. Kill anyway?"))) |
| 1238 | (while info-list | 1238 | (while info-list |
| 1239 | (with-current-buffer (car (car info-list)) | 1239 | (with-current-buffer (car (car info-list)) |
| @@ -3409,7 +3409,7 @@ largest Emacs integer.") | |||
| 3409 | (Math-lessp a math-half-2-word-size)) | 3409 | (Math-lessp a math-half-2-word-size)) |
| 3410 | (and (Math-integer-negp a) | 3410 | (and (Math-integer-negp a) |
| 3411 | (require 'calc-ext) | 3411 | (require 'calc-ext) |
| 3412 | (let ((comparison | 3412 | (let ((comparison |
| 3413 | (math-compare (Math-integer-neg a) math-half-2-word-size))) | 3413 | (math-compare (Math-integer-neg a) math-half-2-word-size))) |
| 3414 | (or (= comparison 0) | 3414 | (or (= comparison 0) |
| 3415 | (= comparison -1)))))) | 3415 | (= comparison -1)))))) |
| @@ -3553,7 +3553,7 @@ largest Emacs integer.") | |||
| 3553 | (math-normalize | 3553 | (math-normalize |
| 3554 | (save-match-data | 3554 | (save-match-data |
| 3555 | (cond | 3555 | (cond |
| 3556 | 3556 | ||
| 3557 | ;; Integers (most common case) | 3557 | ;; Integers (most common case) |
| 3558 | ((string-match "\\` *\\([0-9]+\\) *\\'" s) | 3558 | ((string-match "\\` *\\([0-9]+\\) *\\'" s) |
| 3559 | (let ((digs (math-match-substring s 1))) | 3559 | (let ((digs (math-match-substring s 1))) |
| @@ -3565,22 +3565,22 @@ largest Emacs integer.") | |||
| 3565 | (if (<= (length digs) (* 2 math-bignum-digit-length)) | 3565 | (if (<= (length digs) (* 2 math-bignum-digit-length)) |
| 3566 | (string-to-number digs) | 3566 | (string-to-number digs) |
| 3567 | (cons 'bigpos (math-read-bignum digs)))))) | 3567 | (cons 'bigpos (math-read-bignum digs)))))) |
| 3568 | 3568 | ||
| 3569 | ;; Clean up the string if necessary | 3569 | ;; Clean up the string if necessary |
| 3570 | ((string-match "\\`\\(.*\\)[ \t\n]+\\([^\001]*\\)\\'" s) | 3570 | ((string-match "\\`\\(.*\\)[ \t\n]+\\([^\001]*\\)\\'" s) |
| 3571 | (math-read-number (concat (math-match-substring s 1) | 3571 | (math-read-number (concat (math-match-substring s 1) |
| 3572 | (math-match-substring s 2)))) | 3572 | (math-match-substring s 2)))) |
| 3573 | 3573 | ||
| 3574 | ;; Plus and minus signs | 3574 | ;; Plus and minus signs |
| 3575 | ((string-match "^[-_+]\\(.*\\)$" s) | 3575 | ((string-match "^[-_+]\\(.*\\)$" s) |
| 3576 | (let ((val (math-read-number (math-match-substring s 1)))) | 3576 | (let ((val (math-read-number (math-match-substring s 1)))) |
| 3577 | (and val (if (eq (aref s 0) ?+) val (math-neg val))))) | 3577 | (and val (if (eq (aref s 0) ?+) val (math-neg val))))) |
| 3578 | 3578 | ||
| 3579 | ;; Forms that require extensions module | 3579 | ;; Forms that require extensions module |
| 3580 | ((string-match "[^-+0-9eE.]" s) | 3580 | ((string-match "[^-+0-9eE.]" s) |
| 3581 | (require 'calc-ext) | 3581 | (require 'calc-ext) |
| 3582 | (math-read-number-fancy s)) | 3582 | (math-read-number-fancy s)) |
| 3583 | 3583 | ||
| 3584 | ;; Decimal point | 3584 | ;; Decimal point |
| 3585 | ((string-match "^\\([0-9]*\\)\\.\\([0-9]*\\)$" s) | 3585 | ((string-match "^\\([0-9]*\\)\\.\\([0-9]*\\)$" s) |
| 3586 | (let ((int (math-match-substring s 1)) | 3586 | (let ((int (math-match-substring s 1)) |
| @@ -3593,7 +3593,7 @@ largest Emacs integer.") | |||
| 3593 | (list 'float | 3593 | (list 'float |
| 3594 | (math-add (math-scale-int int flen) frac) | 3594 | (math-add (math-scale-int int flen) frac) |
| 3595 | (- flen))))))) | 3595 | (- flen))))))) |
| 3596 | 3596 | ||
| 3597 | ;; "e" notation | 3597 | ;; "e" notation |
| 3598 | ((string-match "^\\(.*\\)[eE]\\([-+]?[0-9]+\\)$" s) | 3598 | ((string-match "^\\(.*\\)[eE]\\([-+]?[0-9]+\\)$" s) |
| 3599 | (let ((mant (math-match-substring s 1)) | 3599 | (let ((mant (math-match-substring s 1)) |
| @@ -3604,7 +3604,7 @@ largest Emacs integer.") | |||
| 3604 | (and mant exp (Math-realp mant) (> exp -4000000) (< exp 4000000) | 3604 | (and mant exp (Math-realp mant) (> exp -4000000) (< exp 4000000) |
| 3605 | (let ((mant (math-float mant))) | 3605 | (let ((mant (math-float mant))) |
| 3606 | (list 'float (nth 1 mant) (+ (nth 2 mant) exp))))))) | 3606 | (list 'float (nth 1 mant) (+ (nth 2 mant) exp))))))) |
| 3607 | 3607 | ||
| 3608 | ;; Syntax error! | 3608 | ;; Syntax error! |
| 3609 | (t nil))))) | 3609 | (t nil))))) |
| 3610 | 3610 | ||
| @@ -3797,7 +3797,7 @@ See Info node `(calc)Defining Functions'." | |||
| 3797 | (setq unread-command-event nil) | 3797 | (setq unread-command-event nil) |
| 3798 | (setq unread-command-events nil))) | 3798 | (setq unread-command-events nil))) |
| 3799 | 3799 | ||
| 3800 | (defcalcmodevar math-2-word-size | 3800 | (defcalcmodevar math-2-word-size |
| 3801 | (math-read-number-simple "4294967296") | 3801 | (math-read-number-simple "4294967296") |
| 3802 | "Two to the power of `calc-word-size'.") | 3802 | "Two to the power of `calc-word-size'.") |
| 3803 | 3803 | ||
| @@ -3814,5 +3814,9 @@ See Info node `(calc)Defining Functions'." | |||
| 3814 | 3814 | ||
| 3815 | (provide 'calc) | 3815 | (provide 'calc) |
| 3816 | 3816 | ||
| 3817 | ;; Local variables: | ||
| 3818 | ;; coding: utf-8 | ||
| 3819 | ;; End: | ||
| 3820 | |||
| 3817 | ;; arch-tag: 0c3b170c-4ce6-4eaf-8d9b-5834d1fe938f | 3821 | ;; arch-tag: 0c3b170c-4ce6-4eaf-8d9b-5834d1fe938f |
| 3818 | ;;; calc.el ends here | 3822 | ;;; calc.el ends here |
diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el index c8efded9270..7aeb31c7719 100644 --- a/lisp/calc/calccomp.el +++ b/lisp/calc/calccomp.el | |||
| @@ -1,7 +1,7 @@ | |||
| 1 | ;;; calccomp.el --- composition functions for Calc | 1 | ;;; calccomp.el --- composition functions for Calc |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, | 3 | ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 2005, |
| 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. | 4 | ;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
| 5 | 5 | ||
| 6 | ;; Author: David Gillespie <daveg@synaptics.com> | 6 | ;; Author: David Gillespie <daveg@synaptics.com> |
| 7 | ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> | 7 | ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> |
| @@ -50,19 +50,19 @@ | |||
| 50 | ;;; | 50 | ;;; |
| 51 | ;;; (tag X C) Composition C corresponds to sub-expression X | 51 | ;;; (tag X C) Composition C corresponds to sub-expression X |
| 52 | 52 | ||
| 53 | ;; math-comp-just and math-comp-comma-spc are local to | 53 | ;; math-comp-just and math-comp-comma-spc are local to |
| 54 | ;; math-compose-expr, but are used by math-compose-matrix, which is | 54 | ;; math-compose-expr, but are used by math-compose-matrix, which is |
| 55 | ;; called by math-compose-expr | 55 | ;; called by math-compose-expr |
| 56 | (defvar math-comp-just) | 56 | (defvar math-comp-just) |
| 57 | (defvar math-comp-comma-spc) | 57 | (defvar math-comp-comma-spc) |
| 58 | 58 | ||
| 59 | ;; math-comp-vector-prec is local to math-compose-expr, but is used by | 59 | ;; math-comp-vector-prec is local to math-compose-expr, but is used by |
| 60 | ;; math-compose-matrix and math-compose-rows, which are called by | 60 | ;; math-compose-matrix and math-compose-rows, which are called by |
| 61 | ;; math-compose-expr. | 61 | ;; math-compose-expr. |
| 62 | (defvar math-comp-vector-prec) | 62 | (defvar math-comp-vector-prec) |
| 63 | 63 | ||
| 64 | ;; math-comp-left-bracket, math-comp-right-bracket and math-comp-comma are | 64 | ;; math-comp-left-bracket, math-comp-right-bracket and math-comp-comma are |
| 65 | ;; local to math-compose-expr, but are used by math-compose-rows, which is | 65 | ;; local to math-compose-expr, but are used by math-compose-rows, which is |
| 66 | ;; called by math-compose-expr. | 66 | ;; called by math-compose-expr. |
| 67 | (defvar math-comp-left-bracket) | 67 | (defvar math-comp-left-bracket) |
| 68 | (defvar math-comp-right-bracket) | 68 | (defvar math-comp-right-bracket) |
| @@ -100,7 +100,7 @@ | |||
| 100 | (list 'tag a (math-compose-expr a prec)))) | 100 | (list 'tag a (math-compose-expr a prec)))) |
| 101 | ((and (not (consp a)) (not (integerp a))) | 101 | ((and (not (consp a)) (not (integerp a))) |
| 102 | (concat "'" (prin1-to-string a))) | 102 | (concat "'" (prin1-to-string a))) |
| 103 | ((setq spfn (assq (car-safe a) | 103 | ((setq spfn (assq (car-safe a) |
| 104 | (get calc-language 'math-special-function-table))) | 104 | (get calc-language 'math-special-function-table))) |
| 105 | (setq spfn (cdr spfn)) | 105 | (setq spfn (cdr spfn)) |
| 106 | (if (consp spfn) | 106 | (if (consp spfn) |
| @@ -111,12 +111,12 @@ | |||
| 111 | (and (nth 1 calc-frac-format) (Math-integerp a))) | 111 | (and (nth 1 calc-frac-format) (Math-integerp a))) |
| 112 | (if (and | 112 | (if (and |
| 113 | calc-language | 113 | calc-language |
| 114 | (not (memq calc-language | 114 | (not (memq calc-language |
| 115 | '(flat big unform)))) | 115 | '(flat big unform)))) |
| 116 | (let ((aa (math-adjust-fraction a)) | 116 | (let ((aa (math-adjust-fraction a)) |
| 117 | (calc-frac-format nil)) | 117 | (calc-frac-format nil)) |
| 118 | (math-compose-expr (list '/ | 118 | (math-compose-expr (list '/ |
| 119 | (if (memq calc-language | 119 | (if (memq calc-language |
| 120 | calc-lang-slash-idiv) | 120 | calc-lang-slash-idiv) |
| 121 | (math-float (nth 1 aa)) | 121 | (math-float (nth 1 aa)) |
| 122 | (nth 1 aa)) | 122 | (nth 1 aa)) |
| @@ -281,22 +281,22 @@ | |||
| 281 | (cdr a) | 281 | (cdr a) |
| 282 | (if full rows 3) t))))) | 282 | (if full rows 3) t))))) |
| 283 | (if (or calc-full-vectors (< (length a) 7)) | 283 | (if (or calc-full-vectors (< (length a) 7)) |
| 284 | (if (and | 284 | (if (and |
| 285 | (setq spfn (get calc-language 'math-matrix-formatter)) | 285 | (setq spfn (get calc-language 'math-matrix-formatter)) |
| 286 | (math-matrixp a)) | 286 | (math-matrixp a)) |
| 287 | (funcall spfn a) | 287 | (funcall spfn a) |
| 288 | (list 'horiz | 288 | (list 'horiz |
| 289 | math-comp-left-bracket | 289 | math-comp-left-bracket |
| 290 | (math-compose-vector (cdr a) | 290 | (math-compose-vector (cdr a) |
| 291 | (concat math-comp-comma " ") | 291 | (concat math-comp-comma " ") |
| 292 | math-comp-vector-prec) | 292 | math-comp-vector-prec) |
| 293 | math-comp-right-bracket)) | 293 | math-comp-right-bracket)) |
| 294 | (list 'horiz | 294 | (list 'horiz |
| 295 | math-comp-left-bracket | 295 | math-comp-left-bracket |
| 296 | (math-compose-vector (list (nth 1 a) (nth 2 a) (nth 3 a)) | 296 | (math-compose-vector (list (nth 1 a) (nth 2 a) (nth 3 a)) |
| 297 | (concat math-comp-comma " ") | 297 | (concat math-comp-comma " ") |
| 298 | math-comp-vector-prec) | 298 | math-comp-vector-prec) |
| 299 | math-comp-comma | 299 | math-comp-comma |
| 300 | (if (setq spfn (get calc-language 'math-dots)) | 300 | (if (setq spfn (get calc-language 'math-dots)) |
| 301 | (concat " " spfn) | 301 | (concat " " spfn) |
| 302 | " ...") | 302 | " ...") |
| @@ -869,7 +869,7 @@ | |||
| 869 | math-comp-vector-prec) | 869 | math-comp-vector-prec) |
| 870 | (if (= col cols) | 870 | (if (= col cols) |
| 871 | "" | 871 | "" |
| 872 | (concat | 872 | (concat |
| 873 | math-comp-comma-spc " "))))) | 873 | math-comp-comma-spc " "))))) |
| 874 | a))) | 874 | a))) |
| 875 | res))) | 875 | res))) |
| @@ -880,7 +880,7 @@ | |||
| 880 | (if (<= count 0) | 880 | (if (<= count 0) |
| 881 | (if (< count 0) | 881 | (if (< count 0) |
| 882 | (math-compose-rows (cdr a) -1 nil) | 882 | (math-compose-rows (cdr a) -1 nil) |
| 883 | (cons (concat | 883 | (cons (concat |
| 884 | (let ((mdots (get calc-language 'math-dots))) | 884 | (let ((mdots (get calc-language 'math-dots))) |
| 885 | (if mdots | 885 | (if mdots |
| 886 | (concat " " mdots) | 886 | (concat " " mdots) |
| @@ -1119,7 +1119,7 @@ | |||
| 1119 | (if (memq prec '(196 201)) ")" ""))))) | 1119 | (if (memq prec '(196 201)) ")" ""))))) |
| 1120 | 1120 | ||
| 1121 | ;; The variables math-svo-c, math-svo-wid and math-svo-off are local | 1121 | ;; The variables math-svo-c, math-svo-wid and math-svo-off are local |
| 1122 | ;; to math-stack-value-offset in calc.el, but are used by | 1122 | ;; to math-stack-value-offset in calc.el, but are used by |
| 1123 | ;; math-stack-value-offset-fancy, which is called by math-stack-value-offset.. | 1123 | ;; math-stack-value-offset-fancy, which is called by math-stack-value-offset.. |
| 1124 | (defvar math-svo-c) | 1124 | (defvar math-svo-c) |
| 1125 | (defvar math-svo-wid) | 1125 | (defvar math-svo-wid) |
| @@ -1195,11 +1195,11 @@ | |||
| 1195 | ;;; of the formula. | 1195 | ;;; of the formula. |
| 1196 | 1196 | ||
| 1197 | ;; The variables math-comp-full-width, math-comp-highlight, math-comp-word, | 1197 | ;; The variables math-comp-full-width, math-comp-highlight, math-comp-word, |
| 1198 | ;; math-comp-level, math-comp-margin and math-comp-buf are local to | 1198 | ;; math-comp-level, math-comp-margin and math-comp-buf are local to |
| 1199 | ;; math-comp-to-string-flat, but are used by math-comp-to-string-flat-term, | 1199 | ;; math-comp-to-string-flat, but are used by math-comp-to-string-flat-term, |
| 1200 | ;; which is called by math-comp-to-string-flat. | 1200 | ;; which is called by math-comp-to-string-flat. |
| 1201 | ;; math-comp-highlight and math-comp-buf are also local to | 1201 | ;; math-comp-highlight and math-comp-buf are also local to |
| 1202 | ;; math-comp-simplify-term and math-comp-simplify respectively, but are used | 1202 | ;; math-comp-simplify-term and math-comp-simplify respectively, but are used |
| 1203 | ;; by math-comp-add-string. | 1203 | ;; by math-comp-add-string. |
| 1204 | (defvar math-comp-full-width) | 1204 | (defvar math-comp-full-width) |
| 1205 | (defvar math-comp-highlight) | 1205 | (defvar math-comp-highlight) |
| @@ -1244,7 +1244,7 @@ | |||
| 1244 | (cond ((not (consp c)) | 1244 | (cond ((not (consp c)) |
| 1245 | (if math-comp-highlight | 1245 | (if math-comp-highlight |
| 1246 | (setq c (math-comp-highlight-string c))) | 1246 | (setq c (math-comp-highlight-string c))) |
| 1247 | (setq math-comp-word (if (= (length math-comp-word) 0) c | 1247 | (setq math-comp-word (if (= (length math-comp-word) 0) c |
| 1248 | (concat math-comp-word c)) | 1248 | (concat math-comp-word c)) |
| 1249 | math-comp-pos (+ math-comp-pos (length c)))) | 1249 | math-comp-pos (+ math-comp-pos (length c)))) |
| 1250 | 1250 | ||
| @@ -1347,8 +1347,8 @@ | |||
| 1347 | 1347 | ||
| 1348 | 1348 | ||
| 1349 | ;; The variable math-comp-sel-tag is local to calc-find-selected-part | 1349 | ;; The variable math-comp-sel-tag is local to calc-find-selected-part |
| 1350 | ;; in calc-sel.el, but is used by math-comp-sel-flat-term and | 1350 | ;; in calc-sel.el, but is used by math-comp-sel-flat-term and |
| 1351 | ;; math-comp-add-string-sel, which are called (indirectly) by | 1351 | ;; math-comp-add-string-sel, which are called (indirectly) by |
| 1352 | ;; calc-find-selected-part. | 1352 | ;; calc-find-selected-part. |
| 1353 | (defvar math-comp-sel-tag) | 1353 | (defvar math-comp-sel-tag) |
| 1354 | 1354 | ||
| @@ -1668,5 +1668,9 @@ | |||
| 1668 | 1668 | ||
| 1669 | (provide 'calccomp) | 1669 | (provide 'calccomp) |
| 1670 | 1670 | ||
| 1671 | ;; Local variables: | ||
| 1672 | ;; coding: utf-8 | ||
| 1673 | ;; End: | ||
| 1674 | |||
| 1671 | ;; arch-tag: 7c45d10a-a286-4dab-af49-7ae8989fbf78 | 1675 | ;; arch-tag: 7c45d10a-a286-4dab-af49-7ae8989fbf78 |
| 1672 | ;;; calccomp.el ends here | 1676 | ;;; calccomp.el ends here |
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el index b403b7043d8..7fcaab9da34 100644 --- a/lisp/calendar/appt.el +++ b/lisp/calendar/appt.el | |||
| @@ -183,16 +183,25 @@ Only relevant if reminders are being displayed in a window." | |||
| 183 | (defconst appt-buffer-name "*appt-buf*" | 183 | (defconst appt-buffer-name "*appt-buf*" |
| 184 | "Name of the appointments buffer.") | 184 | "Name of the appointments buffer.") |
| 185 | 185 | ||
| 186 | ;; TODO Turn this into an alist? It would be easier to add more | ||
| 187 | ;; optional elements. | ||
| 188 | ;; TODO There should be a way to set WARNTIME (and other properties) | ||
| 189 | ;; from the diary-file. Implementing that would be a good reason | ||
| 190 | ;; to change this to an alist. | ||
| 186 | (defvar appt-time-msg-list nil | 191 | (defvar appt-time-msg-list nil |
| 187 | "The list of appointments for today. | 192 | "The list of appointments for today. |
| 188 | Use `appt-add' and `appt-delete' to add and delete appointments. | 193 | Use `appt-add' and `appt-delete' to add and delete appointments. |
| 189 | The original list is generated from today's `diary-entries-list', and | 194 | The original list is generated from today's `diary-entries-list', and |
| 190 | can be regenerated using the function `appt-check'. | 195 | can be regenerated using the function `appt-check'. |
| 191 | Each element of the generated list has the form (MINUTES STRING [FLAG]); where | 196 | Each element of the generated list has the form |
| 192 | MINUTES is the time in minutes of the appointment after midnight, and | 197 | \(MINUTES STRING [FLAG] [WARNTIME]) |
| 193 | STRING is the description of the appointment. | 198 | where MINUTES is the time in minutes of the appointment after midnight, |
| 194 | FLAG, if non-nil, says that the element was made with `appt-add' | 199 | and STRING is the description of the appointment. |
| 195 | so calling `appt-make-list' again should preserve it.") | 200 | FLAG and WARNTIME can only be present if the element was made |
| 201 | with `appt-add'. A non-nil FLAG indicates that the element was made | ||
| 202 | with `appt-add', so calling `appt-make-list' again should preserve it. | ||
| 203 | If WARNTIME is non-nil, it is an integer to use in place | ||
| 204 | of `appt-message-warning-time'.") | ||
| 196 | 205 | ||
| 197 | (defconst appt-max-time (1- (* 24 60)) | 206 | (defconst appt-max-time (1- (* 24 60)) |
| 198 | "11:59pm in minutes - number of minutes in a day minus 1.") | 207 | "11:59pm in minutes - number of minutes in a day minus 1.") |
| @@ -313,7 +322,7 @@ displayed in a window: | |||
| 313 | (zerop (mod prev-appt-display-count appt-display-interval)))) | 322 | (zerop (mod prev-appt-display-count appt-display-interval)))) |
| 314 | ;; Non-nil means only update the interval displayed in the mode line. | 323 | ;; Non-nil means only update the interval displayed in the mode line. |
| 315 | (mode-line-only (unless full-check appt-now-displayed)) | 324 | (mode-line-only (unless full-check appt-now-displayed)) |
| 316 | now cur-comp-time appt-comp-time) | 325 | now cur-comp-time appt-comp-time appt-warn-time) |
| 317 | (when (or full-check mode-line-only) | 326 | (when (or full-check mode-line-only) |
| 318 | (save-excursion | 327 | (save-excursion |
| 319 | ;; Convert current time to minutes after midnight (12.01am = 1). | 328 | ;; Convert current time to minutes after midnight (12.01am = 1). |
| @@ -353,6 +362,8 @@ displayed in a window: | |||
| 353 | ;; calculate the number of minutes until the appointment. | 362 | ;; calculate the number of minutes until the appointment. |
| 354 | (when (and appt-issue-message appt-time-msg-list) | 363 | (when (and appt-issue-message appt-time-msg-list) |
| 355 | (setq appt-comp-time (caar (car appt-time-msg-list)) | 364 | (setq appt-comp-time (caar (car appt-time-msg-list)) |
| 365 | appt-warn-time (or (nth 3 (car appt-time-msg-list)) | ||
| 366 | appt-message-warning-time) | ||
| 356 | min-to-app (- appt-comp-time cur-comp-time)) | 367 | min-to-app (- appt-comp-time cur-comp-time)) |
| 357 | (while (and appt-time-msg-list | 368 | (while (and appt-time-msg-list |
| 358 | (< appt-comp-time cur-comp-time)) | 369 | (< appt-comp-time cur-comp-time)) |
| @@ -360,21 +371,21 @@ displayed in a window: | |||
| 360 | (if appt-time-msg-list | 371 | (if appt-time-msg-list |
| 361 | (setq appt-comp-time (caar (car appt-time-msg-list))))) | 372 | (setq appt-comp-time (caar (car appt-time-msg-list))))) |
| 362 | ;; If we have an appointment between midnight and | 373 | ;; If we have an appointment between midnight and |
| 363 | ;; `appt-message-warning-time' minutes after midnight, we | 374 | ;; `appt-warn-time' minutes after midnight, we |
| 364 | ;; must begin to issue a message before midnight. Midnight | 375 | ;; must begin to issue a message before midnight. Midnight |
| 365 | ;; is considered 0 minutes and 11:59pm is 1439 | 376 | ;; is considered 0 minutes and 11:59pm is 1439 |
| 366 | ;; minutes. Therefore we must recalculate the minutes to | 377 | ;; minutes. Therefore we must recalculate the minutes to |
| 367 | ;; appointment variable. It is equal to the number of | 378 | ;; appointment variable. It is equal to the number of |
| 368 | ;; minutes before midnight plus the number of minutes after | 379 | ;; minutes before midnight plus the number of minutes after |
| 369 | ;; midnight our appointment is. | 380 | ;; midnight our appointment is. |
| 370 | (if (and (< appt-comp-time appt-message-warning-time) | 381 | (if (and (< appt-comp-time appt-warn-time) |
| 371 | (> (+ cur-comp-time appt-message-warning-time) | 382 | (> (+ cur-comp-time appt-warn-time) |
| 372 | appt-max-time)) | 383 | appt-max-time)) |
| 373 | (setq min-to-app (+ (- (1+ appt-max-time) cur-comp-time) | 384 | (setq min-to-app (+ (- (1+ appt-max-time) cur-comp-time) |
| 374 | appt-comp-time))) | 385 | appt-comp-time))) |
| 375 | ;; Issue warning if the appointment time is within | 386 | ;; Issue warning if the appointment time is within |
| 376 | ;; appt-message-warning time. | 387 | ;; appt-message-warning time. |
| 377 | (when (and (<= min-to-app appt-message-warning-time) | 388 | (when (and (<= min-to-app appt-warn-time) |
| 378 | (>= min-to-app 0)) | 389 | (>= min-to-app 0)) |
| 379 | (setq appt-now-displayed t | 390 | (setq appt-now-displayed t |
| 380 | appt-display-count (1+ prev-appt-display-count)) | 391 | appt-display-count (1+ prev-appt-display-count)) |
| @@ -470,14 +481,28 @@ Usually just deletes the appointment buffer." | |||
| 470 | "[0-9]?[0-9]\\(h\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]\\)\\(am\\|pm\\)?") | 481 | "[0-9]?[0-9]\\(h\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]\\)\\(am\\|pm\\)?") |
| 471 | 482 | ||
| 472 | ;;;###autoload | 483 | ;;;###autoload |
| 473 | (defun appt-add (new-appt-time new-appt-msg) | 484 | (defun appt-add (time msg &optional warntime) |
| 474 | "Add an appointment for today at NEW-APPT-TIME with message NEW-APPT-MSG. | 485 | "Add an appointment for today at TIME with message MSG. |
| 475 | The time should be in either 24 hour format or am/pm format." | 486 | The time should be in either 24 hour format or am/pm format. |
| 476 | (interactive "sTime (hh:mm[am/pm]): \nsMessage: ") | 487 | Optional argument WARNTIME is an integer (or string) giving the number |
| 477 | (unless (string-match appt-time-regexp new-appt-time) | 488 | of minutes before the appointment at which to start warning. |
| 489 | The default is `appt-message-warning-time'." | ||
| 490 | (interactive "sTime (hh:mm[am/pm]): \nsMessage: | ||
| 491 | sMinutes before the appointment to start warning: ") | ||
| 492 | (unless (string-match appt-time-regexp time) | ||
| 478 | (error "Unacceptable time-string")) | 493 | (error "Unacceptable time-string")) |
| 479 | (let ((time-msg (list (list (appt-convert-time new-appt-time)) | 494 | (and (stringp warntime) |
| 480 | (concat new-appt-time " " new-appt-msg) t))) | 495 | (setq warntime (unless (string-equal warntime "") |
| 496 | (string-to-number warntime)))) | ||
| 497 | (and warntime | ||
| 498 | (not (integerp warntime)) | ||
| 499 | (error "Argument WARNTIME must be an integer, or nil")) | ||
| 500 | (let ((time-msg (list (list (appt-convert-time time)) | ||
| 501 | (concat time " " msg) t))) | ||
| 502 | ;; It is presently non-sensical to have multiple warnings about | ||
| 503 | ;; the same appointment with just different delays, but it might | ||
| 504 | ;; not always be so. TODO | ||
| 505 | (if warntime (setq time-msg (append time-msg (list warntime)))) | ||
| 481 | (unless (member time-msg appt-time-msg-list) | 506 | (unless (member time-msg appt-time-msg-list) |
| 482 | (setq appt-time-msg-list | 507 | (setq appt-time-msg-list |
| 483 | (appt-sort-list (nconc appt-time-msg-list (list time-msg))))))) | 508 | (appt-sort-list (nconc appt-time-msg-list (list time-msg))))))) |
diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 218f2a51d7f..735023ceb02 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el | |||
| @@ -618,7 +618,7 @@ as well as widgets, buttons, overlays, and text properties." | |||
| 618 | ,@(if (not eight-bit-p) | 618 | ,@(if (not eight-bit-p) |
| 619 | (let ((unicodedata (describe-char-unicode-data char))) | 619 | (let ((unicodedata (describe-char-unicode-data char))) |
| 620 | (if unicodedata | 620 | (if unicodedata |
| 621 | (cons (list "Unicode data" " ") unicodedata)))))) | 621 | (cons (list "Unicode data" "") unicodedata)))))) |
| 622 | (setq max-width (apply 'max (mapcar (lambda (x) | 622 | (setq max-width (apply 'max (mapcar (lambda (x) |
| 623 | (if (cadr x) (length (car x)) 0)) | 623 | (if (cadr x) (length (car x)) 0)) |
| 624 | item-list))) | 624 | item-list))) |
| @@ -642,7 +642,8 @@ as well as widgets, buttons, overlays, and text properties." | |||
| 642 | (window-width)) | 642 | (window-width)) |
| 643 | (insert "\n") | 643 | (insert "\n") |
| 644 | (indent-to (1+ max-width))) | 644 | (indent-to (1+ max-width))) |
| 645 | (insert " " clm))) | 645 | (unless (zerop (length clm)) |
| 646 | (insert " " clm)))) | ||
| 646 | (insert "\n")))) | 647 | (insert "\n")))) |
| 647 | 648 | ||
| 648 | (when overlays | 649 | (when overlays |
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 325c7b1479f..b14c879fcf7 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el | |||
| @@ -282,7 +282,7 @@ Not documented | |||
| 282 | ;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist | 282 | ;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist |
| 283 | ;;;;;; do* do loop return-from return block etypecase typecase ecase | 283 | ;;;;;; do* do loop return-from return block etypecase typecase ecase |
| 284 | ;;;;;; case load-time-value eval-when destructuring-bind function* | 284 | ;;;;;; case load-time-value eval-when destructuring-bind function* |
| 285 | ;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "fbeedbf769c72fee9b4e0671957c1077") | 285 | ;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "36cafd5054969b5bb0b1ce6a21605fed") |
| 286 | ;;; Generated autoloads from cl-macs.el | 286 | ;;; Generated autoloads from cl-macs.el |
| 287 | 287 | ||
| 288 | (autoload 'gensym "cl-macs" "\ | 288 | (autoload 'gensym "cl-macs" "\ |
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 444178edb0c..694a06f8338 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el | |||
| @@ -438,7 +438,7 @@ It is a list of elements of the form either: | |||
| 438 | ;;;###autoload | 438 | ;;;###autoload |
| 439 | (defmacro destructuring-bind (args expr &rest body) | 439 | (defmacro destructuring-bind (args expr &rest body) |
| 440 | (let* ((bind-lets nil) (bind-forms nil) (bind-inits nil) | 440 | (let* ((bind-lets nil) (bind-forms nil) (bind-inits nil) |
| 441 | (bind-defs nil) (bind-block 'cl-none)) | 441 | (bind-defs nil) (bind-block 'cl-none) (bind-enquote nil)) |
| 442 | (cl-do-arglist (or args '(&aux)) expr) | 442 | (cl-do-arglist (or args '(&aux)) expr) |
| 443 | (append '(progn) bind-inits | 443 | (append '(progn) bind-inits |
| 444 | (list (nconc (list 'let* (nreverse bind-lets)) | 444 | (list (nconc (list 'let* (nreverse bind-lets)) |
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 8bf20b0ccef..43fb5762647 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el | |||
| @@ -885,17 +885,12 @@ already is one.)" | |||
| 885 | (edebug-storing-offsets (1- (point)) 'quote) | 885 | (edebug-storing-offsets (1- (point)) 'quote) |
| 886 | (edebug-read-storing-offsets stream))) | 886 | (edebug-read-storing-offsets stream))) |
| 887 | 887 | ||
| 888 | (defvar edebug-read-backquote-level 0 | ||
| 889 | "If non-zero, we're in a new-style backquote. | ||
| 890 | It should never be negative. This controls how we read comma constructs.") | ||
| 891 | |||
| 892 | (defun edebug-read-backquote (stream) | 888 | (defun edebug-read-backquote (stream) |
| 893 | ;; Turn `thing into (\` thing) | 889 | ;; Turn `thing into (\` thing) |
| 894 | (forward-char 1) | 890 | (forward-char 1) |
| 895 | (list | 891 | (list |
| 896 | (edebug-storing-offsets (1- (point)) '\`) | 892 | (edebug-storing-offsets (1- (point)) '\`) |
| 897 | (let ((edebug-read-backquote-level (1+ edebug-read-backquote-level))) | 893 | (edebug-read-storing-offsets stream))) |
| 898 | (edebug-read-storing-offsets stream)))) | ||
| 899 | 894 | ||
| 900 | (defun edebug-read-comma (stream) | 895 | (defun edebug-read-comma (stream) |
| 901 | ;; Turn ,thing into (\, thing). Handle ,@ and ,. also. | 896 | ;; Turn ,thing into (\, thing). Handle ,@ and ,. also. |
| @@ -910,12 +905,9 @@ It should never be negative. This controls how we read comma constructs.") | |||
| 910 | (forward-char 1))) | 905 | (forward-char 1))) |
| 911 | ;; Generate the same structure of offsets we would have | 906 | ;; Generate the same structure of offsets we would have |
| 912 | ;; if the resulting list appeared verbatim in the input text. | 907 | ;; if the resulting list appeared verbatim in the input text. |
| 913 | (if (zerop edebug-read-backquote-level) | 908 | (list |
| 914 | (edebug-storing-offsets opoint symbol) | 909 | (edebug-storing-offsets opoint symbol) |
| 915 | (list | 910 | (edebug-read-storing-offsets stream))))) |
| 916 | (edebug-storing-offsets opoint symbol) | ||
| 917 | (let ((edebug-read-backquote-level (1- edebug-read-backquote-level))) | ||
| 918 | (edebug-read-storing-offsets stream))))))) | ||
| 919 | 911 | ||
| 920 | (defun edebug-read-function (stream) | 912 | (defun edebug-read-function (stream) |
| 921 | ;; Turn #'thing into (function thing) | 913 | ;; Turn #'thing into (function thing) |
| @@ -937,17 +929,7 @@ It should never be negative. This controls how we read comma constructs.") | |||
| 937 | (prog1 | 929 | (prog1 |
| 938 | (let ((elements)) | 930 | (let ((elements)) |
| 939 | (while (not (memq (edebug-next-token-class) '(rparen dot))) | 931 | (while (not (memq (edebug-next-token-class) '(rparen dot))) |
| 940 | (if (and (eq (edebug-next-token-class) 'backquote) | 932 | (push (edebug-read-storing-offsets stream) elements)) |
| 941 | (null elements) | ||
| 942 | (zerop edebug-read-backquote-level)) | ||
| 943 | (progn | ||
| 944 | ;; Old style backquote. | ||
| 945 | (forward-char 1) ; Skip backquote. | ||
| 946 | ;; Call edebug-storing-offsets here so that we | ||
| 947 | ;; produce the same offsets we would have had | ||
| 948 | ;; if the backquote were an ordinary symbol. | ||
| 949 | (push (edebug-storing-offsets (1- (point)) '\`) elements)) | ||
| 950 | (push (edebug-read-storing-offsets stream) elements))) | ||
| 951 | (setq elements (nreverse elements)) | 933 | (setq elements (nreverse elements)) |
| 952 | (if (eq 'dot (edebug-next-token-class)) | 934 | (if (eq 'dot (edebug-next-token-class)) |
| 953 | (let (dotted-form) | 935 | (let (dotted-form) |
| @@ -4455,7 +4437,7 @@ With prefix argument, make it a temporary breakpoint." | |||
| 4455 | (add-hook 'cl-load-hook | 4437 | (add-hook 'cl-load-hook |
| 4456 | (function (lambda () (require 'cl-specs))))) | 4438 | (function (lambda () (require 'cl-specs))))) |
| 4457 | 4439 | ||
| 4458 | ;;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu | 4440 | ;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu |
| 4459 | (if (featurep 'cl-read) | 4441 | (if (featurep 'cl-read) |
| 4460 | (add-hook 'edebug-setup-hook | 4442 | (add-hook 'edebug-setup-hook |
| 4461 | (function (lambda () (require 'edebug-cl-read)))) | 4443 | (function (lambda () (require 'edebug-cl-read)))) |
| @@ -4466,8 +4448,8 @@ With prefix argument, make it a temporary breakpoint." | |||
| 4466 | 4448 | ||
| 4467 | ;;; Finalize Loading | 4449 | ;;; Finalize Loading |
| 4468 | 4450 | ||
| 4469 | ;;; Finally, hook edebug into the rest of Emacs. | 4451 | ;; Finally, hook edebug into the rest of Emacs. |
| 4470 | ;;; There are probably some other things that could go here. | 4452 | ;; There are probably some other things that could go here. |
| 4471 | 4453 | ||
| 4472 | ;; Install edebug read and eval functions. | 4454 | ;; Install edebug read and eval functions. |
| 4473 | (edebug-install-read-eval-functions) | 4455 | (edebug-install-read-eval-functions) |
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 364e3540703..876b9a468ac 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el | |||
| @@ -134,7 +134,7 @@ Assumes the caller has bound `macroexpand-all-environment'." | |||
| 134 | (maybe-cons fun | 134 | (maybe-cons fun |
| 135 | (maybe-cons (macroexpand-all-forms (cadr form) 2) | 135 | (maybe-cons (macroexpand-all-forms (cadr form) 2) |
| 136 | nil | 136 | nil |
| 137 | (cadr form)) | 137 | (cdr form)) |
| 138 | form) | 138 | form) |
| 139 | form)) | 139 | form)) |
| 140 | ((memq fun '(let let*)) | 140 | ((memq fun '(let let*)) |
| @@ -146,7 +146,7 @@ Assumes the caller has bound `macroexpand-all-environment'." | |||
| 146 | ((eq fun 'quote) | 146 | ((eq fun 'quote) |
| 147 | form) | 147 | form) |
| 148 | ((and (consp fun) (eq (car fun) 'lambda)) | 148 | ((and (consp fun) (eq (car fun) 'lambda)) |
| 149 | ;; embedded lambda | 149 | ;; Embedded lambda in function position. |
| 150 | (maybe-cons (macroexpand-all-forms fun 2) | 150 | (maybe-cons (macroexpand-all-forms fun 2) |
| 151 | (macroexpand-all-forms (cdr form)) | 151 | (macroexpand-all-forms (cdr form)) |
| 152 | form)) | 152 | form)) |
diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el new file mode 100644 index 00000000000..21bd7960d89 --- /dev/null +++ b/lisp/emacs-lisp/package-x.el | |||
| @@ -0,0 +1,220 @@ | |||
| 1 | ;;; package-x.el --- Package extras | ||
| 2 | |||
| 3 | ;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Tom Tromey <tromey@redhat.com> | ||
| 6 | ;; Created: 10 Mar 2007 | ||
| 7 | ;; Version: 0.9 | ||
| 8 | ;; Keywords: tools | ||
| 9 | |||
| 10 | ;; This file is part of GNU Emacs. | ||
| 11 | |||
| 12 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 13 | ;; it under the terms of the GNU General Public License as published by | ||
| 14 | ;; the Free Software Foundation; either version 3, or (at your option) | ||
| 15 | ;; any later version. | ||
| 16 | |||
| 17 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 20 | ;; GNU General Public License for more details. | ||
| 21 | |||
| 22 | ;; You should have received a copy of the GNU General Public License | ||
| 23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 24 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | ||
| 25 | ;; Boston, MA 02110-1301, USA. | ||
| 26 | |||
| 27 | ;;; Commentary: | ||
| 28 | |||
| 29 | ;; This file currently contains parts of the package system most | ||
| 30 | ;; people won't need, such as package uploading. | ||
| 31 | |||
| 32 | ;;; Code: | ||
| 33 | |||
| 34 | (require 'package) | ||
| 35 | (defvar gnus-article-buffer) | ||
| 36 | |||
| 37 | ;; Note that this only works if you have the password, which you | ||
| 38 | ;; probably don't :-). | ||
| 39 | (defvar package-archive-upload-base nil | ||
| 40 | "Base location for uploading to package archive.") | ||
| 41 | |||
| 42 | (defun package--encode (string) | ||
| 43 | "Encode a string by replacing some characters with XML entities." | ||
| 44 | ;; We need a special case for translating "&" to "&". | ||
| 45 | (let ((index)) | ||
| 46 | (while (setq index (string-match "[&]" string index)) | ||
| 47 | (setq string (replace-match "&" t nil string)) | ||
| 48 | (setq index (1+ index)))) | ||
| 49 | (while (string-match "[<]" string) | ||
| 50 | (setq string (replace-match "<" t nil string))) | ||
| 51 | (while (string-match "[>]" string) | ||
| 52 | (setq string (replace-match ">" t nil string))) | ||
| 53 | (while (string-match "[']" string) | ||
| 54 | (setq string (replace-match "'" t nil string))) | ||
| 55 | (while (string-match "[\"]" string) | ||
| 56 | (setq string (replace-match """ t nil string))) | ||
| 57 | string) | ||
| 58 | |||
| 59 | (defun package--make-rss-entry (title text) | ||
| 60 | (let ((date-string (format-time-string "%a, %d %B %Y %T %z"))) | ||
| 61 | (concat "<item>\n" | ||
| 62 | "<title>" (package--encode title) "</title>\n" | ||
| 63 | ;; FIXME: should have a link in the web page. | ||
| 64 | "<link>" package-archive-base "news.html</link>\n" | ||
| 65 | "<description>" (package--encode text) "</description>\n" | ||
| 66 | "<pubDate>" date-string "</pubDate>\n" | ||
| 67 | "</item>\n"))) | ||
| 68 | |||
| 69 | (defun package--make-html-entry (title text) | ||
| 70 | (concat "<li> " (format-time-string "%B %e") " - " | ||
| 71 | title " - " (package--encode text) | ||
| 72 | " </li>\n")) | ||
| 73 | |||
| 74 | (defun package--update-file (file location text) | ||
| 75 | (save-excursion | ||
| 76 | (let ((old-buffer (find-buffer-visiting file))) | ||
| 77 | (with-current-buffer (let ((find-file-visit-truename t)) | ||
| 78 | (or old-buffer (find-file-noselect file))) | ||
| 79 | (goto-char (point-min)) | ||
| 80 | (search-forward location) | ||
| 81 | (forward-line) | ||
| 82 | (insert text) | ||
| 83 | (let ((file-precious-flag t)) | ||
| 84 | (save-buffer)) | ||
| 85 | (unless old-buffer | ||
| 86 | (kill-buffer (current-buffer))))))) | ||
| 87 | |||
| 88 | (defun package-maint-add-news-item (title description) | ||
| 89 | "Add a news item to the ELPA web pages. | ||
| 90 | TITLE is the title of the news item. | ||
| 91 | DESCRIPTION is the text of the news item. | ||
| 92 | You need administrative access to ELPA to use this." | ||
| 93 | (interactive "sTitle: \nsText: ") | ||
| 94 | (package--update-file (concat package-archive-upload-base "elpa.rss") | ||
| 95 | "<description>" | ||
| 96 | (package--make-rss-entry title description)) | ||
| 97 | (package--update-file (concat package-archive-upload-base "news.html") | ||
| 98 | "New entries go here" | ||
| 99 | (package--make-html-entry title description))) | ||
| 100 | |||
| 101 | (defun package--update-news (package version description) | ||
| 102 | "Update the ELPA web pages when a package is uploaded." | ||
| 103 | (package-maint-add-news-item (concat package " version " version) | ||
| 104 | description)) | ||
| 105 | |||
| 106 | (defun package-upload-buffer-internal (pkg-info extension) | ||
| 107 | "Upload a package whose contents are in the current buffer. | ||
| 108 | PKG-INFO is the package info, see `package-buffer-info'. | ||
| 109 | EXTENSION is the file extension, a string. It can be either | ||
| 110 | \"el\" or \"tar\"." | ||
| 111 | (save-excursion | ||
| 112 | (save-restriction | ||
| 113 | (let* ((file-type (cond | ||
| 114 | ((equal extension "el") 'single) | ||
| 115 | ((equal extension "tar") 'tar) | ||
| 116 | (t (error "Unknown extension `%s'" extension)))) | ||
| 117 | (file-name (aref pkg-info 0)) | ||
| 118 | (pkg-name (intern file-name)) | ||
| 119 | (requires (aref pkg-info 1)) | ||
| 120 | (desc (if (string= (aref pkg-info 2) "") | ||
| 121 | (read-string "Description of package: ") | ||
| 122 | (aref pkg-info 2))) | ||
| 123 | (pkg-version (aref pkg-info 3)) | ||
| 124 | (commentary (aref pkg-info 4)) | ||
| 125 | (split-version (package-version-split pkg-version)) | ||
| 126 | (pkg-buffer (current-buffer)) | ||
| 127 | |||
| 128 | ;; Download latest archive-contents. | ||
| 129 | (buffer (url-retrieve-synchronously | ||
| 130 | (concat package-archive-base "archive-contents")))) | ||
| 131 | |||
| 132 | ;; Parse archive-contents. | ||
| 133 | (set-buffer buffer) | ||
| 134 | (package-handle-response) | ||
| 135 | (re-search-forward "^$" nil 'move) | ||
| 136 | (forward-char) | ||
| 137 | (delete-region (point-min) (point)) | ||
| 138 | (let ((contents (package-read-from-string | ||
| 139 | (buffer-substring-no-properties (point-min) | ||
| 140 | (point-max)))) | ||
| 141 | (new-desc (vector split-version requires desc file-type))) | ||
| 142 | (if (> (car contents) package-archive-version) | ||
| 143 | (error "Unrecognized archive version %d" (car contents))) | ||
| 144 | (let ((elt (assq pkg-name (cdr contents)))) | ||
| 145 | (if elt | ||
| 146 | (if (package-version-compare split-version | ||
| 147 | (package-desc-vers (cdr elt)) | ||
| 148 | '<=) | ||
| 149 | (error "New package has smaller version: %s" pkg-version) | ||
| 150 | (setcdr elt new-desc)) | ||
| 151 | (setq contents (cons (car contents) | ||
| 152 | (cons (cons pkg-name new-desc) | ||
| 153 | (cdr contents)))))) | ||
| 154 | |||
| 155 | ;; Now CONTENTS is the updated archive contents. Upload | ||
| 156 | ;; this and the package itself. For now we assume ELPA is | ||
| 157 | ;; writable via file primitives. | ||
| 158 | (let ((print-level nil) | ||
| 159 | (print-length nil)) | ||
| 160 | (write-region (concat (pp-to-string contents) "\n") | ||
| 161 | nil | ||
| 162 | (concat package-archive-upload-base | ||
| 163 | "archive-contents"))) | ||
| 164 | |||
| 165 | ;; If there is a commentary section, write it. | ||
| 166 | (when commentary | ||
| 167 | (write-region commentary nil | ||
| 168 | (concat package-archive-upload-base | ||
| 169 | (symbol-name pkg-name) "-readme.txt"))) | ||
| 170 | |||
| 171 | (set-buffer pkg-buffer) | ||
| 172 | (kill-buffer buffer) | ||
| 173 | (write-region (point-min) (point-max) | ||
| 174 | (concat package-archive-upload-base | ||
| 175 | file-name "-" pkg-version | ||
| 176 | "." extension) | ||
| 177 | nil nil nil 'excl) | ||
| 178 | |||
| 179 | ;; Write a news entry. | ||
| 180 | (package--update-news (concat file-name "." extension) | ||
| 181 | pkg-version desc) | ||
| 182 | |||
| 183 | ;; special-case "package": write a second copy so that the | ||
| 184 | ;; installer can easily find the latest version. | ||
| 185 | (if (string= file-name "package") | ||
| 186 | (write-region (point-min) (point-max) | ||
| 187 | (concat package-archive-upload-base | ||
| 188 | file-name "." extension) | ||
| 189 | nil nil nil 'ask))))))) | ||
| 190 | |||
| 191 | (defun package-upload-buffer () | ||
| 192 | "Upload a single .el file to ELPA from the current buffer." | ||
| 193 | (interactive) | ||
| 194 | (save-excursion | ||
| 195 | (save-restriction | ||
| 196 | ;; Find the package in this buffer. | ||
| 197 | (let ((pkg-info (package-buffer-info))) | ||
| 198 | (package-upload-buffer-internal pkg-info "el"))))) | ||
| 199 | |||
| 200 | (defun package-upload-file (file) | ||
| 201 | (interactive "fPackage file name: ") | ||
| 202 | (with-temp-buffer | ||
| 203 | (insert-file-contents-literally file) | ||
| 204 | (let ((info (cond | ||
| 205 | ((string-match "\\.tar$" file) (package-tar-file-info file)) | ||
| 206 | ((string-match "\\.el$" file) (package-buffer-info)) | ||
| 207 | (t (error "Unrecognized extension `%s'" | ||
| 208 | (file-name-extension file)))))) | ||
| 209 | (package-upload-buffer-internal info (file-name-extension file))))) | ||
| 210 | |||
| 211 | (defun package-gnus-summary-upload () | ||
| 212 | "Upload a package contained in the current *Article* buffer. | ||
| 213 | This should be invoked from the gnus *Summary* buffer." | ||
| 214 | (interactive) | ||
| 215 | (with-current-buffer gnus-article-buffer | ||
| 216 | (package-upload-buffer))) | ||
| 217 | |||
| 218 | (provide 'package-x) | ||
| 219 | |||
| 220 | ;;; package.el ends here | ||
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el new file mode 100644 index 00000000000..c6035442313 --- /dev/null +++ b/lisp/emacs-lisp/package.el | |||
| @@ -0,0 +1,1563 @@ | |||
| 1 | ;;; package.el --- Simple package system for Emacs | ||
| 2 | |||
| 3 | ;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Tom Tromey <tromey@redhat.com> | ||
| 6 | ;; Created: 10 Mar 2007 | ||
| 7 | ;; Version: 0.9 | ||
| 8 | ;; Keywords: tools | ||
| 9 | |||
| 10 | ;; This file is part of GNU Emacs. | ||
| 11 | |||
| 12 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 13 | ;; it under the terms of the GNU General Public License as published by | ||
| 14 | ;; the Free Software Foundation; either version 3, or (at your option) | ||
| 15 | ;; any later version. | ||
| 16 | |||
| 17 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 20 | ;; GNU General Public License for more details. | ||
| 21 | |||
| 22 | ;; You should have received a copy of the GNU General Public License | ||
| 23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 24 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | ||
| 25 | ;; Boston, MA 02110-1301, USA. | ||
| 26 | |||
| 27 | ;;; Change Log: | ||
| 28 | |||
| 29 | ;; 2 Apr 2007 - now using ChangeLog file | ||
| 30 | ;; 15 Mar 2007 - updated documentation | ||
| 31 | ;; 14 Mar 2007 - Changed how obsolete packages are handled | ||
| 32 | ;; 13 Mar 2007 - Wrote package-install-from-buffer | ||
| 33 | ;; 12 Mar 2007 - Wrote package-menu mode | ||
| 34 | |||
| 35 | ;;; Commentary: | ||
| 36 | |||
| 37 | ;; The idea behind package.el is to be able to download packages and | ||
| 38 | ;; install them. Packages are versioned and have versioned | ||
| 39 | ;; dependencies. Furthermore, this supports built-in packages which | ||
| 40 | ;; may or may not be newer than user-specified packages. This makes | ||
| 41 | ;; it possible to upgrade Emacs and automatically disable packages | ||
| 42 | ;; which have moved from external to core. (Note though that we don't | ||
| 43 | ;; currently register any of these, so this feature does not actually | ||
| 44 | ;; work.) | ||
| 45 | |||
| 46 | ;; This code supports a single package repository, ELPA. All packages | ||
| 47 | ;; must be registered there. | ||
| 48 | |||
| 49 | ;; A package is described by its name and version. The distribution | ||
| 50 | ;; format is either a tar file or a single .el file. | ||
| 51 | |||
| 52 | ;; A tar file should be named "NAME-VERSION.tar". The tar file must | ||
| 53 | ;; unpack into a directory named after the package and version: | ||
| 54 | ;; "NAME-VERSION". It must contain a file named "PACKAGE-pkg.el" | ||
| 55 | ;; which consists of a call to define-package. It may also contain a | ||
| 56 | ;; "dir" file and the info files it references. | ||
| 57 | |||
| 58 | ;; A .el file will be named "NAME-VERSION.el" in ELPA, but will be | ||
| 59 | ;; installed as simply "NAME.el" in a directory named "NAME-VERSION". | ||
| 60 | |||
| 61 | ;; The downloader will download all dependent packages. It will also | ||
| 62 | ;; byte-compile the package's lisp at install time. | ||
| 63 | |||
| 64 | ;; At activation time we will set up the load-path and the info path, | ||
| 65 | ;; and we will load the package's autoloads. If a package's | ||
| 66 | ;; dependencies are not available, we will not activate that package. | ||
| 67 | |||
| 68 | ;; Conceptually a package has multiple state transitions: | ||
| 69 | ;; | ||
| 70 | ;; * Download. Fetching the package from ELPA. | ||
| 71 | ;; * Install. Untar the package, or write the .el file, into | ||
| 72 | ;; ~/.emacs.d/elpa/ directory. | ||
| 73 | ;; * Byte compile. Currently this phase is done during install, | ||
| 74 | ;; but we may change this. | ||
| 75 | ;; * Activate. Evaluate the autoloads for the package to make it | ||
| 76 | ;; available to the user. | ||
| 77 | ;; * Load. Actually load the package and run some code from it. | ||
| 78 | |||
| 79 | ;; Other external functions you may want to use: | ||
| 80 | ;; | ||
| 81 | ;; M-x package-list-packages | ||
| 82 | ;; Enters a mode similar to buffer-menu which lets you manage | ||
| 83 | ;; packages. You can choose packages for install (mark with "i", | ||
| 84 | ;; then "x" to execute) or deletion (not implemented yet), and you | ||
| 85 | ;; can see what packages are available. This will automatically | ||
| 86 | ;; fetch the latest list of packages from ELPA. | ||
| 87 | ;; | ||
| 88 | ;; M-x package-list-packages-no-fetch | ||
| 89 | ;; Like package-list-packages, but does not automatically fetch the | ||
| 90 | ;; new list of packages. | ||
| 91 | ;; | ||
| 92 | ;; M-x package-install-from-buffer | ||
| 93 | ;; Install a package consisting of a single .el file that appears | ||
| 94 | ;; in the current buffer. This only works for packages which | ||
| 95 | ;; define a Version header properly; package.el also supports the | ||
| 96 | ;; extension headers Package-Version (in case Version is an RCS id | ||
| 97 | ;; or similar), and Package-Requires (if the package requires other | ||
| 98 | ;; packages). | ||
| 99 | ;; | ||
| 100 | ;; M-x package-install-file | ||
| 101 | ;; Install a package from the indicated file. The package can be | ||
| 102 | ;; either a tar file or a .el file. A tar file must contain an | ||
| 103 | ;; appropriately-named "-pkg.el" file; a .el file must be properly | ||
| 104 | ;; formatted as with package-install-from-buffer. | ||
| 105 | |||
| 106 | ;;; Thanks: | ||
| 107 | ;;; (sorted by sort-lines): | ||
| 108 | |||
| 109 | ;; Jim Blandy <jimb@red-bean.com> | ||
| 110 | ;; Karl Fogel <kfogel@red-bean.com> | ||
| 111 | ;; Kevin Ryde <user42@zip.com.au> | ||
| 112 | ;; Lawrence Mitchell | ||
| 113 | ;; Michael Olson <mwolson@member.fsf.org> | ||
| 114 | ;; Sebastian Tennant <sebyte@smolny.plus.com> | ||
| 115 | ;; Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 116 | ;; Vinicius Jose Latorre <viniciusjl@ig.com.br> | ||
| 117 | ;; Phil Hagelberg <phil@hagelb.org> | ||
| 118 | |||
| 119 | ;;; ToDo: | ||
| 120 | |||
| 121 | ;; - putting info dirs at the start of the info path means | ||
| 122 | ;; users see a weird ordering of categories. OTOH we want to | ||
| 123 | ;; override later entries. maybe emacs needs to enforce | ||
| 124 | ;; the standard layout? | ||
| 125 | ;; - put bytecode in a separate directory tree | ||
| 126 | ;; - perhaps give users a way to recompile their bytecode | ||
| 127 | ;; or do it automatically when emacs changes | ||
| 128 | ;; - give users a way to know whether a package is installed ok | ||
| 129 | ;; - give users a way to view a package's documentation when it | ||
| 130 | ;; only appears in the .el | ||
| 131 | ;; - use/extend checkdoc so people can tell if their package will work | ||
| 132 | ;; - "installed" instead of a blank in the status column | ||
| 133 | ;; - tramp needs its files to be compiled in a certain order. | ||
| 134 | ;; how to handle this? fix tramp? | ||
| 135 | ;; - on emacs 21 we don't kill the -autoloads.el buffer. what about 22? | ||
| 136 | ;; - maybe we need separate .elc directories for various emacs versions | ||
| 137 | ;; and also emacs-vs-xemacs. That way conditional compilation can | ||
| 138 | ;; work. But would this break anything? | ||
| 139 | ;; - should store the package's keywords in archive-contents, then | ||
| 140 | ;; let the users filter the package-menu by keyword. See | ||
| 141 | ;; finder-by-keyword. (We could also let people view the | ||
| 142 | ;; Commentary, but it isn't clear how useful this is.) | ||
| 143 | ;; - William Xu suggests being able to open a package file without | ||
| 144 | ;; installing it | ||
| 145 | ;; - Interface with desktop.el so that restarting after an install | ||
| 146 | ;; works properly | ||
| 147 | ;; - Implement M-x package-upgrade, to upgrade any/all existing packages | ||
| 148 | ;; - Use hierarchical layout. PKG/etc PKG/lisp PKG/info | ||
| 149 | ;; ... except maybe lisp? | ||
| 150 | ;; - It may be nice to have a macro that expands to the package's | ||
| 151 | ;; private data dir, aka ".../etc". Or, maybe data-directory | ||
| 152 | ;; needs to be a list (though this would be less nice) | ||
| 153 | ;; a few packages want this, eg sokoban | ||
| 154 | ;; - package menu needs: | ||
| 155 | ;; ability to know which packages are built-in & thus not deletable | ||
| 156 | ;; it can sometimes print odd results, like 0.3 available but 0.4 active | ||
| 157 | ;; why is that? | ||
| 158 | ;; - Allow multiple versions on the server...? | ||
| 159 | ;; [ why bother? ] | ||
| 160 | ;; - Don't install a package which will invalidate dependencies overall | ||
| 161 | ;; - Allow something like (or (>= emacs 21.0) (>= xemacs 21.5)) | ||
| 162 | ;; [ currently thinking, why bother.. KISS ] | ||
| 163 | ;; - Allow optional package dependencies | ||
| 164 | ;; then if we require 'bbdb', bbdb-specific lisp in lisp/bbdb | ||
| 165 | ;; and just don't compile to add to load path ...? | ||
| 166 | ;; - Have a list of archive URLs? [ maybe there's no point ] | ||
| 167 | ;; - David Kastrup pointed out on the xemacs list that for GPL it | ||
| 168 | ;; is friendlier to ship the source tree. We could "support" that | ||
| 169 | ;; by just having a "src" subdir in the package. This isn't ideal | ||
| 170 | ;; but it probably is not worth trying to support random source | ||
| 171 | ;; tree layouts, build schemes, etc. | ||
| 172 | ;; - Our treatment of the info path is somewhat bogus | ||
| 173 | ;; - perhaps have an "unstable" tree in ELPA as well as a stable one | ||
| 174 | |||
| 175 | ;;; Code: | ||
| 176 | |||
| 177 | (defgroup package nil | ||
| 178 | "Manager for Emacs Lisp packages." | ||
| 179 | :group 'applications | ||
| 180 | :version "24.1") | ||
| 181 | |||
| 182 | ;;;###autoload | ||
| 183 | (defcustom package-enable-at-startup t | ||
| 184 | "Whether to activate installed packages when Emacs starts. | ||
| 185 | If non-nil, packages are activated after reading the init file | ||
| 186 | and before `after-init-hook'. Activation is not done if | ||
| 187 | `user-init-file' is nil (e.g. Emacs was started with \"-q\"). | ||
| 188 | |||
| 189 | Even if the value is nil, you can type \\[package-initialize] to | ||
| 190 | activate the package system at any time." | ||
| 191 | :type 'boolean | ||
| 192 | :group 'package | ||
| 193 | :version "24.1") | ||
| 194 | |||
| 195 | (defcustom package-load-list '(all) | ||
| 196 | "List of packages for `package-initialize' to load. | ||
| 197 | Each element in this list should be a list (NAME VERSION), or the | ||
| 198 | symbol `all'. The symbol `all' says to load the latest installed | ||
| 199 | versions of all packages not specified by other elements. | ||
| 200 | |||
| 201 | For an element (NAME VERSION), NAME is a package name (a symbol). | ||
| 202 | VERSION should be t, a string, or nil. | ||
| 203 | If VERSION is t, all versions are loaded, though obsolete ones | ||
| 204 | will be put in `package-obsolete-alist' and not activated. | ||
| 205 | If VERSION is a string, only that version is ever loaded. | ||
| 206 | Any other version, even if newer, is silently ignored. | ||
| 207 | Hence, the package is \"held\" at that version. | ||
| 208 | If VERSION is nil, the package is not loaded (it is \"disabled\")." | ||
| 209 | :type '(repeat symbol) | ||
| 210 | :group 'package | ||
| 211 | :version "24.1") | ||
| 212 | |||
| 213 | (defvar Info-directory-list) | ||
| 214 | (declare-function info-initialize "info" ()) | ||
| 215 | (declare-function url-http-parse-response "url-http" ()) | ||
| 216 | (declare-function lm-header "lisp-mnt" (header)) | ||
| 217 | (declare-function lm-commentary "lisp-mnt" (&optional file)) | ||
| 218 | (declare-function dired-delete-file "dired" (file &optional recursive trash)) | ||
| 219 | |||
| 220 | (defconst package-archive-base "http://elpa.gnu.org/packages/" | ||
| 221 | "Base URL for the Emacs Lisp Package Archive (ELPA). | ||
| 222 | Ordinarily you should not need to change this. | ||
| 223 | Note that some code in package.el assumes that this is an http: URL.") | ||
| 224 | |||
| 225 | (defconst package-archive-version 1 | ||
| 226 | "Version number of the package archive understood by this file. | ||
| 227 | Lower version numbers than this will probably be understood as well.") | ||
| 228 | |||
| 229 | (defconst package-el-version "1.0" | ||
| 230 | "Version of package.el.") | ||
| 231 | |||
| 232 | ;; We don't prime the cache since it tends to get out of date. | ||
| 233 | (defvar package-archive-contents nil | ||
| 234 | "Cache of the contents of the Emacs Lisp Package Archive. | ||
| 235 | This is an alist mapping package names (symbols) to package | ||
| 236 | descriptor vectors. These are like the vectors for `package-alist' | ||
| 237 | but have an extra entry which is 'tar for tar packages and | ||
| 238 | 'single for single-file packages.") | ||
| 239 | |||
| 240 | (defcustom package-user-dir (locate-user-emacs-file "elpa") | ||
| 241 | "Directory containing the user's Emacs Lisp packages. | ||
| 242 | The directory name should be absolute. | ||
| 243 | Apart from this directory, Emacs also looks for system-wide | ||
| 244 | packages in `package-directory-list'." | ||
| 245 | :type 'directory | ||
| 246 | :group 'package | ||
| 247 | :version "24.1") | ||
| 248 | |||
| 249 | (defcustom package-directory-list | ||
| 250 | ;; Defaults are subdirs named "elpa" in the site-lisp dirs. | ||
| 251 | (let (result) | ||
| 252 | (dolist (f load-path) | ||
| 253 | (if (equal (file-name-nondirectory f) "site-lisp") | ||
| 254 | (push (expand-file-name "elpa" f) result))) | ||
| 255 | (nreverse result)) | ||
| 256 | "List of additional directories containing Emacs Lisp packages. | ||
| 257 | Each directory name should be absolute. | ||
| 258 | |||
| 259 | These directories contain packages intended for system-wide; in | ||
| 260 | contrast, `package-user-dir' contains packages for personal use." | ||
| 261 | :type '(repeat directory) | ||
| 262 | :group 'package | ||
| 263 | :version "24.1") | ||
| 264 | |||
| 265 | (defun package-version-split (string) | ||
| 266 | "Split a package string into a version list." | ||
| 267 | (mapcar 'string-to-int (split-string string "[.]"))) | ||
| 268 | |||
| 269 | (defconst package--builtins-base | ||
| 270 | ;; We use package-version split here to make sure to pick up the | ||
| 271 | ;; minor version. | ||
| 272 | `((emacs . [,(package-version-split emacs-version) nil | ||
| 273 | "GNU Emacs"]) | ||
| 274 | (package . [,(package-version-split package-el-version) | ||
| 275 | nil "Simple package system for GNU Emacs"])) | ||
| 276 | "Packages which are always built-in.") | ||
| 277 | |||
| 278 | (defvar package--builtins | ||
| 279 | (delq nil | ||
| 280 | (append | ||
| 281 | package--builtins-base | ||
| 282 | (if (>= emacs-major-version 22) | ||
| 283 | ;; FIXME: emacs 22 includes tramp, rcirc, maybe | ||
| 284 | ;; other things... | ||
| 285 | '((erc . [(5 2) nil "An Emacs Internet Relay Chat client"]) | ||
| 286 | ;; The external URL is version 1.15, so make sure the | ||
| 287 | ;; built-in one looks newer. | ||
| 288 | (url . [(1 16) nil "URL handling libary"]))) | ||
| 289 | (if (>= emacs-major-version 23) | ||
| 290 | '(;; Strangely, nxml-version is missing in Emacs 23. | ||
| 291 | ;; We pick the merge date as the version. | ||
| 292 | (nxml . [(20071123) nil "Major mode for editing XML documents."]) | ||
| 293 | (bubbles . [(0 5) nil "Puzzle game for Emacs."]))))) | ||
| 294 | "Alist of all built-in packages. | ||
| 295 | Maps the package name to a vector [VERSION REQS DOCSTRING].") | ||
| 296 | |||
| 297 | (defvar package-alist package--builtins | ||
| 298 | "Alist of all packages available for activation. | ||
| 299 | This maps the package name to a vector [VERSION REQS DOCSTRING]. | ||
| 300 | |||
| 301 | The value is generated by `package-load-descriptor', usually | ||
| 302 | called via `package-initialize'. For user customizations of | ||
| 303 | which packages to load/activate, see `package-load-list'.") | ||
| 304 | |||
| 305 | (defvar package-activated-list | ||
| 306 | (mapcar #'car package-alist) | ||
| 307 | "List of the names of currently activated packages.") | ||
| 308 | |||
| 309 | (defvar package-obsolete-alist nil | ||
| 310 | "Representation of obsolete packages. | ||
| 311 | Like `package-alist', but maps package name to a second alist. | ||
| 312 | The inner alist is keyed by version.") | ||
| 313 | |||
| 314 | (defconst package-subdirectory-regexp | ||
| 315 | "^\\([^.].*\\)-\\([0-9]+\\(?:[.][0-9]+\\)*\\)$" | ||
| 316 | "Regular expression matching the name of a package subdirectory. | ||
| 317 | The first subexpression is the package name. | ||
| 318 | The second subexpression is the version string.") | ||
| 319 | |||
| 320 | (defun package-version-join (l) | ||
| 321 | "Turn a list of version numbers into a version string." | ||
| 322 | (mapconcat 'int-to-string l ".")) | ||
| 323 | |||
| 324 | (defun package--version-first-nonzero (l) | ||
| 325 | (while (and l (= (car l) 0)) | ||
| 326 | (setq l (cdr l))) | ||
| 327 | (if l (car l) 0)) | ||
| 328 | |||
| 329 | (defun package-version-compare (v1 v2 fun) | ||
| 330 | "Compare two version lists according to FUN. | ||
| 331 | FUN can be <, <=, =, >, >=, or /=." | ||
| 332 | (while (and v1 v2 (= (car v1) (car v2))) | ||
| 333 | (setq v1 (cdr v1) | ||
| 334 | v2 (cdr v2))) | ||
| 335 | (if v1 | ||
| 336 | (if v2 | ||
| 337 | ;; Both not null; we know the cars are not =. | ||
| 338 | (funcall fun (car v1) (car v2)) | ||
| 339 | ;; V1 not null, V2 null. | ||
| 340 | (funcall fun (package--version-first-nonzero v1) 0)) | ||
| 341 | (if v2 | ||
| 342 | ;; V1 null, V2 not null. | ||
| 343 | (funcall fun 0 (package--version-first-nonzero v2)) | ||
| 344 | ;; Both null. | ||
| 345 | (funcall fun 0 0)))) | ||
| 346 | |||
| 347 | (defun package--test-version-compare () | ||
| 348 | "Test suite for `package-version-compare'." | ||
| 349 | (unless (and (package-version-compare '(0) '(0) '=) | ||
| 350 | (not (package-version-compare '(1) '(0) '=)) | ||
| 351 | (package-version-compare '(1 0 1) '(1) '>=) | ||
| 352 | (package-version-compare '(1 0 1) '(1) '>) | ||
| 353 | (not (package-version-compare '(0 9 1) '(1 0 2) '>=))) | ||
| 354 | (error "Failed")) | ||
| 355 | t) | ||
| 356 | |||
| 357 | (defun package-strip-version (dirname) | ||
| 358 | "Strip the version from a combined package name and version. | ||
| 359 | E.g., if given \"quux-23.0\", will return \"quux\"" | ||
| 360 | (if (string-match package-subdirectory-regexp dirname) | ||
| 361 | (match-string 1 dirname))) | ||
| 362 | |||
| 363 | (defun package-load-descriptor (dir package) | ||
| 364 | "Load the description file for a package. | ||
| 365 | DIR is the directory in which to find the package subdirectory, | ||
| 366 | and PACKAGE is the name of the package subdirectory. | ||
| 367 | Return nil if the package could not be found." | ||
| 368 | (let ((pkg-dir (expand-file-name package dir))) | ||
| 369 | (if (file-directory-p pkg-dir) | ||
| 370 | (load (expand-file-name (concat (package-strip-version package) | ||
| 371 | "-pkg") | ||
| 372 | pkg-dir) | ||
| 373 | nil t)))) | ||
| 374 | |||
| 375 | (defun package-load-all-descriptors () | ||
| 376 | "Load descriptors for installed Emacs Lisp packages. | ||
| 377 | This looks for package subdirectories in `package-user-dir' and | ||
| 378 | `package-directory-list'. The variable `package-load-list' | ||
| 379 | controls which package subdirectories may be loaded. | ||
| 380 | |||
| 381 | In each valid package subdirectory, this function loads the | ||
| 382 | description file containing a call to `define-package', which | ||
| 383 | updates `package-alist' and `package-obsolete-alist'." | ||
| 384 | (let ((all (memq 'all package-load-list)) | ||
| 385 | name version force) | ||
| 386 | (dolist (dir (cons package-user-dir package-directory-list)) | ||
| 387 | (when (file-directory-p dir) | ||
| 388 | (dolist (subdir (directory-files dir)) | ||
| 389 | (when (and (file-directory-p (expand-file-name subdir dir)) | ||
| 390 | (string-match package-subdirectory-regexp subdir)) | ||
| 391 | (setq name (intern (match-string 1 subdir)) | ||
| 392 | version (match-string 2 subdir) | ||
| 393 | force (assq name package-load-list)) | ||
| 394 | (when (cond | ||
| 395 | ((null force) | ||
| 396 | all) ; not in package-load-list | ||
| 397 | ((null (setq force (cadr force))) | ||
| 398 | nil) ; disabled | ||
| 399 | ((eq force t) | ||
| 400 | t) | ||
| 401 | ((stringp force) ; held | ||
| 402 | (package-version-compare (package-version-split version) | ||
| 403 | (package-version-split force) | ||
| 404 | '=)) | ||
| 405 | (t | ||
| 406 | (error "Invalid element in `package-load-list'"))) | ||
| 407 | (package-load-descriptor dir subdir)))))))) | ||
| 408 | |||
| 409 | (defsubst package-desc-vers (desc) | ||
| 410 | "Extract version from a package description vector." | ||
| 411 | (aref desc 0)) | ||
| 412 | |||
| 413 | (defsubst package-desc-reqs (desc) | ||
| 414 | "Extract requirements from a package description vector." | ||
| 415 | (aref desc 1)) | ||
| 416 | |||
| 417 | (defsubst package-desc-doc (desc) | ||
| 418 | "Extract doc string from a package description vector." | ||
| 419 | (aref desc 2)) | ||
| 420 | |||
| 421 | (defsubst package-desc-kind (desc) | ||
| 422 | "Extract the kind of download from an archive package description vector." | ||
| 423 | (aref desc 3)) | ||
| 424 | |||
| 425 | (defun package--dir (name version-string) | ||
| 426 | (let* ((subdir (concat name "-" version-string)) | ||
| 427 | (dir-list (cons package-user-dir package-directory-list)) | ||
| 428 | pkg-dir) | ||
| 429 | (while dir-list | ||
| 430 | (let ((subdir-full (expand-file-name subdir (car dir-list)))) | ||
| 431 | (if (file-directory-p subdir-full) | ||
| 432 | (setq pkg-dir subdir-full | ||
| 433 | dir-list nil) | ||
| 434 | (setq dir-list (cdr dir-list))))) | ||
| 435 | pkg-dir)) | ||
| 436 | |||
| 437 | (defun package-activate-1 (package pkg-vec) | ||
| 438 | (let* ((name (symbol-name package)) | ||
| 439 | (version-str (package-version-join (package-desc-vers pkg-vec))) | ||
| 440 | (pkg-dir (package--dir name version-str))) | ||
| 441 | (unless pkg-dir | ||
| 442 | (error "Internal error: could not find directory for %s-%s" | ||
| 443 | name version-str)) | ||
| 444 | ;; Add info node. | ||
| 445 | (if (file-exists-p (expand-file-name "dir" pkg-dir)) | ||
| 446 | (progn | ||
| 447 | ;; FIXME: not the friendliest, but simple. | ||
| 448 | (require 'info) | ||
| 449 | (info-initialize) | ||
| 450 | (setq Info-directory-list (cons pkg-dir Info-directory-list)))) | ||
| 451 | ;; Add to load path, add autoloads, and activate the package. | ||
| 452 | (setq load-path (cons pkg-dir load-path)) | ||
| 453 | (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) | ||
| 454 | (setq package-activated-list (cons package package-activated-list)) | ||
| 455 | ;; Don't return nil. | ||
| 456 | t)) | ||
| 457 | |||
| 458 | (defun package--built-in (package version) | ||
| 459 | "Return true if the package is built-in to Emacs." | ||
| 460 | (let ((elt (assq package package--builtins))) | ||
| 461 | (and elt | ||
| 462 | (package-version-compare (package-desc-vers (cdr elt)) version '=)))) | ||
| 463 | |||
| 464 | ;; FIXME: return a reason instead? | ||
| 465 | (defun package-activate (package version) | ||
| 466 | "Activate a package, and recursively activate its dependencies. | ||
| 467 | Return nil if the package could not be activated." | ||
| 468 | ;; Assume the user knows what he is doing -- go ahead and activate a | ||
| 469 | ;; newer version of a package if an older one has already been | ||
| 470 | ;; activated. This is not ideal; we'd at least need to check to see | ||
| 471 | ;; if the package has actually been loaded, and not merely | ||
| 472 | ;; activated. However, don't try to activate 'emacs', as that makes | ||
| 473 | ;; no sense. | ||
| 474 | (unless (eq package 'emacs) | ||
| 475 | (let* ((pkg-desc (assq package package-alist)) | ||
| 476 | (this-version (package-desc-vers (cdr pkg-desc))) | ||
| 477 | (req-list (package-desc-reqs (cdr pkg-desc))) | ||
| 478 | ;; If the package was never activated, do it now. | ||
| 479 | (keep-going (or (not (memq package package-activated-list)) | ||
| 480 | (package-version-compare this-version version '>)))) | ||
| 481 | (while (and req-list keep-going) | ||
| 482 | (let* ((req (car req-list)) | ||
| 483 | (req-name (car req)) | ||
| 484 | (req-version (cadr req))) | ||
| 485 | (or (package-activate req-name req-version) | ||
| 486 | (setq keep-going nil))) | ||
| 487 | (setq req-list (cdr req-list))) | ||
| 488 | (if keep-going | ||
| 489 | (package-activate-1 package (cdr pkg-desc)) | ||
| 490 | ;; We get here if a dependency failed to activate -- but we | ||
| 491 | ;; can also get here if the requested package was already | ||
| 492 | ;; activated. Return non-nil in the latter case. | ||
| 493 | (and (memq package package-activated-list) | ||
| 494 | (package-version-compare this-version version '>=)))))) | ||
| 495 | |||
| 496 | (defun package-mark-obsolete (package pkg-vec) | ||
| 497 | "Put package on the obsolete list, if not already there." | ||
| 498 | (let ((elt (assq package package-obsolete-alist))) | ||
| 499 | (if elt | ||
| 500 | ;; If this obsolete version does not exist in the list, update | ||
| 501 | ;; it the list. | ||
| 502 | (unless (assoc (package-desc-vers pkg-vec) (cdr elt)) | ||
| 503 | (setcdr elt (cons (cons (package-desc-vers pkg-vec) pkg-vec) | ||
| 504 | (cdr elt)))) | ||
| 505 | ;; Make a new association. | ||
| 506 | (setq package-obsolete-alist | ||
| 507 | (cons (cons package (list (cons (package-desc-vers pkg-vec) | ||
| 508 | pkg-vec))) | ||
| 509 | package-obsolete-alist))))) | ||
| 510 | |||
| 511 | ;; (define-package "emacs" "21.4.1" "GNU Emacs core package.") | ||
| 512 | ;; (define-package "erc" "5.1" "ERC - irc client" '((emacs "21.0"))) | ||
| 513 | (defun define-package (name-str version-string | ||
| 514 | &optional docstring requirements) | ||
| 515 | "Define a new package. | ||
| 516 | NAME is the name of the package, a string. | ||
| 517 | VERSION-STRING is the version of the package, a dotted sequence | ||
| 518 | of integers. | ||
| 519 | DOCSTRING is the optional description. | ||
| 520 | REQUIREMENTS is a list of requirements on other packages. | ||
| 521 | Each requirement is of the form (OTHER-PACKAGE \"VERSION\")." | ||
| 522 | (let* ((name (intern name-str)) | ||
| 523 | (pkg-desc (assq name package-alist)) | ||
| 524 | (new-version (package-version-split version-string)) | ||
| 525 | (new-pkg-desc | ||
| 526 | (cons name | ||
| 527 | (vector new-version | ||
| 528 | (mapcar | ||
| 529 | (lambda (elt) | ||
| 530 | (list (car elt) | ||
| 531 | (package-version-split (car (cdr elt))))) | ||
| 532 | requirements) | ||
| 533 | docstring)))) | ||
| 534 | ;; Only redefine a package if the redefinition is newer. | ||
| 535 | (if (or (not pkg-desc) | ||
| 536 | (package-version-compare new-version | ||
| 537 | (package-desc-vers (cdr pkg-desc)) | ||
| 538 | '>)) | ||
| 539 | (progn | ||
| 540 | (when pkg-desc | ||
| 541 | ;; Remove old package and declare it obsolete. | ||
| 542 | (setq package-alist (delq pkg-desc package-alist)) | ||
| 543 | (package-mark-obsolete (car pkg-desc) (cdr pkg-desc))) | ||
| 544 | ;; Add package to the alist. | ||
| 545 | (setq package-alist (cons new-pkg-desc package-alist))) | ||
| 546 | ;; You can have two packages with the same version, for instance | ||
| 547 | ;; one in the system package directory and one in your private | ||
| 548 | ;; directory. We just let the first one win. | ||
| 549 | (unless (package-version-compare new-version | ||
| 550 | (package-desc-vers (cdr pkg-desc)) | ||
| 551 | '=) | ||
| 552 | ;; The package is born obsolete. | ||
| 553 | (package-mark-obsolete (car new-pkg-desc) (cdr new-pkg-desc)))))) | ||
| 554 | |||
| 555 | ;; From Emacs 22. | ||
| 556 | (defun package-autoload-ensure-default-file (file) | ||
| 557 | "Make sure that the autoload file FILE exists and if not create it." | ||
| 558 | (unless (file-exists-p file) | ||
| 559 | (write-region | ||
| 560 | (concat ";;; " (file-name-nondirectory file) | ||
| 561 | " --- automatically extracted autoloads\n" | ||
| 562 | ";;\n" | ||
| 563 | ";;; Code:\n\n" | ||
| 564 | "\n;; Local Variables:\n" | ||
| 565 | ";; version-control: never\n" | ||
| 566 | ";; no-byte-compile: t\n" | ||
| 567 | ";; no-update-autoloads: t\n" | ||
| 568 | ";; End:\n" | ||
| 569 | ";;; " (file-name-nondirectory file) | ||
| 570 | " ends here\n") | ||
| 571 | nil file)) | ||
| 572 | file) | ||
| 573 | |||
| 574 | (defun package-generate-autoloads (name pkg-dir) | ||
| 575 | (let* ((auto-name (concat name "-autoloads.el")) | ||
| 576 | (ignore-name (concat name "-pkg.el")) | ||
| 577 | (generated-autoload-file (expand-file-name auto-name pkg-dir)) | ||
| 578 | (version-control 'never)) | ||
| 579 | (require 'autoload) | ||
| 580 | (unless (fboundp 'autoload-ensure-default-file) | ||
| 581 | (package-autoload-ensure-default-file generated-autoload-file)) | ||
| 582 | (update-directory-autoloads pkg-dir))) | ||
| 583 | |||
| 584 | (defun package-untar-buffer () | ||
| 585 | "Untar the current buffer. | ||
| 586 | This uses `tar-untar-buffer' if it is available. | ||
| 587 | Otherwise it uses an external `tar' program. | ||
| 588 | `default-directory' should be set by the caller." | ||
| 589 | (require 'tar-mode) | ||
| 590 | (if (fboundp 'tar-untar-buffer) | ||
| 591 | (progn | ||
| 592 | ;; tar-mode messes with narrowing, so we just let it have the | ||
| 593 | ;; whole buffer to play with. | ||
| 594 | (delete-region (point-min) (point)) | ||
| 595 | (tar-mode) | ||
| 596 | (tar-untar-buffer)) | ||
| 597 | ;; FIXME: check the result. | ||
| 598 | (call-process-region (point) (point-max) "tar" nil '(nil nil) nil | ||
| 599 | "xf" "-"))) | ||
| 600 | |||
| 601 | (defun package-unpack (name version) | ||
| 602 | (let ((pkg-dir (expand-file-name (concat (symbol-name name) "-" version) | ||
| 603 | package-user-dir))) | ||
| 604 | ;; Be careful!! | ||
| 605 | (make-directory package-user-dir t) | ||
| 606 | (if (file-directory-p pkg-dir) | ||
| 607 | (mapc (lambda (file) nil) ; 'delete-file -- FIXME: when we're | ||
| 608 | ; more confident | ||
| 609 | (directory-files pkg-dir t "^[^.]"))) | ||
| 610 | (let* ((default-directory (file-name-as-directory package-user-dir))) | ||
| 611 | (package-untar-buffer) | ||
| 612 | (package-generate-autoloads (symbol-name name) pkg-dir) | ||
| 613 | (let ((load-path (cons pkg-dir load-path))) | ||
| 614 | (byte-recompile-directory pkg-dir 0 t))))) | ||
| 615 | |||
| 616 | (defun package-unpack-single (file-name version desc requires) | ||
| 617 | "Install the contents of the current buffer as a package." | ||
| 618 | ;; Special case "package". | ||
| 619 | (if (string= file-name "package") | ||
| 620 | (write-region (point-min) (point-max) | ||
| 621 | (expand-file-name (concat file-name ".el") | ||
| 622 | package-user-dir) | ||
| 623 | nil nil nil nil) | ||
| 624 | (let* ((pkg-dir (expand-file-name (concat file-name "-" version) | ||
| 625 | package-user-dir)) | ||
| 626 | (el-file (expand-file-name (concat file-name ".el") pkg-dir)) | ||
| 627 | (pkg-file (expand-file-name (concat file-name "-pkg.el") pkg-dir))) | ||
| 628 | (make-directory pkg-dir t) | ||
| 629 | (write-region (point-min) (point-max) el-file nil nil nil 'excl) | ||
| 630 | (let ((print-level nil) | ||
| 631 | (print-length nil)) | ||
| 632 | (write-region | ||
| 633 | (concat | ||
| 634 | (prin1-to-string | ||
| 635 | (list 'define-package | ||
| 636 | file-name | ||
| 637 | version | ||
| 638 | desc | ||
| 639 | (list 'quote | ||
| 640 | ;; Turn version lists into string form. | ||
| 641 | (mapcar | ||
| 642 | (lambda (elt) | ||
| 643 | (list (car elt) | ||
| 644 | (package-version-join (car (cdr elt))))) | ||
| 645 | requires)))) | ||
| 646 | "\n") | ||
| 647 | nil | ||
| 648 | pkg-file | ||
| 649 | nil nil nil 'excl)) | ||
| 650 | (package-generate-autoloads file-name pkg-dir) | ||
| 651 | (let ((load-path (cons pkg-dir load-path))) | ||
| 652 | (byte-recompile-directory pkg-dir 0 t))))) | ||
| 653 | |||
| 654 | (defun package-handle-response () | ||
| 655 | "Handle the response from the server. | ||
| 656 | Parse the HTTP response and throw if an error occurred. | ||
| 657 | The url package seems to require extra processing for this. | ||
| 658 | This should be called in a `save-excursion', in the download buffer. | ||
| 659 | It will move point to somewhere in the headers." | ||
| 660 | ;; We assume HTTP here. | ||
| 661 | (require 'url-http) | ||
| 662 | (let ((response (url-http-parse-response))) | ||
| 663 | (when (or (< response 200) (>= response 300)) | ||
| 664 | (display-buffer (current-buffer)) | ||
| 665 | (error "Error during download request:%s" | ||
| 666 | (buffer-substring-no-properties (point) (progn | ||
| 667 | (end-of-line) | ||
| 668 | (point))))))) | ||
| 669 | |||
| 670 | (defun package-download-single (name version desc requires) | ||
| 671 | "Download and install a single-file package." | ||
| 672 | (let ((buffer (url-retrieve-synchronously | ||
| 673 | (concat package-archive-base | ||
| 674 | (symbol-name name) "-" version ".el")))) | ||
| 675 | (with-current-buffer buffer | ||
| 676 | (package-handle-response) | ||
| 677 | (re-search-forward "^$" nil 'move) | ||
| 678 | (forward-char) | ||
| 679 | (delete-region (point-min) (point)) | ||
| 680 | (package-unpack-single (symbol-name name) version desc requires) | ||
| 681 | (kill-buffer buffer)))) | ||
| 682 | |||
| 683 | (defun package-download-tar (name version) | ||
| 684 | "Download and install a tar package." | ||
| 685 | (let ((tar-buffer (url-retrieve-synchronously | ||
| 686 | (concat package-archive-base | ||
| 687 | (symbol-name name) "-" version ".tar")))) | ||
| 688 | (with-current-buffer tar-buffer | ||
| 689 | (package-handle-response) | ||
| 690 | (re-search-forward "^$" nil 'move) | ||
| 691 | (forward-char) | ||
| 692 | (package-unpack name version) | ||
| 693 | (kill-buffer tar-buffer)))) | ||
| 694 | |||
| 695 | (defun package-installed-p (package version) | ||
| 696 | (let ((pkg-desc (assq package package-alist))) | ||
| 697 | (and pkg-desc | ||
| 698 | (package-version-compare version | ||
| 699 | (package-desc-vers (cdr pkg-desc)) | ||
| 700 | '>=)))) | ||
| 701 | |||
| 702 | (defun package-compute-transaction (result requirements) | ||
| 703 | (dolist (elt requirements) | ||
| 704 | (let* ((next-pkg (car elt)) | ||
| 705 | (next-version (cadr elt))) | ||
| 706 | (unless (package-installed-p next-pkg next-version) | ||
| 707 | ;; A package is required, but not installed. It might also be | ||
| 708 | ;; blocked via `package-load-list'. | ||
| 709 | (let ((pkg-desc (assq next-pkg package-archive-contents)) | ||
| 710 | hold) | ||
| 711 | (when (setq hold (assq next-pkg package-load-list)) | ||
| 712 | (setq hold (cadr hold)) | ||
| 713 | (cond ((eq hold nil) | ||
| 714 | (error "Required package '%s' is disabled" | ||
| 715 | (symbol-name next-pkg))) | ||
| 716 | ((null (stringp hold)) | ||
| 717 | (error "Invalid element in `package-load-list'")) | ||
| 718 | ((package-version-compare next-version | ||
| 719 | (package-version-split hold) | ||
| 720 | '>) | ||
| 721 | (error "Package '%s' held at version %s, \ | ||
| 722 | but version %s required" | ||
| 723 | (symbol-name next-pkg) hold | ||
| 724 | (package-version-join next-version))))) | ||
| 725 | (unless pkg-desc | ||
| 726 | (error "Package '%s' is not available for installation" | ||
| 727 | (symbol-name next-pkg))) | ||
| 728 | (unless (package-version-compare (package-desc-vers (cdr pkg-desc)) | ||
| 729 | next-version | ||
| 730 | '>=) | ||
| 731 | (error | ||
| 732 | "Need package '%s' with version %s, but only %s is available" | ||
| 733 | (symbol-name next-pkg) (package-version-join next-version) | ||
| 734 | (package-version-join (package-desc-vers (cdr pkg-desc))))) | ||
| 735 | ;; Only add to the transaction if we don't already have it. | ||
| 736 | (unless (memq next-pkg result) | ||
| 737 | (setq result (cons next-pkg result))) | ||
| 738 | (setq result | ||
| 739 | (package-compute-transaction result | ||
| 740 | (package-desc-reqs | ||
| 741 | (cdr pkg-desc)))))))) | ||
| 742 | result) | ||
| 743 | |||
| 744 | (defun package-read-from-string (str) | ||
| 745 | "Read a Lisp expression from STR. | ||
| 746 | Signal an error if the entire string was not used." | ||
| 747 | (let* ((read-data (read-from-string str)) | ||
| 748 | (more-left | ||
| 749 | (condition-case nil | ||
| 750 | ;; The call to `ignore' suppresses a compiler warning. | ||
| 751 | (progn (ignore (read-from-string | ||
| 752 | (substring str (cdr read-data)))) | ||
| 753 | t) | ||
| 754 | (end-of-file nil)))) | ||
| 755 | (if more-left | ||
| 756 | (error "Can't read whole string") | ||
| 757 | (car read-data)))) | ||
| 758 | |||
| 759 | (defun package--read-archive-file (file) | ||
| 760 | "Re-read archive file FILE, if it exists. | ||
| 761 | Will return the data from the file, or nil if the file does not exist. | ||
| 762 | Will throw an error if the archive version is too new." | ||
| 763 | (let ((filename (expand-file-name file package-user-dir))) | ||
| 764 | (if (file-exists-p filename) | ||
| 765 | (with-temp-buffer | ||
| 766 | (insert-file-contents-literally filename) | ||
| 767 | (let ((contents (package-read-from-string | ||
| 768 | (buffer-substring-no-properties (point-min) | ||
| 769 | (point-max))))) | ||
| 770 | (if (> (car contents) package-archive-version) | ||
| 771 | (error "Package archive version %d is greater than %d - upgrade package.el" | ||
| 772 | (car contents) package-archive-version)) | ||
| 773 | (cdr contents)))))) | ||
| 774 | |||
| 775 | (defun package-read-archive-contents () | ||
| 776 | "Re-read `archive-contents' and `builtin-packages', if they exist. | ||
| 777 | Set `package-archive-contents' and `package--builtins' if successful. | ||
| 778 | Throw an error if the archive version is too new." | ||
| 779 | (let ((archive-contents (package--read-archive-file "archive-contents")) | ||
| 780 | (builtins (package--read-archive-file "builtin-packages"))) | ||
| 781 | (if archive-contents | ||
| 782 | ;; Version 1 of 'archive-contents' is identical to our | ||
| 783 | ;; internal representation. | ||
| 784 | (setq package-archive-contents archive-contents)) | ||
| 785 | (if builtins | ||
| 786 | ;; Version 1 of 'builtin-packages' is a list where the car is | ||
| 787 | ;; a split emacs version and the cdr is an alist suitable for | ||
| 788 | ;; package--builtins. | ||
| 789 | (let ((our-version (package-version-split emacs-version)) | ||
| 790 | (result package--builtins-base)) | ||
| 791 | (setq package--builtins | ||
| 792 | (dolist (elt builtins result) | ||
| 793 | (if (package-version-compare our-version (car elt) '>=) | ||
| 794 | (setq result (append (cdr elt) result))))))))) | ||
| 795 | |||
| 796 | (defun package-download-transaction (transaction) | ||
| 797 | "Download and install all the packages in the given transaction." | ||
| 798 | (dolist (elt transaction) | ||
| 799 | (let* ((desc (cdr (assq elt package-archive-contents))) | ||
| 800 | ;; As an exception, if package is "held" in | ||
| 801 | ;; `package-load-list', download the held version. | ||
| 802 | (hold (cadr (assq elt package-load-list))) | ||
| 803 | (v-string (or (and (stringp hold) hold) | ||
| 804 | (package-version-join (package-desc-vers desc)))) | ||
| 805 | (kind (package-desc-kind desc))) | ||
| 806 | (cond | ||
| 807 | ((eq kind 'tar) | ||
| 808 | (package-download-tar elt v-string)) | ||
| 809 | ((eq kind 'single) | ||
| 810 | (package-download-single elt v-string | ||
| 811 | (package-desc-doc desc) | ||
| 812 | (package-desc-reqs desc))) | ||
| 813 | (t | ||
| 814 | (error "Unknown package kind: %s" (symbol-name kind))))))) | ||
| 815 | |||
| 816 | ;;;###autoload | ||
| 817 | (defun package-install (name) | ||
| 818 | "Install the package named NAME. | ||
| 819 | Interactively, prompt for the package name. | ||
| 820 | The package is found on the archive site, see `package-archive-base'." | ||
| 821 | (interactive | ||
| 822 | (list (progn | ||
| 823 | ;; Make sure we're using the most recent download of the | ||
| 824 | ;; archive. Maybe we should be updating the archive first? | ||
| 825 | (package-read-archive-contents) | ||
| 826 | (intern (completing-read "Install package: " | ||
| 827 | (mapcar (lambda (elt) | ||
| 828 | (cons (symbol-name (car elt)) | ||
| 829 | nil)) | ||
| 830 | package-archive-contents) | ||
| 831 | nil t))))) | ||
| 832 | (let ((pkg-desc (assq name package-archive-contents))) | ||
| 833 | (unless pkg-desc | ||
| 834 | (error "Package '%s' not available for installation" | ||
| 835 | (symbol-name name))) | ||
| 836 | (let ((transaction | ||
| 837 | (package-compute-transaction (list name) | ||
| 838 | (package-desc-reqs (cdr pkg-desc))))) | ||
| 839 | (package-download-transaction transaction))) | ||
| 840 | ;; Try to activate it. | ||
| 841 | (package-initialize)) | ||
| 842 | |||
| 843 | (defun package-strip-rcs-id (v-str) | ||
| 844 | "Strip RCS version ID from the version string. | ||
| 845 | If the result looks like a dotted numeric version, return it. | ||
| 846 | Otherwise return nil." | ||
| 847 | (if v-str | ||
| 848 | (if (string-match "^[ \t]*[$]Revision:[ \t]\([0-9.]+\)[ \t]*[$]$" v-str) | ||
| 849 | (match-string 1 v-str) | ||
| 850 | (if (string-match "^[0-9.]*$" v-str) | ||
| 851 | v-str)))) | ||
| 852 | |||
| 853 | (defun package-buffer-info () | ||
| 854 | "Return a vector of information about the package in the current buffer. | ||
| 855 | The vector looks like [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY] | ||
| 856 | FILENAME is the file name, a string. It does not have the \".el\" extension. | ||
| 857 | REQUIRES is a requires list, or nil. | ||
| 858 | DESCRIPTION is the package description (a string). | ||
| 859 | VERSION is the version, a string. | ||
| 860 | COMMENTARY is the commentary section, a string, or nil if none. | ||
| 861 | Throws an exception if the buffer does not contain a conforming package. | ||
| 862 | If there is a package, narrows the buffer to the file's boundaries. | ||
| 863 | May narrow buffer or move point even on failure." | ||
| 864 | (goto-char (point-min)) | ||
| 865 | (if (re-search-forward "^;;; \\([^ ]*\\)\\.el --- \\(.*\\)$" nil t) | ||
| 866 | (let ((file-name (match-string 1)) | ||
| 867 | (desc (match-string 2)) | ||
| 868 | (start (progn (beginning-of-line) (point)))) | ||
| 869 | (if (search-forward (concat ";;; " file-name ".el ends here")) | ||
| 870 | (progn | ||
| 871 | ;; Try to include a trailing newline. | ||
| 872 | (forward-line) | ||
| 873 | (narrow-to-region start (point)) | ||
| 874 | (require 'lisp-mnt) | ||
| 875 | ;; Use some headers we've invented to drive the process. | ||
| 876 | (let* ((requires-str (lm-header "package-requires")) | ||
| 877 | (requires (if requires-str | ||
| 878 | (package-read-from-string requires-str))) | ||
| 879 | ;; Prefer Package-Version, because if it is | ||
| 880 | ;; defined the package author probably wants us | ||
| 881 | ;; to use it. Otherwise try Version. | ||
| 882 | (pkg-version | ||
| 883 | (or (package-strip-rcs-id (lm-header "package-version")) | ||
| 884 | (package-strip-rcs-id (lm-header "version")))) | ||
| 885 | (commentary (lm-commentary))) | ||
| 886 | (unless pkg-version | ||
| 887 | (error | ||
| 888 | "Package does not define a usable \"Version\" or \"Package-Version\" header")) | ||
| 889 | ;; Turn string version numbers into list form. | ||
| 890 | (setq requires | ||
| 891 | (mapcar | ||
| 892 | (lambda (elt) | ||
| 893 | (list (car elt) | ||
| 894 | (package-version-split (car (cdr elt))))) | ||
| 895 | requires)) | ||
| 896 | (set-text-properties 0 (length file-name) nil file-name) | ||
| 897 | (set-text-properties 0 (length pkg-version) nil pkg-version) | ||
| 898 | (set-text-properties 0 (length desc) nil desc) | ||
| 899 | (vector file-name requires desc pkg-version commentary))) | ||
| 900 | (error "Package missing a terminating comment"))) | ||
| 901 | (error "No starting comment for package"))) | ||
| 902 | |||
| 903 | (defun package-tar-file-info (file) | ||
| 904 | "Find package information for a tar file. | ||
| 905 | FILE is the name of the tar file to examine. | ||
| 906 | The return result is a vector like `package-buffer-info'." | ||
| 907 | (unless (string-match "^\\(.+\\)-\\([0-9.]+\\)\\.tar$" file) | ||
| 908 | (error "`%s' doesn't have a package-ish name" file)) | ||
| 909 | (let* ((pkg-name (file-name-nondirectory (match-string-no-properties 1 file))) | ||
| 910 | (pkg-version (match-string-no-properties 2 file)) | ||
| 911 | ;; Extract the package descriptor. | ||
| 912 | (pkg-def-contents (shell-command-to-string | ||
| 913 | ;; Requires GNU tar. | ||
| 914 | (concat "tar -xOf " file " " | ||
| 915 | pkg-name "-" pkg-version "/" | ||
| 916 | pkg-name "-pkg.el"))) | ||
| 917 | (pkg-def-parsed (package-read-from-string pkg-def-contents))) | ||
| 918 | (unless (eq (car pkg-def-parsed) 'define-package) | ||
| 919 | (error "%s-pkg.el doesn't contain `define-package' sexp" pkg-name)) | ||
| 920 | (let ((name-str (nth 1 pkg-def-parsed)) | ||
| 921 | (version-string (nth 2 pkg-def-parsed)) | ||
| 922 | (docstring (nth 3 pkg-def-parsed)) | ||
| 923 | (requires (nth 4 pkg-def-parsed)) | ||
| 924 | |||
| 925 | (readme (shell-command-to-string | ||
| 926 | ;; Requires GNU tar. | ||
| 927 | (concat "tar -xOf " file " " | ||
| 928 | pkg-name "-" pkg-version "/README")))) | ||
| 929 | (unless (equal pkg-version version-string) | ||
| 930 | (error "Inconsistent versions!")) | ||
| 931 | (unless (equal pkg-name name-str) | ||
| 932 | (error "Inconsistent names!")) | ||
| 933 | ;; Kind of a hack. | ||
| 934 | (if (string-match ": Not found in archive" readme) | ||
| 935 | (setq readme nil)) | ||
| 936 | ;; Turn string version numbers into list form. | ||
| 937 | (if (eq (car requires) 'quote) | ||
| 938 | (setq requires (car (cdr requires)))) | ||
| 939 | (setq requires | ||
| 940 | (mapcar | ||
| 941 | (lambda (elt) | ||
| 942 | (list (car elt) | ||
| 943 | (package-version-split (car (cdr elt))))) | ||
| 944 | requires)) | ||
| 945 | (vector pkg-name requires docstring version-string readme)))) | ||
| 946 | |||
| 947 | (defun package-install-buffer-internal (pkg-info type) | ||
| 948 | (save-excursion | ||
| 949 | (save-restriction | ||
| 950 | (let* ((file-name (aref pkg-info 0)) | ||
| 951 | (requires (aref pkg-info 1)) | ||
| 952 | (desc (if (string= (aref pkg-info 2) "") | ||
| 953 | "No description available." | ||
| 954 | (aref pkg-info 2))) | ||
| 955 | (pkg-version (aref pkg-info 3))) | ||
| 956 | ;; Download and install the dependencies. | ||
| 957 | (let ((transaction (package-compute-transaction nil requires))) | ||
| 958 | (package-download-transaction transaction)) | ||
| 959 | ;; Install the package itself. | ||
| 960 | (cond | ||
| 961 | ((eq type 'single) | ||
| 962 | (package-unpack-single file-name pkg-version desc requires)) | ||
| 963 | ((eq type 'tar) | ||
| 964 | (package-unpack (intern file-name) pkg-version)) | ||
| 965 | (t | ||
| 966 | (error "Unknown type: %s" (symbol-name type)))) | ||
| 967 | ;; Try to activate it. | ||
| 968 | (package-initialize))))) | ||
| 969 | |||
| 970 | ;;;###autoload | ||
| 971 | (defun package-install-from-buffer () | ||
| 972 | "Install a package from the current buffer. | ||
| 973 | The package is assumed to be a single .el file which | ||
| 974 | follows the elisp comment guidelines; see | ||
| 975 | info node `(elisp)Library Headers'." | ||
| 976 | (interactive) | ||
| 977 | (package-install-buffer-internal (package-buffer-info) 'single)) | ||
| 978 | |||
| 979 | ;;;###autoload | ||
| 980 | (defun package-install-file (file) | ||
| 981 | "Install a package from a file. | ||
| 982 | The file can either be a tar file or an Emacs Lisp file." | ||
| 983 | (interactive "fPackage file name: ") | ||
| 984 | (with-temp-buffer | ||
| 985 | (insert-file-contents-literally file) | ||
| 986 | (cond | ||
| 987 | ((string-match "\\.el$" file) (package-install-from-buffer)) | ||
| 988 | ((string-match "\\.tar$" file) | ||
| 989 | (package-install-buffer-internal (package-tar-file-info file) 'tar)) | ||
| 990 | (t (error "Unrecognized extension `%s'" (file-name-extension file)))))) | ||
| 991 | |||
| 992 | (defun package-delete (name version) | ||
| 993 | (require 'dired) ; for dired-delete-file | ||
| 994 | (dired-delete-file (expand-file-name (concat name "-" version) | ||
| 995 | package-user-dir) | ||
| 996 | ;; FIXME: query user? | ||
| 997 | 'always)) | ||
| 998 | |||
| 999 | (defun package--download-one-archive (file) | ||
| 1000 | "Download a single archive file and cache it locally." | ||
| 1001 | (let ((buffer (url-retrieve-synchronously | ||
| 1002 | (concat package-archive-base file)))) | ||
| 1003 | (with-current-buffer buffer | ||
| 1004 | (package-handle-response) | ||
| 1005 | (re-search-forward "^$" nil 'move) | ||
| 1006 | (forward-char) | ||
| 1007 | (delete-region (point-min) (point)) | ||
| 1008 | (setq buffer-file-name (concat (file-name-as-directory package-user-dir) | ||
| 1009 | file)) | ||
| 1010 | (let ((version-control 'never)) | ||
| 1011 | (save-buffer)) | ||
| 1012 | (kill-buffer buffer)))) | ||
| 1013 | |||
| 1014 | (defun package-refresh-contents () | ||
| 1015 | "Download the ELPA archive description if needed. | ||
| 1016 | Invoking this will ensure that Emacs knows about the latest versions | ||
| 1017 | of all packages. This will let Emacs make them available for | ||
| 1018 | download." | ||
| 1019 | (interactive) | ||
| 1020 | (unless (file-exists-p package-user-dir) | ||
| 1021 | (make-directory package-user-dir t)) | ||
| 1022 | (package--download-one-archive "archive-contents") | ||
| 1023 | (package--download-one-archive "builtin-packages") | ||
| 1024 | (package-read-archive-contents)) | ||
| 1025 | |||
| 1026 | ;;;###autoload | ||
| 1027 | (defun package-initialize () | ||
| 1028 | "Load Emacs Lisp packages, and activate them. | ||
| 1029 | The variable `package-load-list' controls which packages to load." | ||
| 1030 | (interactive) | ||
| 1031 | (setq package-obsolete-alist nil) | ||
| 1032 | (package-load-all-descriptors) | ||
| 1033 | (package-read-archive-contents) | ||
| 1034 | ;; Try to activate all our packages. | ||
| 1035 | (mapc (lambda (elt) | ||
| 1036 | (package-activate (car elt) (package-desc-vers (cdr elt)))) | ||
| 1037 | package-alist)) | ||
| 1038 | |||
| 1039 | |||
| 1040 | ;;;; Package description buffer. | ||
| 1041 | |||
| 1042 | ;;;###autoload | ||
| 1043 | (defun describe-package (package) | ||
| 1044 | "Display the full documentation of PACKAGE (a symbol)." | ||
| 1045 | (interactive | ||
| 1046 | (let* ((packages (append (mapcar 'car package-alist) | ||
| 1047 | (mapcar 'car package-archive-contents))) | ||
| 1048 | (guess (function-called-at-point)) | ||
| 1049 | val) | ||
| 1050 | (unless (memq guess packages) | ||
| 1051 | (setq guess nil)) | ||
| 1052 | (setq packages (mapcar 'symbol-name packages)) | ||
| 1053 | (setq val | ||
| 1054 | (completing-read (if guess | ||
| 1055 | (format "Describe package (default %s): " | ||
| 1056 | guess) | ||
| 1057 | "Describe package: ") | ||
| 1058 | packages nil t nil nil guess)) | ||
| 1059 | (list (if (equal val "") | ||
| 1060 | guess | ||
| 1061 | (intern val))))) | ||
| 1062 | (if (or (null package) (null (symbolp package))) | ||
| 1063 | (message "You did not specify a package") | ||
| 1064 | (help-setup-xref (list #'describe-package package) | ||
| 1065 | (called-interactively-p 'interactive)) | ||
| 1066 | (with-help-window (help-buffer) | ||
| 1067 | (with-current-buffer standard-output | ||
| 1068 | (describe-package-1 package))))) | ||
| 1069 | |||
| 1070 | (defun describe-package-1 (package) | ||
| 1071 | (let ((desc (cdr (assq package package-alist))) | ||
| 1072 | reqs version installable) | ||
| 1073 | (prin1 package) | ||
| 1074 | (princ " is ") | ||
| 1075 | (cond | ||
| 1076 | (desc | ||
| 1077 | ;; This package is loaded (i.e. in `package-alist'). | ||
| 1078 | (let (pkg-dir) | ||
| 1079 | (setq version (package-version-join (package-desc-vers desc))) | ||
| 1080 | (if (assq package package--builtins) | ||
| 1081 | (princ "a built-in package.\n\n") | ||
| 1082 | (setq pkg-dir (package--dir (symbol-name package) version)) | ||
| 1083 | (if pkg-dir | ||
| 1084 | (progn | ||
| 1085 | (insert "a package installed in `") | ||
| 1086 | (help-insert-xref-button (file-name-as-directory pkg-dir) | ||
| 1087 | 'help-package-def pkg-dir) | ||
| 1088 | (insert "'.\n\n")) | ||
| 1089 | ;; This normally does not happen. | ||
| 1090 | (insert "a deleted package.\n\n") | ||
| 1091 | (setq version nil))))) | ||
| 1092 | (t | ||
| 1093 | ;; An uninstalled package. | ||
| 1094 | (setq desc (cdr (assq package package-archive-contents)) | ||
| 1095 | version (package-version-join (package-desc-vers desc)) | ||
| 1096 | installable t) | ||
| 1097 | (insert "an installable package.\n\n"))) | ||
| 1098 | (if version | ||
| 1099 | (insert " Version: " version "\n")) | ||
| 1100 | (setq reqs (package-desc-reqs desc)) | ||
| 1101 | (when reqs | ||
| 1102 | (insert " Requires: ") | ||
| 1103 | (let ((first t) | ||
| 1104 | name vers text) | ||
| 1105 | (dolist (req reqs) | ||
| 1106 | (setq name (car req) | ||
| 1107 | vers (cadr req) | ||
| 1108 | text (format "%s-%s" (symbol-name name) | ||
| 1109 | (package-version-join vers))) | ||
| 1110 | (cond (first (setq first nil)) | ||
| 1111 | ((>= (+ 2 (current-column) (length text)) | ||
| 1112 | (window-width)) | ||
| 1113 | (insert ",\n ")) | ||
| 1114 | (t (insert ", "))) | ||
| 1115 | (help-insert-xref-button text 'help-package name)) | ||
| 1116 | (insert "\n"))) | ||
| 1117 | (insert " Description: " (package-desc-doc desc) "\n") | ||
| 1118 | ;; Todo: button for uninstalling a package. | ||
| 1119 | (when installable | ||
| 1120 | (let ((button-text (if (display-graphic-p) | ||
| 1121 | "Install" | ||
| 1122 | "[Install]")) | ||
| 1123 | (button-face (if (display-graphic-p) | ||
| 1124 | '(:box (:line-width 2 :color "dark grey") | ||
| 1125 | :background "light grey" | ||
| 1126 | :foreground "black") | ||
| 1127 | 'link))) | ||
| 1128 | (insert "\n") | ||
| 1129 | (insert-text-button button-text | ||
| 1130 | 'face button-face | ||
| 1131 | 'follow-link t | ||
| 1132 | 'package-symbol package | ||
| 1133 | 'action (lambda (button) | ||
| 1134 | (package-install | ||
| 1135 | (button-get button 'package-symbol)) | ||
| 1136 | (revert-buffer nil t) | ||
| 1137 | (goto-char (point-min)))) | ||
| 1138 | (insert "\n"))))) | ||
| 1139 | |||
| 1140 | |||
| 1141 | ;;;; Package menu mode. | ||
| 1142 | |||
| 1143 | (defvar package-menu-mode-map | ||
| 1144 | (let ((map (make-keymap)) | ||
| 1145 | (menu-map (make-sparse-keymap "Package"))) | ||
| 1146 | (suppress-keymap map) | ||
| 1147 | (define-key map "\C-m" 'package-menu-describe-package) | ||
| 1148 | (define-key map "q" 'quit-window) | ||
| 1149 | (define-key map "n" 'next-line) | ||
| 1150 | (define-key map "p" 'previous-line) | ||
| 1151 | (define-key map "u" 'package-menu-mark-unmark) | ||
| 1152 | (define-key map "\177" 'package-menu-backup-unmark) | ||
| 1153 | (define-key map "d" 'package-menu-mark-delete) | ||
| 1154 | (define-key map "i" 'package-menu-mark-install) | ||
| 1155 | (define-key map "g" 'package-menu-revert) | ||
| 1156 | (define-key map "r" 'package-menu-refresh) | ||
| 1157 | (define-key map "~" 'package-menu-mark-obsolete-for-deletion) | ||
| 1158 | (define-key map "x" 'package-menu-execute) | ||
| 1159 | (define-key map "h" 'package-menu-quick-help) | ||
| 1160 | (define-key map "?" 'package-menu-view-commentary) | ||
| 1161 | (define-key map [menu-bar package-menu] (cons "Package" menu-map)) | ||
| 1162 | (define-key menu-map [mq] | ||
| 1163 | '(menu-item "Quit" quit-window | ||
| 1164 | :help "Quit package selection")) | ||
| 1165 | (define-key menu-map [s1] '("--")) | ||
| 1166 | (define-key menu-map [mn] | ||
| 1167 | '(menu-item "Next" next-line | ||
| 1168 | :help "Next Line")) | ||
| 1169 | (define-key menu-map [mp] | ||
| 1170 | '(menu-item "Previous" previous-line | ||
| 1171 | :help "Previous Line")) | ||
| 1172 | (define-key menu-map [s2] '("--")) | ||
| 1173 | (define-key menu-map [mu] | ||
| 1174 | '(menu-item "Unmark" package-menu-mark-unmark | ||
| 1175 | :help "Clear any marks on a package and move to the next line")) | ||
| 1176 | (define-key menu-map [munm] | ||
| 1177 | '(menu-item "Unmark backwards" package-menu-backup-unmark | ||
| 1178 | :help "Back up one line and clear any marks on that package")) | ||
| 1179 | (define-key menu-map [md] | ||
| 1180 | '(menu-item "Mark for deletion" package-menu-mark-delete | ||
| 1181 | :help "Mark a package for deletion and move to the next line")) | ||
| 1182 | (define-key menu-map [mi] | ||
| 1183 | '(menu-item "Mark for install" package-menu-mark-install | ||
| 1184 | :help "Mark a package for installation and move to the next line")) | ||
| 1185 | (define-key menu-map [s3] '("--")) | ||
| 1186 | (define-key menu-map [mg] | ||
| 1187 | '(menu-item "Update package list" package-menu-revert | ||
| 1188 | :help "Update the list of packages")) | ||
| 1189 | (define-key menu-map [mr] | ||
| 1190 | '(menu-item "Refresh package list" package-menu-refresh | ||
| 1191 | :help "Download the ELPA archive")) | ||
| 1192 | (define-key menu-map [s4] '("--")) | ||
| 1193 | (define-key menu-map [mt] | ||
| 1194 | '(menu-item "Mark obsolete packages" package-menu-mark-obsolete-for-deletion | ||
| 1195 | :help "Mark all obsolete packages for deletion")) | ||
| 1196 | (define-key menu-map [mx] | ||
| 1197 | '(menu-item "Execute actions" package-menu-execute | ||
| 1198 | :help "Perform all the marked actions")) | ||
| 1199 | (define-key menu-map [s5] '("--")) | ||
| 1200 | (define-key menu-map [mh] | ||
| 1201 | '(menu-item "Help" package-menu-quick-help | ||
| 1202 | :help "Show short key binding help for package-menu-mode")) | ||
| 1203 | (define-key menu-map [mc] | ||
| 1204 | '(menu-item "View Commentary" package-menu-view-commentary | ||
| 1205 | :help "Display information about this package")) | ||
| 1206 | map) | ||
| 1207 | "Local keymap for `package-menu-mode' buffers.") | ||
| 1208 | |||
| 1209 | (defvar package-menu-sort-button-map | ||
| 1210 | (let ((map (make-sparse-keymap))) | ||
| 1211 | (define-key map [header-line mouse-1] 'package-menu-sort-by-column) | ||
| 1212 | (define-key map [follow-link] 'mouse-face) | ||
| 1213 | map) | ||
| 1214 | "Local keymap for package menu sort buttons.") | ||
| 1215 | |||
| 1216 | (put 'package-menu-mode 'mode-class 'special) | ||
| 1217 | |||
| 1218 | (defun package-menu-mode () | ||
| 1219 | "Major mode for browsing a list of packages. | ||
| 1220 | Letters do not insert themselves; instead, they are commands. | ||
| 1221 | \\<package-menu-mode-map> | ||
| 1222 | \\{package-menu-mode-map}" | ||
| 1223 | (kill-all-local-variables) | ||
| 1224 | (use-local-map package-menu-mode-map) | ||
| 1225 | (setq major-mode 'package-menu-mode) | ||
| 1226 | (setq mode-name "Package Menu") | ||
| 1227 | (setq truncate-lines t) | ||
| 1228 | (setq buffer-read-only t) | ||
| 1229 | ;; Support Emacs 21. | ||
| 1230 | (if (fboundp 'run-mode-hooks) | ||
| 1231 | (run-mode-hooks 'package-menu-mode-hook) | ||
| 1232 | (run-hooks 'package-menu-mode-hook))) | ||
| 1233 | |||
| 1234 | (defun package-menu-refresh () | ||
| 1235 | "Download the ELPA archive. | ||
| 1236 | This fetches the file describing the current contents of | ||
| 1237 | the Emacs Lisp Package Archive, and then refreshes the | ||
| 1238 | package menu. This lets you see what new packages are | ||
| 1239 | available for download." | ||
| 1240 | (interactive) | ||
| 1241 | (package-refresh-contents) | ||
| 1242 | (package-list-packages-internal)) | ||
| 1243 | |||
| 1244 | (defun package-menu-revert () | ||
| 1245 | "Update the list of packages." | ||
| 1246 | (interactive) | ||
| 1247 | (package-list-packages-internal)) | ||
| 1248 | |||
| 1249 | (defun package-menu-describe-package () | ||
| 1250 | "Describe the package in the current line." | ||
| 1251 | (interactive) | ||
| 1252 | (let ((name (package-menu-get-package))) | ||
| 1253 | (if name | ||
| 1254 | (describe-package (intern name)) | ||
| 1255 | (message "No package on this line")))) | ||
| 1256 | |||
| 1257 | (defun package-menu-mark-internal (what) | ||
| 1258 | (unless (eobp) | ||
| 1259 | (let ((buffer-read-only nil)) | ||
| 1260 | (beginning-of-line) | ||
| 1261 | (delete-char 1) | ||
| 1262 | (insert what) | ||
| 1263 | (forward-line)))) | ||
| 1264 | |||
| 1265 | ;; fixme numeric argument | ||
| 1266 | (defun package-menu-mark-delete (num) | ||
| 1267 | "Mark a package for deletion and move to the next line." | ||
| 1268 | (interactive "p") | ||
| 1269 | (package-menu-mark-internal "D")) | ||
| 1270 | |||
| 1271 | (defun package-menu-mark-install (num) | ||
| 1272 | "Mark a package for installation and move to the next line." | ||
| 1273 | (interactive "p") | ||
| 1274 | (package-menu-mark-internal "I")) | ||
| 1275 | |||
| 1276 | (defun package-menu-mark-unmark (num) | ||
| 1277 | "Clear any marks on a package and move to the next line." | ||
| 1278 | (interactive "p") | ||
| 1279 | (package-menu-mark-internal " ")) | ||
| 1280 | |||
| 1281 | (defun package-menu-backup-unmark () | ||
| 1282 | "Back up one line and clear any marks on that package." | ||
| 1283 | (interactive) | ||
| 1284 | (forward-line -1) | ||
| 1285 | (package-menu-mark-internal " ") | ||
| 1286 | (forward-line -1)) | ||
| 1287 | |||
| 1288 | (defun package-menu-mark-obsolete-for-deletion () | ||
| 1289 | "Mark all obsolete packages for deletion." | ||
| 1290 | (interactive) | ||
| 1291 | (save-excursion | ||
| 1292 | (goto-char (point-min)) | ||
| 1293 | (forward-line 2) | ||
| 1294 | (while (not (eobp)) | ||
| 1295 | (if (looking-at ".*\\s obsolete\\s ") | ||
| 1296 | (package-menu-mark-internal "D") | ||
| 1297 | (forward-line 1))))) | ||
| 1298 | |||
| 1299 | (defun package-menu-quick-help () | ||
| 1300 | "Show short key binding help for package-menu-mode." | ||
| 1301 | (interactive) | ||
| 1302 | (message "n-ext, i-nstall, d-elete, u-nmark, x-ecute, r-efresh, h-elp")) | ||
| 1303 | |||
| 1304 | (defun package-menu-view-commentary () | ||
| 1305 | "Display information about this package. | ||
| 1306 | For single-file packages, shows the commentary section from the header. | ||
| 1307 | For larger packages, shows the README file." | ||
| 1308 | (interactive) | ||
| 1309 | (let* (start-point ok | ||
| 1310 | (pkg-name (package-menu-get-package)) | ||
| 1311 | (buffer (url-retrieve-synchronously (concat package-archive-base | ||
| 1312 | pkg-name | ||
| 1313 | "-readme.txt")))) | ||
| 1314 | (with-current-buffer buffer | ||
| 1315 | ;; FIXME: it would be nice to work with any URL type. | ||
| 1316 | (setq start-point url-http-end-of-headers) | ||
| 1317 | (setq ok (eq (url-http-parse-response) 200))) | ||
| 1318 | (let ((new-buffer (get-buffer-create "*Package Info*"))) | ||
| 1319 | (with-current-buffer new-buffer | ||
| 1320 | (let ((buffer-read-only nil)) | ||
| 1321 | (erase-buffer) | ||
| 1322 | (insert "Package information for " pkg-name "\n\n") | ||
| 1323 | (if ok | ||
| 1324 | (insert-buffer-substring buffer start-point) | ||
| 1325 | (insert "This package does not have a README file or commentary comment.\n")) | ||
| 1326 | (goto-char (point-min)) | ||
| 1327 | (view-mode))) | ||
| 1328 | (display-buffer new-buffer t)))) | ||
| 1329 | |||
| 1330 | ;; Return the name of the package on the current line. | ||
| 1331 | (defun package-menu-get-package () | ||
| 1332 | (save-excursion | ||
| 1333 | (beginning-of-line) | ||
| 1334 | (if (looking-at ". \\([^ \t]*\\)") | ||
| 1335 | (match-string-no-properties 1)))) | ||
| 1336 | |||
| 1337 | ;; Return the version of the package on the current line. | ||
| 1338 | (defun package-menu-get-version () | ||
| 1339 | (save-excursion | ||
| 1340 | (beginning-of-line) | ||
| 1341 | (if (looking-at ". [^ \t]*[ \t]*\\([0-9.]*\\)") | ||
| 1342 | (match-string 1)))) | ||
| 1343 | |||
| 1344 | (defun package-menu-get-status () | ||
| 1345 | (save-excursion | ||
| 1346 | (if (looking-at ". [^ \t]*[ \t]*[^ \t]*[ \t]*\\([^ \t]*\\)") | ||
| 1347 | (match-string 1) | ||
| 1348 | ""))) | ||
| 1349 | |||
| 1350 | (defun package-menu-execute () | ||
| 1351 | "Perform all the marked actions. | ||
| 1352 | Packages marked for installation will be downloaded and | ||
| 1353 | installed. Packages marked for deletion will be removed. | ||
| 1354 | Note that after installing packages you will want to restart | ||
| 1355 | Emacs." | ||
| 1356 | (interactive) | ||
| 1357 | (goto-char (point-min)) | ||
| 1358 | (forward-line 2) | ||
| 1359 | (while (not (eobp)) | ||
| 1360 | (let ((cmd (char-after)) | ||
| 1361 | (pkg-name (package-menu-get-package)) | ||
| 1362 | (pkg-vers (package-menu-get-version)) | ||
| 1363 | (pkg-status (package-menu-get-status))) | ||
| 1364 | (cond | ||
| 1365 | ((eq cmd ?D) | ||
| 1366 | (when (and (string= pkg-status "installed") | ||
| 1367 | (string= pkg-name "package")) | ||
| 1368 | ;; FIXME: actually, we could be tricky and remove all info. | ||
| 1369 | ;; But that is drastic and the user can do that instead. | ||
| 1370 | (error "Can't delete most recent version of `package'")) | ||
| 1371 | ;; Ask for confirmation here? Maybe if package status is ""? | ||
| 1372 | ;; Or if any lisp from package is actually loaded? | ||
| 1373 | (message "Deleting %s-%s..." pkg-name pkg-vers) | ||
| 1374 | (package-delete pkg-name pkg-vers) | ||
| 1375 | (message "Deleting %s-%s... done" pkg-name pkg-vers)) | ||
| 1376 | ((eq cmd ?I) | ||
| 1377 | (package-install (intern pkg-name))))) | ||
| 1378 | (forward-line)) | ||
| 1379 | (package-menu-revert)) | ||
| 1380 | |||
| 1381 | (defun package-print-package (package version key desc) | ||
| 1382 | (let ((face | ||
| 1383 | (cond ((eq package 'emacs) 'font-lock-builtin-face) | ||
| 1384 | ((string= key "available") 'default) | ||
| 1385 | ((string= key "held") 'font-lock-constant-face) | ||
| 1386 | ((string= key "disabled") 'font-lock-warning-face) | ||
| 1387 | ((string= key "installed") 'font-lock-comment-face) | ||
| 1388 | (t ; obsolete, but also the default. | ||
| 1389 | 'font-lock-warning-face)))) | ||
| 1390 | (insert (propertize " " 'font-lock-face face)) | ||
| 1391 | (insert-text-button (symbol-name package) | ||
| 1392 | 'face 'link | ||
| 1393 | 'follow-link t | ||
| 1394 | 'package-symbol package | ||
| 1395 | 'action (lambda (button) | ||
| 1396 | (describe-package | ||
| 1397 | (button-get button 'package-symbol)))) | ||
| 1398 | (indent-to 20 1) | ||
| 1399 | (insert (propertize (package-version-join version) 'font-lock-face face)) | ||
| 1400 | (indent-to 32 1) | ||
| 1401 | (insert (propertize key 'font-lock-face face)) | ||
| 1402 | ;; FIXME: this 'when' is bogus... | ||
| 1403 | (when desc | ||
| 1404 | (indent-to 43 1) | ||
| 1405 | (insert (propertize desc 'font-lock-face face))) | ||
| 1406 | (insert "\n"))) | ||
| 1407 | |||
| 1408 | (defun package-list-maybe-add (package version status description result) | ||
| 1409 | (unless (assoc (cons package version) result) | ||
| 1410 | (setq result (cons (list (cons package version) status description) | ||
| 1411 | result))) | ||
| 1412 | result) | ||
| 1413 | |||
| 1414 | ;; This decides how we should sort; nil means by package name. | ||
| 1415 | (defvar package-menu-sort-key nil) | ||
| 1416 | |||
| 1417 | (defun package-list-packages-internal () | ||
| 1418 | (package-initialize) ; FIXME: do this here? | ||
| 1419 | (with-current-buffer (get-buffer-create "*Packages*") | ||
| 1420 | (setq buffer-read-only nil) | ||
| 1421 | (erase-buffer) | ||
| 1422 | (let ((info-list) | ||
| 1423 | name desc hold) | ||
| 1424 | ;; List installed packages | ||
| 1425 | (dolist (elt package-alist) | ||
| 1426 | (setq name (car elt) | ||
| 1427 | desc (cdr elt) | ||
| 1428 | hold (assq name package-load-list)) | ||
| 1429 | (setq info-list | ||
| 1430 | (package-list-maybe-add name (package-desc-vers desc) | ||
| 1431 | ;; FIXME: it turns out to be | ||
| 1432 | ;; tricky to see if this package | ||
| 1433 | ;; is presently activated. | ||
| 1434 | (if (stringp (cadr hold)) | ||
| 1435 | "held" | ||
| 1436 | "installed") | ||
| 1437 | (package-desc-doc desc) | ||
| 1438 | info-list))) | ||
| 1439 | ;; List available packages | ||
| 1440 | (dolist (elt package-archive-contents) | ||
| 1441 | (setq name (car elt) | ||
| 1442 | desc (cdr elt) | ||
| 1443 | hold (assq name package-load-list)) | ||
| 1444 | (unless (and hold (stringp (cadr hold)) | ||
| 1445 | (package-installed-p | ||
| 1446 | name (package-version-split (cadr hold)))) | ||
| 1447 | (setq info-list | ||
| 1448 | (package-list-maybe-add name | ||
| 1449 | (package-desc-vers desc) | ||
| 1450 | (if (and hold (null (cadr hold))) | ||
| 1451 | "disabled" | ||
| 1452 | "available") | ||
| 1453 | (package-desc-doc (cdr elt)) | ||
| 1454 | info-list)))) | ||
| 1455 | ;; List obsolete packages | ||
| 1456 | (mapc (lambda (elt) | ||
| 1457 | (mapc (lambda (inner-elt) | ||
| 1458 | (setq info-list | ||
| 1459 | (package-list-maybe-add (car elt) | ||
| 1460 | (package-desc-vers | ||
| 1461 | (cdr inner-elt)) | ||
| 1462 | "obsolete" | ||
| 1463 | (package-desc-doc | ||
| 1464 | (cdr inner-elt)) | ||
| 1465 | info-list))) | ||
| 1466 | (cdr elt))) | ||
| 1467 | package-obsolete-alist) | ||
| 1468 | (let ((selector (cond | ||
| 1469 | ((string= package-menu-sort-key "Version") | ||
| 1470 | ;; FIXME this doesn't work. | ||
| 1471 | #'(lambda (e) (cdr (car e)))) | ||
| 1472 | ((string= package-menu-sort-key "Status") | ||
| 1473 | #'(lambda (e) (car (cdr e)))) | ||
| 1474 | ((string= package-menu-sort-key "Description") | ||
| 1475 | #'(lambda (e) (car (cdr (cdr e))))) | ||
| 1476 | (t ; "Package" is default. | ||
| 1477 | #'(lambda (e) (symbol-name (car (car e)))))))) | ||
| 1478 | (setq info-list | ||
| 1479 | (sort info-list | ||
| 1480 | (lambda (left right) | ||
| 1481 | (let ((vleft (funcall selector left)) | ||
| 1482 | (vright (funcall selector right))) | ||
| 1483 | (string< vleft vright)))))) | ||
| 1484 | (mapc (lambda (elt) | ||
| 1485 | (package-print-package (car (car elt)) | ||
| 1486 | (cdr (car elt)) | ||
| 1487 | (car (cdr elt)) | ||
| 1488 | (car (cdr (cdr elt))))) | ||
| 1489 | info-list)) | ||
| 1490 | (goto-char (point-min)) | ||
| 1491 | (current-buffer))) | ||
| 1492 | |||
| 1493 | (defun package-menu-sort-by-column (&optional e) | ||
| 1494 | "Sort the package menu by the last column clicked on." | ||
| 1495 | (interactive (list last-input-event)) | ||
| 1496 | (if e (mouse-select-window e)) | ||
| 1497 | (let* ((pos (event-start e)) | ||
| 1498 | (obj (posn-object pos)) | ||
| 1499 | (col (if obj | ||
| 1500 | (get-text-property (cdr obj) 'column-name (car obj)) | ||
| 1501 | (get-text-property (posn-point pos) 'column-name)))) | ||
| 1502 | (setq package-menu-sort-key col)) | ||
| 1503 | (package-list-packages-internal)) | ||
| 1504 | |||
| 1505 | (defun package--list-packages () | ||
| 1506 | "Display a list of packages. | ||
| 1507 | Helper function that does all the work for the user-facing functions." | ||
| 1508 | (with-current-buffer (package-list-packages-internal) | ||
| 1509 | (package-menu-mode) | ||
| 1510 | ;; Set up the header line. | ||
| 1511 | (setq header-line-format | ||
| 1512 | (mapconcat | ||
| 1513 | (lambda (pair) | ||
| 1514 | (let ((column (car pair)) | ||
| 1515 | (name (cdr pair))) | ||
| 1516 | (concat | ||
| 1517 | ;; Insert a space that aligns the button properly. | ||
| 1518 | (propertize " " 'display (list 'space :align-to column) | ||
| 1519 | 'face 'fixed-pitch) | ||
| 1520 | ;; Set up the column button. | ||
| 1521 | (if (string= name "Version") | ||
| 1522 | name | ||
| 1523 | (propertize name | ||
| 1524 | 'column-name name | ||
| 1525 | 'help-echo "mouse-1: sort by column" | ||
| 1526 | 'mouse-face 'highlight | ||
| 1527 | 'keymap package-menu-sort-button-map))))) | ||
| 1528 | ;; We take a trick from buff-menu and have a dummy leading | ||
| 1529 | ;; space to align the header line with the beginning of the | ||
| 1530 | ;; text. This doesn't really work properly on Emacs 21, | ||
| 1531 | ;; but it is close enough. | ||
| 1532 | '((0 . "") | ||
| 1533 | (2 . "Package") | ||
| 1534 | (20 . "Version") | ||
| 1535 | (30 . "Status") | ||
| 1536 | (41 . "Description")) | ||
| 1537 | "")) | ||
| 1538 | |||
| 1539 | ;; It's okay to use pop-to-buffer here. The package menu buffer | ||
| 1540 | ;; has keybindings, and the user just typed 'M-x | ||
| 1541 | ;; package-list-packages', suggesting that they might want to use | ||
| 1542 | ;; them. | ||
| 1543 | (pop-to-buffer (current-buffer)))) | ||
| 1544 | |||
| 1545 | ;;;###autoload | ||
| 1546 | (defun package-list-packages () | ||
| 1547 | "Display a list of packages. | ||
| 1548 | Fetches the updated list of packages before displaying. | ||
| 1549 | The list is displayed in a buffer named `*Packages*'." | ||
| 1550 | (interactive) | ||
| 1551 | (package-refresh-contents) | ||
| 1552 | (package--list-packages)) | ||
| 1553 | |||
| 1554 | (defun package-list-packages-no-fetch () | ||
| 1555 | "Display a list of packages. | ||
| 1556 | Does not fetch the updated list of packages before displaying. | ||
| 1557 | The list is displayed in a buffer named `*Packages*'." | ||
| 1558 | (interactive) | ||
| 1559 | (package--list-packages)) | ||
| 1560 | |||
| 1561 | (provide 'package) | ||
| 1562 | |||
| 1563 | ;;; package.el ends here | ||
diff --git a/lisp/facemenu.el b/lisp/facemenu.el index 19b5967215a..20b86676ea9 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el | |||
| @@ -600,9 +600,11 @@ You can change the color sort order by customizing `list-colors-sort'." | |||
| 600 | (with-current-buffer buf | 600 | (with-current-buffer buf |
| 601 | (erase-buffer) | 601 | (erase-buffer) |
| 602 | (setq truncate-lines t) | 602 | (setq truncate-lines t) |
| 603 | ;; Display buffer before generating content to allow | ||
| 604 | ;; `list-colors-print' to get the right window-width. | ||
| 605 | (pop-to-buffer buf) | ||
| 603 | (list-colors-print list callback) | 606 | (list-colors-print list callback) |
| 604 | (set-buffer-modified-p nil)) | 607 | (set-buffer-modified-p nil))) |
| 605 | (pop-to-buffer buf)) | ||
| 606 | (if callback | 608 | (if callback |
| 607 | (message "Click on a color to select it."))) | 609 | (message "Click on a color to select it."))) |
| 608 | 610 | ||
diff --git a/lisp/font-core.el b/lisp/font-core.el index be3a2a3eaca..d33295b3c34 100644 --- a/lisp/font-core.el +++ b/lisp/font-core.el | |||
| @@ -97,7 +97,7 @@ It will be passed one argument, which is the current value of | |||
| 97 | `font-lock-mode'.") | 97 | `font-lock-mode'.") |
| 98 | 98 | ||
| 99 | ;; The mode for which font-lock was initialized, or nil if none. | 99 | ;; The mode for which font-lock was initialized, or nil if none. |
| 100 | (defvar font-lock-mode-major-mode) | 100 | (defvar font-lock-major-mode) |
| 101 | (define-minor-mode font-lock-mode | 101 | (define-minor-mode font-lock-mode |
| 102 | "Toggle Font Lock mode. | 102 | "Toggle Font Lock mode. |
| 103 | With arg, turn Font Lock mode off if and only if arg is a non-positive | 103 | With arg, turn Font Lock mode off if and only if arg is a non-positive |
| @@ -159,9 +159,7 @@ your own function which is called when `font-lock-mode' is toggled via | |||
| 159 | ;; Arrange to unfontify this buffer if we change major mode later. | 159 | ;; Arrange to unfontify this buffer if we change major mode later. |
| 160 | (if font-lock-mode | 160 | (if font-lock-mode |
| 161 | (add-hook 'change-major-mode-hook 'font-lock-change-mode nil t) | 161 | (add-hook 'change-major-mode-hook 'font-lock-change-mode nil t) |
| 162 | (remove-hook 'change-major-mode-hook 'font-lock-change-mode t)) | 162 | (remove-hook 'change-major-mode-hook 'font-lock-change-mode t))) |
| 163 | (when font-lock-mode | ||
| 164 | (setq font-lock-mode-major-mode major-mode))) | ||
| 165 | 163 | ||
| 166 | ;; Get rid of fontification for the old major mode. | 164 | ;; Get rid of fontification for the old major mode. |
| 167 | ;; We do this when changing major modes. | 165 | ;; We do this when changing major modes. |
| @@ -213,8 +211,8 @@ this function onto `change-major-mode-hook'." | |||
| 213 | (and mode | 211 | (and mode |
| 214 | (boundp 'font-lock-set-defaults) | 212 | (boundp 'font-lock-set-defaults) |
| 215 | font-lock-set-defaults | 213 | font-lock-set-defaults |
| 216 | font-lock-mode-major-mode | 214 | font-lock-major-mode |
| 217 | (not (eq font-lock-mode-major-mode major-mode)))) | 215 | (not (eq font-lock-major-mode major-mode)))) |
| 218 | (font-lock-mode-internal mode))) | 216 | (font-lock-mode-internal mode))) |
| 219 | 217 | ||
| 220 | (defun turn-on-font-lock () | 218 | (defun turn-on-font-lock () |
diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 7e8562c433a..db665857fdb 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el | |||
| @@ -1783,15 +1783,18 @@ preserve `hi-lock-mode' highlighting patterns." | |||
| 1783 | (kill-local-variable 'font-lock-set-defaults) | 1783 | (kill-local-variable 'font-lock-set-defaults) |
| 1784 | (font-lock-mode 1)) | 1784 | (font-lock-mode 1)) |
| 1785 | 1785 | ||
| 1786 | (defvar font-lock-mode-major-mode) | 1786 | (defvar font-lock-major-mode nil |
| 1787 | "Major mode for which the font-lock settings have been setup.") | ||
| 1788 | (make-variable-buffer-local 'font-lock-major-mode) | ||
| 1789 | |||
| 1787 | (defun font-lock-set-defaults () | 1790 | (defun font-lock-set-defaults () |
| 1788 | "Set fontification defaults appropriately for this mode. | 1791 | "Set fontification defaults appropriately for this mode. |
| 1789 | Sets various variables using `font-lock-defaults' (or, if nil, using | 1792 | Sets various variables using `font-lock-defaults' (or, if nil, using |
| 1790 | `font-lock-defaults-alist') and `font-lock-maximum-decoration'." | 1793 | `font-lock-defaults-alist') and `font-lock-maximum-decoration'." |
| 1791 | ;; Set fontification defaults if not previously set for correct major mode. | 1794 | ;; Set fontification defaults if not previously set for correct major mode. |
| 1792 | (unless (and font-lock-set-defaults | 1795 | (unless (and font-lock-set-defaults |
| 1793 | (eq font-lock-mode-major-mode major-mode)) | 1796 | (eq font-lock-major-mode major-mode)) |
| 1794 | (setq font-lock-mode-major-mode major-mode) | 1797 | (setq font-lock-major-mode major-mode) |
| 1795 | (set (make-local-variable 'font-lock-set-defaults) t) | 1798 | (set (make-local-variable 'font-lock-set-defaults) t) |
| 1796 | (make-local-variable 'font-lock-fontified) | 1799 | (make-local-variable 'font-lock-fontified) |
| 1797 | (make-local-variable 'font-lock-multiline) | 1800 | (make-local-variable 'font-lock-multiline) |
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index e50bdb58575..d25caf70347 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,3 +1,8 @@ | |||
| 1 | 2010-06-22 Mark A. Hershberger <mah@everybody.org> | ||
| 2 | |||
| 3 | * mm-url.el (mm-url-encode-multipart-form-data): New function to handle | ||
| 4 | the *other* type of HTML form submission. | ||
| 5 | |||
| 1 | 2010-06-15 Michael Albinus <michael.albinus@gmx.de> | 6 | 2010-06-15 Michael Albinus <michael.albinus@gmx.de> |
| 2 | 7 | ||
| 3 | * auth-source.el (auth-source-pick): If choice does not contain a | 8 | * auth-source.el (auth-source-pick): If choice does not contain a |
diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index c5a8d9f7fdc..c72f520d60a 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el | |||
| @@ -418,6 +418,48 @@ spaces. Die Die Die." | |||
| 418 | (mm-url-form-encode-xwfu (cdr data)))) | 418 | (mm-url-form-encode-xwfu (cdr data)))) |
| 419 | pairs "&")) | 419 | pairs "&")) |
| 420 | 420 | ||
| 421 | (defun mm-url-encode-multipart-form-data (pairs &optional boundary) | ||
| 422 | "Return PAIRS encoded in multipart/form-data." | ||
| 423 | ;; RFC1867 | ||
| 424 | |||
| 425 | ;; Get a good boundary | ||
| 426 | (unless boundary | ||
| 427 | (setq boundary (mml-compute-boundary '()))) | ||
| 428 | |||
| 429 | (concat | ||
| 430 | |||
| 431 | ;; Start with the boundary | ||
| 432 | "--" boundary "\r\n" | ||
| 433 | |||
| 434 | ;; Create name value pairs | ||
| 435 | (mapconcat | ||
| 436 | 'identity | ||
| 437 | ;; Delete any returned items that are empty | ||
| 438 | (delq nil | ||
| 439 | (mapcar (lambda (data) | ||
| 440 | (when (car data) | ||
| 441 | ;; For each pair | ||
| 442 | (concat | ||
| 443 | |||
| 444 | ;; Encode the name | ||
| 445 | "Content-Disposition: form-data; name=\"" | ||
| 446 | (car data) "\"\r\n" | ||
| 447 | "Content-Type: text/plain; charset=utf-8\r\n" | ||
| 448 | "Content-Transfer-Encoding: binary\r\n\r\n" | ||
| 449 | |||
| 450 | (cond ((stringp (cdr data)) | ||
| 451 | (cdr data)) | ||
| 452 | ((integerp (cdr data)) | ||
| 453 | (int-to-string (cdr data)))) | ||
| 454 | |||
| 455 | "\r\n"))) | ||
| 456 | pairs)) | ||
| 457 | ;; use the boundary as a separator | ||
| 458 | (concat "--" boundary "\r\n")) | ||
| 459 | |||
| 460 | ;; put a boundary at the end. | ||
| 461 | "--" boundary "--\r\n")) | ||
| 462 | |||
| 421 | (defun mm-url-fetch-form (url pairs) | 463 | (defun mm-url-fetch-form (url pairs) |
| 422 | "Fetch a form from URL with PAIRS as the data using the POST method." | 464 | "Fetch a form from URL with PAIRS as the data using the POST method." |
| 423 | (mm-url-load-url) | 465 | (mm-url-load-url) |
diff --git a/lisp/help-mode.el b/lisp/help-mode.el index f115e425325..7a7a1ddaf79 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el | |||
| @@ -244,6 +244,16 @@ The format is (FUNCTION ARGS...).") | |||
| 244 | (message "Unable to find location in file")))) | 244 | (message "Unable to find location in file")))) |
| 245 | 'help-echo (purecopy "mouse-2, RET: find face's definition")) | 245 | 'help-echo (purecopy "mouse-2, RET: find face's definition")) |
| 246 | 246 | ||
| 247 | (define-button-type 'help-package | ||
| 248 | :supertype 'help-xref | ||
| 249 | 'help-function 'describe-package | ||
| 250 | 'help-echo (purecopy "mouse-2, RET: Describe package")) | ||
| 251 | |||
| 252 | (define-button-type 'help-package-def | ||
| 253 | :supertype 'help-xref | ||
| 254 | 'help-function (lambda (file) (dired file)) | ||
| 255 | 'help-echo (purecopy "mouse-2, RET: visit package directory")) | ||
| 256 | |||
| 247 | 257 | ||
| 248 | ;;;###autoload | 258 | ;;;###autoload |
| 249 | (defun help-mode () | 259 | (defun help-mode () |
| @@ -272,6 +282,9 @@ Commands: | |||
| 272 | (with-current-buffer buffer | 282 | (with-current-buffer buffer |
| 273 | (bury-buffer)))) | 283 | (bury-buffer)))) |
| 274 | 284 | ||
| 285 | (set (make-local-variable 'revert-buffer-function) | ||
| 286 | 'help-mode-revert-buffer) | ||
| 287 | |||
| 275 | (run-mode-hooks 'help-mode-hook)) | 288 | (run-mode-hooks 'help-mode-hook)) |
| 276 | 289 | ||
| 277 | ;;;###autoload | 290 | ;;;###autoload |
| @@ -783,6 +796,17 @@ Show all docs for that symbol as either a variable, function or face." | |||
| 783 | (fboundp sym) (facep sym)) | 796 | (fboundp sym) (facep sym)) |
| 784 | (help-do-xref pos #'help-xref-interned (list sym))))) | 797 | (help-do-xref pos #'help-xref-interned (list sym))))) |
| 785 | 798 | ||
| 799 | (defun help-mode-revert-buffer (ignore-auto noconfirm) | ||
| 800 | (when (or noconfirm (yes-or-no-p "Revert help buffer? ")) | ||
| 801 | (let ((pos (point)) | ||
| 802 | (item help-xref-stack-item) | ||
| 803 | ;; Pretend there is no current item to add to the history. | ||
| 804 | (help-xref-stack-item nil) | ||
| 805 | ;; Use the current buffer. | ||
| 806 | (help-xref-following t)) | ||
| 807 | (apply (car item) (cdr item)) | ||
| 808 | (goto-char pos)))) | ||
| 809 | |||
| 786 | (defun help-insert-string (string) | 810 | (defun help-insert-string (string) |
| 787 | "Insert STRING to the help buffer and install xref info for it. | 811 | "Insert STRING to the help buffer and install xref info for it. |
| 788 | This function can be used to restore the old contents of the help buffer | 812 | This function can be used to restore the old contents of the help buffer |
diff --git a/lisp/info.el b/lisp/info.el index e76a8da146e..9a30f63fff0 100644 --- a/lisp/info.el +++ b/lisp/info.el | |||
| @@ -238,7 +238,9 @@ This only has an effect if `Info-hide-note-references' is non-nil." | |||
| 238 | (defcustom Info-breadcrumbs-depth 4 | 238 | (defcustom Info-breadcrumbs-depth 4 |
| 239 | "Depth of breadcrumbs to display. | 239 | "Depth of breadcrumbs to display. |
| 240 | 0 means do not display breadcrumbs." | 240 | 0 means do not display breadcrumbs." |
| 241 | :type 'integer) | 241 | :version "23.1" |
| 242 | :type 'integer | ||
| 243 | :group 'info) | ||
| 242 | 244 | ||
| 243 | (defcustom Info-search-whitespace-regexp "\\s-+" | 245 | (defcustom Info-search-whitespace-regexp "\\s-+" |
| 244 | "If non-nil, regular expression to match a sequence of whitespace chars. | 246 | "If non-nil, regular expression to match a sequence of whitespace chars. |
| @@ -800,17 +802,22 @@ otherwise, that defaults to `Top'." | |||
| 800 | "Go to an Info node FILENAME and NODENAME, re-reading disk contents. | 802 | "Go to an Info node FILENAME and NODENAME, re-reading disk contents. |
| 801 | When *info* is already displaying FILENAME and NODENAME, the window position | 803 | When *info* is already displaying FILENAME and NODENAME, the window position |
| 802 | is preserved, if possible." | 804 | is preserved, if possible." |
| 803 | (pop-to-buffer "*info*") | 805 | (or (eq major-mode 'Info-mode) (pop-to-buffer "*info*")) |
| 804 | (let ((old-filename Info-current-file) | 806 | (let ((old-filename Info-current-file) |
| 805 | (old-nodename Info-current-node) | 807 | (old-nodename Info-current-node) |
| 808 | (old-buffer-name (buffer-name)) | ||
| 806 | (pcolumn (current-column)) | 809 | (pcolumn (current-column)) |
| 807 | (pline (count-lines (point-min) (line-beginning-position))) | 810 | (pline (count-lines (point-min) (line-beginning-position))) |
| 808 | (wline (count-lines (point-min) (window-start))) | 811 | (wline (count-lines (point-min) (window-start))) |
| 812 | (old-history-forward Info-history-forward) | ||
| 809 | (old-history Info-history) | 813 | (old-history Info-history) |
| 810 | (new-history (and Info-current-file | 814 | (new-history (and Info-current-file |
| 811 | (list Info-current-file Info-current-node (point))))) | 815 | (list Info-current-file Info-current-node (point))))) |
| 812 | (kill-buffer (current-buffer)) | 816 | (kill-buffer (current-buffer)) |
| 817 | (pop-to-buffer (or old-buffer-name "*info*")) | ||
| 818 | (Info-mode) | ||
| 813 | (Info-find-node filename nodename) | 819 | (Info-find-node filename nodename) |
| 820 | (setq Info-history-forward old-history-forward) | ||
| 814 | (setq Info-history old-history) | 821 | (setq Info-history old-history) |
| 815 | (if (and (equal old-filename Info-current-file) | 822 | (if (and (equal old-filename Info-current-file) |
| 816 | (equal old-nodename Info-current-node)) | 823 | (equal old-nodename Info-current-node)) |
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index d831744f311..903bea36044 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el | |||
| @@ -703,6 +703,10 @@ by \"Save Options\" in Custom buffers.") | |||
| 703 | (when need-save | 703 | (when need-save |
| 704 | (custom-save-all)))) | 704 | (custom-save-all)))) |
| 705 | 705 | ||
| 706 | (define-key menu-bar-options-menu [package] | ||
| 707 | '(menu-item "Manage Emacs Packages" package-list-packages | ||
| 708 | :help "Install or uninstall additional Emacs packages")) | ||
| 709 | |||
| 706 | (define-key menu-bar-options-menu [save] | 710 | (define-key menu-bar-options-menu [save] |
| 707 | `(menu-item ,(purecopy "Save Options") menu-bar-options-save | 711 | `(menu-item ,(purecopy "Save Options") menu-bar-options-save |
| 708 | :help ,(purecopy "Save options set from the menu above"))) | 712 | :help ,(purecopy "Save options set from the menu above"))) |
| @@ -1055,7 +1059,7 @@ mail status in mode line")) | |||
| 1055 | (define-key menu-bar-options-menu [cua-emulation-mode] | 1059 | (define-key menu-bar-options-menu [cua-emulation-mode] |
| 1056 | (menu-bar-make-mm-toggle cua-mode | 1060 | (menu-bar-make-mm-toggle cua-mode |
| 1057 | "Shift movement mark region (CUA)" | 1061 | "Shift movement mark region (CUA)" |
| 1058 | "Use shifted movement keys to set and extend the region." | 1062 | "Use shifted movement keys to set and extend the region" |
| 1059 | (:visible (and (boundp 'cua-enable-cua-keys) | 1063 | (:visible (and (boundp 'cua-enable-cua-keys) |
| 1060 | (not cua-enable-cua-keys))))) | 1064 | (not cua-enable-cua-keys))))) |
| 1061 | 1065 | ||
diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index 35007edfe15..6857a42862a 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog | |||
| @@ -1,3 +1,8 @@ | |||
| 1 | 2010-06-22 Glenn Morris <rgm@gnu.org> | ||
| 2 | |||
| 3 | * org-entities.el: Add explicit utf-8 coding cookie to file with | ||
| 4 | utf-8 characters. | ||
| 5 | |||
| 1 | 2010-05-26 Stefan Monnier <monnier@iro.umontreal.ca> | 6 | 2010-05-26 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 7 | ||
| 3 | * org.el (org-file-complete-link): Avoid (expand-file-name "."). | 8 | * org.el (org-file-complete-link): Avoid (expand-file-name "."). |
diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el index 709c037d488..4dfe3a95e1b 100644 --- a/lisp/org/org-entities.el +++ b/lisp/org/org-entities.el | |||
| @@ -488,6 +488,9 @@ Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'." | |||
| 488 | 488 | ||
| 489 | (provide 'org-entities) | 489 | (provide 'org-entities) |
| 490 | 490 | ||
| 491 | ;; arch-tag: e6bd163f-7419-4009-9c93-a74623016424 | 491 | ;; Local variables: |
| 492 | ;; coding: utf-8 | ||
| 493 | ;; End: | ||
| 492 | 494 | ||
| 495 | ;; arch-tag: e6bd163f-7419-4009-9c93-a74623016424 | ||
| 493 | ;;; org-entities.el ends here | 496 | ;;; org-entities.el ends here |
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 7eb0016ff43..e5e108106f1 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el | |||
| @@ -1082,7 +1082,7 @@ been put there by c-put-char-property. POINT remains unchanged." | |||
| 1082 | (setq place (next-single-property-change place property nil to))) | 1082 | (setq place (next-single-property-change place property nil to))) |
| 1083 | (< place to)) | 1083 | (< place to)) |
| 1084 | (setq end-place (next-single-property-change place property nil to)) | 1084 | (setq end-place (next-single-property-change place property nil to)) |
| 1085 | (put-text-property place end-place property nil) | 1085 | (remove-text-properties place end-place (cons property nil)) |
| 1086 | ;; Do we have to do anything with stickiness here? | 1086 | ;; Do we have to do anything with stickiness here? |
| 1087 | (setq place end-place)))) | 1087 | (setq place end-place)))) |
| 1088 | 1088 | ||
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 1ee3c295fe1..9bbf82a0449 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el | |||
| @@ -4985,7 +4985,8 @@ comment at the start of cc-engine.el for more info." | |||
| 4985 | ;; POS (default point) is at a < character. If it is both marked | 4985 | ;; POS (default point) is at a < character. If it is both marked |
| 4986 | ;; with open/close paren syntax-table property, and has a matching > | 4986 | ;; with open/close paren syntax-table property, and has a matching > |
| 4987 | ;; (also marked) which is after LIM, remove the property both from | 4987 | ;; (also marked) which is after LIM, remove the property both from |
| 4988 | ;; the current > and its partner. | 4988 | ;; the current > and its partner. Return t when this happens, nil |
| 4989 | ;; when it doesn't. | ||
| 4989 | (save-excursion | 4990 | (save-excursion |
| 4990 | (if pos | 4991 | (if pos |
| 4991 | (goto-char pos) | 4992 | (goto-char pos) |
| @@ -4998,13 +4999,15 @@ comment at the start of cc-engine.el for more info." | |||
| 4998 | (equal (c-get-char-property (1- (point)) 'syntax-table) | 4999 | (equal (c-get-char-property (1- (point)) 'syntax-table) |
| 4999 | c->-as-paren-syntax)) ; should always be true. | 5000 | c->-as-paren-syntax)) ; should always be true. |
| 5000 | (c-unmark-<->-as-paren (1- (point))) | 5001 | (c-unmark-<->-as-paren (1- (point))) |
| 5001 | (c-unmark-<->-as-paren pos))))) | 5002 | (c-unmark-<->-as-paren pos)) |
| 5003 | t))) | ||
| 5002 | 5004 | ||
| 5003 | (defun c-clear->-pair-props-if-match-before (lim &optional pos) | 5005 | (defun c-clear->-pair-props-if-match-before (lim &optional pos) |
| 5004 | ;; POS (default point) is at a > character. If it is both marked | 5006 | ;; POS (default point) is at a > character. If it is both marked |
| 5005 | ;; with open/close paren syntax-table property, and has a matching < | 5007 | ;; with open/close paren syntax-table property, and has a matching < |
| 5006 | ;; (also marked) which is before LIM, remove the property both from | 5008 | ;; (also marked) which is before LIM, remove the property both from |
| 5007 | ;; the current < and its partner. | 5009 | ;; the current < and its partner. Return t when this happens, nil |
| 5010 | ;; when it doesn't. | ||
| 5008 | (save-excursion | 5011 | (save-excursion |
| 5009 | (if pos | 5012 | (if pos |
| 5010 | (goto-char pos) | 5013 | (goto-char pos) |
| @@ -5017,7 +5020,8 @@ comment at the start of cc-engine.el for more info." | |||
| 5017 | (equal (c-get-char-property (point) 'syntax-table) | 5020 | (equal (c-get-char-property (point) 'syntax-table) |
| 5018 | c-<-as-paren-syntax)) ; should always be true. | 5021 | c-<-as-paren-syntax)) ; should always be true. |
| 5019 | (c-unmark-<->-as-paren (point)) | 5022 | (c-unmark-<->-as-paren (point)) |
| 5020 | (c-unmark-<->-as-paren pos))))) | 5023 | (c-unmark-<->-as-paren pos)) |
| 5024 | t))) | ||
| 5021 | 5025 | ||
| 5022 | (defun c-before-change-check-<>-operators (beg end) | 5026 | (defun c-before-change-check-<>-operators (beg end) |
| 5023 | ;; Unmark certain pairs of "< .... >" which are currently marked as | 5027 | ;; Unmark certain pairs of "< .... >" which are currently marked as |
| @@ -5040,25 +5044,39 @@ comment at the start of cc-engine.el for more info." | |||
| 5040 | ;; 2010-01-29. | 5044 | ;; 2010-01-29. |
| 5041 | (save-excursion | 5045 | (save-excursion |
| 5042 | (let ((beg-lit-limits (progn (goto-char beg) (c-literal-limits))) | 5046 | (let ((beg-lit-limits (progn (goto-char beg) (c-literal-limits))) |
| 5043 | (end-lit-limits (progn (goto-char end) (c-literal-limits)))) | 5047 | (end-lit-limits (progn (goto-char end) (c-literal-limits))) |
| 5048 | new-beg new-end need-new-beg need-new-end) | ||
| 5044 | ;; Locate the barrier before the changed region | 5049 | ;; Locate the barrier before the changed region |
| 5045 | (goto-char (if beg-lit-limits (car beg-lit-limits) beg)) | 5050 | (goto-char (if beg-lit-limits (car beg-lit-limits) beg)) |
| 5046 | (c-syntactic-skip-backward "^;{}" (max (- beg 2048) (point-min))) | 5051 | (c-syntactic-skip-backward "^;{}" (max (- beg 2048) (point-min))) |
| 5052 | (setq new-beg (point)) | ||
| 5047 | 5053 | ||
| 5048 | ;; Remove the syntax-table properties from each pertinent <...> pair. | 5054 | ;; Remove the syntax-table properties from each pertinent <...> pair. |
| 5049 | ;; Firsly, the ones with the < before beg and > after beg. | 5055 | ;; Firsly, the ones with the < before beg and > after beg. |
| 5050 | (while (c-search-forward-char-property 'category 'c-<-as-paren-syntax beg) | 5056 | (while (c-search-forward-char-property 'category 'c-<-as-paren-syntax beg) |
| 5051 | (c-clear-<-pair-props-if-match-after beg (1- (point)))) | 5057 | (if (c-clear-<-pair-props-if-match-after beg (1- (point))) |
| 5058 | (setq need-new-beg t))) | ||
| 5052 | 5059 | ||
| 5053 | ;; Locate the barrier after END. | 5060 | ;; Locate the barrier after END. |
| 5054 | (goto-char (if end-lit-limits (cdr end-lit-limits) end)) | 5061 | (goto-char (if end-lit-limits (cdr end-lit-limits) end)) |
| 5055 | (c-syntactic-re-search-forward "[;{}]" | 5062 | (c-syntactic-re-search-forward "[;{}]" |
| 5056 | (min (+ end 2048) (point-max)) 'end) | 5063 | (min (+ end 2048) (point-max)) 'end) |
| 5064 | (setq new-end (point)) | ||
| 5057 | 5065 | ||
| 5058 | ;; Remove syntax-table properties from the remaining pertinent <...> | 5066 | ;; Remove syntax-table properties from the remaining pertinent <...> |
| 5059 | ;; pairs, those with a > after end and < before end. | 5067 | ;; pairs, those with a > after end and < before end. |
| 5060 | (while (c-search-backward-char-property 'category 'c->-as-paren-syntax end) | 5068 | (while (c-search-backward-char-property 'category 'c->-as-paren-syntax end) |
| 5061 | (c-clear->-pair-props-if-match-before end))))) | 5069 | (if (c-clear->-pair-props-if-match-before end) |
| 5070 | (setq need-new-end t))) | ||
| 5071 | |||
| 5072 | ;; Extend the fontification region, if needed. | ||
| 5073 | (when need-new-beg | ||
| 5074 | (goto-char new-beg) | ||
| 5075 | (c-forward-syntactic-ws) | ||
| 5076 | (and (< (point) c-new-BEG) (setq c-new-BEG (point)))) | ||
| 5077 | |||
| 5078 | (when need-new-end | ||
| 5079 | (and (> new-end c-new-END) (setq c-new-END new-end)))))) | ||
| 5062 | 5080 | ||
| 5063 | 5081 | ||
| 5064 | 5082 | ||
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index ed17e6f34e6..9044b42a838 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el | |||
| @@ -640,6 +640,8 @@ compatible with old code; callers should always specify it." | |||
| 640 | ;; Starting a mode is a sort of "change". So call the change functions... | 640 | ;; Starting a mode is a sort of "change". So call the change functions... |
| 641 | (save-restriction | 641 | (save-restriction |
| 642 | (widen) | 642 | (widen) |
| 643 | (setq c-new-BEG (point-min)) | ||
| 644 | (setq c-new-END (point-max)) | ||
| 643 | (save-excursion | 645 | (save-excursion |
| 644 | (if c-get-state-before-change-functions | 646 | (if c-get-state-before-change-functions |
| 645 | (mapc (lambda (fn) | 647 | (mapc (lambda (fn) |
| @@ -886,17 +888,19 @@ Note that the style variables are always made local to the buffer." | |||
| 886 | ;; inside a string, comment, or macro. | 888 | ;; inside a string, comment, or macro. |
| 887 | (goto-char c-old-BOM) ; already set to old start of macro or begg. | 889 | (goto-char c-old-BOM) ; already set to old start of macro or begg. |
| 888 | (setq c-new-BEG | 890 | (setq c-new-BEG |
| 889 | (if (setq limits (c-state-literal-at (point))) | 891 | (min c-new-BEG |
| 890 | (cdr limits) ; go forward out of any string or comment. | 892 | (if (setq limits (c-state-literal-at (point))) |
| 891 | (point))) | 893 | (cdr limits) ; go forward out of any string or comment. |
| 894 | (point)))) | ||
| 892 | 895 | ||
| 893 | (goto-char endd) | 896 | (goto-char endd) |
| 894 | (if (setq limits (c-state-literal-at (point))) | 897 | (if (setq limits (c-state-literal-at (point))) |
| 895 | (goto-char (car limits))) ; go backward out of any string or comment. | 898 | (goto-char (car limits))) ; go backward out of any string or comment. |
| 896 | (if (c-beginning-of-macro) | 899 | (if (c-beginning-of-macro) |
| 897 | (c-end-of-macro)) | 900 | (c-end-of-macro)) |
| 898 | (setq c-new-END (max (+ (- c-old-EOM old-len) (- endd begg)) | 901 | (setq c-new-END (max c-new-END |
| 899 | (point))) | 902 | (+ (- c-old-EOM old-len) (- endd begg)) |
| 903 | (point))) | ||
| 900 | 904 | ||
| 901 | ;; Clear all old relevant properties. | 905 | ;; Clear all old relevant properties. |
| 902 | (c-clear-char-property-with-value c-new-BEG c-new-END 'syntax-table '(1)) | 906 | (c-clear-char-property-with-value c-new-BEG c-new-END 'syntax-table '(1)) |
diff --git a/lisp/simple.el b/lisp/simple.el index 08ed329a9b8..ef30e98dd1c 100644 --- a/lisp/simple.el +++ b/lisp/simple.el | |||
| @@ -5698,7 +5698,7 @@ Each action has the form (FUNCTION . ARGS)." | |||
| 5698 | The default mail mode is now Message mode. | 5698 | The default mail mode is now Message mode. |
| 5699 | You have the following Mail mode variable%s customized: | 5699 | You have the following Mail mode variable%s customized: |
| 5700 | \n %s\n\nTo use Mail mode, set `mail-user-agent' to sendmail-user-agent. | 5700 | \n %s\n\nTo use Mail mode, set `mail-user-agent' to sendmail-user-agent. |
| 5701 | To disable this warning, set `compose-mail-check-user-agent' to nil." | 5701 | To disable this warning, set `compose-mail-user-agent-warnings' to nil." |
| 5702 | (if (> (length warn-vars) 1) "s" "") | 5702 | (if (> (length warn-vars) 1) "s" "") |
| 5703 | (mapconcat 'symbol-name | 5703 | (mapconcat 'symbol-name |
| 5704 | warn-vars " ")))))) | 5704 | warn-vars " ")))))) |
diff --git a/lisp/startup.el b/lisp/startup.el index 87f1a00bd54..71857076d4f 100644 --- a/lisp/startup.el +++ b/lisp/startup.el | |||
| @@ -1166,6 +1166,9 @@ the `--debug-init' option to view a complete error backtrace." | |||
| 1166 | (eq face-ignored-fonts old-face-ignored-fonts)) | 1166 | (eq face-ignored-fonts old-face-ignored-fonts)) |
| 1167 | (clear-face-cache))) | 1167 | (clear-face-cache))) |
| 1168 | 1168 | ||
| 1169 | ;; Load ELPA packages. | ||
| 1170 | (and user-init-file package-enable-at-startup (package-initialize)) | ||
| 1171 | |||
| 1169 | (setq after-init-time (current-time)) | 1172 | (setq after-init-time (current-time)) |
| 1170 | (run-hooks 'after-init-hook) | 1173 | (run-hooks 'after-init-hook) |
| 1171 | 1174 | ||
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 94eb721e4cf..4d0cc842351 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el | |||
| @@ -660,8 +660,8 @@ re-start Emacs." | |||
| 660 | "[^A-Za-z\241\243\246\254\257\261\263\266\274\277\306\312\321\323\346\352\361\363]" | 660 | "[^A-Za-z\241\243\246\254\257\261\263\266\274\277\306\312\321\323\346\352\361\363]" |
| 661 | "[.]" nil nil nil iso-8859-2) | 661 | "[.]" nil nil nil iso-8859-2) |
| 662 | ("portugues" ; Portuguese mode | 662 | ("portugues" ; Portuguese mode |
| 663 | "[a-zA-Z\301\302\311\323\340\341\342\351\352\355\363\343\372]" | 663 | "[a-zA-Z\301\302\307\311\323\340\341\342\351\352\355\363\343\347\372]" |
| 664 | "[^a-zA-Z\301\302\311\323\340\341\342\351\352\355\363\343\372]" | 664 | "[^a-zA-Z\301\302\307\311\323\340\341\342\351\352\355\363\343\347\372]" |
| 665 | "[']" t ("-C") "~latin1" iso-8859-1) | 665 | "[']" t ("-C") "~latin1" iso-8859-1) |
| 666 | ("russian" ; Russian.aff (KOI8-R charset) | 666 | ("russian" ; Russian.aff (KOI8-R charset) |
| 667 | "[\341\342\367\347\344\345\263\366\372\351\352\353\354\355\356\357\360\362\363\364\365\346\350\343\376\373\375\370\371\377\374\340\361\301\302\327\307\304\305\243\326\332\311\312\313\314\315\316\317\320\322\323\324\325\306\310\303\336\333\335\330\331\337\334\300\321]" | 667 | "[\341\342\367\347\344\345\263\366\372\351\352\353\354\355\356\357\360\362\363\364\365\346\350\343\376\373\375\370\371\377\374\340\361\301\302\327\307\304\305\243\326\332\311\312\313\314\315\316\317\320\322\323\324\325\306\310\303\336\333\335\330\331\337\334\300\321]" |
| @@ -982,8 +982,8 @@ Assumes that value contains no whitespace." | |||
| 982 | ;; This returns nil if the data file does not exist. | 982 | ;; This returns nil if the data file does not exist. |
| 983 | ;; Can someone please explain the return value format when the | 983 | ;; Can someone please explain the return value format when the |
| 984 | ;; file does exist -- rms? | 984 | ;; file does exist -- rms? |
| 985 | (let* ((lang ;; Strip out region, variant, etc. | 985 | (let* ((lang ;; Strip out variant, etc. |
| 986 | (and (string-match "^[[:alpha:]]+" dict-name) | 986 | (and (string-match "^[[:alpha:]_]+" dict-name) |
| 987 | (match-string 0 dict-name))) | 987 | (match-string 0 dict-name))) |
| 988 | (data-file | 988 | (data-file |
| 989 | (concat (or ispell-aspell-data-dir | 989 | (concat (or ispell-aspell-data-dir |
diff --git a/lisp/textmodes/texinfmt.el b/lisp/textmodes/texinfmt.el index b735b446b81..577287c60bc 100644 --- a/lisp/textmodes/texinfmt.el +++ b/lisp/textmodes/texinfmt.el | |||
| @@ -1,8 +1,8 @@ | |||
| 1 | ;;; texinfmt.el --- format Texinfo files into Info files | 1 | ;;; texinfmt.el --- format Texinfo files into Info files |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1985, 1986, 1988, 1990, 1991, 1992, 1993, | 3 | ;; Copyright (C) 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, |
| 4 | ;; 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, | 4 | ;; 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, |
| 5 | ;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. | 5 | ;; 2008, 2009, 2010 Free Software Foundation, Inc. |
| 6 | 6 | ||
| 7 | ;; Maintainer: Robert J. Chassell <bug-texinfo@gnu.org> | 7 | ;; Maintainer: Robert J. Chassell <bug-texinfo@gnu.org> |
| 8 | ;; Keywords: maint, tex, docs | 8 | ;; Keywords: maint, tex, docs |
| @@ -224,7 +224,7 @@ converted to Info is stored in a temporary buffer." | |||
| 224 | (save-restriction | 224 | (save-restriction |
| 225 | (widen) | 225 | (widen) |
| 226 | (goto-char (point-min)) | 226 | (goto-char (point-min)) |
| 227 | (let ((search-end (save-excursion (forward-line 100) (point)))) | 227 | (let ((search-end (line-beginning-position 101))) |
| 228 | (if (or | 228 | (if (or |
| 229 | ;; Either copy header text. | 229 | ;; Either copy header text. |
| 230 | (and | 230 | (and |
| @@ -285,7 +285,7 @@ converted to Info is stored in a temporary buffer." | |||
| 285 | (let ((filename (concat input-directory | 285 | (let ((filename (concat input-directory |
| 286 | (texinfo-parse-line-arg)))) | 286 | (texinfo-parse-line-arg)))) |
| 287 | (re-search-backward "^@include") | 287 | (re-search-backward "^@include") |
| 288 | (delete-region (point) (save-excursion (forward-line 1) (point))) | 288 | (delete-region (point) (line-beginning-position 2)) |
| 289 | (message "Reading included file: %s" filename) | 289 | (message "Reading included file: %s" filename) |
| 290 | (save-excursion | 290 | (save-excursion |
| 291 | (save-restriction | 291 | (save-restriction |
| @@ -323,8 +323,7 @@ converted to Info is stored in a temporary buffer." | |||
| 323 | 323 | ||
| 324 | ;; Insert Info region title text. | 324 | ;; Insert Info region title text. |
| 325 | (goto-char (point-min)) | 325 | (goto-char (point-min)) |
| 326 | (if (search-forward | 326 | (if (search-forward "@setfilename" (line-beginning-position 101) t) |
| 327 | "@setfilename" (save-excursion (forward-line 100) (point)) t) | ||
| 328 | (progn | 327 | (progn |
| 329 | (setq texinfo-command-end (point)) | 328 | (setq texinfo-command-end (point)) |
| 330 | (beginning-of-line) | 329 | (beginning-of-line) |
| @@ -772,13 +771,13 @@ commands." | |||
| 772 | ((eq type '@raisesections) | 771 | ((eq type '@raisesections) |
| 773 | (setq level (1+ level)) | 772 | (setq level (1+ level)) |
| 774 | (delete-region | 773 | (delete-region |
| 775 | (point) (save-excursion (forward-line 1) (point)))) | 774 | (point) (line-beginning-position 2))) |
| 776 | 775 | ||
| 777 | ;; 2. Decrement level | 776 | ;; 2. Decrement level |
| 778 | ((eq type '@lowersections) | 777 | ((eq type '@lowersections) |
| 779 | (setq level (1- level)) | 778 | (setq level (1- level)) |
| 780 | (delete-region | 779 | (delete-region |
| 781 | (point) (save-excursion (forward-line 1) (point)))) | 780 | (point) (line-beginning-position 2))) |
| 782 | 781 | ||
| 783 | ;; Now handle structuring commands | 782 | ;; Now handle structuring commands |
| 784 | ((cond | 783 | ((cond |
| @@ -1505,9 +1504,7 @@ The node is constructed automatically." | |||
| 1505 | (progn (goto-char node-name-beginning) ; skip over node command | 1504 | (progn (goto-char node-name-beginning) ; skip over node command |
| 1506 | (skip-chars-forward " \t") ; and over spaces | 1505 | (skip-chars-forward " \t") ; and over spaces |
| 1507 | (point)) | 1506 | (point)) |
| 1508 | (if (search-forward | 1507 | (if (search-forward "," (line-end-position) t) ; bound search |
| 1509 | "," | ||
| 1510 | (save-excursion (end-of-line) (point)) t) ; bound search | ||
| 1511 | (1- (point)) | 1508 | (1- (point)) |
| 1512 | (end-of-line) (point)))))) | 1509 | (end-of-line) (point)))))) |
| 1513 | (texinfo-discard-command) ; remove or insert whitespace, as needed | 1510 | (texinfo-discard-command) ; remove or insert whitespace, as needed |
| @@ -1692,7 +1689,7 @@ Used by @refill indenting command to avoid indenting within lists, etc.") | |||
| 1692 | (put 'itemize 'texinfo-item 'texinfo-itemize-item) | 1689 | (put 'itemize 'texinfo-item 'texinfo-itemize-item) |
| 1693 | (defun texinfo-itemize-item () | 1690 | (defun texinfo-itemize-item () |
| 1694 | ;; (texinfo-discard-line) ; Did not handle text on same line as @item. | 1691 | ;; (texinfo-discard-line) ; Did not handle text on same line as @item. |
| 1695 | (delete-region (1+ (point)) (save-excursion (beginning-of-line) (point))) | 1692 | (delete-region (1+ (point)) (line-beginning-position)) |
| 1696 | (if (looking-at "[ \t]*[^ \t\n]+") | 1693 | (if (looking-at "[ \t]*[^ \t\n]+") |
| 1697 | ;; Text on same line as @item command. | 1694 | ;; Text on same line as @item command. |
| 1698 | (insert "\b " (nth 1 (car texinfo-stack)) " \n") | 1695 | (insert "\b " (nth 1 (car texinfo-stack)) " \n") |
| @@ -2132,10 +2129,10 @@ This command is executed when texinfmt sees @item inside @multitable." | |||
| 2132 | (narrow-to-region start end) | 2129 | (narrow-to-region start end) |
| 2133 | ;; Remove whitespace before and after entry. | 2130 | ;; Remove whitespace before and after entry. |
| 2134 | (skip-chars-forward " ") | 2131 | (skip-chars-forward " ") |
| 2135 | (delete-region (point) (save-excursion (beginning-of-line) (point))) | 2132 | (delete-region (point) (line-beginning-position)) |
| 2136 | (goto-char (point-max)) | 2133 | (goto-char (point-max)) |
| 2137 | (skip-chars-backward " ") | 2134 | (skip-chars-backward " ") |
| 2138 | (delete-region (point) (save-excursion (end-of-line) (point))) | 2135 | (delete-region (point) (line-end-position)) |
| 2139 | ;; Temporarily set texinfo-stack to nil so texinfo-format-scan | 2136 | ;; Temporarily set texinfo-stack to nil so texinfo-format-scan |
| 2140 | ;; does not see an unterminated @multitable. | 2137 | ;; does not see an unterminated @multitable. |
| 2141 | (let (texinfo-stack) ; nil | 2138 | (let (texinfo-stack) ; nil |
| @@ -2409,16 +2406,14 @@ Use only the FILENAME arg; for Info, ignore the other arguments to @image." | |||
| 2409 | (let ((start (1- (point))) | 2406 | (let ((start (1- (point))) |
| 2410 | args) | 2407 | args) |
| 2411 | (skip-chars-forward " ") | 2408 | (skip-chars-forward " ") |
| 2412 | (save-excursion (end-of-line) (setq texinfo-command-end (point))) | 2409 | (setq texinfo-command-end (line-end-position)) |
| 2413 | (if (not (looking-at "\\([^=]+\\)=\\(.*\\)")) | 2410 | (if (not (looking-at "\\([^=]+\\)=\\(.*\\)")) |
| 2414 | (error "Invalid alias command") | 2411 | (error "Invalid alias command") |
| 2415 | (push (cons | 2412 | (push (cons |
| 2416 | (match-string-no-properties 1) | 2413 | (match-string-no-properties 1) |
| 2417 | (match-string-no-properties 2)) | 2414 | (match-string-no-properties 2)) |
| 2418 | texinfo-alias-list) | 2415 | texinfo-alias-list) |
| 2419 | (texinfo-discard-command)) | 2416 | (texinfo-discard-command)))) |
| 2420 | ) | ||
| 2421 | ) | ||
| 2422 | 2417 | ||
| 2423 | 2418 | ||
| 2424 | ;;; @var, @code and the like | 2419 | ;;; @var, @code and the like |
| @@ -2455,7 +2450,7 @@ Use only the FILENAME arg; for Info, ignore the other arguments to @image." | |||
| 2455 | "Insert ` ... ' around arg unless inside a table; in that case, no quotes." | 2450 | "Insert ` ... ' around arg unless inside a table; in that case, no quotes." |
| 2456 | ;; `looking-at-backward' not available in v. 18.57, 20.2 | 2451 | ;; `looking-at-backward' not available in v. 18.57, 20.2 |
| 2457 | (if (not (search-backward "" ; searched-for character is a control-H | 2452 | (if (not (search-backward "" ; searched-for character is a control-H |
| 2458 | (save-excursion (beginning-of-line) (point)) | 2453 | (line-beginning-position) |
| 2459 | t)) | 2454 | t)) |
| 2460 | (insert "`" (texinfo-parse-arg-discard) "'") | 2455 | (insert "`" (texinfo-parse-arg-discard) "'") |
| 2461 | (insert (texinfo-parse-arg-discard))) | 2456 | (insert (texinfo-parse-arg-discard))) |
| @@ -2840,8 +2835,7 @@ Default is to leave paragraph indentation as is." | |||
| 2840 | (defun texinfo-noindent () | 2835 | (defun texinfo-noindent () |
| 2841 | (save-excursion | 2836 | (save-excursion |
| 2842 | (forward-paragraph 1) | 2837 | (forward-paragraph 1) |
| 2843 | (if (search-backward "@refill" | 2838 | (if (search-backward "@refill" (line-beginning-position 0) t) |
| 2844 | (save-excursion (forward-line -1) (point)) t) | ||
| 2845 | () ; leave @noindent command so @refill command knows not to indent | 2839 | () ; leave @noindent command so @refill command knows not to indent |
| 2846 | ;; else | 2840 | ;; else |
| 2847 | (texinfo-discard-line)))) | 2841 | (texinfo-discard-line)))) |
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index f61c8d2566d..4499ea5ff52 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog | |||
| @@ -1,3 +1,13 @@ | |||
| 1 | 2010-06-22 Mark A. Hershberger <mah@everybody.org> | ||
| 2 | |||
| 3 | * url-parse.el (url-user-for-url, url-password-for-url): | ||
| 4 | Convenience functions that get usernames and passwords for urls | ||
| 5 | from auth-source functions. | ||
| 6 | |||
| 7 | 2010-06-12 Štěpán Němec <stepnem@gmail.com> (tiny change) | ||
| 8 | |||
| 9 | * url-vars.el (url-privacy-level): Fix doc typo. (Bug#6406) | ||
| 10 | |||
| 1 | 2010-05-19 Stefan Monnier <monnier@iro.umontreal.ca> | 11 | 2010-05-19 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 12 | ||
| 3 | * url-util.el (url-unhex-string): Don't accidentally decode as latin-1. | 13 | * url-util.el (url-unhex-string): Don't accidentally decode as latin-1. |
diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el index e68e0791558..20432dcf7e5 100644 --- a/lisp/url/url-parse.el +++ b/lisp/url/url-parse.el | |||
| @@ -25,6 +25,7 @@ | |||
| 25 | ;;; Code: | 25 | ;;; Code: |
| 26 | 26 | ||
| 27 | (require 'url-vars) | 27 | (require 'url-vars) |
| 28 | (require 'auth-source) | ||
| 28 | (eval-when-compile (require 'cl)) | 29 | (eval-when-compile (require 'cl)) |
| 29 | 30 | ||
| 30 | (autoload 'url-scheme-get-property "url-methods") | 31 | (autoload 'url-scheme-get-property "url-methods") |
| @@ -174,6 +175,25 @@ TYPE USER PASSWORD HOST PORTSPEC FILENAME TARGET ATTRIBUTES FULLNESS." | |||
| 174 | (url-parse-make-urlobj | 175 | (url-parse-make-urlobj |
| 175 | prot user pass host port file refs attr full))))))) | 176 | prot user pass host port file refs attr full))))))) |
| 176 | 177 | ||
| 178 | (defmacro url-bit-for-url (method lookfor url) | ||
| 179 | `(let* ((urlobj (url-generic-parse-url url)) | ||
| 180 | (bit (funcall ,method urlobj)) | ||
| 181 | (methods (list 'url-recreate-url | ||
| 182 | 'url-host))) | ||
| 183 | (while (and (not bit) (> (length methods) 0)) | ||
| 184 | (setq bit | ||
| 185 | (auth-source-user-or-password | ||
| 186 | ,lookfor (funcall (pop methods) urlobj) (url-type urlobj)))) | ||
| 187 | bit)) | ||
| 188 | |||
| 189 | (defun url-user-for-url (url) | ||
| 190 | "Attempt to use .authinfo to find a user for this URL." | ||
| 191 | (url-bit-for-url 'url-user "login" url)) | ||
| 192 | |||
| 193 | (defun url-password-for-url (url) | ||
| 194 | "Attempt to use .authinfo to find a password for this URL." | ||
| 195 | (url-bit-for-url 'url-password "password" url)) | ||
| 196 | |||
| 177 | (provide 'url-parse) | 197 | (provide 'url-parse) |
| 178 | 198 | ||
| 179 | ;; arch-tag: f338325f-71ab-4bee-93cc-78fb9a03d403 | 199 | ;; arch-tag: f338325f-71ab-4bee-93cc-78fb9a03d403 |
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el index 1b9fd7b76cc..65622a06e02 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el | |||
| @@ -128,7 +128,7 @@ email -- the email address | |||
| 128 | os -- the operating system info | 128 | os -- the operating system info |
| 129 | lastloc -- the last location | 129 | lastloc -- the last location |
| 130 | agent -- do not send the User-Agent string | 130 | agent -- do not send the User-Agent string |
| 131 | cookie -- never accept HTTP cookies | 131 | cookies -- never accept HTTP cookies |
| 132 | 132 | ||
| 133 | Samples: | 133 | Samples: |
| 134 | 134 | ||
diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el index d21d40d50f2..d0951bdd404 100644 --- a/lisp/vc/vc-annotate.el +++ b/lisp/vc/vc-annotate.el | |||
| @@ -316,7 +316,7 @@ use; you may override this using the second optional arg MODE." | |||
| 316 | 316 | ||
| 317 | ;;;###autoload | 317 | ;;;###autoload |
| 318 | (defun vc-annotate (file rev &optional display-mode buf move-point-to) | 318 | (defun vc-annotate (file rev &optional display-mode buf move-point-to) |
| 319 | "Display the edit history of the current file using colors. | 319 | "Display the edit history of the current FILE using colors. |
| 320 | 320 | ||
| 321 | This command creates a buffer that shows, for each line of the current | 321 | This command creates a buffer that shows, for each line of the current |
| 322 | file, when it was last edited and by whom. Additionally, colors are | 322 | file, when it was last edited and by whom. Additionally, colors are |
| @@ -326,7 +326,7 @@ default, the time scale stretches back one year into the past; | |||
| 326 | everything that is older than that is shown in blue. | 326 | everything that is older than that is shown in blue. |
| 327 | 327 | ||
| 328 | With a prefix argument, this command asks two questions in the | 328 | With a prefix argument, this command asks two questions in the |
| 329 | minibuffer. First, you may enter a revision number; then the buffer | 329 | minibuffer. First, you may enter a revision number REV; then the buffer |
| 330 | displays and annotates that revision instead of the working revision | 330 | displays and annotates that revision instead of the working revision |
| 331 | \(type RET in the minibuffer to leave that default unchanged). Then, | 331 | \(type RET in the minibuffer to leave that default unchanged). Then, |
| 332 | you are prompted for the time span in days which the color range | 332 | you are prompted for the time span in days which the color range |
| @@ -348,9 +348,9 @@ mode-specific menu. `vc-annotate-color-map' and | |||
| 348 | (list buffer-file-name | 348 | (list buffer-file-name |
| 349 | (let ((def (vc-working-revision buffer-file-name))) | 349 | (let ((def (vc-working-revision buffer-file-name))) |
| 350 | (if (null current-prefix-arg) def | 350 | (if (null current-prefix-arg) def |
| 351 | (read-string | 351 | (vc-read-revision |
| 352 | (format "Annotate from revision (default %s): " def) | 352 | (format "Annotate from revision (default %s): " def) |
| 353 | nil nil def))) | 353 | (list buffer-file-name) nil def))) |
| 354 | (if (null current-prefix-arg) | 354 | (if (null current-prefix-arg) |
| 355 | vc-annotate-display-mode | 355 | vc-annotate-display-mode |
| 356 | (float (string-to-number | 356 | (float (string-to-number |
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index cd43d425af1..889a60c278e 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el | |||
| @@ -170,7 +170,7 @@ want to force an empty list of arguments, use t." | |||
| 170 | (?? . unregistered) | 170 | (?? . unregistered) |
| 171 | ;; This is what vc-svn-parse-status does. | 171 | ;; This is what vc-svn-parse-status does. |
| 172 | (?~ . edited))) | 172 | (?~ . edited))) |
| 173 | (re (if remote "^\\(.\\)...... \\([ *]\\) +\\(?:[-0-9]+\\)? \\(.*\\)$" | 173 | (re (if remote "^\\(.\\)......? \\([ *]\\) +\\(?:[-0-9]+\\)? \\(.*\\)$" |
| 174 | ;; Subexp 2 is a dummy in this case, so the numbers match. | 174 | ;; Subexp 2 is a dummy in this case, so the numbers match. |
| 175 | "^\\(.\\)....\\(.\\) \\(.*\\)$")) | 175 | "^\\(.\\)....\\(.\\) \\(.*\\)$")) |
| 176 | result) | 176 | result) |