Using saved parent location: http://bzr.savannah.gnu.org/r/emacs/trunk/ Now on revision 101244. ------------------------------------------------------------ revno: 101244 [merge] committer: Katsumi Yamaoka branch nick: trunk timestamp: Tue 2010-08-31 04:22:49 +0000 message: Bump custom version of some user options of which the default values changed. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-08-31 00:42:27 +0000 +++ lisp/gnus/ChangeLog 2010-08-31 04:21:18 +0000 @@ -1,3 +1,16 @@ +2010-08-31 Katsumi Yamaoka + + * gnus-sum.el (gnus-summary-stop-at-end-of-message) + * gnus.el (gnus-valid-select-methods) + * message.el (message-send-mail-partially-limit) + * mm-decode.el (mm-text-html-renderer) + * mml.el (mml-insert-mime-headers-always) + * smiley.el (smiley-regexp-alist): Bump custom version. + +2010-08-31 Lars Magne Ingebrigtsen + + * gnus-html.el: require mm-url. + 2010-08-30 Lars Magne Ingebrigtsen * gnus-sum.el: As per discussion 3 years, 8 weeks, 3 days, 9 hours, 57 === modified file 'lisp/gnus/gnus-sum.el' --- lisp/gnus/gnus-sum.el 2010-08-31 00:42:27 +0000 +++ lisp/gnus/gnus-sum.el 2010-08-31 04:21:18 +0000 @@ -80,6 +80,7 @@ "If non-nil, don't select the next message when using `SPC'." :link '(custom-manual "(gnus)Group Maneuvering") :group 'gnus-summary-maneuvering + :version "24.1" :type 'boolean) (defcustom gnus-fetch-old-headers nil === modified file 'lisp/gnus/gnus.el' --- lisp/gnus/gnus.el 2010-08-31 00:38:32 +0000 +++ lisp/gnus/gnus.el 2010-08-31 04:21:18 +0000 @@ -1773,7 +1773,8 @@ (const :format "%v " prompt-address) (const :format "%v " physical-address) (const :format "%v " virtual) - (const respool))))) + (const respool)))) + :version "24.1") (defun gnus-redefine-select-method-widget () "Recomputes the select-method widget based on the value of === modified file 'lisp/gnus/message.el' --- lisp/gnus/message.el 2010-08-30 23:24:56 +0000 +++ lisp/gnus/message.el 2010-08-31 04:21:18 +0000 @@ -1624,7 +1624,7 @@ "The limitation of messages sent as message/partial. The lower bound of message size in characters, beyond which the message should be sent in several parts. If it is nil, the size is unlimited." - :version "21.1" + :version "24.1" :group 'message-buffers :link '(custom-manual "(message)Mail Variables") :type '(choice (const :tag "unlimited" nil) === modified file 'lisp/gnus/mm-decode.el' --- lisp/gnus/mm-decode.el 2010-08-30 06:17:45 +0000 +++ lisp/gnus/mm-decode.el 2010-08-31 04:21:18 +0000 @@ -123,7 +123,7 @@ `w3' : use Emacs/W3; `html2text' : use html2text; nil : use external viewer (default web browser)." - :version "23.0" ;; No Gnus + :version "24.1" :type '(choice (const w3) (const w3m :tag "emacs-w3m") (const w3m-standalone :tag "standalone w3m" ) === modified file 'lisp/gnus/mml.el' --- lisp/gnus/mml.el 2010-08-31 00:11:37 +0000 +++ lisp/gnus/mml.el 2010-08-31 04:21:18 +0000 @@ -123,7 +123,7 @@ (defcustom mml-insert-mime-headers-always t "If non-nil, always put Content-Type: text/plain at top of empty parts. It is necessary to work against a bug in certain clients." - :version "22.1" + :version "24.1" :type 'boolean :group 'message) === modified file 'lisp/gnus/smiley.el' --- lisp/gnus/smiley.el 2010-08-30 06:28:53 +0000 +++ lisp/gnus/smiley.el 2010-08-31 04:21:18 +0000 @@ -120,6 +120,7 @@ The elements are (REGEXP MATCH IMAGE), where MATCH is the submatch in regexp to replace with IMAGE. IMAGE is the name of an image file in `smiley-data-directory'." + :version "24.1" :type '(repeat (list regexp (integer :tag "Regexp match number") (string :tag "Image name"))) ------------------------------------------------------------ revno: 101243 committer: Chong Yidong branch nick: trunk timestamp: Mon 2010-08-30 21:53:46 -0400 message: Fix several Package Menu and Finder bugs. * finder.el: Load finder-inf using `require'. (finder-list-matches): Sorting by status is now the default. (finder-compile-keywords): Simpify printing. * emacs-lisp/package.el (package--read-archive-file): Just use `read', to avoid copying an additional string. (package-menu-mode): Set header-line-format here. (package-menu-refresh, package-menu-revert): Signal an error if not in the Package Menu. (package-menu-package-list): New var. (package--generate-package-list): Operate on the current buffer; don't assume that it is *Packages*, since the user may rename it. Allow persistent package listings and sort keys using package-menu-package-list and package-menu-package-sort-key. (package-menu--version-predicate): Fix version calculation. (package-menu-sort-by-column): Don't select the window. (package--list-packages): Create the *Packages* buffer. Set package-menu-package-list-key. (list-packages): Sorting by status is now the default. (package-buffer-info): Use match-string-no-properties. (define-package): Add a &rest argument for future proofing, but don't use it yet. (package-install-from-buffer, package-install-buffer-internal): Merged into a single function, package-install-from-buffer. (package-install-file): Caller changed. Also, fix headers for hfy-cmap.el and ps-print.el. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-08-30 20:34:52 +0000 +++ lisp/ChangeLog 2010-08-31 01:53:46 +0000 @@ -1,3 +1,31 @@ +2010-08-31 Chong Yidong + + * emacs-lisp/package.el (package--read-archive-file): Just use + `read', to avoid copying an additional string. + (package-menu-mode): Set header-line-format here. + (package-menu-refresh, package-menu-revert): Signal an error if + not in the Package Menu. + (package-menu-package-list): New var. + (package--generate-package-list): Operate on the current buffer; + don't assume that it is *Packages*, since the user may rename it. + Allow persistent package listings and sort keys using + package-menu-package-list and package-menu-package-sort-key. + (package-menu--version-predicate): Fix version calculation. + (package-menu-sort-by-column): Don't select the window. + (package--list-packages): Create the *Packages* buffer. Set + package-menu-package-list-key. + (list-packages): Sorting by status is now the default. + (package-buffer-info): Use match-string-no-properties. + (define-package): Add a &rest argument for future proofing, but + don't use it yet. + (package-install-from-buffer, package-install-buffer-internal): + Merged into a single function, package-install-from-buffer. + (package-install-file): Caller changed. + + * finder.el: Load finder-inf using `require'. + (finder-list-matches): Sorting by status is now the default. + (finder-compile-keywords): Simpify printing. + 2010-08-30 Stefan Monnier * progmodes/octave-mod.el (octave-font-lock-keywords): Use regexp-opt. === modified file 'lisp/emacs-lisp/cl-loaddefs.el' --- lisp/emacs-lisp/cl-loaddefs.el 2010-08-29 16:17:13 +0000 +++ lisp/emacs-lisp/cl-loaddefs.el 2010-08-31 01:53:46 +0000 @@ -754,7 +754,7 @@ ;;;;;; find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not ;;;;;; substitute-if substitute delete-duplicates remove-duplicates ;;;;;; delete-if-not delete-if delete* remove-if-not remove-if remove* -;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "8f4ba525c894365101b9a53905db94ba") +;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "7b7531276ddf8457abecdd487d3cf0b7") ;;; Generated autoloads from cl-seq.el (autoload 'reduce "cl-seq" "\ === modified file 'lisp/emacs-lisp/package.el' --- lisp/emacs-lisp/package.el 2010-08-29 22:15:09 +0000 +++ lisp/emacs-lisp/package.el 2010-08-31 01:53:46 +0000 @@ -471,17 +471,18 @@ pkg-vec))) package-obsolete-alist))))) -;; (define-package "emacs" "21.4.1" "GNU Emacs core package.") -;; (define-package "erc" "5.1" "ERC - irc client" '((emacs "21.0"))) (defun define-package (name-str version-string - &optional docstring requirements) + &optional docstring requirements + &rest extra-properties) "Define a new package. NAME is the name of the package, a string. VERSION-STRING is the version of the package, a dotted sequence of integers. DOCSTRING is the optional description. REQUIREMENTS is a list of requirements on other packages. -Each requirement is of the form (OTHER-PACKAGE \"VERSION\")." +Each requirement is of the form (OTHER-PACKAGE \"VERSION\"). + +EXTRA-PROPERTIES is currently unused." (let* ((name (intern name-str)) (pkg-desc (assq name package-alist)) (new-version (version-to-list version-string)) @@ -717,13 +718,13 @@ "Read a Lisp expression from STR. Signal an error if the entire string was not used." (let* ((read-data (read-from-string str)) - (more-left - (condition-case nil - ;; The call to `ignore' suppresses a compiler warning. - (progn (ignore (read-from-string - (substring str (cdr read-data)))) - t) - (end-of-file nil)))) + (more-left + (condition-case nil + ;; The call to `ignore' suppresses a compiler warning. + (progn (ignore (read-from-string + (substring str (cdr read-data)))) + t) + (end-of-file nil)))) (if more-left (error "Can't read whole string") (car read-data)))) @@ -733,16 +734,14 @@ Will return the data from the file, or nil if the file does not exist. Will throw an error if the archive version is too new." (let ((filename (expand-file-name file package-user-dir))) - (if (file-exists-p filename) - (with-temp-buffer - (insert-file-contents-literally filename) - (let ((contents (package-read-from-string - (buffer-substring-no-properties (point-min) - (point-max))))) - (if (> (car contents) package-archive-version) - (error "Package archive version %d is greater than %d - upgrade package.el" - (car contents) package-archive-version)) - (cdr contents)))))) + (when (file-exists-p filename) + (with-temp-buffer + (insert-file-contents-literally filename) + (let ((contents (read (current-buffer)))) + (if (> (car contents) package-archive-version) + (error "Package archive version %d is higher than %d" + (car contents) package-archive-version)) + (cdr contents)))))) (defun package-read-all-archive-contents () "Re-read `archive-contents', if it exists. @@ -751,18 +750,17 @@ (package-read-archive-contents (car archive)))) (defun package-read-archive-contents (archive) - "Re-read `archive-contents' and `builtin-packages' for ARCHIVE. -If successful, set `package-archive-contents' and `package--builtins'. + "Re-read archive contents for ARCHIVE. +If successful, set the variable `package-archive-contents'. If the archive version is too new, signal an error." - (let ((archive-contents (package--read-archive-file - (concat "archives/" archive - "/archive-contents")))) - (if archive-contents - ;; Version 1 of 'archive-contents' is identical to our - ;; internal representation. - ;; TODO: merge archive lists - (dolist (package archive-contents) - (package--add-to-archive-contents package archive))))) + ;; Version 1 of 'archive-contents' is identical to our internal + ;; representation. + (let* ((dir (concat "archives/" archive)) + (contents-file (concat dir "/archive-contents")) + contents) + (when (setq contents (package--read-archive-file contents-file)) + (dolist (package contents) + (package--add-to-archive-contents package archive))))) (defun package--add-to-archive-contents (package archive) "Add the PACKAGE from the given ARCHIVE if necessary. @@ -833,61 +831,60 @@ v-str)))) (defun package-buffer-info () - "Return a vector of information about the package in the current buffer. -The vector looks like [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY] -FILENAME is the file name, a string. It does not have the \".el\" extension. + "Return a vector describing the package in the current buffer. +The vector has the form + + [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY] + +FILENAME is the file name, a string, sans the \".el\" extension. REQUIRES is a requires list, or nil. -DESCRIPTION is the package description (a string). +DESCRIPTION is the package description, a string. VERSION is the version, a string. COMMENTARY is the commentary section, a string, or nil if none. -Throws an exception if the buffer does not contain a conforming package. -If there is a package, narrows the buffer to the file's boundaries. -May narrow buffer or move point even on failure." + +If the buffer does not contain a conforming package, signal an +error. If there is a package, narrow the buffer to the file's +boundaries." (goto-char (point-min)) - (if (re-search-forward "^;;; \\([^ ]*\\)\\.el --- \\(.*\\)$" nil t) - (let ((file-name (match-string 1)) - (desc (match-string 2)) - (start (progn (beginning-of-line) (point)))) - (if (search-forward (concat ";;; " file-name ".el ends here")) - (progn - ;; Try to include a trailing newline. - (forward-line) - (narrow-to-region start (point)) - (require 'lisp-mnt) - ;; Use some headers we've invented to drive the process. - (let* ((requires-str (lm-header "package-requires")) - (requires (if requires-str - (package-read-from-string requires-str))) - ;; Prefer Package-Version, because if it is - ;; defined the package author probably wants us - ;; to use it. Otherwise try Version. - (pkg-version - (or (package-strip-rcs-id (lm-header "package-version")) - (package-strip-rcs-id (lm-header "version")))) - (commentary (lm-commentary))) - (unless pkg-version - (error - "Package does not define a usable \"Version\" or \"Package-Version\" header")) - ;; Turn string version numbers into list form. - (setq requires - (mapcar - (lambda (elt) - (list (car elt) - (version-to-list (car (cdr elt))))) - requires)) - (set-text-properties 0 (length file-name) nil file-name) - (set-text-properties 0 (length pkg-version) nil pkg-version) - (set-text-properties 0 (length desc) nil desc) - (vector file-name requires desc pkg-version commentary))) - (error "Package missing a terminating comment"))) - (error "No starting comment for package"))) + (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el --- \\(.*\\)$" nil t) + (error "Packages lacks a file header")) + (let ((file-name (match-string-no-properties 1)) + (desc (match-string-no-properties 2)) + (start (line-beginning-position))) + (unless (search-forward (concat ";;; " file-name ".el ends here")) + (error "Package lacks a terminating comment")) + ;; Try to include a trailing newline. + (forward-line) + (narrow-to-region start (point)) + (require 'lisp-mnt) + ;; Use some headers we've invented to drive the process. + (let* ((requires-str (lm-header "package-requires")) + (requires (if requires-str + (package-read-from-string requires-str))) + ;; Prefer Package-Version; if defined, the package author + ;; probably wants us to use it. Otherwise try Version. + (pkg-version + (or (package-strip-rcs-id (lm-header "package-version")) + (package-strip-rcs-id (lm-header "version")))) + (commentary (lm-commentary))) + (unless pkg-version + (error + "Package lacks a \"Version\" or \"Package-Version\" header")) + ;; Turn string version numbers into list form. + (setq requires + (mapcar + (lambda (elt) + (list (car elt) + (version-to-list (car (cdr elt))))) + requires)) + (vector file-name requires desc pkg-version commentary)))) (defun package-tar-file-info (file) "Find package information for a tar file. FILE is the name of the tar file to examine. The return result is a vector like `package-buffer-info'." (unless (string-match "^\\(.+\\)-\\([0-9.]+\\)\\.tar$" file) - (error "`%s' doesn't have a package-ish name" file)) + (error "Invalid package name `%s'" file)) (let* ((pkg-name (file-name-nondirectory (match-string-no-properties 1 file))) (pkg-version (match-string-no-properties 2 file)) ;; Extract the package descriptor. @@ -898,20 +895,19 @@ pkg-name "-pkg.el"))) (pkg-def-parsed (package-read-from-string pkg-def-contents))) (unless (eq (car pkg-def-parsed) 'define-package) - (error "%s-pkg.el doesn't contain `define-package' sexp" pkg-name)) - (let ((name-str (nth 1 pkg-def-parsed)) + (error "No `define-package' sexp is present in `%s-pkg.el'" pkg-name)) + (let ((name-str (nth 1 pkg-def-parsed)) (version-string (nth 2 pkg-def-parsed)) - (docstring (nth 3 pkg-def-parsed)) - (requires (nth 4 pkg-def-parsed)) - + (docstring (nth 3 pkg-def-parsed)) + (requires (nth 4 pkg-def-parsed)) (readme (shell-command-to-string ;; Requires GNU tar. (concat "tar -xOf " file " " pkg-name "-" pkg-version "/README")))) (unless (equal pkg-version version-string) - (error "Inconsistent versions!")) + (error "Package has inconsistent versions")) (unless (equal pkg-name name-str) - (error "Inconsistent names!")) + (error "Package has inconsistent names")) ;; Kind of a hack. (if (string-match ": Not found in archive" readme) (setq readme nil)) @@ -919,18 +915,27 @@ (if (eq (car requires) 'quote) (setq requires (car (cdr requires)))) (setq requires - (mapcar - (lambda (elt) - (list (car elt) - (version-to-list (car (cdr elt))))) - requires)) + (mapcar (lambda (elt) + (list (car elt) + (version-to-list (cadr elt)))) + requires)) (vector pkg-name requires docstring version-string readme)))) -(defun package-install-buffer-internal (pkg-info type) +;;;###autoload +(defun package-install-from-buffer (pkg-info type) + "Install a package from the current buffer. +When called interactively, the current buffer is assumed to be a +single .el file that follows the packaging guidelines; see info +node `(elisp)Packaging'. + +When called from Lisp, PKG-INFO is a vector describing the +information, of the type returned by `package-buffer-info'; and +TYPE is the package type (either `single' or `tar')." + (interactive (list (package-buffer-info) 'single)) (save-excursion (save-restriction (let* ((file-name (aref pkg-info 0)) - (requires (aref pkg-info 1)) + (requires (aref pkg-info 1)) (desc (if (string= (aref pkg-info 2) "") "No description available." (aref pkg-info 2))) @@ -950,15 +955,6 @@ (package-initialize))))) ;;;###autoload -(defun package-install-from-buffer () - "Install a package from the current buffer. -The package is assumed to be a single .el file which -follows the elisp comment guidelines; see -info node `(elisp)Library Headers'." - (interactive) - (package-install-buffer-internal (package-buffer-info) 'single)) - -;;;###autoload (defun package-install-file (file) "Install a package from a file. The file can either be a tar file or an Emacs Lisp file." @@ -966,9 +962,10 @@ (with-temp-buffer (insert-file-contents-literally file) (cond - ((string-match "\\.el$" file) (package-install-from-buffer)) + ((string-match "\\.el$" file) + (package-install-from-buffer (package-buffer-info) 'single)) ((string-match "\\.tar$" file) - (package-install-buffer-internal (package-tar-file-info file) 'tar)) + (package-install-from-buffer (package-tar-file-info file) 'tar)) (t (error "Unrecognized extension `%s'" (file-name-extension file)))))) (defun package-delete (name version) @@ -1012,7 +1009,7 @@ (dolist (archive package-archives) (condition-case nil (package--download-one-archive archive "archive-contents") - (error (message "Failed to download archive `%s'." + (error (message "Failed to download `%s' archive." (car archive))))) (package-read-all-archive-contents)) @@ -1275,10 +1272,32 @@ (setq mode-name "Package Menu") (setq truncate-lines t) (setq buffer-read-only t) - ;; Support Emacs 21. - (if (fboundp 'run-mode-hooks) - (run-mode-hooks 'package-menu-mode-hook) - (run-hooks 'package-menu-mode-hook))) + (setq header-line-format + (mapconcat + (lambda (pair) + (let ((column (car pair)) + (name (cdr pair))) + (concat + ;; Insert a space that aligns the button properly. + (propertize " " 'display (list 'space :align-to column) + 'face 'fixed-pitch) + ;; Set up the column button. + (propertize name + 'column-name name + 'help-echo "mouse-1: sort by column" + 'mouse-face 'highlight + 'keymap package-menu-sort-button-map)))) + ;; We take a trick from buff-menu and have a dummy leading + ;; space to align the header line with the beginning of the + ;; text. This doesn't really work properly on Emacs 21, but + ;; it is close enough. + '((0 . "") + (2 . "Package") + (20 . "Version") + (32 . "Status") + (43 . "Description")) + "")) + (run-mode-hooks 'package-menu-mode-hook)) (defun package-menu-refresh () "Download the ELPA archive. @@ -1287,12 +1306,16 @@ package menu. This lets you see what new packages are available for download." (interactive) + (unless (eq major-mode 'package-menu-mode) + (error "The current buffer is not a Package Menu")) (package-refresh-contents) (package--generate-package-list)) (defun package-menu-revert () "Update the list of packages." (interactive) + (unless (eq major-mode 'package-menu-mode) + (error "The current buffer is not a Package Menu")) (package--generate-package-list)) (defun package-menu-describe-package () @@ -1438,96 +1461,99 @@ result))) result) -;; This decides how we should sort; nil means by package name. -(defvar package-menu-sort-key nil) - -(defun package--generate-package-list (&optional packages) - (package-initialize) ; FIXME: do this here? - (with-current-buffer (get-buffer-create "*Packages*") +(defvar package-menu-package-list nil + "List of packages to display in the Package Menu buffer. +A value of nil means to display all packages.") + +(defvar package-menu-sort-key nil + "Sort key for the current Package Menu buffer.") + +(defun package--generate-package-list () + "Populate the current Package Menu buffer." + (package-initialize) + (let ((inhibit-read-only t) + info-list name desc hold builtin) (setq buffer-read-only nil) (erase-buffer) - (let ((info-list) - name desc hold - builtin) - ;; List installed packages - (dolist (elt package-alist) - (setq name (car elt)) - (when (and (not (eq name 'emacs)) ; Hide the `emacs' package. - (or (null packages) - (memq name packages))) - (setq desc (cdr elt) - hold (cadr (assq name package-load-list)) - builtin (cdr (assq name package--builtins))) - (setq info-list - (package-list-maybe-add - name (package-desc-vers desc) - ;; FIXME: it turns out to be tricky to see if this - ;; package is presently activated. - (cond ((stringp hold) "held") - ((and builtin - (version-list-= - (package-desc-vers builtin) - (package-desc-vers desc))) - "built-in") - (t "installed")) - (package-desc-doc desc) - info-list)))) - - ;; List available and disabled packages - (dolist (elt package-archive-contents) - (setq name (car elt) - desc (cdr elt) - hold (assq name package-load-list)) - (when (or (null packages) - (memq name packages)) - (setq info-list - (package-list-maybe-add name - (package-desc-vers desc) - (if (and hold (null (cadr hold))) - "disabled" - "available") - (package-desc-doc (cdr elt)) - info-list)))) - ;; List obsolete packages - (mapc (lambda (elt) - (mapc (lambda (inner-elt) - (setq info-list - (package-list-maybe-add (car elt) - (package-desc-vers - (cdr inner-elt)) - "obsolete" - (package-desc-doc - (cdr inner-elt)) - info-list))) - (cdr elt))) - package-obsolete-alist) - - (setq info-list - (sort info-list - (cond ((string= package-menu-sort-key "Version") - 'package-menu--version-predicate) - ((string= package-menu-sort-key "Status") - 'package-menu--status-predicate) - ((string= package-menu-sort-key "Description") - 'package-menu--description-predicate) - (t ; Sort by package name by default - 'package-menu--name-predicate)))) - - (dolist (elt info-list) - (package-print-package (car (car elt)) - (cdr (car elt)) - (car (cdr elt)) - (car (cdr (cdr elt)))))) + ;; List installed packages + (dolist (elt package-alist) + (setq name (car elt)) + (when (and (not (eq name 'emacs)) ; Hide the `emacs' package. + (or (null package-menu-package-list) + (memq name package-menu-package-list))) + (setq desc (cdr elt) + hold (cadr (assq name package-load-list)) + builtin (cdr (assq name package--builtins))) + (setq info-list + (package-list-maybe-add + name (package-desc-vers desc) + ;; FIXME: it turns out to be tricky to see if this + ;; package is presently activated. + (cond ((stringp hold) "held") + ((and builtin + (version-list-= + (package-desc-vers builtin) + (package-desc-vers desc))) + "built-in") + (t "installed")) + (package-desc-doc desc) + info-list)))) + + ;; List available and disabled packages + (dolist (elt package-archive-contents) + (setq name (car elt) + desc (cdr elt) + hold (assq name package-load-list)) + (when (or (null package-menu-package-list) + (memq name package-menu-package-list)) + (setq info-list + (package-list-maybe-add name + (package-desc-vers desc) + (if (and hold (null (cadr hold))) + "disabled" + "available") + (package-desc-doc (cdr elt)) + info-list)))) + ;; List obsolete packages + (mapc (lambda (elt) + (mapc (lambda (inner-elt) + (setq info-list + (package-list-maybe-add (car elt) + (package-desc-vers + (cdr inner-elt)) + "obsolete" + (package-desc-doc + (cdr inner-elt)) + info-list))) + (cdr elt))) + package-obsolete-alist) + + (setq info-list + (sort info-list + (cond ((string= package-menu-sort-key "Package") + 'package-menu--name-predicate) + ((string= package-menu-sort-key "Version") + 'package-menu--version-predicate) + ((string= package-menu-sort-key "Description") + 'package-menu--description-predicate) + (t ; By default, sort by package status + 'package-menu--status-predicate)))) + + (dolist (elt info-list) + (package-print-package (car (car elt)) + (cdr (car elt)) + (car (cdr elt)) + (car (cdr (cdr elt))))) (goto-char (point-min)) (set-buffer-modified-p nil) (current-buffer))) (defun package-menu--version-predicate (left right) - (let ((vleft (cdr (car left))) - (vright (cdr (car right)))) - (if (version-list-= vleft right) + (let ((vleft (or (cdr (car left)) '(0))) + (vright (or (cdr (car right)) '(0)))) + (if (version-list-= vleft vright) (package-menu--name-predicate left right) - (version-list-< left right)))) + (version-list-< vleft vright)))) (defun package-menu--status-predicate (left right) (let ((sleft (cadr left)) @@ -1558,53 +1584,28 @@ (symbol-name (caar right)))) (defun package-menu-sort-by-column (&optional e) - "Sort the package menu by the last column clicked on." + "Sort the package menu by the column of the mouse click E." (interactive "e") - (if e (mouse-select-window e)) (let* ((pos (event-start e)) - (obj (posn-object pos)) - (col (if obj - (get-text-property (cdr obj) 'column-name (car obj)) - (get-text-property (posn-point pos) 'column-name))) - (inhibit-read-only t)) - (setq package-menu-sort-key col) - (package--generate-package-list))) + (obj (posn-object pos)) + (col (if obj + (get-text-property (cdr obj) 'column-name (car obj)) + (get-text-property (posn-point pos) 'column-name))) + (buf (window-buffer (posn-window (event-start e))))) + (with-current-buffer buf + (when (eq major-mode 'package-menu-mode) + (setq package-menu-sort-key col) + (package--generate-package-list))))) (defun package--list-packages (&optional packages) - "Display the properties of PACKAGES. -PACKAGES should be a list of package names (symbols). -If PACKAGES is nil, display all packages in `package-alist'." - (with-current-buffer (package--generate-package-list packages) + "Generate and pop to the *Packages* buffer. +Optional PACKAGES is a list of names of packages (symbols) to +list; the default is to display everything in `package-alist'." + (with-current-buffer (get-buffer-create "*Packages*") (package-menu-mode) - ;; Set up the header line. - (setq header-line-format - (mapconcat - (lambda (pair) - (let ((column (car pair)) - (name (cdr pair))) - (concat - ;; Insert a space that aligns the button properly. - (propertize " " 'display (list 'space :align-to column) - 'face 'fixed-pitch) - ;; Set up the column button. - (if (string= name "Version") - name - (propertize name - 'column-name name - 'help-echo "mouse-1: sort by column" - 'mouse-face 'highlight - 'keymap package-menu-sort-button-map))))) - ;; We take a trick from buff-menu and have a dummy leading - ;; space to align the header line with the beginning of the - ;; text. This doesn't really work properly on Emacs 21, - ;; but it is close enough. - '((0 . "") - (2 . "Package") - (20 . "Version") - (32 . "Status") - (43 . "Description")) - "")) - + (set (make-local-variable 'package-menu-package-list) packages) + (set (make-local-variable 'package-menu-sort-key) nil) + (package--generate-package-list) ;; It's okay to use pop-to-buffer here. The package menu buffer ;; has keybindings, and the user just typed `M-x list-packages', ;; suggesting that they might want to use them. @@ -1617,7 +1618,6 @@ The list is displayed in a buffer named `*Packages*'." (interactive) (package-refresh-contents) - (setq package-menu-sort-key "Status") (package--list-packages)) ;;;###autoload === modified file 'lisp/finder.el' --- lisp/finder.el 2010-08-29 22:15:09 +0000 +++ lisp/finder.el 2010-08-31 01:53:46 +0000 @@ -32,10 +32,8 @@ (require 'package) (require 'lisp-mnt) -(require 'find-func) ;for find-library(-suffixes) -;; Use `load' rather than `require' so that it doesn't get loaded -;; during byte-compilation (at which point it might be missing). -(load "finder-inf" t t) +(require 'find-func) ;for find-library(-suffixes) +(require 'finder-inf nil t) ;; These are supposed to correspond to top-level customization groups, ;; says rms. @@ -234,17 +232,10 @@ (search-backward " ") (insert "(setq package--builtins '(\n") (dolist (package package--builtins) - (insert " (") - (prin1 (car package) (current-buffer)) - (insert " .\n [") - (let ((desc (cdr package))) - (prin1 (aref desc 0) (current-buffer)) - (insert " ") - (prin1 (aref desc 1) (current-buffer)) - (insert " ") - (prin1 (aref desc 2) (current-buffer))) - (insert "])\n")) - (insert " ))\n\n") + (insert " ") + (prin1 package (current-buffer)) + (insert "\n")) + (insert "))\n\n") ;; Insert hash table. (insert "(setq finder-keywords-hash\n ") (prin1 finder-keywords-hash (current-buffer)) @@ -325,7 +316,6 @@ (packages (gethash id finder-keywords-hash))) (unless packages (error "No packages matching key `%s'" key)) - (setq package-menu-sort-key nil) (package--list-packages packages))) (define-button-type 'finder-xref 'action #'finder-goto-xref) === modified file 'lisp/hfy-cmap.el' --- lisp/hfy-cmap.el 2010-04-24 02:36:43 +0000 +++ lisp/hfy-cmap.el 2010-08-31 01:53:46 +0000 @@ -13,6 +13,7 @@ ;; Description: fallback code for colour name -> rgb mapping ;; URL: http://rtfm.etla.org/emacs/htmlfontify/ ;; Last-Updated: Sat 2003-02-15 03:49:32 +0000 +;; Package: htmlfontify ;; This file is part of GNU Emacs. === modified file 'lisp/ps-print.el' --- lisp/ps-print.el 2010-08-29 16:17:13 +0000 +++ lisp/ps-print.el 2010-08-31 01:53:46 +0000 @@ -13,7 +13,6 @@ ;; Keywords: wp, print, PostScript ;; Version: 7.3.5 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre -;; Package: ps-print (defconst ps-print-version "7.3.5" "ps-print.el, v 7.3.5 <2009/12/23 vinicius> ------------------------------------------------------------ revno: 101242 committer: Katsumi Yamaoka branch nick: trunk timestamp: Tue 2010-08-31 01:15:32 +0000 message: gnus-html.el: require mm-url; by Lars Magne Ingebrigtsen . diff: === modified file 'lisp/gnus/gnus-html.el' --- lisp/gnus/gnus-html.el 2010-08-31 00:51:08 +0000 +++ lisp/gnus/gnus-html.el 2010-08-31 01:15:32 +0000 @@ -28,6 +28,8 @@ ;;; Code: +(require 'mm-url) + (defcustom gnus-html-cache-directory (nnheader-concat gnus-directory "html-cache/") "Where Gnus will cache images it downloads from the web." :group 'gnus-art ------------------------------------------------------------ revno: 101241 committer: Katsumi Yamaoka branch nick: trunk timestamp: Tue 2010-08-31 00:51:08 +0000 message: Fix previous merge from Gnus trunk. diff: === modified file 'lisp/gnus/gnus-ems.el' --- lisp/gnus/gnus-ems.el 2010-08-30 23:35:19 +0000 +++ lisp/gnus/gnus-ems.el 2010-08-31 00:51:08 +0000 @@ -274,15 +274,13 @@ (setq props (plist-put props :background (face-background face)))) (apply 'create-image file type data-p props))) -(defun gnus-put-image (glyph &optional string category point) - (let ((point (or point (point)))) - (save-excursion - (goto-char point) - (insert-image glyph (or string " ")) - (put-text-property point (point) 'gnus-image-category category) - (unless string - (put-text-property (1- (point)) (point) - 'gnus-image-text-deletable t))) +(defun gnus-put-image (glyph &optional string category) + (let ((point (point))) + (insert-image glyph (or string " ")) + (put-text-property point (point) 'gnus-image-category category) + (unless string + (put-text-property (1- (point)) (point) + 'gnus-image-text-deletable t)) glyph)) (defun gnus-remove-image (image &optional category) === modified file 'lisp/gnus/gnus-html.el' --- lisp/gnus/gnus-html.el 2010-08-31 00:23:25 +0000 +++ lisp/gnus/gnus-html.el 2010-08-31 00:51:08 +0000 @@ -172,7 +172,8 @@ (if (and image ;; Kludge to avoid displaying 30x30 gif images, which ;; seems to be a signal of a broken image. - (not (and (eq (getf (cdr image) :type) 'gif) + (not (and (listp image) + (eq (getf (cdr image) :type) 'gif) (= (car (image-size image t)) 30) (= (cdr (image-size image t)) 30)))) (progn ------------------------------------------------------------ revno: 101240 committer: Katsumi Yamaoka branch nick: trunk timestamp: Tue 2010-08-31 00:42:27 +0000 message: Remove the `w' and `i' summary keybindings, since they aren't useful; by Lars Magne Ingebrigtsen . diff: === modified file 'doc/misc/gnus.texi' --- doc/misc/gnus.texi 2010-08-31 00:34:43 +0000 +++ doc/misc/gnus.texi 2010-08-31 00:42:27 +0000 @@ -6399,8 +6399,6 @@ If the prefix is 1, prompt for a group name to find the posting style. @item S i -@itemx i -@kindex i (Summary) @kindex S i (Summary) @findex gnus-summary-news-other-window Prepare a news (@code{gnus-summary-news-other-window}). By default, === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-08-31 00:38:32 +0000 +++ lisp/gnus/ChangeLog 2010-08-31 00:42:27 +0000 @@ -1,5 +1,9 @@ 2010-08-30 Lars Magne Ingebrigtsen + * gnus-sum.el: As per discussion 3 years, 8 weeks, 3 days, 9 hours, 57 + minutes, 56 seconds ago on the ding list, remove the `w' and `i' + bindings, as they aren't useful at all. `w' is moved to `W w'. + * gnus-move.el: Removed file, since it doesn't really work. * gnus-html.el (gnus-article-html): Tell w3m that the input is === modified file 'lisp/gnus/gnus-sum.el' --- lisp/gnus/gnus-sum.el 2010-08-30 06:21:33 +0000 +++ lisp/gnus/gnus-sum.el 2010-08-31 00:42:27 +0000 @@ -1859,7 +1859,6 @@ "=" gnus-summary-expand-window "\C-x\C-s" gnus-summary-reselect-current-group "\M-g" gnus-summary-rescan-group - "w" gnus-summary-stop-page-breaking "\C-c\C-r" gnus-summary-caesar-message "f" gnus-summary-followup "F" gnus-summary-followup-with-original @@ -1881,7 +1880,6 @@ [follow-link] mouse-face "m" gnus-summary-mail-other-window "a" gnus-summary-post-news - "i" gnus-summary-news-other-window "x" gnus-summary-limit-to-unread "s" gnus-summary-isearch-article "t" gnus-summary-toggle-header ------------------------------------------------------------ revno: 101239 committer: Katsumi Yamaoka branch nick: trunk timestamp: Tue 2010-08-31 00:38:32 +0000 message: Removed gnus-move.el and pointers to it, since it doesn't really work; by Lars Magne Ingebrigtsen . diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-08-31 00:23:25 +0000 +++ lisp/gnus/ChangeLog 2010-08-31 00:38:32 +0000 @@ -1,5 +1,7 @@ 2010-08-30 Lars Magne Ingebrigtsen + * gnus-move.el: Removed file, since it doesn't really work. + * gnus-html.el (gnus-article-html): Tell w3m that the input is UTF-8. This seems to fix problems with some German web feeds. === removed file 'lisp/gnus/gnus-move.el' --- lisp/gnus/gnus-move.el 2010-01-13 08:35:10 +0000 +++ lisp/gnus/gnus-move.el 1970-01-01 00:00:00 +0000 @@ -1,181 +0,0 @@ -;;; gnus-move.el --- commands for moving Gnus from one server to another - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-start) -(require 'gnus-int) -(require 'gnus-range) - -;;; -;;; Moving by comparing Message-ID's. -;;; - -;;;###autoload -(defun gnus-change-server (from-server to-server) - "Move from FROM-SERVER to TO-SERVER. -Update the .newsrc.eld file to reflect the change of nntp server." - (interactive - (list gnus-select-method (gnus-read-method "Move to method: "))) - - ;; First start Gnus. - (let ((gnus-activate-level 0) - (mail-sources nil)) - (gnus)) - - (save-excursion - ;; Go through all groups and translate. - (let ((nntp-nov-gap nil)) - (dolist (info gnus-newsrc-alist) - (when (gnus-group-native-p (gnus-info-group info)) - (gnus-move-group-to-server info from-server to-server)))))) - -(defun gnus-move-group-to-server (info from-server to-server) - "Move group INFO from FROM-SERVER to TO-SERVER." - (let ((group (gnus-info-group info)) - to-active hashtb type mark marks - to-article to-reads to-marks article - act-articles) - (gnus-message 7 "Translating %s..." group) - (when (gnus-request-group group nil to-server) - (setq to-active (gnus-parse-active) - hashtb (gnus-make-hashtable 1024) - act-articles (gnus-uncompress-range to-active)) - ;; Fetch the headers from the `to-server'. - (when (and to-active - act-articles - (setq type (gnus-retrieve-headers - act-articles - group to-server))) - ;; Convert HEAD headers. I don't care. - (when (eq type 'headers) - (nnvirtual-convert-headers)) - ;; Create a mapping from Message-ID to article number. - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while (looking-at - "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t") - (gnus-sethash - (buffer-substring (match-beginning 1) (match-end 1)) - (read (current-buffer)) - hashtb) - (forward-line 1)) - ;; Then we read the headers from the `from-server'. - (when (and (gnus-request-group group nil from-server) - (gnus-active group) - (gnus-uncompress-range - (gnus-active group)) - (setq type (gnus-retrieve-headers - (gnus-uncompress-range - (gnus-active group)) - group from-server))) - ;; Make it easier to map marks. - (let ((mark-lists (gnus-info-marks info)) - ms type m) - (while mark-lists - (setq type (caar mark-lists) - ms (gnus-uncompress-range (cdr (pop mark-lists)))) - (while ms - (if (setq m (assq (car ms) marks)) - (setcdr m (cons type (cdr m))) - (push (list (car ms) type) marks)) - (pop ms)))) - ;; Convert. - (when (eq type 'headers) - (nnvirtual-convert-headers)) - ;; Go through the headers and map away. - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while (looking-at - "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t") - (when (setq to-article - (gnus-gethash - (buffer-substring (match-beginning 1) (match-end 1)) - hashtb)) - ;; Add this article to the list of read articles. - (push to-article to-reads) - ;; See if there are any marks and then add them. - (when (setq mark (assq (read (current-buffer)) marks)) - (setq marks (delq mark marks)) - (setcar mark to-article) - (push mark to-marks)) - (forward-line 1))) - ;; Now we know what the read articles are and what the - ;; article marks are. We transform the information - ;; into the Gnus info format. - (setq to-reads - (gnus-range-add - (gnus-compress-sequence - (and (setq to-reads (delq nil to-reads)) - (sort to-reads '<)) - t) - (cons 1 (1- (car to-active))))) - (gnus-info-set-read info to-reads) - ;; Do the marks. I'm sure y'all understand what's - ;; going on down below, so I won't bother with any - ;; further comments. - (let ((mlists gnus-article-mark-lists) - lists ms a) - (while mlists - (push (list (cdr (pop mlists))) lists)) - (while (setq ms (pop marks)) - (setq article (pop ms)) - (while ms - (setcdr (setq a (assq (pop ms) lists)) - (cons article (cdr a))))) - (setq a lists) - (while a - (setcdr (car a) (gnus-compress-sequence - (and (cdar a) (sort (cdar a) '<)))) - (pop a)) - (gnus-info-set-marks info lists t))))) - (gnus-message 7 "Translating %s...done" group))) - -(defun gnus-group-move-group-to-server (info from-server to-server) - "Move the group on the current line from FROM-SERVER to TO-SERVER." - (interactive - (let ((info (gnus-get-info (gnus-group-group-name)))) - (list info (gnus-find-method-for-group (gnus-info-group info)) - (gnus-read-method (format "Move group %s to method: " - (gnus-info-group info)))))) - (save-excursion - (gnus-move-group-to-server info from-server to-server) - ;; We have to update the group info to point use the right server. - (gnus-info-set-method info to-server t) - ;; We also have to change the name of the group and stuff. - (let* ((group (gnus-info-group info)) - (new-name (gnus-group-prefixed-name - (gnus-group-real-name group) to-server))) - (gnus-info-set-group info new-name) - (gnus-sethash new-name (gnus-group-entry group) gnus-newsrc-hashtb) - (gnus-sethash group nil gnus-newsrc-hashtb)))) - -(provide 'gnus-move) - -;; arch-tag: 503742b8-7d66-4d79-bb31-4a698070707b -;;; gnus-move.el ends here === modified file 'lisp/gnus/gnus.el' --- lisp/gnus/gnus.el 2010-08-31 00:19:31 +0000 +++ lisp/gnus/gnus.el 2010-08-31 00:38:32 +0000 @@ -3026,8 +3026,6 @@ gnus-dup-enter-articles) ("gnus-range" gnus-copy-sequence) ("gnus-eform" gnus-edit-form) - ("gnus-move" :interactive t - gnus-group-move-group-to-server gnus-change-server) ("gnus-logic" gnus-score-advanced) ("gnus-undo" gnus-undo-mode gnus-undo-register) ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next ------------------------------------------------------------ revno: 101238 committer: Katsumi Yamaoka branch nick: trunk timestamp: Tue 2010-08-31 00:34:43 +0000 message: gnus.texi (Changing Servers): Remove documentation on gnus-change-server and friends, since it's been removed; by Lars Magne Ingebrigtsen . diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2010-08-31 00:28:54 +0000 +++ doc/misc/ChangeLog 2010-08-31 00:34:43 +0000 @@ -2,6 +2,8 @@ * gnus.texi (Summary Mail Commands): Note that only the addresses from the first message are used for wide replies. + (Changing Servers): Remove documentation on gnus-change-server and + friends, since it's been removed. 2010-08-29 Lars Magne Ingebrigtsen === modified file 'doc/misc/gnus.texi' --- doc/misc/gnus.texi 2010-08-31 00:28:54 +0000 +++ doc/misc/gnus.texi 2010-08-31 00:34:43 +0000 @@ -1384,31 +1384,11 @@ change @code{gnus-select-method}, your @file{.newsrc} file becomes worthless. -Gnus provides a few functions to attempt to translate a @file{.newsrc} -file from one server to another. They all have one thing in -common---they take a looong time to run. You don't want to use these -functions more than absolutely necessary. - -@kindex M-x gnus-change-server -@findex gnus-change-server -If you have access to both servers, Gnus can request the headers for all -the articles you have read and compare @code{Message-ID}s and map the -article numbers of the read articles and article marks. The @kbd{M-x -gnus-change-server} command will do this for all your native groups. It -will prompt for the method you want to move to. - -@kindex M-x gnus-group-move-group-to-server -@findex gnus-group-move-group-to-server -You can also move individual groups with the @kbd{M-x -gnus-group-move-group-to-server} command. This is useful if you want to -move a (foreign) group from one server to another. - @kindex M-x gnus-group-clear-data-on-native-groups @findex gnus-group-clear-data-on-native-groups -If you don't have access to both the old and new server, all your marks -and read ranges have become worthless. You can use the @kbd{M-x -gnus-group-clear-data-on-native-groups} command to clear out all data -that you have on your native groups. Use with caution. +You can use the @kbd{M-x gnus-group-clear-data-on-native-groups} +command to clear out all data that you have on your native groups. +Use with caution. @kindex M-x gnus-group-clear-data @findex gnus-group-clear-data ------------------------------------------------------------ revno: 101237 committer: Katsumi Yamaoka branch nick: trunk timestamp: Tue 2010-08-31 00:28:54 +0000 message: gnus.texi (Summary Mail Commands): Note that only the addresses from the first message are used for wide replies; by Lars Magne Ingebrigtsen . diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2010-08-30 06:44:58 +0000 +++ doc/misc/ChangeLog 2010-08-31 00:28:54 +0000 @@ -1,3 +1,8 @@ +2010-08-30 Lars Magne Ingebrigtsen + + * gnus.texi (Summary Mail Commands): Note that only the addresses from + the first message are used for wide replies. + 2010-08-29 Lars Magne Ingebrigtsen * gnus.texi (Drafts): Mention B DEL. === modified file 'doc/misc/gnus.texi' --- doc/misc/gnus.texi 2010-08-30 23:53:47 +0000 +++ doc/misc/gnus.texi 2010-08-31 00:28:54 +0000 @@ -6354,7 +6354,8 @@ @findex gnus-summary-wide-reply-with-original Mail a wide reply to the current article and include the original message (@code{gnus-summary-wide-reply-with-original}). This command uses -the process/prefix convention. +the process/prefix convention, but only uses the headers from the +first article to determine the recipients. @item S v @kindex S v (Summary) ------------------------------------------------------------ revno: 101236 committer: Katsumi Yamaoka branch nick: trunk timestamp: Tue 2010-08-31 00:23:25 +0000 message: Tell w3m that the input is UTF-8; This seems to fix problems with some German web feeds; by Lars Magne Ingebrigtsen . diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-08-31 00:19:31 +0000 +++ lisp/gnus/ChangeLog 2010-08-31 00:23:25 +0000 @@ -1,5 +1,8 @@ 2010-08-30 Lars Magne Ingebrigtsen + * gnus-html.el (gnus-article-html): Tell w3m that the input is + UTF-8. This seems to fix problems with some German web feeds. + * gnus.el (gnus-group-startup-message): Put the xpm version of the logo at the top so that the proper colours are applied. === modified file 'lisp/gnus/gnus-html.el' --- lisp/gnus/gnus-html.el 2010-08-31 00:07:40 +0000 +++ lisp/gnus/gnus-html.el 2010-08-31 00:23:25 +0000 @@ -59,8 +59,10 @@ nil article-buffer nil "-halfdump" "-no-cookie" + "-I" "UTF-8" "-O" "UTF-8" "-o" "ext_halfdump=1" + "-o" "pre_conv=1" "-t" (format "%s" tab-width) "-cols" (format "%s" gnus-html-frame-width) "-o" "display_image=off" ------------------------------------------------------------ revno: 101235 committer: Katsumi Yamaoka branch nick: trunk timestamp: Tue 2010-08-31 00:19:31 +0000 message: Put the xpm version of the logo at the top so that the proper colours are applied; by Lars Magne Ingebrigtsen . diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-08-31 00:15:33 +0000 +++ lisp/gnus/ChangeLog 2010-08-31 00:19:31 +0000 @@ -1,5 +1,8 @@ 2010-08-30 Lars Magne Ingebrigtsen + * gnus.el (gnus-group-startup-message): Put the xpm version of the logo + at the top so that the proper colours are applied. + * gnus-art.el (gnus-article-view-part): Doc fix. * gnus-html.el (gnus-html-put-image): Use gnus-create-image to be === modified file 'lisp/gnus/gnus.el' --- lisp/gnus/gnus.el 2010-08-30 23:53:47 +0000 +++ lisp/gnus/gnus.el 2010-08-31 00:19:31 +0000 @@ -1058,14 +1058,14 @@ (symbol-value 'image-load-path)) (t load-path))) (image (find-image - `((:type svg :file "gnus.svg") - (:type png :file "gnus.png") - (:type xpm :file "gnus.xpm" + `((:type xpm :file "gnus.xpm" :color-symbols (("thing" . ,(car gnus-logo-colors)) ("shadow" . ,(cadr gnus-logo-colors)) ("oort" . "#eeeeee") ("background" . ,(face-background 'default)))) + (:type svg :file "gnus.svg") + (:type png :file "gnus.png") (:type pbm :file "gnus.pbm" ;; Account for the pbm's blackground. :background ,(face-foreground 'gnus-splash) ------------------------------------------------------------ revno: 101234 committer: Katsumi Yamaoka branch nick: trunk timestamp: Tue 2010-08-31 00:15:33 +0000 message: gnus-article-view-part: Doc fix by Lars Magne Ingebrigtsen . diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-08-31 00:07:40 +0000 +++ lisp/gnus/ChangeLog 2010-08-31 00:15:33 +0000 @@ -1,5 +1,7 @@ 2010-08-30 Lars Magne Ingebrigtsen + * gnus-art.el (gnus-article-view-part): Doc fix. + * gnus-html.el (gnus-html-put-image): Use gnus-create-image to be XEmacs-compatible. (gnus-html-put-image): Don't do images on non-graphic displays. === modified file 'lisp/gnus/gnus-art.el' --- lisp/gnus/gnus-art.el 2010-08-30 06:17:45 +0000 +++ lisp/gnus/gnus-art.el 2010-08-31 00:15:33 +0000 @@ -5549,7 +5549,9 @@ 1)) (defun gnus-article-view-part (&optional n) - "View MIME part N, which is the numerical prefix." + "View MIME part N, which is the numerical prefix. +If the part is already shown, hide the part. If N is nil, view +all parts." (interactive "P") (with-current-buffer gnus-article-buffer (or (numberp n) (setq n (gnus-article-mime-match-handle-first ------------------------------------------------------------ revno: 101233 committer: Katsumi Yamaoka branch nick: trunk timestamp: Tue 2010-08-31 00:11:37 +0000 message: Always insert Content-Type headers, to make broken recipients happier; by Lars Magne Ingebrigtsen . diff: === modified file 'lisp/gnus/mml.el' --- lisp/gnus/mml.el 2010-07-21 05:56:18 +0000 +++ lisp/gnus/mml.el 2010-08-31 00:11:37 +0000 @@ -120,7 +120,7 @@ ,dispositions)))) :group 'message) -(defcustom mml-insert-mime-headers-always nil +(defcustom mml-insert-mime-headers-always t "If non-nil, always put Content-Type: text/plain at top of empty parts. It is necessary to work against a bug in certain clients." :version "22.1" ------------------------------------------------------------ revno: 101232 committer: Katsumi Yamaoka branch nick: trunk timestamp: Tue 2010-08-31 00:07:40 +0000 message: Use gnus-create-image to be XEmacs-compatible; Don't do images on non-graphic displays; by Lars Magne Ingebrigtsen . diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-08-30 23:53:47 +0000 +++ lisp/gnus/ChangeLog 2010-08-31 00:07:40 +0000 @@ -1,5 +1,9 @@ 2010-08-30 Lars Magne Ingebrigtsen + * gnus-html.el (gnus-html-put-image): Use gnus-create-image to be + XEmacs-compatible. + (gnus-html-put-image): Don't do images on non-graphic displays. + * nnslashdot.el: Removed this unused backend. * gnus-undo.el (gnus-undo-register-1): Limit the undo actions to 100 === modified file 'lisp/gnus/gnus-html.el' --- lisp/gnus/gnus-html.el 2010-08-30 23:35:19 +0000 +++ lisp/gnus/gnus-html.el 2010-08-31 00:07:40 +0000 @@ -162,21 +162,24 @@ (gnus-html-schedule-image-fetching buffer images))))) (defun gnus-html-put-image (file point) - (let ((image (ignore-errors - (create-image file)))) - (if (and image - ;; Kludge to avoid displaying 30x30 gif images, which - ;; seems to be a signal of a broken image. - (not (and (eq (getf (cdr image) :type) 'gif) - (= (car (image-size image t)) 30) - (= (cdr (image-size image t)) 30)))) - (progn - (gnus-put-image image nil nil point) - t) - (when (fboundp 'find-image) - (gnus-put-image (find-image '((:type xpm :file "lock-broken.xpm"))) - nil nil point)) - nil))) + (when (display-graphic-p) + (let ((image (ignore-errors + (gnus-create-image file)))) + (save-excursion + (goto-char point) + (if (and image + ;; Kludge to avoid displaying 30x30 gif images, which + ;; seems to be a signal of a broken image. + (not (and (eq (getf (cdr image) :type) 'gif) + (= (car (image-size image t)) 30) + (= (cdr (image-size image t)) 30)))) + (progn + (gnus-put-image image) + t) + (when (fboundp 'find-image) + (gnus-put-image (find-image + '((:type xpm :file "lock-broken.xpm"))))) + nil))))) (defun gnus-html-prune-cache () (let ((total-size 0) ------------------------------------------------------------ revno: 101231 committer: Katsumi Yamaoka branch nick: trunk timestamp: Mon 2010-08-30 23:53:47 +0000 message: Remove the unused nnslashdot backend by Lars Magne Ingebrigtsen . diff: === modified file 'doc/misc/gnus.texi' --- doc/misc/gnus.texi 2010-08-30 06:44:58 +0000 +++ doc/misc/gnus.texi 2010-08-30 23:53:47 +0000 @@ -695,7 +695,6 @@ * Archiving Mail:: * Web Searches:: Creating groups from articles that match a string. -* Slashdot:: Reading the Slashdot comments. * Ultimate:: The Ultimate Bulletin Board systems. * Web Archive:: Reading mailing list archived on web. * RSS:: Reading RDF site summary. @@ -1295,7 +1294,7 @@ topic parameter that looks like @example -"nnslashdot" +"nnml" @end example will mean that all groups that match that regex will be subscribed under @@ -17417,7 +17416,6 @@ @menu * Archiving Mail:: * Web Searches:: Creating groups from articles that match a string. -* Slashdot:: Reading the Slashdot comments. * Ultimate:: The Ultimate Bulletin Board systems. * Web Archive:: Reading mailing list archived on web. * RSS:: Reading RDF site summary. @@ -17562,94 +17560,6 @@ @end table -@node Slashdot -@subsection Slashdot -@cindex Slashdot -@cindex nnslashdot - -@uref{http://slashdot.org/, Slashdot} is a popular news site, with -lively discussion following the news articles. @code{nnslashdot} will -let you read this forum in a convenient manner. - -The easiest way to read this source is to put something like the -following in your @file{~/.gnus.el} file: - -@lisp -(setq gnus-secondary-select-methods - '((nnslashdot ""))) -@end lisp - -This will make Gnus query the @code{nnslashdot} back end for new comments -and groups. The @kbd{F} command will subscribe each new news article as -a new Gnus group, and you can read the comments by entering these -groups. (Note that the default subscription method is to subscribe new -groups as zombies. Other methods are available (@pxref{Subscription -Methods}). - -If you want to remove an old @code{nnslashdot} group, the @kbd{G DEL} -command is the most handy tool (@pxref{Foreign Groups}). - -When following up to @code{nnslashdot} comments (or posting new -comments), some light @acronym{HTML}izations will be performed. In -particular, text quoted with @samp{> } will be quoted with -@samp{blockquote} instead, and signatures will have @samp{br} added to -the end of each line. Other than that, you can just write @acronym{HTML} -directly into the message buffer. Note that Slashdot filters out some -@acronym{HTML} forms. - -The following variables can be altered to change its behavior: - -@table @code -@item nnslashdot-threaded -Whether @code{nnslashdot} should display threaded groups or not. The -default is @code{t}. To be able to display threads, @code{nnslashdot} -has to retrieve absolutely all comments in a group upon entry. If a -threaded display is not required, @code{nnslashdot} will only retrieve -the comments that are actually wanted by the user. Threading is nicer, -but much, much slower than unthreaded. - -@item nnslashdot-login-name -@vindex nnslashdot-login-name -The login name to use when posting. - -@item nnslashdot-password -@vindex nnslashdot-password -The password to use when posting. - -@item nnslashdot-directory -@vindex nnslashdot-directory -Where @code{nnslashdot} will store its files. The default is -@file{~/News/slashdot/}. - -@item nnslashdot-active-url -@vindex nnslashdot-active-url -The @acronym{URL} format string that will be used to fetch the -information on news articles and comments. The default is@* -@samp{http://slashdot.org/search.pl?section=&min=%d}. - -@item nnslashdot-comments-url -@vindex nnslashdot-comments-url -The @acronym{URL} format string that will be used to fetch comments. - -@item nnslashdot-article-url -@vindex nnslashdot-article-url -The @acronym{URL} format string that will be used to fetch the news -article. The default is -@samp{http://slashdot.org/article.pl?sid=%s&mode=nocomment}. - -@item nnslashdot-threshold -@vindex nnslashdot-threshold -The score threshold. The default is -1. - -@item nnslashdot-group-number -@vindex nnslashdot-group-number -The number of old groups, in addition to the ten latest, to keep -updated. The default is 0. - -@end table - - - @node Ultimate @subsection Ultimate @cindex nnultimate @@ -29591,7 +29501,7 @@ @code{nnml-nov-is-evil}, @code{nnspool-nov-is-evil}, and @code{nnwarchive-nov-is-evil}. Note that a non-@code{nil} value for @code{gnus-nov-is-evil} overrides all those variables.@footnote{Although -the back ends @code{nnkiboze}, @code{nnslashdot}, @code{nnultimate}, and +the back ends @code{nnkiboze}, @code{nnultimate}, and @code{nnwfm} don't have their own nn*-nov-is-evil.} @end table === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-08-30 23:47:12 +0000 +++ lisp/gnus/ChangeLog 2010-08-30 23:53:47 +0000 @@ -1,7 +1,10 @@ 2010-08-30 Lars Magne Ingebrigtsen + * nnslashdot.el: Removed this unused backend. + * gnus-undo.el (gnus-undo-register-1): Limit the undo actions to 100 actions. + (gnus-undo-register-1): Revert last change. * gnus-group.el (gnus-group-completing-read): Protect against not having completion-styles bound. === modified file 'lisp/gnus/gnus-undo.el' --- lisp/gnus/gnus-undo.el 2010-08-30 23:47:12 +0000 +++ lisp/gnus/gnus-undo.el 2010-08-30 23:53:47 +0000 @@ -154,9 +154,6 @@ ;; We are on a boundary, so we create a new action. (gnus-undo-boundary (push (list function) gnus-undo-actions) - ;; Don't let the undo actions grow infinitely. - (when (> (length gnus-undo-actions) 100) - (setcdr (nthcdr 100 gnus-undo-actions) nil)) (setq gnus-undo-boundary nil)) ;; Prepend the function to an old action. (gnus-undo-actions === modified file 'lisp/gnus/gnus.el' --- lisp/gnus/gnus.el 2010-08-30 06:10:18 +0000 +++ lisp/gnus/gnus.el 2010-08-30 23:53:47 +0000 @@ -1746,7 +1746,6 @@ ("nnfolder" mail respool address) ("nngateway" post-mail address prompt-address physical-address) ("nnweb" none) - ("nnslashdot" post) ("nnultimate" none) ("nnrss" none) ("nnwfm" none) === removed file 'lisp/gnus/nnslashdot.el' --- lisp/gnus/nnslashdot.el 2010-01-13 08:35:10 +0000 +++ lisp/gnus/nnslashdot.el 1970-01-01 00:00:00 +0000 @@ -1,505 +0,0 @@ -;;; nnslashdot.el --- interfacing with Slashdot - -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'nnoo) -(require 'message) -(require 'gnus-util) -(require 'gnus) -(require 'nnmail) -(require 'mm-util) -(require 'mm-url) - -(nnoo-declare nnslashdot) - -(defvoo nnslashdot-directory (nnheader-concat gnus-directory "slashdot/") - "Where nnslashdot will save its files.") - -(defvoo nnslashdot-active-url "http://slashdot.org/search.pl?section=&min=%d" - "Where nnslashdot will fetch the active file from.") - -(defvoo nnslashdot-comments-url "http://slashdot.org/comments.pl?sid=%s&threshold=%d&commentsort=%d&mode=flat&startat=%d" - "Where nnslashdot will fetch comments from.") - -(defvoo nnslashdot-article-url - "http://slashdot.org/article.pl?sid=%s&mode=nocomment" - "Where nnslashdot will fetch the article from.") - -(defvoo nnslashdot-backslash-url "http://slashdot.org/slashdot.xml" - "Where nnslashdot will fetch the stories from.") - -(defvoo nnslashdot-use-front-page nil - "Use the front page in addition to the backslash page.") - -(defvoo nnslashdot-threshold -1 - "The article threshold.") - -(defvoo nnslashdot-threaded t - "Whether the nnslashdot groups should be threaded or not.") - -(defvoo nnslashdot-group-number 0 - "The number of non-fresh groups to keep updated.") - -(defvoo nnslashdot-login-name "" - "The login name to use when posting.") - -(defvoo nnslashdot-password "" - "The password to use when posting.") - -;;; Internal variables - -(defvar nnslashdot-groups nil) -(defvar nnslashdot-buffer nil) -(defvar nnslashdot-headers nil) - -;;; Interface functions - -(nnoo-define-basics nnslashdot) - -(deffoo nnslashdot-retrieve-headers (articles &optional group server fetch-old) - (nnslashdot-possibly-change-server group server) - (condition-case why - (unless gnus-nov-is-evil - (nnslashdot-retrieve-headers-1 articles group)) - (search-failed (nnslashdot-lose why)))) - -(deffoo nnslashdot-retrieve-headers-1 (articles group) - (let* ((last (car (last articles))) - (start (if nnslashdot-threaded 1 (pop articles))) - (entry (assoc group nnslashdot-groups)) - (sid (nth 2 entry)) - (first-comments t) - headers article subject score from date lines parent point cid - s startats changed) - (save-excursion - (set-buffer nnslashdot-buffer) - (let ((case-fold-search t)) - (erase-buffer) - (when (= start 1) - (mm-url-insert (format nnslashdot-article-url sid) t) - (goto-char (point-min)) - (if (eobp) - (error "Couldn't open connection to slashdot")) - (re-search-forward "Posted by[ \t\r\n]+") - (when (looking-at "\\(]+>\\)?[ \t\r\n]*\\([^<\r\n]+\\)") - (setq from (mm-url-decode-entities-string (match-string 2)))) - (search-forward "on ") - (setq date (nnslashdot-date-to-date - (buffer-substring (point) (1- (search-forward "<"))))) - (setq lines (/ (- (point) - (progn (forward-line 1) (point))) - 60)) - (push - (cons - 1 - (make-full-mail-header - 1 group from date - (concat "<" sid "%1@slashdot>") - "" 0 lines nil nil)) - headers) - (setq start (if nnslashdot-threaded 2 (pop articles)))) - (while (and start (<= start last)) - (setq point (goto-char (point-max))) - (mm-url-insert - (format nnslashdot-comments-url sid - nnslashdot-threshold 0 (- start 2)) - t) - (when (and nnslashdot-threaded first-comments) - (setq first-comments nil) - (goto-char (point-max)) - (while (re-search-backward "startat=\\([0-9]+\\)" nil t) - (setq s (string-to-number (match-string 1))) - (unless (memq s startats) - (push s startats))) - (setq startats (sort startats '<))) - (setq article (if (and article (< start article)) article start)) - (goto-char point) - (while (re-search-forward - "\\([^<]+\\)\\(?:.*\n\\)\\{2,10\\}.*score:\\([^)]+\\))" - nil t) - (setq cid (match-string 1) - subject (match-string 2) - score (match-string 3)) - (unless (assq article (nth 4 entry)) - (setcar (nthcdr 4 entry) (cons (cons article cid) (nth 4 entry))) - (setq changed t)) - (when (string-match "^Re: *" subject) - (setq subject (concat "Re: " (substring subject (match-end 0))))) - (setq subject (mm-url-decode-entities-string subject) - from "") - (when (re-search-forward "by[ \t\n]+<[^>]+>\\([^<(]+\\)" nil t) - (setq from - (concat - (mm-url-decode-entities-string (match-string 1)) - " "))) - (search-forward "on ") - (setq date - (nnslashdot-date-to-date - (buffer-substring - (point) (progn (skip-chars-forward "^()<>\n\r") (point))))) - (setq lines (/ (abs (- (search-forward ""))) - 70)) - (if (not - (re-search-forward ".*cid=\\([0-9]+\\)\">Parent" nil t)) - (setq parent nil) - (setq parent (match-string 1)) - (when (string= parent "0") - (setq parent nil))) - (push - (cons - article - (make-full-mail-header - article - (concat subject " (" score ")") - from date - (concat "<" sid "%" cid "@slashdot>") - (if parent - (concat "<" sid "%" parent "@slashdot>") - "") - 0 lines nil nil)) - headers) - (while (and articles (<= (car articles) article)) - (pop articles)) - (setq article (1+ article))) - (if nnslashdot-threaded - (progn - (setq start (pop startats)) - (if start (setq start (+ start 2)))) - (setq start (pop articles)))))) - (if changed (nnslashdot-write-groups)) - (setq nnslashdot-headers (sort headers 'car-less-than-car)) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (mm-with-unibyte-current-buffer - (dolist (header nnslashdot-headers) - (nnheader-insert-nov (cdr header))))) - 'nov)) - -(deffoo nnslashdot-request-group (group &optional server dont-check) - (nnslashdot-possibly-change-server nil server) - (let ((elem (assoc group nnslashdot-groups))) - (cond - ((not elem) - (nnheader-report 'nnslashdot "Group does not exist")) - (t - (nnheader-report 'nnslashdot "Opened group %s" group) - (nnheader-insert - "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem) - (prin1-to-string group)))))) - -(deffoo nnslashdot-close-group (group &optional server) - (nnslashdot-possibly-change-server group server) - (when (gnus-buffer-live-p nnslashdot-buffer) - (save-excursion - (set-buffer nnslashdot-buffer) - (kill-buffer nnslashdot-buffer))) - t) - -(deffoo nnslashdot-request-article (article &optional group server buffer) - (nnslashdot-possibly-change-server group server) - (let (contents cid) - (condition-case why - (save-excursion - (set-buffer nnslashdot-buffer) - (let ((case-fold-search t)) - (goto-char (point-min)) - (when (and (stringp article) - (string-match "%\\([0-9]+\\)@" article)) - (setq cid (match-string 1 article)) - (let ((map (nth 4 (assoc group nnslashdot-groups)))) - (while map - (if (equal (cdar map) cid) - (setq article (caar map) - map nil) - (setq map (cdr map)))))) - (when (numberp article) - (if (= article 1) - (progn - (search-forward "Posted by") - (search-forward "
") - (setq contents - (buffer-substring - (point) - (progn - (search-forward "commentwrap") - (match-beginning 0))))) - (setq cid (cdr (assq article - (nth 4 (assoc group nnslashdot-groups))))) - (search-forward (format "" cid)) - (setq contents - (buffer-substring - (search-forward "
") - (progn - (search-forward "
\r?\\)+" nil t) - (replace-match "

" t t)) - (goto-char (point-min)) - (insert "Content-Type: text/html\nMIME-Version: 1.0\n") - (insert "Newsgroups: " (caddr (assoc group nnslashdot-groups)) - "\n") - (let ((header (cdr (assq article nnslashdot-headers)))) - (nnheader-insert-header header)) - (nnheader-report 'nnslashdot "Fetched article %s" article)) - (cons group article))))) - -(deffoo nnslashdot-close-server (&optional server) - (when (and (nnslashdot-server-opened server) - (gnus-buffer-live-p nnslashdot-buffer)) - (save-excursion - (set-buffer nnslashdot-buffer) - (kill-buffer nnslashdot-buffer))) - (nnoo-close-server 'nnslashdot server)) - -(deffoo nnslashdot-request-list (&optional server) - (nnslashdot-possibly-change-server nil server) - (let ((number 0) - (first nnslashdot-use-front-page) - sid elem description articles gname) - (condition-case why - ;; First we do the Ultramode to get info on all the latest groups. - (progn - (mm-with-unibyte-buffer - (mm-url-insert nnslashdot-backslash-url t) - (goto-char (point-min)) - (if (eobp) - (error "Couldn't open connection to slashdot")) - (while (search-forward "" nil t) - (narrow-to-region (point) (search-forward "")) - (goto-char (point-min)) - (re-search-forward "\\([^<]+\\)") - (setq description - (mm-url-decode-entities-string (match-string 1))) - (re-search-forward "\\([^<]+\\)") - (setq sid (match-string 1)) - (string-match "sid=\\([0-9/]+\\)\\(.shtml\\|$\\)" sid) - (setq sid (match-string 1 sid)) - (re-search-forward "\\([^<]+\\)") - (setq articles (string-to-number (match-string 1))) - (setq gname (concat description " (" sid ")")) - (if (setq elem (assoc gname nnslashdot-groups)) - (setcar (cdr elem) articles) - (push (list gname articles sid (current-time) nil) - nnslashdot-groups)) - (goto-char (point-max)) - (widen))) - ;; Then do the older groups. - (while (or first - (> (- nnslashdot-group-number number) 0)) - (setq first nil) - (mm-with-unibyte-buffer - (let ((case-fold-search t)) - (mm-url-insert (format nnslashdot-active-url number) t) - (goto-char (point-min)) - (while (re-search-forward - "article.pl\\?sid=\\([^&]+\\).*>\\([^<]+\\)" - nil t) - (setq sid (match-string 1) - description - (mm-url-decode-entities-string (match-string 2))) - (forward-line 1) - (when (re-search-forward "with \\([0-9]+\\) comment" nil t) - (setq articles (1+ (string-to-number (match-string 1))))) - (setq gname (concat description " (" sid ")")) - (if (setq elem (assoc gname nnslashdot-groups)) - (setcar (cdr elem) articles) - (push (list gname articles sid (current-time) nil) - nnslashdot-groups))))) - (incf number 30))) - (search-failed (nnslashdot-lose why))) - (nnslashdot-write-groups) - (nnslashdot-generate-active) - t)) - -(deffoo nnslashdot-request-newgroups (date &optional server) - (nnslashdot-possibly-change-server nil server) - (nnslashdot-generate-active) - t) - -(deffoo nnslashdot-request-post (&optional server) - (nnslashdot-possibly-change-server nil server) - (let ((sid (message-fetch-field "newsgroups")) - (subject (message-fetch-field "subject")) - (references (car (last (split-string - (message-fetch-field "references"))))) - body quoted pid) - (string-match "%\\([0-9]+\\)@slashdot" references) - (setq pid (match-string 1 references)) - (message-goto-body) - (narrow-to-region (point) (progn (message-goto-signature) (point))) - (goto-char (point-min)) - (while (not (eobp)) - (if (looking-at "> ") - (progn - (delete-region (point) (+ (point) 2)) - (unless quoted - (insert "

\n")) - (setq quoted t)) - (when quoted - (insert "
\n") - (setq quoted nil))) - (forward-line 1)) - (goto-char (point-min)) - (while (re-search-forward "^ *\n" nil t) - (replace-match "

\n")) - (widen) - (when (message-goto-signature) - (forward-line -1) - (insert "

\n") - (while (not (eobp)) - (end-of-line) - (insert "
") - (forward-line 1))) - (message-goto-body) - (setq body (buffer-substring (point) (point-max))) - (erase-buffer) - (mm-url-fetch-form - "http://slashdot.org/comments.pl" - `(("sid" . ,sid) - ("pid" . ,pid) - ("rlogin" . "userlogin") - ("unickname" . ,nnslashdot-login-name) - ("upasswd" . ,nnslashdot-password) - ("postersubj" . ,subject) - ("op" . "Submit") - ("postercomment" . ,body) - ("posttype" . "html"))))) - -(deffoo nnslashdot-request-delete-group (group &optional force server) - (nnslashdot-possibly-change-server group server) - (setq nnslashdot-groups (delq (assoc group nnslashdot-groups) - nnslashdot-groups)) - (nnslashdot-write-groups)) - -(deffoo nnslashdot-request-close () - (setq nnslashdot-headers nil - nnslashdot-groups nil)) - -(deffoo nnslashdot-request-expire-articles - (articles group &optional server force) - (nnslashdot-possibly-change-server group server) - (let ((item (assoc group nnslashdot-groups))) - (when item - (if (fourth item) - (when (and (>= (length articles) (cadr item)) ;; All are expirable. - (nnmail-expired-article-p - group - (fourth item) - force)) - (setq nnslashdot-groups (delq item nnslashdot-groups)) - (nnslashdot-write-groups) - (setq articles nil)) ;; all expired. - (setcdr (cddr item) (list (current-time))) - (nnslashdot-write-groups)))) - articles) - -(nnoo-define-skeleton nnslashdot) - -;;; Internal functions - -(defun nnslashdot-possibly-change-server (&optional group server) - (nnslashdot-init server) - (when (and server - (not (nnslashdot-server-opened server))) - (nnslashdot-open-server server)) - (unless nnslashdot-groups - (nnslashdot-read-groups))) - -(defun nnslashdot-make-tuple (tuple n) - (prog1 - tuple - (while (> n 1) - (unless (cdr tuple) - (setcdr tuple (list nil))) - (setq tuple (cdr tuple) - n (1- n))))) - -(defun nnslashdot-read-groups () - (let ((file (expand-file-name "groups" nnslashdot-directory))) - (when (file-exists-p file) - (mm-with-unibyte-buffer - (insert-file-contents file) - (goto-char (point-min)) - (setq nnslashdot-groups (read (current-buffer)))) - (when (and nnslashdot-groups (< (length (car nnslashdot-groups)) 5)) - (dolist (group nnslashdot-groups) - (nnslashdot-make-tuple group 5)))))) - -(defun nnslashdot-write-groups () - (with-temp-file (expand-file-name "groups" nnslashdot-directory) - (gnus-prin1 nnslashdot-groups))) - -(defun nnslashdot-init (server) - "Initialize buffers and such." - (unless (file-exists-p nnslashdot-directory) - (gnus-make-directory nnslashdot-directory)) - (unless (gnus-buffer-live-p nnslashdot-buffer) - (setq nnslashdot-buffer - (save-excursion - (nnheader-set-temp-buffer - (format " *nnslashdot %s*" server)))) - (push nnslashdot-buffer gnus-buffers))) - -(defun nnslashdot-date-to-date (sdate) - (condition-case err - (let ((elem (delete "" (split-string sdate)))) - (concat (substring (nth 0 elem) 0 3) " " - (substring (nth 1 elem) 0 3) " " - (substring (nth 2 elem) 0 2) " " - (substring (nth 3 elem) 1 6) " " - (format-time-string "%Y") " " - (nth 4 elem))) - (error ""))) - -(defun nnslashdot-generate-active () - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (dolist (elem nnslashdot-groups) - (when (numberp (cadr elem)) - (insert (prin1-to-string (car elem)) - " " (number-to-string (cadr elem)) " 1 y\n"))))) - -(defun nnslashdot-lose (why) - (error "Slashdot HTML has changed; please get a new version of nnslashdot")) - -(provide 'nnslashdot) - -;; arch-tag: aa73df7a-f7e6-4eef-bdea-5ce2f8c691b3 -;;; nnslashdot.el ends here ------------------------------------------------------------ revno: 101230 committer: Katsumi Yamaoka branch nick: trunk timestamp: Mon 2010-08-30 23:47:12 +0000 message: Limit the undo actions to 100 actions by Lars Magne Ingebrigtsen . diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-08-30 23:40:10 +0000 +++ lisp/gnus/ChangeLog 2010-08-30 23:47:12 +0000 @@ -1,5 +1,8 @@ 2010-08-30 Lars Magne Ingebrigtsen + * gnus-undo.el (gnus-undo-register-1): Limit the undo actions to 100 + actions. + * gnus-group.el (gnus-group-completing-read): Protect against not having completion-styles bound. === modified file 'lisp/gnus/gnus-undo.el' --- lisp/gnus/gnus-undo.el 2010-05-06 04:15:34 +0000 +++ lisp/gnus/gnus-undo.el 2010-08-30 23:47:12 +0000 @@ -154,6 +154,9 @@ ;; We are on a boundary, so we create a new action. (gnus-undo-boundary (push (list function) gnus-undo-actions) + ;; Don't let the undo actions grow infinitely. + (when (> (length gnus-undo-actions) 100) + (setcdr (nthcdr 100 gnus-undo-actions) nil)) (setq gnus-undo-boundary nil)) ;; Prepend the function to an old action. (gnus-undo-actions ------------------------------------------------------------ revno: 101229 committer: Katsumi Yamaoka branch nick: trunk timestamp: Mon 2010-08-30 23:40:10 +0000 message: Protect against not having completion-styles bound by Lars Magne Ingebrigtsen . diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-08-30 23:29:56 +0000 +++ lisp/gnus/ChangeLog 2010-08-30 23:40:10 +0000 @@ -1,5 +1,11 @@ 2010-08-30 Lars Magne Ingebrigtsen + * gnus-group.el (gnus-group-completing-read): Protect against not + having completion-styles bound. + + * mml.el (mml-insert-mime-headers-always): Change the default to t, to + make broken recipients happier. + * gnus-html.el (gnus-html-put-image): Use gnus-put-image. * gnus-ems.el (gnus-put-image): Have gnus-put-image take an optional === modified file 'lisp/gnus/gnus-group.el' --- lisp/gnus/gnus-group.el 2010-08-30 23:24:56 +0000 +++ lisp/gnus/gnus-group.el 2010-08-30 23:40:10 +0000 @@ -2202,7 +2202,8 @@ The arguments are the same as `completing-read' except that COLLECTION and HIST default to `gnus-active-hashtb' and `gnus-group-history' respectively if they are omitted." - (let ((completion-styles completion-styles) + (let ((completion-styles (and (boundp 'completion-styles) + completion-styles)) group) (push 'substring completion-styles) (mapatoms (lambda (symbol) ------------------------------------------------------------ revno: 101228 committer: Katsumi Yamaoka branch nick: trunk timestamp: Mon 2010-08-30 23:35:19 +0000 message: Use insert-image instead of put-image when putting images into a buffer; This makes all the Gnus image-inserting functions work, I think; by Lars Magne Ingebrigtsen . diff: === modified file 'lisp/gnus/gnus-ems.el' --- lisp/gnus/gnus-ems.el 2010-08-30 23:29:56 +0000 +++ lisp/gnus/gnus-ems.el 2010-08-30 23:35:19 +0000 @@ -278,7 +278,7 @@ (let ((point (or point (point)))) (save-excursion (goto-char point) - (put-image glyph point) + (insert-image glyph (or string " ")) (put-text-property point (point) 'gnus-image-category category) (unless string (put-text-property (1- (point)) (point) === modified file 'lisp/gnus/gnus-html.el' --- lisp/gnus/gnus-html.el 2010-08-30 23:29:56 +0000 +++ lisp/gnus/gnus-html.el 2010-08-30 23:35:19 +0000 @@ -157,7 +157,7 @@ (set-buffer buffer) (let ((buffer-read-only nil)) (when (gnus-html-put-image file (cadr spec)) - (delete-region (cadr spec) (caddr spec)))))) + (delete-region (1+ (cadr spec)) (caddr spec)))))) (when images (gnus-html-schedule-image-fetching buffer images))))) ------------------------------------------------------------ revno: 101227 committer: Katsumi Yamaoka branch nick: trunk timestamp: Mon 2010-08-30 23:29:56 +0000 message: Make html image insertion probably work for XEmacs, too by Lars Magne Ingebrigtsen . diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-08-30 23:24:56 +0000 +++ lisp/gnus/ChangeLog 2010-08-30 23:29:56 +0000 @@ -1,5 +1,10 @@ 2010-08-30 Lars Magne Ingebrigtsen + * gnus-html.el (gnus-html-put-image): Use gnus-put-image. + + * gnus-ems.el (gnus-put-image): Have gnus-put-image take an optional + point parameter. + * gnus-group.el (gnus-group-completing-read): Add 'substring to completion-styles for group selection. === modified file 'lisp/gnus/gnus-ems.el' --- lisp/gnus/gnus-ems.el 2010-01-13 08:35:10 +0000 +++ lisp/gnus/gnus-ems.el 2010-08-30 23:29:56 +0000 @@ -274,13 +274,15 @@ (setq props (plist-put props :background (face-background face)))) (apply 'create-image file type data-p props))) -(defun gnus-put-image (glyph &optional string category) - (let ((point (point))) - (insert-image glyph (or string " ")) - (put-text-property point (point) 'gnus-image-category category) - (unless string - (put-text-property (1- (point)) (point) - 'gnus-image-text-deletable t)) +(defun gnus-put-image (glyph &optional string category point) + (let ((point (or point (point)))) + (save-excursion + (goto-char point) + (put-image glyph point) + (put-text-property point (point) 'gnus-image-category category) + (unless string + (put-text-property (1- (point)) (point) + 'gnus-image-text-deletable t))) glyph)) (defun gnus-remove-image (image &optional category) === modified file 'lisp/gnus/gnus-html.el' --- lisp/gnus/gnus-html.el 2010-08-30 06:17:45 +0000 +++ lisp/gnus/gnus-html.el 2010-08-30 23:29:56 +0000 @@ -171,11 +171,11 @@ (= (car (image-size image t)) 30) (= (cdr (image-size image t)) 30)))) (progn - (put-image image point) + (gnus-put-image image nil nil point) t) (when (fboundp 'find-image) - (put-image (find-image '((:type xpm :file "lock-broken.xpm"))) - point)) + (gnus-put-image (find-image '((:type xpm :file "lock-broken.xpm"))) + nil nil point)) nil))) (defun gnus-html-prune-cache () ------------------------------------------------------------ revno: 101226 committer: Katsumi Yamaoka branch nick: trunk timestamp: Mon 2010-08-30 23:24:56 +0000 message: gnus-group-completing-read: Add 'substring to completion-styles for group selection; imap.el, mailcap.el, message.el, mm-util.el, nnheader.el, nnmail.el, pop3.el: Remove references to outdated systems; References to win32 w32 mswindows ms-windows emx were probably cargo-culted, and are removed for clarity; By Lars Magne Ingebrigtsen . diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-08-30 06:32:33 +0000 +++ lisp/gnus/ChangeLog 2010-08-30 23:24:56 +0000 @@ -1,3 +1,8 @@ +2010-08-30 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-completing-read): Add 'substring to + completion-styles for group selection. + 2009-02-04 Andreas Schwab * gnus-score.el (gnus-score-string): Fix regex for matching extra === modified file 'lisp/gnus/gnus-group.el' --- lisp/gnus/gnus-group.el 2010-05-07 06:58:17 +0000 +++ lisp/gnus/gnus-group.el 2010-08-30 23:24:56 +0000 @@ -2202,7 +2202,9 @@ The arguments are the same as `completing-read' except that COLLECTION and HIST default to `gnus-active-hashtb' and `gnus-group-history' respectively if they are omitted." - (let (group) + (let ((completion-styles completion-styles) + group) + (push 'substring completion-styles) (mapatoms (lambda (symbol) (setq group (symbol-name symbol)) (set (intern (if (string-match "[^\000-\177]" group) === modified file 'lisp/gnus/mailcap.el' --- lisp/gnus/mailcap.el 2010-01-13 08:35:10 +0000 +++ lisp/gnus/mailcap.el 2010-08-30 23:24:56 +0000 @@ -335,7 +335,7 @@ :group 'mailcap) (defvar mailcap-poor-system-types - '(ms-dos ms-windows windows-nt win32 w32 mswindows) + '(ms-dos windows-nt) "Systems that don't have a Unix-like directory hierarchy.") ;;; === modified file 'lisp/gnus/message.el' --- lisp/gnus/message.el 2010-08-30 06:25:05 +0000 +++ lisp/gnus/message.el 2010-08-30 23:24:56 +0000 @@ -5433,7 +5433,7 @@ (* 25 25))) (let ((tm (current-time))) (concat - (if (or (memq system-type '(ms-dos emx)) + (if (or (eq system-type 'ms-dos) ;; message-number-base36 doesn't handle bigints. (floatp (user-uid))) (let ((user (downcase (user-login-name)))) @@ -6451,9 +6451,7 @@ (setq buffer-file-name (expand-file-name (concat (if (memq system-type - '(ms-dos ms-windows windows-nt - cygwin cygwin32 win32 w32 - mswindows)) + '(ms-dos windows-nt cygwin)) "message" "*message*") (format-time-string "-%Y%m%d-%H%M%S")) === modified file 'lisp/gnus/mm-util.el' --- lisp/gnus/mm-util.el 2010-05-10 12:07:40 +0000 +++ lisp/gnus/mm-util.el 2010-08-30 23:24:56 +0000 @@ -680,7 +680,7 @@ "100% binary coding system.") (defvar mm-text-coding-system - (or (if (memq system-type '(windows-nt ms-dos ms-windows)) + (or (if (memq system-type '(windows-nt ms-dos)) (and (mm-coding-system-p 'raw-text-dos) 'raw-text-dos) (and (mm-coding-system-p 'raw-text) 'raw-text)) mm-binary-coding-system) @@ -692,12 +692,12 @@ (defvar mm-auto-save-coding-system (cond ((mm-coding-system-p 'utf-8-emacs) ; Mule 7 - (if (memq system-type '(windows-nt ms-dos ms-windows)) + (if (memq system-type '(windows-nt ms-dos)) (if (mm-coding-system-p 'utf-8-emacs-dos) 'utf-8-emacs-dos mm-binary-coding-system) 'utf-8-emacs)) ((mm-coding-system-p 'emacs-mule) - (if (memq system-type '(windows-nt ms-dos ms-windows)) + (if (memq system-type '(windows-nt ms-dos)) (if (mm-coding-system-p 'emacs-mule-dos) 'emacs-mule-dos mm-binary-coding-system) 'emacs-mule)) === modified file 'lisp/gnus/nnheader.el' --- lisp/gnus/nnheader.el 2010-03-19 02:55:37 +0000 +++ lisp/gnus/nnheader.el 2010-08-30 23:24:56 +0000 @@ -77,7 +77,7 @@ "*Length of each read operation when trying to fetch HEAD headers.") (defvar nnheader-read-timeout - (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin" + (if (string-match "windows-nt\\|os/2\\|cygwin" (symbol-name system-type)) ;; http://thread.gmane.org/v9655t3pjo.fsf@marauder.physik.uni-ulm.de ;; @@ -102,7 +102,7 @@ (defvar nnheader-file-name-translation-alist (let ((case-fold-search t)) (cond - ((string-match "windows-nt\\|os/2\\|emx\\|cygwin" + ((string-match "windows-nt\\|os/2\\|cygwin" (symbol-name system-type)) (append (mapcar (lambda (c) (cons c ?_)) '(?: ?* ?\" ?< ?> ??)) @@ -786,8 +786,7 @@ ;; We translate -- but only the file name. We leave the directory ;; alone. (if (and (featurep 'xemacs) - (memq system-type '(cygwin32 win32 w32 mswindows windows-nt - cygwin))) + (memq system-type '(windows-nt cygwin))) ;; This is needed on NT and stuff, because ;; file-name-nondirectory is not enough to split ;; file names, containing ':', e.g. === modified file 'lisp/gnus/nnmail.el' --- lisp/gnus/nnmail.el 2010-08-01 23:49:32 +0000 +++ lisp/gnus/nnmail.el 2010-08-30 23:24:56 +0000 @@ -265,7 +265,7 @@ :type 'function) (defcustom nnmail-crosspost-link-function - (if (string-match "windows-nt\\|emx" (symbol-name system-type)) + (if (string-match "windows-nt" (symbol-name system-type)) 'copy-file 'add-name-to-file) "*Function called to create a copy of a file. === modified file 'lisp/gnus/pop3.el' --- lisp/gnus/pop3.el 2010-03-23 07:37:09 +0000 +++ lisp/gnus/pop3.el 2010-08-30 23:24:56 +0000 @@ -120,7 +120,7 @@ (defalias 'pop3-accept-process-output 'nnheader-accept-process-output) ;; Borrowed from `nnheader.el': (defvar pop3-read-timeout - (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin" + (if (string-match "windows-nt\\|os/2\\|cygwin" (symbol-name system-type)) 1.0 0.01) === modified file 'lisp/net/imap.el' --- lisp/net/imap.el 2010-05-25 02:11:08 +0000 +++ lisp/net/imap.el 2010-08-30 23:24:56 +0000 @@ -267,7 +267,7 @@ :type 'string) (defcustom imap-read-timeout (if (string-match - "windows-nt\\|os/2\\|emx\\|cygwin" + "windows-nt\\|os/2\\|cygwin" (symbol-name system-type)) 1.0 0.1) ------------------------------------------------------------ revno: 101225 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2010-08-30 22:34:52 +0200 message: Use SMIE for octave-mode. * test/indent/octave.m: New file. * lisp/progmodes/octave-mod.el (octave-font-lock-keywords): Use regexp-opt. (octave-mode-map): Remove special bindings for forward/backward-block and octave-backward-up-block. Use smie-close-block. (octave-continuation-marker-regexp): New var. (octave-continuation-regexp): Use it. (octave-operator-table, octave-smie-op-levels) (octave-operator-regexp, octave-smie-indent-rules): New vars. (octave-smie-backward-token, octave-smie-forward-token): New funs. (octave-mode): Use SMIE. (octave-close-block): Delete. diff: === modified file '.bzrignore' --- .bzrignore 2010-08-22 20:02:16 +0000 +++ .bzrignore 2010-08-30 20:34:52 +0000 @@ -71,3 +71,4 @@ src/prefix-args* src/stamp-oldxmenu src/temacs +test/indent/*.new === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-08-30 18:11:34 +0000 +++ lisp/ChangeLog 2010-08-30 20:34:52 +0000 @@ -1,3 +1,16 @@ +2010-08-30 Stefan Monnier + + * progmodes/octave-mod.el (octave-font-lock-keywords): Use regexp-opt. + (octave-mode-map): Remove special bindings for forward/backward-block + and octave-backward-up-block. Use smie-close-block. + (octave-continuation-marker-regexp): New var. + (octave-continuation-regexp): Use it. + (octave-operator-table, octave-smie-op-levels) + (octave-operator-regexp, octave-smie-indent-rules): New vars. + (octave-smie-backward-token, octave-smie-forward-token): New funs. + (octave-mode): Use SMIE. + (octave-close-block): Delete. + 2010-08-30 Eli Zaretskii * menu-bar.el (menu-bar-edit-menu) <"Paste">: Check selection in === modified file 'lisp/progmodes/octave-mod.el' --- lisp/progmodes/octave-mod.el 2010-08-18 13:12:34 +0000 +++ lisp/progmodes/octave-mod.el 2010-08-30 20:34:52 +0000 @@ -161,8 +161,8 @@ (list ;; Fontify all builtin keywords. (cons (concat "\\<\\(" - (mapconcat 'identity octave-reserved-words "\\|") - (mapconcat 'identity octave-text-functions "\\|") + (regexp-opt (append octave-reserved-words + octave-text-functions)) "\\)\\>") 'font-lock-keyword-face) ;; Fontify all builtin operators. @@ -223,13 +223,10 @@ (define-key map "\C-c\C-n" 'octave-next-code-line) (define-key map "\C-c\C-a" 'octave-beginning-of-line) (define-key map "\C-c\C-e" 'octave-end-of-line) - (define-key map "\C-c\M-\C-n" 'octave-forward-block) - (define-key map "\C-c\M-\C-p" 'octave-backward-block) - (define-key map "\C-c\M-\C-u" 'octave-backward-up-block) (define-key map "\C-c\M-\C-d" 'octave-down-block) (define-key map "\C-c\M-\C-h" 'octave-mark-block) - (define-key map "\C-c]" 'octave-close-block) - (define-key map "\C-c/" 'octave-close-block) + (define-key map "\C-c]" 'smie-close-block) + (define-key map "\C-c/" 'smie-close-block) (define-key map "\C-c\C-f" 'octave-insert-defun) (define-key map "\C-c\C-h" 'octave-help) (define-key map "\C-c\C-il" 'octave-send-line) @@ -261,12 +258,9 @@ ["End of Continuation" octave-end-of-line t] ["Split Line at Point" octave-indent-new-comment-line t]) ("Blocks" - ["Next Block" octave-forward-block t] - ["Previous Block" octave-backward-block t] ["Down Block" octave-down-block t] - ["Up Block" octave-backward-up-block t] ["Mark Block" octave-mark-block t] - ["Close Block" octave-close-block t]) + ["Close Block" smie-close-block t]) ("Functions" ["Indent Function" octave-indent-defun t] ["Insert Function" octave-insert-defun t]) @@ -386,8 +380,11 @@ "Extra indentation applied to Octave continuation lines." :type 'integer :group 'octave) +(eval-and-compile + (defconst octave-continuation-marker-regexp "\\\\\\|\\.\\.\\.")) (defvar octave-continuation-regexp - "[^#%\n]*\\(\\\\\\|\\.\\.\\.\\)\\s-*\\(\\s<.*\\)?$") + (concat "[^#%\n]*\\(" octave-continuation-marker-regexp + "\\)\\s-*\\(\\s<.*\\)?$")) (defcustom octave-continuation-string "\\" "Character string used for Octave continuation lines. Normally \\." :type 'string @@ -425,6 +422,143 @@ :group 'octave) +;;; SMIE indentation + +(require 'smie) + +(defconst octave-operator-table + '((assoc ";" "\n") (assoc ",") ; The doc claims they have equal precedence!? + (right "=" "+=" "-=" "*=" "/=") + (assoc "&&") (assoc "||") ; The doc claims they have equal precedence!? + (assoc "&") (assoc "|") ; The doc claims they have equal precedence!? + (nonassoc "<" "<=" "==" ">=" ">" "!=" "~=") + (nonassoc ":") ;No idea what this is. + (assoc "+" "-") + (assoc "*" "/" "\\" ".\\" ".*" "./") + (nonassoc "'" ".'") + (nonassoc "++" "--" "!" "~") ;And unary "+" and "-". + (right "^" "**" ".^" ".**") + ;; It's not really an operator, but for indentation purposes it + ;; could be convenient to treat it as one. + (assoc "..."))) + +(defconst octave-smie-op-levels + (smie-prec2-levels + (smie-merge-prec2s + (smie-bnf-precedence-table + '((atom) + ;; We can't distinguish the first element in a sequence with + ;; precedence grammars, so we can't distinguish the condition + ;; if the `if' from the subsequent body, for example. + ;; This has to be done later in the indentation rules. + (exp (exp "\n" exp) + ;; We need to mention at least one of the operators in this part + ;; of the grammar: if the BNF and the operator table have + ;; no overlap, SMIE can't know how they relate. + (exp ";" exp) + ("try" exp "catch" exp "end_try_catch") + ("try" exp "catch" exp "end") + ("unwind_protect" exp + "unwind_protect_cleanup" exp "end_unwind_protect") + ("unwind_protect" exp "unwind_protect_cleanup" exp "end") + ("for" exp "endfor") + ("for" exp "end") + ("do" exp "until" atom) + ("while" exp "endwhile") + ("while" exp "end") + ("if" exp "endif") + ("if" exp "else" exp "endif") + ("if" exp "elseif" exp "else" exp "endif") + ("if" exp "elseif" exp "elseif" exp "else" exp "endif") + ("if" exp "elseif" exp "elseif" exp "else" exp "end") + ("switch" exp "case" exp "endswitch") + ("switch" exp "case" exp "otherwise" exp "endswitch") + ("switch" exp "case" exp "case" exp "otherwise" exp "endswitch") + ("switch" exp "case" exp "case" exp "otherwise" exp "end") + ("function" exp "endfunction") + ("function" exp "end")) + ;; (fundesc (atom "=" atom)) + ) + '((assoc "\n" ";"))) + + (smie-precs-precedence-table + (append octave-operator-table + '((nonassoc " -dummy- "))) ;Bogus anchor at the end. + )))) + +;; Tokenizing needs to be refined so that ";;" is treated as two +;; tokens and also so as to recognize the \n separator (and +;; corresponding continuation lines). + +(defconst octave-operator-regexp + (regexp-opt (apply 'append (mapcar 'cdr octave-operator-table)))) + +(defun octave-smie-backward-token () + (let ((pos (point))) + (forward-comment (- (point))) + (cond + ((and (not (eq (char-before) ?\;)) ;Coalesce ";" and "\n". + (> pos (line-end-position)) + (if (looking-back octave-continuation-marker-regexp (- (point) 3)) + (progn + (goto-char (match-beginning 0)) + (forward-comment (- (point))) + nil) + t) + ;; Ignore it if it's within parentheses. + (let ((ppss (syntax-ppss))) + (not (and (nth 1 ppss) + (eq ?\( (char-after (nth 1 ppss))))))) + (skip-chars-forward " \t") + ;; Why bother distinguishing \n and ;? + ";") ;;"\n" + ((and (looking-back octave-operator-regexp (- (point) 3) 'greedy) + ;; Don't mistake a string quote for a transpose. + (not (looking-back "\\s\"" (1- (point))))) + (goto-char (match-beginning 0)) + (match-string-no-properties 0)) + (t + (smie-default-backward-token))))) + +(defun octave-smie-forward-token () + (skip-chars-forward " \t") + (when (looking-at (eval-when-compile + (concat "\\(" octave-continuation-marker-regexp + "\\)[ \t]*\\($\\|[%#]\\)"))) + (goto-char (match-end 1)) + (forward-comment 1)) + (cond + ((and (looking-at "$\\|[%#]") + ;; Ignore it if it's within parentheses. + (prog1 (let ((ppss (syntax-ppss))) + (not (and (nth 1 ppss) + (eq ?\( (char-after (nth 1 ppss)))))) + (forward-comment (point-max)))) + ;; Why bother distinguishing \n and ;? + ";") ;;"\n" + ((looking-at ";[ \t]*\\($\\|[%#]\\)") + ;; Combine the ; with the subsequent \n. + (goto-char (match-beginning 1)) + (forward-comment 1) + ";") + ((and (looking-at octave-operator-regexp) + ;; Don't mistake a string quote for a transpose. + (not (looking-at "\\s\""))) + (goto-char (match-end 0)) + (match-string-no-properties 0)) + (t + (smie-default-forward-token)))) + +(defconst octave-smie-indent-rules + '((";" + (:parent ("function" "if" "while" "else" "elseif" "for" "otherwise" + "case" "try" "catch" "unwind_protect" "unwind_protect_cleanup") + ;; FIXME: don't hardcode 2. + (+ parent octave-block-offset)) + ;; (:parent "switch" 4) ;For (invalid) code between switch and case. + 0) + ((:before . "case") octave-block-offset))) + ;;;###autoload (define-derived-mode octave-mode prog-mode "Octave" "Major mode for editing Octave code. @@ -511,7 +645,17 @@ including a reproducible test case and send the message." (setq local-abbrev-table octave-abbrev-table) - (set (make-local-variable 'indent-line-function) 'octave-indent-line) + (smie-setup octave-smie-op-levels octave-smie-indent-rules) + (set (make-local-variable 'smie-indent-basic) 'octave-block-offset) + (set (make-local-variable 'smie-backward-token-function) + 'octave-smie-backward-token) + (set (make-local-variable 'smie-forward-token-function) + 'octave-smie-forward-token) + (set (make-local-variable 'forward-sexp-function) + 'smie-forward-sexp-command) + (set (make-local-variable 'smie-closer-alist) + (mapcar (lambda (elem) (cons (car elem) (car (last elem)))) + octave-block-match-alist)) (set (make-local-variable 'comment-start) octave-comment-start) (set (make-local-variable 'comment-end) "") @@ -924,29 +1068,6 @@ (goto-char pos) (message "No block to mark found")))) -(defun octave-close-block () - "Close the current Octave block on a separate line. -An error is signaled if no block to close is found." - (interactive) - (let (bb-keyword) - (condition-case nil - (progn - (save-excursion - (octave-backward-up-block 1) - (setq bb-keyword (buffer-substring-no-properties - (match-beginning 1) (match-end 1)))) - (if (save-excursion - (beginning-of-line) - (looking-at "^\\s-*$")) - (indent-according-to-mode) - (octave-reindent-then-newline-and-indent)) - (insert (car (reverse - (assoc bb-keyword - octave-block-match-alist)))) - (octave-reindent-then-newline-and-indent) - t) - (error (message "No block to close found"))))) - (defun octave-blink-matching-block-open () "Blink the matching Octave begin block keyword. If point is right after an Octave else or end type block keyword, move === modified file 'test/ChangeLog' --- test/ChangeLog 2010-08-08 17:42:47 +0000 +++ test/ChangeLog 2010-08-30 20:34:52 +0000 @@ -1,6 +1,10 @@ +2010-08-30 Stefan Monnier + + * indent/octave.m: New file. + 2010-08-08 Ulf Jasper - * icalendar-testsuite.el (icalendar-testsuite-run): Added internal tests. + * icalendar-testsuite.el (icalendar-testsuite-run): Add internal tests. (icalendar-testsuite--trim, icalendar-testsuite--compare-strings) (icalendar-testsuite--run-internal-tests): New. (icalendar-testsuite--test-convert-ordinary-to-ical) @@ -13,7 +17,7 @@ (icalendar-testsuite--do-test-cycle): Use icalendar-testsuite--compare-strings (icalendar-testsuite--run-import-tests): Comment added. (icalendar-testsuite--run-import-tests) - (icalendar-testsuite--run-real-world-tests): Fixed expected results. + (icalendar-testsuite--run-real-world-tests): Fix expected results. 2010-06-25 Chong Yidong === modified file 'test/indent/Makefile' --- test/indent/Makefile 2010-06-02 20:13:11 +0000 +++ test/indent/Makefile 2010-08-30 20:34:52 +0000 @@ -8,8 +8,8 @@ # - mark the places where the indentation is known to be incorrect, # and allow either ignoring those errors or not. %.test: % - -$(RM) $<.test + -$(RM) $<.new $(EMACS) --batch $< \ --eval '(indent-region (point-min) (point-max) nil)' \ - --eval '(write-region (point-min) (point-max) "$<.test")' - diff -u -B $< $<.test + --eval '(write-region (point-min) (point-max) "$<.new")' + diff -u -B $< $<.new === added file 'test/indent/octave.m' --- test/indent/octave.m 1970-01-01 00:00:00 +0000 +++ test/indent/octave.m 2010-08-30 20:34:52 +0000 @@ -0,0 +1,2318 @@ +## -*- octave -*- + +function res = tcomp (fn) + %% res = tcomp (fn) + %% imports components and rearranges them. + + if nargin ~= 1 + print_usage() + endif + + data = dlmread(fn, 3, 0); + + x = data(:,2:end); + y = 'hello'; + z = y'; + + cnty = repmat(x(:,1)(:), 10, 1); + + pop = x(:,1:10)(:); + bir = x(:,11:20)(:); + dth = x(:,21:30)(:); + imig = x(:,31:40)(:); + dmig = x(:,41:50)(:); + gq = x(:,51:60)(:); + + yrs = repmat(2000:2009, 39, 1)(:); + + res = [yrs, cnty, pop, bir, dth, imig, dmig, gq]; + +endfunction + +## Copyright (C) 2005, 2006, 2007, 2008, 2009 S�ren Hauberg +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Command} pkg @var{command} @var{pkg_name} +## @deftypefnx {Command} pkg @var{command} @var{option} @var{pkg_name} +## This command interacts with the package manager. Different actions will +## be taken depending on the value of @var{command}. +## +## @table @samp +## @item install +## Install named packages. For example, +## @example +## pkg install image-1.0.0.tar.gz +## @end example +## @noindent +## installs the package found in the file @file{image-1.0.0.tar.gz}. +## +## The @var{option} variable can contain options that affect the manner +## in which a package is installed. These options can be one or more of +## +## @table @code +## @item -nodeps +## The package manager will disable the dependency checking. That way it +## is possible to install a package even if it depends on another package +## that's not installed on the system. @strong{Use this option with care.} +## +## @item -noauto +## The package manager will not automatically load the installed package +## when starting Octave, even if the package requests that it is. +## +## @item -auto +## The package manager will automatically load the installed package when +## starting Octave, even if the package requests that it isn't. +## +## @item -local +## A local installation is forced, even if the user has system privileges. +## +## @item -global +## A global installation is forced, even if the user doesn't normally have +## system privileges +## +## @item -verbose +## The package manager will print the output of all of the commands that are +## performed. +## @end table +## +## @item uninstall +## Uninstall named packages. For example, +## @example +## pkg uninstall image +## @end example +## @noindent +## removes the @code{image} package from the system. If another installed +## package depends on the @code{image} package an error will be issued. +## The package can be uninstalled anyway by using the @code{-nodeps} option. +## @item load +## Add named packages to the path. After loading a package it is +## possible to use the functions provided by the package. For example, +## @example +## pkg load image +## @end example +## @noindent +## adds the @code{image} package to the path. It is possible to load all +## installed packages at once with the command +## @example +## pkg load all +## @end example +## @item unload +## Removes named packages from the path. After unloading a package it is +## no longer possible to use the functions provided by the package. +## This command behaves like the @code{load} command. +## @item list +## Show a list of the currently installed packages. By requesting one or two +## output argument it is possible to get a list of the currently installed +## packages. For example, +## @example +## installed_packages = pkg list; +## @end example +## @noindent +## returns a cell array containing a structure for each installed package. +## The command +## @example +## [@var{user_packages}, @var{system_packages}] = pkg list +## @end example +## @noindent +## splits the list of installed packages into those who are installed by +## the current user, and those installed by the system administrator. +## @item describe +## Show a short description of the named installed packages, with the option +## '-verbose' also list functions provided by the package, e.g.: +## @example +## pkg describe -verbose all +## @end example +## @noindent +## will describe all installed packages and the functions they provide. +## If one output is requested a cell of structure containing the +## description and list of functions of each package is returned as +## output rather than printed on screen: +## @example +## desc = pkg ("describe", "secs1d", "image") +## @end example +## @noindent +## If any of the requested packages is not installed, pkg returns an +## error, unless a second output is requested: +## @example +## [ desc, flag] = pkg ("describe", "secs1d", "image") +## @end example +## @noindent +## @var{flag} will take one of the values "Not installed", "Loaded" or +## "Not loaded" for each of the named packages. +## @item prefix +## Set the installation prefix directory. For example, +## @example +## pkg prefix ~/my_octave_packages +## @end example +## @noindent +## sets the installation prefix to @file{~/my_octave_packages}. +## Packages will be installed in this directory. +## +## It is possible to get the current installation prefix by requesting an +## output argument. For example, +## @example +## p = pkg prefix +## @end example +## +## The location in which to install the architecture dependent files can be +## independent specified with an addition argument. For example +## +## @example +## pkg prefix ~/my_octave_packages ~/my_arch_dep_pkgs +## @end example +## @item local_list +## Set the file in which to look for information on the locally +## installed packages. Locally installed packages are those that are +## typically available only to the current user. For example +## @example +## pkg local_list ~/.octave_packages +## @end example +## It is possible to get the current value of local_list with the following +## @example +## pkg local_list +## @end example +## @item global_list +## Set the file in which to look for, for information on the globally +## installed packages. Globally installed packages are those that are +## typically available to all users. For example +## @example +## pkg global_list /usr/share/octave/octave_packages +## @end example +## It is possible to get the current value of global_list with the following +## @example +## pkg global_list +## @end example +## @item rebuild +## Rebuilds the package database from the installed directories. This can +## be used in cases where for some reason the package database is corrupted. +## It can also take the @code{-auto} and @code{-noauto} options to allow the +## autoloading state of a package to be changed. For example +## +## @example +## pkg rebuild -noauto image +## @end example +## +## will remove the autoloading status of the image package. +## @item build +## Builds a binary form of a package or packages. The binary file produced +## will itself be an Octave package that can be installed normally with +## @code{pkg}. The form of the command to build a binary package is +## +## @example +## pkg build builddir image-1.0.0.tar.gz @dots{} +## @end example +## +## @noindent +## where @code{builddir} is the name of a directory where the temporary +## installation will be produced and the binary packages will be found. +## The options @code{-verbose} and @code{-nodeps} are respected, while +## the other options are ignored. +## @end table +## @end deftypefn + +function [local_packages, global_packages] = pkg (varargin) + ## Installation prefix (FIXME: what should these be on windows?) + persistent user_prefix = false; + persistent prefix = -1; + persistent archprefix = -1; + persistent local_list = tilde_expand (fullfile ("~", ".octave_packages")); + persistent global_list = fullfile (OCTAVE_HOME (), "share", "octave", + "octave_packages"); + mlock (); + + global_install = issuperuser (); + + if (prefix == -1) + if (global_install) + prefix = fullfile (OCTAVE_HOME (), "share", "octave", "packages"); + archprefix = fullfile (octave_config_info ("libexecdir"), + "octave", "packages"); + else + prefix = fullfile ("~", "octave"); + archprefix = prefix; + endif + prefix = tilde_expand (prefix); + archprefix = tilde_expand (archprefix); + endif + + available_actions = {"list", "install", "uninstall", "load", ... + "unload", "prefix", "local_list", ... + "global_list", "rebuild", "build","describe"}; + ## Handle input + if (length (varargin) == 0 || ! iscellstr (varargin)) + print_usage (); + endif + files = {}; + deps = true; + auto = 0; + action = "none"; + verbose = false; + for i = 1:length (varargin) + switch (varargin{i}) + case "-nodeps" + deps = false; + case "-noauto" + auto = -1; + case "-auto" + auto = 1; + case "-verbose" + verbose = true; + case "-local" + global_install = false; + if (! user_prefix) + prefix = tilde_expand (fullfile ("~", "octave")); + archprefix = prefix; + endif + case "-global" + global_install = true; + if (! user_prefix) + prefix = fullfile (OCTAVE_HOME (), "share", "octave", "packages"); + archprefix = fullfile (octave_config_info ("libexecdir"), + "octave", "packages"); + endif + case available_actions + if (strcmp (action, "none")) + action = varargin{i}; + else + error ("more than one action specified"); + endif + otherwise + files{end+1} = varargin{i}; + endswitch + endfor + + ## Take action + switch (action) + case "list" + if (nargout == 0) + installed_packages (local_list, global_list); + elseif (nargout == 1) + local_packages = installed_packages (local_list, global_list); + elseif (nargout == 2) + [local_packages, global_packages] = installed_packages (local_list, + global_list); + else + error ("too many output arguments requested"); + endif + + case "install" + if (length (files) == 0) + error ("you must specify at least one filename when calling 'pkg install'"); + endif + install (files, deps, auto, prefix, archprefix, verbose, local_list, + global_list, global_install); + + case "uninstall" + if (length (files) == 0) + error ("you must specify at least one package when calling 'pkg uninstall'"); + endif + uninstall (files, deps, verbose, local_list, + global_list, global_install); + + case "load" + if (length (files) == 0) + error ("you must specify at least one package, 'all' or 'auto' when calling 'pkg load'"); + endif + load_packages (files, deps, local_list, global_list); + + case "unload" + if (length (files) == 0) + error ("you must specify at least one package or 'all' when calling 'pkg unload'"); + endif + unload_packages (files, deps, local_list, global_list); + + case "prefix" + if (length (files) == 0 && nargout == 0) + printf ("Installation prefix: %s\n", prefix); + printf ("Architecture dependent prefix: %s\n", archprefix); + elseif (length (files) == 0 && nargout >= 1) + local_packages = prefix; + global_packages = archprefix; + elseif (length (files) >= 1 && nargout <= 2 && ischar (files{1})) + prefix = files{1}; + prefix = absolute_pathname (prefix); + local_packages = prefix; + user_prefix = true; + if (length (files) >= 2 && ischar (files{2})) + archprefix = files{2}; + try + archprefix = absolute_pathname (archprefix); + catch + mkdir (archprefix); + warning ("creating the directory %s\n", archprefix); + archprefix = absolute_pathname (archprefix); + end_try_catch + global_packages = archprefix; + endif + else + error ("you must specify a prefix directory, or request an output argument"); + endif + + case "local_list" + if (length (files) == 0 && nargout == 0) + disp (local_list); + elseif (length (files) == 0 && nargout == 1) + local_packages = local_list; + elseif (length (files) == 1 && nargout == 0 && ischar (files{1})) + try + local_list = absolute_pathname (files{1}); + catch + ## Force file to be created + fclose (fopen (files{1}, "wt")); + local_list = absolute_pathname (files{1}); + end_try_catch + else + error ("you must specify a local_list file, or request an output argument"); + endif + + case "global_list" + if (length (files) == 0 && nargout == 0) + disp(global_list); + elseif (length (files) == 0 && nargout == 1) + local_packages = global_list; + elseif (length (files) == 1 && nargout == 0 && ischar (files{1})) + try + global_list = absolute_pathname (files{1}); + catch + ## Force file to be created + fclose (fopen (files{1}, "wt")); + global_list = absolute_pathname (files{1}); + end_try_catch + else + error ("you must specify a global_list file, or request an output argument"); + endif + + case "rebuild" + if (global_install) + global_packages = rebuild (prefix, archprefix, global_list, files, + auto, verbose); + global_packages = save_order (global_packages); + save (global_list, "global_packages"); + if (nargout > 0) + local_packages = global_packages; + endif + else + local_packages = rebuild (prefix, archprefix, local_list, files, auto, + verbose); + local_packages = save_order (local_packages); + save (local_list, "local_packages"); + if (nargout == 0) + clear ("local_packages"); + endif + endif + + case "build" + if (length (files) < 2) + error ("you must specify at least the build directory and one filename\nwhen calling 'pkg build'"); + endif + build (files, deps, auto, verbose); + + case "describe" + if (length (files) == 0) + error ("you must specify at least one package or 'all' when calling 'pkg describe'"); + endif + ## FIXME: the name of the output variables is inconsistent + ## with their content + switch (nargout) + case 0 + describe (files, verbose, local_list, global_list); + case 1 + pkg_desc_list = describe (files, verbose, local_list, ... + global_list); + local_packages = pkg_desc_list; + case 2 + [pkg_desc_list, flag] = describe (files, verbose, local_list, ... + global_list); + local_packages = pkg_desc_list; + global_packages = flag; + otherwise + error ("you can request at most two outputs when calling 'pkg describe'"); + endswitch + + otherwise + error ("you must specify a valid action for 'pkg'. See 'help pkg' for details"); + endswitch +endfunction + +function descriptions = rebuild (prefix, archprefix, list, files, auto, verbose) + if (isempty (files)) + [dirlist, err, msg] = readdir (prefix); + if (err) + error ("couldn't read directory %s: %s", prefix, msg); + endif + ## the two first entries of dirlist are "." and ".." + dirlist([1,2]) = []; + else + old_descriptions = installed_packages (list, list); + wd = pwd (); + unwind_protect + cd (prefix); + dirlist = glob (cellfun(@(x) cstrcat(x, '-*'), files, 'UniformOutput', 0)); + unwind_protect_cleanup + cd (wd); + end_unwind_protect + endif + descriptions = {}; + for k = 1:length (dirlist) + descfile = fullfile (prefix, dirlist{k}, "packinfo", "DESCRIPTION"); + if (verbose) + printf ("recreating package description from %s\n", dirlist{k}); + endif + if (exist (descfile, "file")) + desc = get_description (descfile); + desc.dir = fullfile (prefix, dirlist{k}); + desc.archprefix = fullfile (archprefix, cstrcat (desc.name, "-", + desc.version)); + if (auto != 0) + if (exist (fullfile (desc.dir, "packinfo", ".autoload"), "file")) + unlink (fullfile (desc.dir, "packinfo", ".autoload")); + endif + if (auto < 0) + desc.autoload = 0; + elseif (auto > 0) + desc.autoload = 1; + fclose (fopen (fullfile (desc.dir, "packinfo", ".autoload"), "wt")); + endif + else + if (exist (fullfile (desc.dir, "packinfo", ".autoload"), "file")) + desc.autoload = 1; + else + desc.autoload = 0; + endif + endif + descriptions{end + 1} = desc; + elseif (verbose) + warning ("directory %s is not a valid package", dirlist{k}); + endif + endfor + + if (! isempty (files)) + ## We are rebuilding for a particular package(s) so we should take + ## care to keep the other untouched packages in the descriptions + descriptions = {descriptions{:}, old_descriptions{:}}; + + dup = []; + for i = 1:length (descriptions) + if (find (dup, i)) + continue; + endif + for j = (i+1):length (descriptions) + if (find (dup, j)) + continue; + endif + if (strcmp (descriptions{i}.name, descriptions{j}.name)) + dup = [dup, j]; + endif + endfor + endfor + if (! isempty (dup)) + descriptions (dup) = []; + endif + endif +endfunction + +function build (files, handle_deps, autoload, verbose) + if (length (files) < 1) + error ("insufficient number of files"); + endif + builddir = files{1}; + if (! exist (builddir, "dir")) + warning ("creating build directory %s", builddir); + [status, msg] = mkdir (builddir); + if (status != 1) + error ("could not create installation directory: %s", msg); + endif + endif + builddir = absolute_pathname (builddir); + installdir = fullfile (builddir, "install"); + if (! exist (installdir, "dir")) + [status, msg] = mkdir (installdir); + if (status != 1) + error ("could not create installation directory: %s", msg); + endif + endif + files(1) = []; + buildlist = fullfile (builddir, "octave_packages"); + install (files, handle_deps, autoload, installdir, installdir, verbose, + buildlist, "", false); + unwind_protect + repackage (builddir, buildlist); + unwind_protect_cleanup + unload_packages ({"all"}, handle_deps, buildlist, ""); + if (exist (installdir, "dir")) + rm_rf (installdir); + endif + if (exist (buildlist, "file")) + unlink (buildlist); + endif + end_unwind_protect +endfunction + +function install (files, handle_deps, autoload, prefix, archprefix, verbose, + local_list, global_list, global_install) + + ## Check that the directory in prefix exist. If it doesn't: create it! + if (! exist (prefix, "dir")) + warning ("creating installation directory %s", prefix); + [status, msg] = mkdir (prefix); + if (status != 1) + error ("could not create installation directory: %s", msg); + endif + endif + + ## Get the list of installed packages. + [local_packages, global_packages] = installed_packages (local_list, + global_list); + + installed_pkgs_lst = {local_packages{:}, global_packages{:}}; + + if (global_install) + packages = global_packages; + else + packages = local_packages; + endif + + ## Uncompress the packages and read the DESCRIPTION files. + tmpdirs = packdirs = descriptions = {}; + try + ## Warn about non existent files. + for i = 1:length (files) + if (isempty (glob(files{i}))) + warning ("file %s does not exist", files{i}); + endif + endfor + + ## Unpack the package files and read the DESCRIPTION files. + files = glob (files); + packages_to_uninstall = []; + for i = 1:length (files) + tgz = files{i}; + + if (exist (tgz, "file")) + ## Create a temporary directory. + tmpdir = tmpnam (); + tmpdirs{end+1} = tmpdir; + if (verbose) + printf ("mkdir (%s)\n", tmpdir); + endif + [status, msg] = mkdir (tmpdir); + if (status != 1) + error ("couldn't create temporary directory: %s", msg); + endif + + ## Uncompress the package. + if (verbose) + printf ("untar (%s, %s)\n", tgz, tmpdir); + endif + untar (tgz, tmpdir); + + ## Get the name of the directories produced by tar. + [dirlist, err, msg] = readdir (tmpdir); + if (err) + error ("couldn't read directory produced by tar: %s", msg); + endif + + if (length (dirlist) > 3) + error ("bundles of packages are not allowed") + endif + endif + + ## The filename pointed to an uncompressed package to begin with. + if (exist (tgz, "dir")) + dirlist = {".", "..", tgz}; + endif + + if (exist (tgz, "file") || exist (tgz, "dir")) + ## The two first entries of dirlist are "." and "..". + if (exist (tgz, "file")) + packdir = fullfile (tmpdir, dirlist{3}); + else + packdir = fullfile (pwd(), dirlist{3}); + endif + packdirs{end+1} = packdir; + + ## Make sure the package contains necessary files. + verify_directory (packdir); + + ## Read the DESCRIPTION file. + filename = fullfile (packdir, "DESCRIPTION"); + desc = get_description (filename); + + ## Verify that package name corresponds with filename. + [dummy, nm] = fileparts (tgz); + if ((length (nm) >= length (desc.name)) + && ! strcmp (desc.name, nm(1:length(desc.name)))) + error ("package name '%s' doesn't correspond to its filename '%s'", + desc.name, nm); + endif + + ## Set default installation directory. + desc.dir = fullfile (prefix, cstrcat (desc.name, "-", desc.version)); + + ## Set default architectire dependent installation directory. + desc.archprefix = fullfile (archprefix, cstrcat (desc.name, "-", + desc.version)); + + ## Save desc. + descriptions{end+1} = desc; + + ## Are any of the new packages already installed? + ## If so we'll remove the old version. + for j = 1:length (packages) + if (strcmp (packages{j}.name, desc.name)) + packages_to_uninstall(end+1) = j; + endif + endfor + endif + endfor + catch + ## Something went wrong, delete tmpdirs. + for i = 1:length (tmpdirs) + rm_rf (tmpdirs{i}); + endfor + rethrow (lasterror ()); + end_try_catch + + ## Check dependencies. + if (handle_deps) + ok = true; + error_text = ""; + for i = 1:length (descriptions) + desc = descriptions{i}; + idx2 = complement (i, 1:length(descriptions)); + if (global_install) + ## Global installation is not allowed to have dependencies on locally + ## installed packages. + idx1 = complement (packages_to_uninstall, + 1:length(global_packages)); + pseudo_installed_packages = {global_packages{idx1}, ... + descriptions{idx2}}; + else + idx1 = complement (packages_to_uninstall, + 1:length(local_packages)); + pseudo_installed_packages = {local_packages{idx1}, ... + global_packages{:}, ... + descriptions{idx2}}; + endif + bad_deps = get_unsatisfied_deps (desc, pseudo_installed_packages); + ## Are there any unsatisfied dependencies? + if (! isempty (bad_deps)) + ok = false; + for i = 1:length (bad_deps) + dep = bad_deps{i}; + error_text = cstrcat (error_text, " ", desc.name, " needs ", + dep.package, " ", dep.operator, " ", + dep.version, "\n"); + endfor + endif + endfor + + ## Did we find any unsatisfied dependencies? + if (! ok) + error ("the following dependencies where unsatisfied:\n %s", error_text); + endif + endif + + ## Prepare each package for installation. + try + for i = 1:length (descriptions) + desc = descriptions{i}; + pdir = packdirs{i}; + prepare_installation (desc, pdir); + configure_make (desc, pdir, verbose); + endfor + catch + ## Something went wrong, delete tmpdirs. + for i = 1:length (tmpdirs) + rm_rf (tmpdirs{i}); + endfor + rethrow (lasterror ()); + end_try_catch + + ## Uninstall the packages that will be replaced. + try + for i = packages_to_uninstall + if (global_install) + uninstall ({global_packages{i}.name}, false, verbose, local_list, + global_list, global_install); + else + uninstall ({local_packages{i}.name}, false, verbose, local_list, + global_list, global_install); + endif + endfor + catch + ## Something went wrong, delete tmpdirs. + for i = 1:length (tmpdirs) + rm_rf (tmpdirs{i}); + endfor + rethrow (lasterror ()); + end_try_catch + + ## Install each package. + try + for i = 1:length (descriptions) + desc = descriptions{i}; + pdir = packdirs{i}; + copy_files (desc, pdir, global_install); + create_pkgadddel (desc, pdir, "PKG_ADD", global_install); + create_pkgadddel (desc, pdir, "PKG_DEL", global_install); + finish_installation (desc, pdir, global_install); + generate_lookfor_cache (desc); + endfor + catch + ## Something went wrong, delete tmpdirs. + for i = 1:length (tmpdirs) + rm_rf (tmpdirs{i}); + endfor + for i = 1:length (descriptions) + rm_rf (descriptions{i}.dir); + rm_rf (getarchdir (descriptions{i})); + endfor + rethrow (lasterror ()); + end_try_catch + + ## Check if the installed directory is empty. If it is remove it + ## from the list. + for i = length (descriptions):-1:1 + if (dirempty (descriptions{i}.dir, {"packinfo", "doc"}) && + dirempty (getarchdir (descriptions{i}))) + warning ("package %s is empty\n", descriptions{i}.name); + rm_rf (descriptions{i}.dir); + rm_rf (getarchdir (descriptions{i})); + descriptions(i) = []; + endif + endfor + + ## If the package requested that it is autoloaded, or the installer + ## requested that it is, then mark the package as autoloaded. + for i = length (descriptions):-1:1 + if (autoload > 0 || (autoload == 0 && isautoload (descriptions(i)))) + fclose (fopen (fullfile (descriptions{i}.dir, "packinfo", + ".autoload"), "wt")); + descriptions{i}.autoload = 1; + endif + endfor + + ## Add the packages to the package list. + try + if (global_install) + idx = complement (packages_to_uninstall, 1:length(global_packages)); + global_packages = save_order ({global_packages{idx}, descriptions{:}}); + save (global_list, "global_packages"); + installed_pkgs_lst = {local_packages{:}, global_packages{:}}; + else + idx = complement (packages_to_uninstall, 1:length(local_packages)); + local_packages = save_order ({local_packages{idx}, descriptions{:}}); + save (local_list, "local_packages"); + installed_pkgs_lst = {local_packages{:}, global_packages{:}}; + endif + catch + ## Something went wrong, delete tmpdirs. + for i = 1:length (tmpdirs) + rm_rf (tmpdirs{i}); + endfor + for i = 1:length (descriptions) + rm_rf (descriptions{i}.dir); + endfor + if (global_install) + printf ("error: couldn't append to %s\n", global_list); + else + printf ("error: couldn't append to %s\n", local_list); + endif + rethrow (lasterror ()); + end_try_catch + + ## All is well, let's clean up. + for i = 1:length (tmpdirs) + [status, msg] = rm_rf (tmpdirs{i}); + if (status != 1) + warning ("couldn't clean up after my self: %s\n", msg); + endif + endfor + + ## Add the newly installed packages to the path, so the user + ## can begin using them. Only load them if they are marked autoload. + if (length (descriptions) > 0) + idx = []; + for i = 1:length (descriptions) + if (isautoload (descriptions(i))) + nm = descriptions{i}.name; + for j = 1:length (installed_pkgs_lst) + if (strcmp (nm, installed_pkgs_lst{j}.name)) + idx (end + 1) = j; + break; + endif + endfor + endif + endfor + load_packages_and_dependencies (idx, handle_deps, installed_pkgs_lst, + global_install); + endif +endfunction + +function uninstall (pkgnames, handle_deps, verbose, local_list, + global_list, global_install) + ## Get the list of installed packages. + [local_packages, global_packages] = installed_packages(local_list, + global_list); + if (global_install) + installed_pkgs_lst = {local_packages{:}, global_packages{:}}; + else + installed_pkgs_lst = local_packages; + endif + + num_packages = length (installed_pkgs_lst); + delete_idx = []; + for i = 1:num_packages + cur_name = installed_pkgs_lst{i}.name; + if (any (strcmp (cur_name, pkgnames))) + delete_idx(end+1) = i; + endif + endfor + + ## Are all the packages that should be uninstalled already installed? + if (length (delete_idx) != length (pkgnames)) + if (global_install) + ## Try again for a locally installed package. + installed_pkgs_lst = local_packages; + + num_packages = length (installed_pkgs_lst); + delete_idx = []; + for i = 1:num_packages + cur_name = installed_pkgs_lst{i}.name; + if (any (strcmp (cur_name, pkgnames))) + delete_idx(end+1) = i; + endif + endfor + if (length (delete_idx) != length (pkgnames)) + ## FIXME: We should have a better error message. + warning ("some of the packages you want to uninstall are not installed"); + endif + else + ## FIXME: We should have a better error message. + warning ("some of the packages you want to uninstall are not installed"); + endif + endif + + ## Compute the packages that will remain installed. + idx = complement (delete_idx, 1:num_packages); + remaining_packages = {installed_pkgs_lst{idx}}; + + ## Check dependencies. + if (handle_deps) + error_text = ""; + for i = 1:length (remaining_packages) + desc = remaining_packages{i}; + bad_deps = get_unsatisfied_deps (desc, remaining_packages); + + ## Will the uninstallation break any dependencies? + if (! isempty (bad_deps)) + for i = 1:length (bad_deps) + dep = bad_deps{i}; + error_text = cstrcat (error_text, " ", desc.name, " needs ", + dep.package, " ", dep.operator, " ", + dep.version, "\n"); + endfor + endif + endfor + + if (! isempty (error_text)) + error ("the following dependencies where unsatisfied:\n %s", error_text); + endif + endif + + ## Delete the directories containing the packages. + for i = delete_idx + desc = installed_pkgs_lst{i}; + ## If an 'on_uninstall.m' exist, call it! + if (exist (fullfile (desc.dir, "packinfo", "on_uninstall.m"), "file")) + wd = pwd (); + cd (fullfile (desc.dir, "packinfo")); + on_uninstall (desc); + cd (wd); + endif + ## Do the actual deletion. + if (desc.loaded) + rmpath (desc.dir); + if (exist (getarchdir (desc))) + rmpath (getarchdir (desc)); + endif + endif + if (exist (desc.dir, "dir")) + [status, msg] = rm_rf (desc.dir); + if (status != 1) + error ("couldn't delete directory %s: %s", desc.dir, msg); + endif + [status, msg] = rm_rf (getarchdir (desc)); + if (status != 1) + error ("couldn't delete directory %s: %s", getarchdir (desc), msg); + endif + if (dirempty (desc.archprefix)) + rm_rf (desc.archprefix); + endif + else + warning ("directory %s previously lost", desc.dir); + endif + endfor + + ## Write a new ~/.octave_packages. + if (global_install) + if (length (remaining_packages) == 0) + unlink (global_list); + else + global_packages = save_order (remaining_packages); + save (global_list, "global_packages"); + endif + else + if (length (remaining_packages) == 0) + unlink (local_list); + else + local_packages = save_order (remaining_packages); + save (local_list, "local_packages"); + endif + endif + +endfunction + +function [pkg_desc_list, flag] = describe (pkgnames, verbose, + local_list, global_list) + + ## Get the list of installed packages. + installed_pkgs_lst = installed_packages(local_list, global_list); + num_packages = length (installed_pkgs_lst); + + + describe_all = false; + if (any (strcmp ("all", pkgnames))) + describe_all = true; + flag(1:num_packages) = {"Not Loaded"}; + num_pkgnames = num_packages; + else + num_pkgnames = length (pkgnames); + flag(1:num_pkgnames) = {"Not installed"}; + endif + + for i = 1:num_packages + curr_name = installed_pkgs_lst{i}.name; + if (describe_all) + name_pos = i; + else + name_pos = find(strcmp (curr_name, pkgnames)); + endif + + if (! isempty (name_pos)) + if (installed_pkgs_lst{i}.loaded) + flag{name_pos} = "Loaded"; + else + flag{name_pos} = "Not loaded"; + endif + + pkg_desc_list{name_pos}.name = installed_pkgs_lst{i}.name; + pkg_desc_list{name_pos}.version = installed_pkgs_lst{i}.version; + pkg_desc_list{name_pos}.description = installed_pkgs_lst{i}.description; + pkg_desc_list{name_pos}.provides = parse_pkg_idx (installed_pkgs_lst{i}.dir); + + endif + endfor + + non_inst = find (strcmp (flag, "Not installed")); + if (! isempty (non_inst)) + if (nargout < 2) + non_inst_str = sprintf (" %s ", pkgnames{non_inst}); + error ("some packages are not installed: %s", non_inst_str); + else + pkg_desc_list{non_inst} = struct ("name", {}, "description", + {}, "provides", {}); + endif + endif + + if (nargout == 0) + for i = 1:num_pkgnames + print_package_description (pkg_desc_list{i}.name, + pkg_desc_list{i}.version, + pkg_desc_list{i}.provides, + pkg_desc_list{i}.description, + flag{i}, verbose); + endfor + endif + +endfunction + +## AUXILIARY FUNCTIONS + +## Read an INDEX file. +function [pkg_idx_struct] = parse_pkg_idx (packdir) + + index_file = fullfile (packdir, "packinfo", "INDEX"); + + if (! exist (index_file, "file")) + error ("could not find any INDEX file in directory %s, try 'pkg rebuild all' to generate missing INDEX files", packdir); + endif + + + [fid, msg] = fopen (index_file, "r"); + if (fid == -1) + error ("the INDEX file %s could not be read: %s", + index_file, msg); + endif + + cat_num = 1; + pkg_idx_struct{1}.category = "Uncategorized"; + pkg_idx_struct{1}.functions = {}; + + line = fgetl (fid); + while (isempty (strfind (line, ">>")) && ! feof (fid)) + line = fgetl (fid); + endwhile + + while (! feof (fid) || line != -1) + if (! any (! isspace (line)) || line(1) == "#" || any (line == "=")) + ## Comments, blank lines or comments about unimplemented + ## functions: do nothing + ## FIXME: probably comments and pointers to external functions + ## could be treated better when printing to screen? + elseif (! isempty (strfind (line, ">>"))) + ## Skip package name and description as they are in DESCRIPTION + ## already. + elseif (! isspace (line(1))) + ## Category. + if (! isempty (pkg_idx_struct{cat_num}.functions)) + pkg_idx_struct{++cat_num}.functions = {}; + endif + pkg_idx_struct{cat_num}.category = deblank (line); + else + ## Function names. + while (any (! isspace (line))) + [fun_name, line] = strtok (line); + pkg_idx_struct{cat_num}.functions{end+1} = deblank (fun_name); + endwhile + endif + line = fgetl (fid); + endwhile + fclose (fid); +endfunction + +function print_package_description (pkg_name, pkg_ver, pkg_idx_struct, + pkg_desc, status, verbose) + + printf ("---\nPackage name:\n\t%s\n", pkg_name); + printf ("Version:\n\t%s\n", pkg_ver); + printf ("Short description:\n\t%s\n", pkg_desc); + printf ("Status:\n\t%s\n", status); + if (verbose) + printf ("---\nProvides:\n"); + for i = 1:length(pkg_idx_struct) + if (! isempty (pkg_idx_struct{i}.functions)) + printf ("%s\n", pkg_idx_struct{i}.category); + for j = 1:length(pkg_idx_struct{i}.functions) + printf ("\t%s\n", pkg_idx_struct{i}.functions{j}); + endfor + endif + endfor + endif + +endfunction + + +function pth = absolute_pathname (pth) + [status, msg, msgid] = fileattrib (pth); + if (status != 1) + error ("could not find the file or path %s", pth); + else + pth = msg.Name; + endif +endfunction + +function repackage (builddir, buildlist) + packages = installed_packages (buildlist, buildlist); + + wd = pwd(); + for i = 1 : length(packages) + pack = packages{i}; + unwind_protect + cd (builddir); + mkdir (pack.name); + mkdir (fullfile (pack.name, "inst")); + copyfile (fullfile (pack.dir, "*"), fullfile (pack.name, "inst")); + movefile (fullfile (pack.name, "inst","packinfo", "*"), pack.name); + if (exist (fullfile (pack.name, "inst","packinfo", ".autoload"), "file")) + unlink (fullfile (pack.name, "inst","packinfo", ".autoload")); + endif + rmdir (fullfile (pack.name, "inst", "packinfo")); + if (exist (fullfile (pack.name, "inst", "doc"), "dir")) + movefile (fullfile (pack.name, "inst", "doc"), pack.name); + endif + if (exist (fullfile (pack.name, "inst", "bin"), "dir")) + movefile (fullfile (pack.name, "inst", "bin"), pack.name); + endif + archdir = fullfile (pack.archprefix, cstrcat (pack.name, "-", + pack.version), getarch ()); + if (exist (archdir, "dir")) + if (exist (fullfile (pack.name, "inst", "PKG_ADD"), "file")) + unlink (fullfile (pack.name, "inst", "PKG_ADD")); + endif + if (exist (fullfile (pack.name, "inst", "PKG_DEL"), "file")) + unlink (fullfile (pack.name, "inst", "PKG_DEL")); + endif + if (exist (fullfile (archdir, "PKG_ADD"), "file")) + movefile (fullfile (archdir, "PKG_ADD"), + fullfile (pack.name, "PKG_ADD")); + endif + if (exist (fullfile (archdir, "PKG_DEL"), "file")) + movefile (fullfile (archdir, "PKG_DEL"), + fullfile (pack.name, "PKG_DEL")); + endif + else + if (exist (fullfile (pack.name, "inst", "PKG_ADD"), "file")) + movefile (fullfile (pack.name, "inst", "PKG_ADD"), + fullfile (pack.name, "PKG_ADD")); + endif + if (exist (fullfile (pack.name, "inst", "PKG_DEL"), "file")) + movefile (fullfile (pack.name, "inst", "PKG_DEL"), + fullfile (pack.name, "PKG_DEL")); + endif + endif + tfile = cstrcat (pack.name, "-", pack.version, ".tar"); + tar (tfile, pack.name); + try + gzip (tfile); + unlink (tfile); + catch + warning ("failed to compress %s", tfile); + end_try_catch + unwind_protect_cleanup + if (exist (pack.name, "dir")) + rm_rf (pack.name); + endif + cd (wd); + end_unwind_protect + endfor +endfunction + +function auto = isautoload (desc) + auto = false; + if (isfield (desc{1}, "autoload")) + a = desc{1}.autoload; + if ((isnumeric (a) && a > 0) + || (ischar (a) && (strcmpi (a, "true") + || strcmpi (a, "on") + || strcmpi (a, "yes") + || strcmpi (a, "1")))) + auto = true; + endif + endif +endfunction + +function prepare_installation (desc, packdir) + ## Is there a pre_install to call? + if (exist (fullfile (packdir, "pre_install.m"), "file")) + wd = pwd (); + try + cd (packdir); + pre_install (desc); + cd (wd); + catch + cd (wd); + rethrow (lasterror ()); + end_try_catch + endif + + ## If the directory "inst" doesn't exist, we create it. + inst_dir = fullfile (packdir, "inst"); + if (! exist (inst_dir, "dir")) + [status, msg] = mkdir (inst_dir); + if (status != 1) + rm_rf (desc.dir); + error ("the 'inst' directory did not exist and could not be created: %s", + msg); + endif + endif +endfunction + +function configure_make (desc, packdir, verbose) + ## Perform ./configure, make, make install in "src". + if (exist (fullfile (packdir, "src"), "dir")) + src = fullfile (packdir, "src"); + ## Configure. + if (exist (fullfile (src, "configure"), "file")) + flags = ""; + if (isempty (getenv ("CC"))) + flags = cstrcat (flags, " CC=\"", octave_config_info ("CC"), "\""); + endif + if (isempty (getenv ("CXX"))) + flags = cstrcat (flags, " CXX=\"", octave_config_info ("CXX"), "\""); + endif + if (isempty (getenv ("AR"))) + flags = cstrcat (flags, " AR=\"", octave_config_info ("AR"), "\""); + endif + if (isempty (getenv ("RANLIB"))) + flags = cstrcat (flags, " RANLIB=\"", octave_config_info ("RANLIB"), "\""); + endif + [status, output] = shell (strcat ("cd '", src, "'; ./configure --prefix=\"", + desc.dir, "\"", flags)); + if (status != 0) + rm_rf (desc.dir); + error ("the configure script returned the following error: %s", output); + elseif (verbose) + printf("%s", output); + endif + + endif + + ## Make. + if (exist (fullfile (src, "Makefile"), "file")) + [status, output] = shell (cstrcat ("export INSTALLDIR=\"", desc.dir, + "\"; make -C '", src, "'")); + if (status != 0) + rm_rf (desc.dir); + error ("'make' returned the following error: %s", output); + elseif (verbose) + printf("%s", output); + endif + endif + + ## Copy files to "inst" and "inst/arch" (this is instead of 'make + ## install'). + files = fullfile (src, "FILES"); + instdir = fullfile (packdir, "inst"); + archdir = fullfile (packdir, "inst", getarch ()); + + ## Get file names. + if (exist (files, "file")) + [fid, msg] = fopen (files, "r"); + if (fid < 0) + error ("couldn't open %s: %s", files, msg); + endif + filenames = char (fread (fid))'; + fclose (fid); + if (filenames(end) == "\n") + filenames(end) = []; + endif + filenames = split_by (filenames, "\n"); + delete_idx = []; + for i = 1:length (filenames) + if (! all (isspace (filenames{i}))) + filenames{i} = fullfile (src, filenames{i}); + else + delete_idx(end+1) = i; + endif + endfor + filenames(delete_idx) = []; + else + m = dir (fullfile (src, "*.m")); + oct = dir (fullfile (src, "*.oct")); + mex = dir (fullfile (src, "*.mex")); + + filenames = cellfun (@(x) fullfile (src, x), + {m.name, oct.name, mex.name}, + "UniformOutput", false); + endif + + ## Split into architecture dependent and independent files. + if (isempty (filenames)) + idx = []; + else + idx = cellfun (@is_architecture_dependent, filenames); + endif + archdependent = filenames (idx); + archindependent = filenames (!idx); + + ## Copy the files. + if (! all (isspace ([filenames{:}]))) + if (! exist (instdir, "dir")) # fixindent + mkdir (instdir); + endif + if (! all (isspace ([archindependent{:}]))) + if (verbose) + printf ("copyfile"); + printf (" %s", archindependent{:}); + printf ("%s\n", instdir); + endif + [status, output] = copyfile (archindependent, instdir); + if (status != 1) + rm_rf (desc.dir); + error ("Couldn't copy files from 'src' to 'inst': %s", output); + endif + endif + if (! all (isspace ([archdependent{:}]))) + if (verbose) + printf ("copyfile"); + printf (" %s", archdependent{:}); + printf (" %s\n", archdir); + endif + if (! exist (archdir, "dir")) + mkdir (archdir); + endif + [status, output] = copyfile (archdependent, archdir); + if (status != 1) + rm_rf (desc.dir); + error ("Couldn't copy files from 'src' to 'inst': %s", output); + endif + endif + endif + endif +endfunction + +function pkg = extract_pkg (nm, pat) + fid = fopen (nm, "rt"); + pkg = ""; + if (fid >= 0) + while (! feof (fid)) + ln = fgetl (fid); + if (ln > 0) + t = regexp (ln, pat, "tokens"); + if (! isempty (t)) + pkg = cstrcat (pkg, "\n", t{1}{1}); + endif + endif + endwhile + if (! isempty (pkg)) + pkg = cstrcat (pkg, "\n"); + endif + fclose (fid); + endif +endfunction + +function create_pkgadddel (desc, packdir, nm, global_install) + instpkg = fullfile (desc.dir, nm); + instfid = fopen (instpkg, "wt"); + ## If it is exists, most of the PKG_* file should go into the + ## architecture dependent directory so that the autoload/mfilename + ## commands work as expected. The only part that doesn't is the + ## part in the main directory. + archdir = fullfile (getarchprefix (desc), cstrcat (desc.name, "-", + desc.version), getarch ()); + if (exist (getarchdir (desc, global_install), "dir")) + archpkg = fullfile (getarchdir (desc, global_install), nm); + archfid = fopen (archpkg, "at"); + else + archpkg = instpkg; + archfid = instfid; + endif + + if (archfid >= 0 && instfid >= 0) + ## Search all dot-m files for PKG commands. + lst = dir (fullfile (packdir, "inst", "*.m")); + for i = 1:length (lst) + nam = fullfile (packdir, "inst", lst(i).name); + fwrite (instfid, extract_pkg (nam, ['^[#%][#%]* *' nm ': *(.*)$'])); + endfor # fixindent + + ## Search all C++ source files for PKG commands. + lst = dir (fullfile (packdir, "src", "*.cc")); # fixindent + for i = 1:length (lst) + nam = fullfile (packdir, "src", lst(i).name); + fwrite (archfid, extract_pkg (nam, ['^//* *' nm ': *(.*)$'])); + fwrite (archfid, extract_pkg (nam, ['^/\** *' nm ': *(.*) *\*/$'])); + endfor + + ## Add developer included PKG commands. + packdirnm = fullfile (packdir, nm); + if (exist (packdirnm, "file")) + fid = fopen (packdirnm, "rt"); + if (fid >= 0) + while (! feof (fid)) + ln = fgets (fid); + if (ln > 0) + fwrite (archfid, ln); + endif + endwhile + fclose (fid); + endif + endif + + ## If the files is empty remove it. + fclose (instfid); + t = dir (instpkg); + if (t.bytes <= 0) + unlink (instpkg); + endif + + if (instfid != archfid) + fclose (archfid); + t = dir (archpkg); + if (t.bytes <= 0) + unlink (archpkg); + endif + endif + endif # fixindent +endfunction # fixindent + +function copy_files (desc, packdir, global_install) # fixindent + ## Create the installation directory. + if (! exist (desc.dir, "dir")) + [status, output] = mkdir (desc.dir); + if (status != 1) + error ("couldn't create installation directory %s : %s", + desc.dir, output); + endif + endif + + octfiledir = getarchdir (desc); + + ## Copy the files from "inst" to installdir. + instdir = fullfile (packdir, "inst"); + if (! dirempty (instdir)) + [status, output] = copyfile (fullfile (instdir, "*"), desc.dir); + if (status != 1) + rm_rf (desc.dir); + error ("couldn't copy files to the installation directory"); + endif + if (exist (fullfile (desc.dir, getarch ()), "dir") && + ! strcmp (fullfile (desc.dir, getarch ()), octfiledir)) + if (! exist (octfiledir, "dir")) + ## Can be required to create upto three levels of dirs. + octm1 = fileparts (octfiledir); + if (! exist (octm1, "dir")) + octm2 = fileparts (octm1); + if (! exist (octm2, "dir")) + octm3 = fileparts (octm2); + if (! exist (octm3, "dir")) + [status, output] = mkdir (octm3); + if (status != 1) + rm_rf (desc.dir); + error ("couldn't create installation directory %s : %s", + octm3, output); + endif + endif + [status, output] = mkdir (octm2); + if (status != 1) + rm_rf (desc.dir); + error ("couldn't create installation directory %s : %s", + octm2, output); + endif + endif + [status, output] = mkdir (octm1); + if (status != 1) + rm_rf (desc.dir); + error ("couldn't create installation directory %s : %s", + octm1, output); + endif + endif + [status, output] = mkdir (octfiledir); + if (status != 1) + rm_rf (desc.dir); + error ("couldn't create installation directory %s : %s", + octfiledir, output); + endif + endif + [status, output] = movefile (fullfile (desc.dir, getarch (), "*"), + octfiledir); + rm_rf (fullfile (desc.dir, getarch ())); + + if (status != 1) + rm_rf (desc.dir); + rm_rf (octfiledir); + error ("couldn't copy files to the installation directory"); + endif + endif + + endif + + ## Create the "packinfo" directory. + packinfo = fullfile (desc.dir, "packinfo"); + [status, msg] = mkdir (packinfo); + if (status != 1) + rm_rf (desc.dir); + rm_rf (octfiledir); + error ("couldn't create packinfo directory: %s", msg); + endif + + ## Copy DESCRIPTION. + [status, output] = copyfile (fullfile (packdir, "DESCRIPTION"), packinfo); + if (status != 1) + rm_rf (desc.dir); + rm_rf (octfiledir); + error ("couldn't copy DESCRIPTION: %s", output); + endif + + ## Copy COPYING. + [status, output] = copyfile (fullfile (packdir, "COPYING"), packinfo); + if (status != 1) + rm_rf (desc.dir); + rm_rf (octfiledir); + error ("couldn't copy COPYING: %s", output); + endif + + ## If the file ChangeLog exists, copy it. + changelog_file = fullfile (packdir, "ChangeLog"); + if (exist (changelog_file, "file")) + [status, output] = copyfile (changelog_file, packinfo); + if (status != 1) + rm_rf (desc.dir); + rm_rf (octfiledir); + error ("couldn't copy ChangeLog file: %s", output); + endif + endif + + ## Is there an INDEX file to copy or should we generate one? + index_file = fullfile (packdir, "INDEX"); + if (exist(index_file, "file")) + [status, output] = copyfile (index_file, packinfo); + if (status != 1) + rm_rf (desc.dir); + rm_rf (octfiledir); + error ("couldn't copy INDEX file: %s", output); + endif + else + try + write_index (desc, fullfile (packdir, "inst"), + fullfile (packinfo, "INDEX"), global_install); + catch + rm_rf (desc.dir); + rm_rf (octfiledir); + rethrow (lasterror ()); + end_try_catch + endif + + ## Is there an 'on_uninstall.m' to install? + fon_uninstall = fullfile (packdir, "on_uninstall.m"); + if (exist (fon_uninstall, "file")) + [status, output] = copyfile (fon_uninstall, packinfo); + if (status != 1) + rm_rf (desc.dir); + rm_rf (octfiledir); + error ("couldn't copy on_uninstall.m: %s", output); + endif + endif + + ## Is there a doc/ directory that needs to be installed? + docdir = fullfile (packdir, "doc"); + if (exist (docdir, "dir") && ! dirempty (docdir)) + [status, output] = copyfile (docdir, desc.dir); + endif + + ## Is there a bin/ directory that needs to be installed? + ## FIXME: Need to treat architecture dependent files in bin/ + bindir = fullfile (packdir, "bin"); + if (exist (bindir, "dir") && ! dirempty (bindir)) + [status, output] = copyfile (bindir, desc.dir); + endif +endfunction + +function finish_installation (desc, packdir, global_install) + ## Is there a post-install to call? + if (exist (fullfile (packdir, "post_install.m"), "file")) + wd = pwd (); + try + cd (packdir); + post_install (desc); + cd (wd); + catch + cd (wd); + rm_rf (desc.dir); + rm_rf (getarchdir (desc), global_install); + rethrow (lasterror ()); + end_try_catch + endif +endfunction + +function generate_lookfor_cache (desc) + dirs = split_by (genpath (desc.dir), pathsep ()); + for i = 1 : length (dirs) + gen_doc_cache (fullfile (dirs{i}, "doc-cache"), dirs{i}); + endfor +endfunction + +## Make sure the package contains the essential files. +function verify_directory (dir) + needed_files = {"COPYING", "DESCRIPTION"}; + for f = needed_files + if (! exist (fullfile (dir, f{1}), "file")) + error ("package is missing file: %s", f{1}); + endif + endfor +endfunction + +## Parse the DESCRIPTION file. +function desc = get_description (filename) + [fid, msg] = fopen (filename, "r"); + if (fid == -1) + error ("the DESCRIPTION file %s could not be read: %s", filename, msg); + endif + + desc = struct (); + + line = fgetl (fid); + while (line != -1) + if (line(1) == "#") + ## Comments, do nothing. + elseif (isspace(line(1))) + ## Continuation lines + if (exist ("keyword", "var") && isfield (desc, keyword)) + desc.(keyword) = cstrcat (desc.(keyword), " ", rstrip(line)); + endif + else + ## Keyword/value pair + colon = find (line == ":"); + if (length (colon) == 0) + disp ("skipping line"); + else + colon = colon(1); + keyword = tolower (strip (line(1:colon-1))); + value = strip (line (colon+1:end)); + if (length (value) == 0) + fclose (fid); + error ("the keyword %s has an empty value", desc.keywords{end}); + endif + desc.(keyword) = value; + endif + endif + line = fgetl (fid); + endwhile + fclose (fid); + + ## Make sure all is okay. + needed_fields = {"name", "version", "date", "title", ... + "author", "maintainer", "description"}; + for f = needed_fields + if (! isfield (desc, f{1})) + error ("description is missing needed field %s", f{1}); + endif + endfor + desc.version = fix_version (desc.version); + if (isfield (desc, "depends")) + desc.depends = fix_depends (desc.depends); + else + desc.depends = ""; + endif + desc.name = tolower (desc.name); +endfunction + +## Make sure the version string v is a valid x.y.z version string +## Examples: "0.1" => "0.1.0", "monkey" => error(...). +function out = fix_version (v) + dots = find (v == "."); + if (length (dots) == 1) + major = str2num (v(1:dots-1)); + minor = str2num (v(dots+1:end)); + if (length (major) != 0 && length (minor) != 0) + out = sprintf ("%d.%d.0", major, minor); + return; + endif + elseif (length (dots) == 2) + major = str2num (v(1:dots(1)-1)); + minor = str2num (v(dots(1)+1:dots(2)-1)); + rev = str2num (v(dots(2)+1:end)); + if (length (major) != 0 && length (minor) != 0 && length (rev) != 0) + out = sprintf ("%d.%d.%d", major, minor, rev); + return; + endif + endif + error ("bad version string: %s", v); +endfunction + +## Make sure the depends field is of the right format. +## This function returns a cell of structures with the following fields: +## package, version, operator +function deps_cell = fix_depends (depends) + deps = split_by (tolower (depends), ","); + deps_cell = cell (1, length (deps)); + + ## For each dependency. + for i = 1:length (deps) + dep = deps{i}; + lpar = find (dep == "("); + rpar = find (dep == ")"); + ## Does the dependency specify a version + ## Example: package(>= version). + if (length (lpar) == 1 && length (rpar) == 1) + package = tolower (strip (dep(1:lpar-1))); + sub = dep(lpar(1)+1:rpar(1)-1); + parts = strsplit (sub, " ", true); + if (length (parts) != 2) + error ("incorrect syntax for dependency `%s' in the DESCRIPTION file\n", + dep); + endif + operator = parts{1}; + if (! any (strcmp (operator, {">", ">=", "<=", "<", "=="}))) + error ("unsupported operator: %s", operator); + endif + version = fix_version (parts{2}); + + ## If no version is specified for the dependency + ## we say that the version should be greater than + ## or equal to "0.0.0". + else + package = tolower (strip (dep)); + operator = ">="; + version = "0.0.0"; + endif + deps_cell{i} = struct ("package", package, "operator", operator, + "version", version); + endfor +endfunction + +## Strip the text of spaces from the right +## Example: " hello world " => " hello world" +## FIXME -- is this the same as deblank? +function text = rstrip (text) + chars = find (! isspace (text)); + if (length (chars) > 0) + ## FIXME: shouldn't it be text = text(1:chars(end)); + text = text (chars(1):end); + else + text = ""; + endif +endfunction + +## Strip the text of spaces from the left and the right. +## Example: " hello world " => "hello world" +function text = strip (text) + chars = find (! isspace (text)); + if (length (chars) > 0) + text = text(chars(1):chars(end)); + else + text = ""; + endif +endfunction + +## Split the text into a cell array of strings by sep. +## Example: "A, B" => {"A", "B"} (with sep = ",") +function out = split_by (text, sep) + out = strtrim (strsplit (text, sep)); +endfunction + +## Create an INDEX file for a package that doesn't provide one. +## 'desc' describes the package. +## 'dir' is the 'inst' directory in temporary directory. +## 'index_file' is the name (including path) of resulting INDEX file. +function write_index (desc, dir, index_file, global_install) + ## Get names of functions in dir + [files, err, msg] = readdir (dir); + if (err) + error ("couldn't read directory %s: %s", dir, msg); + endif + + ## Check for architecture dependent files. + tmpdir = getarchdir (desc); + if (exist (tmpdir, "dir")) + [files2, err, msg] = readdir (tmpdir); + if (err) + error ("couldn't read directory %s: %s", tmpdir, msg); + endif + files = [files; files2]; + endif + + functions = {}; + for i = 1:length (files) + file = files{i}; + lf = length (file); + if (lf > 2 && strcmp (file(end-1:end), ".m")) + functions{end+1} = file(1:end-2); + elseif (lf > 4 && strcmp (file(end-3:end), ".oct")) + functions{end+1} = file(1:end-4); + endif + endfor + + ## Does desc have a categories field? + if (! isfield (desc, "categories")) + error ("the DESCRIPTION file must have a Categories field, when no INDEX file is given"); + endif + categories = split_by (desc.categories, ","); + if (length (categories) < 1) + error ("the Category field is empty"); + endif + + ## Write INDEX. + fid = fopen (index_file, "w"); + if (fid == -1) + error ("couldn't open %s for writing.", index_file); + endif + fprintf (fid, "%s >> %s\n", desc.name, desc.title); + fprintf (fid, "%s\n", categories{1}); + fprintf (fid, " %s\n", functions{:}); + fclose (fid); +endfunction + +function bad_deps = get_unsatisfied_deps (desc, installed_pkgs_lst) + bad_deps = {}; + + ## For each dependency. + for i = 1:length (desc.depends) + dep = desc.depends{i}; + + ## Is the current dependency Octave? + if (strcmp (dep.package, "octave")) + if (! compare_versions (OCTAVE_VERSION, dep.version, dep.operator)) + bad_deps{end+1} = dep; + endif + ## Is the current dependency not Octave? + else + ok = false; + for i = 1:length (installed_pkgs_lst) + cur_name = installed_pkgs_lst{i}.name; + cur_version = installed_pkgs_lst{i}.version; + if (strcmp (dep.package, cur_name) + && compare_versions (cur_version, dep.version, dep.operator)) + ok = true; + break; + endif + endfor + if (! ok) + bad_deps{end+1} = dep; + endif + endif + endfor +endfunction + +function [out1, out2] = installed_packages (local_list, global_list) + ## Get the list of installed packages. + try + local_packages = load (local_list).local_packages; + catch + local_packages = {}; + end_try_catch + try + global_packages = load (global_list).global_packages; + catch + global_packages = {}; + end_try_catch + installed_pkgs_lst = {local_packages{:}, global_packages{:}}; + + ## Eliminate duplicates in the installed package list. + ## Locally installed packages take precedence. + dup = []; + for i = 1:length (installed_pkgs_lst) + if (find (dup, i)) + continue; + endif + for j = (i+1):length (installed_pkgs_lst) + if (find (dup, j)) + continue; + endif + if (strcmp (installed_pkgs_lst{i}.name, installed_pkgs_lst{j}.name)) + dup = [dup, j]; + endif + endfor + endfor + if (! isempty(dup)) + installed_pkgs_lst(dup) = []; + endif + + ## Now check if the package is loaded. + tmppath = strrep (path(), "\\", "/"); + for i = 1:length (installed_pkgs_lst) + if (findstr (tmppath, strrep (installed_pkgs_lst{i}.dir, "\\", "/"))) + installed_pkgs_lst{i}.loaded = true; + else + installed_pkgs_lst{i}.loaded = false; + endif + endfor + for i = 1:length (local_packages) + if (findstr (tmppath, strrep (local_packages{i}.dir, "\\", "/"))) + local_packages{i}.loaded = true; + else + local_packages{i}.loaded = false; + endif + endfor + for i = 1:length (global_packages) + if (findstr (tmppath, strrep (global_packages{i}.dir, "\\", "/"))) + global_packages{i}.loaded = true; + else + global_packages{i}.loaded = false; + endif + endfor + + ## Should we return something? + if (nargout == 2) + out1 = local_packages; + out2 = global_packages; + return; + elseif (nargout == 1) + out1 = installed_pkgs_lst; + return; + endif + + ## We shouldn't return something, so we'll print something. + num_packages = length (installed_pkgs_lst); + if (num_packages == 0) + printf ("no packages installed.\n"); + return; + endif + + ## Compute the maximal lengths of name, version, and dir. + h1 = "Package Name"; + h2 = "Version"; + h3 = "Installation directory"; + max_name_length = length (h1); + max_version_length = length (h2); + names = cell (num_packages, 1); + for i = 1:num_packages + max_name_length = max (max_name_length, + length (installed_pkgs_lst{i}.name)); + max_version_length = max (max_version_length, + length (installed_pkgs_lst{i}.version)); + names{i} = installed_pkgs_lst{i}.name; + endfor + max_dir_length = terminal_size()(2) - max_name_length - ... + max_version_length - 7; + if (max_dir_length < 20) + max_dir_length = Inf; + endif + + h1 = postpad (h1, max_name_length + 1, " "); + h2 = postpad (h2, max_version_length, " ");; + + ## Print a header. + header = sprintf("%s | %s | %s\n", h1, h2, h3); + printf (header); + tmp = sprintf (repmat ("-", 1, length(header)-1)); + tmp(length(h1)+2) = "+"; + tmp(length(h1)+length(h2)+5) = "+"; + printf ("%s\n", tmp); + + ## Print the packages. + format = sprintf ("%%%ds %%1s| %%%ds | %%s\n", max_name_length, + max_version_length); + [dummy, idx] = sort (names); + for i = 1:num_packages + cur_name = installed_pkgs_lst{idx(i)}.name; + cur_version = installed_pkgs_lst{idx(i)}.version; + cur_dir = installed_pkgs_lst{idx(i)}.dir; + if (length (cur_dir) > max_dir_length) + first_char = length (cur_dir) - max_dir_length + 4; + first_filesep = strfind (cur_dir(first_char:end), filesep()); + if (! isempty (first_filesep)) + cur_dir = cstrcat ("...", + cur_dir((first_char + first_filesep(1) - 1):end)); + else + cur_dir = cstrcat ("...", cur_dir(first_char:end)); + endif + endif + if (installed_pkgs_lst{idx(i)}.loaded) + cur_loaded = "*"; + else + cur_loaded = " "; + endif + printf (format, cur_name, cur_loaded, cur_version, cur_dir); + endfor +endfunction + +function load_packages (files, handle_deps, local_list, global_list) + installed_pkgs_lst = installed_packages (local_list, global_list); + num_packages = length (installed_pkgs_lst); + + ## Read package names and installdirs into a more convenient format. + pnames = pdirs = cell (1, num_packages); + for i = 1:num_packages + pnames{i} = installed_pkgs_lst{i}.name; + pdirs{i} = installed_pkgs_lst{i}.dir; + endfor + + ## Load all. + if (length (files) == 1 && strcmp (files{1}, "all")) + idx = [1:length(installed_pkgs_lst)]; + ## Load auto. + elseif (length (files) == 1 && strcmp (files{1}, "auto")) + idx = []; + for i = 1:length (installed_pkgs_lst) + if (exist (fullfile (pdirs{i}, "packinfo", ".autoload"), "file")) + idx (end + 1) = i; + endif + endfor + ## Load package_name1 ... + else + idx = []; + for i = 1:length (files) + idx2 = find (strcmp (pnames, files{i})); + if (! any (idx2)) + error ("package %s is not installed", files{i}); + endif + idx (end + 1) = idx2; + endfor + endif + + ## Load the packages, but take care of the ordering of dependencies. + load_packages_and_dependencies (idx, handle_deps, installed_pkgs_lst, true); +endfunction + +function unload_packages (files, handle_deps, local_list, global_list) + installed_pkgs_lst = installed_packages (local_list, global_list); + num_packages = length (installed_pkgs_lst); + + ## Read package names and installdirs into a more convenient format. + pnames = pdirs = cell (1, num_packages); + for i = 1:num_packages + pnames{i} = installed_pkgs_lst{i}.name; + pdirs{i} = installed_pkgs_lst{i}.dir; + pdeps{i} = installed_pkgs_lst{i}.depends; + endfor + + ## Get the current octave path. + p = split_by (path(), pathsep ()); + + if (length (files) == 1 && strcmp (files{1}, "all")) + ## Unload all. + dirs = pdirs; + desc = installed_pkgs_lst; + else + ## Unload package_name1 ... + dirs = {}; + desc = {}; + for i = 1:length (files) + idx = strcmp (pnames, files{i}); + if (! any (idx)) + error ("package %s is not installed", files{i}); + endif + dirs{end+1} = pdirs{idx}; + desc{end+1} = installed_pkgs_lst{idx}; + endfor + endif + + ## Check for architecture dependent directories. + archdirs = {}; + for i = 1:length (dirs) + tmpdir = getarchdir (desc{i}); + if (exist (tmpdir, "dir")) + archdirs{end+1} = dirs{i}; + archdirs{end+1} = tmpdir; + else + archdirs{end+1} = dirs{i}; + endif + endfor + + ## Unload the packages. + for i = 1:length (archdirs) + d = archdirs{i}; + idx = strcmp (p, d); + if (any (idx)) + rmpath (d); + ## FIXME: We should also check if we need to remove items from + ## EXEC_PATH. + endif + endfor +endfunction + +function [status_out, msg_out] = rm_rf (dir) + if (exist (dir)) + crr = confirm_recursive_rmdir (); + unwind_protect + confirm_recursive_rmdir (false); + [status, msg] = rmdir (dir, "s"); + unwind_protect_cleanup + confirm_recursive_rmdir (crr); + end_unwind_protect + else + status = 1; + msg = ""; + endif + if (nargout > 0) + status_out = status; + endif + if (nargout > 1) + msg_out = msg; + endif +endfunction + +function emp = dirempty (nm, ign) + if (exist (nm, "dir")) + if (nargin < 2) + ign = {".", ".."}; + else + ign = [{".", ".."}, ign]; + endif + l = dir (nm); + for i = 1:length (l) + found = false; + for j = 1:length (ign) + if (strcmp (l(i).name, ign{j})) + found = true; + break; + endif + endfor + if (! found) + emp = false; + return + endif + endfor + emp = true; + else + emp = true; + endif +endfunction + +function arch = getarch () + persistent _arch = cstrcat (octave_config_info("canonical_host_type"), ... + "-", octave_config_info("api_version")); + arch = _arch; +endfunction + +function archprefix = getarchprefix (desc, global_install) + if ((nargin == 2 && global_install) || (nargin < 2 && issuperuser ())) + archprefix = fullfile (octave_config_info ("libexecdir"), "octave", + "packages", cstrcat(desc.name, "-", desc.version)); + else + archprefix = desc.dir; + endif +endfunction + +function archdir = getarchdir (desc) + archdir = fullfile (desc.archprefix, getarch()); +endfunction + +function s = issuperuser () + if ((ispc () && ! isunix ()) || (geteuid() == 0)) + s = true; + else + s = false; + endif +endfunction + +function [status, output] = shell (cmd) + persistent have_sh; + + cmd = strrep (cmd, "\\", "/"); + if (ispc () && ! isunix ()) + if (isempty(have_sh)) + if (system("sh.exe -c \"exit\"")) + have_sh = false; + else + have_sh = true; + endif + endif + if (have_sh) + [status, output] = system (cstrcat ("sh.exe -c \"", cmd, "\"")); + else + error ("Can not find the command shell") + endif + else + [status, output] = system (cmd); + endif +endfunction + +function newdesc = save_order (desc) + newdesc = {}; + for i = 1 : length(desc) + deps = desc{i}.depends; + if (isempty (deps) || (length (deps) == 1 && + strcmp(deps{1}.package, "octave"))) + newdesc {end + 1} = desc{i}; + else + tmpdesc = {}; + for k = 1 : length (deps) + for j = 1 : length (desc) + if (strcmp (desc{j}.name, deps{k}.package)) + tmpdesc{end+1} = desc{j}; + break; + endif + endfor + endfor + if (! isempty (tmpdesc)) + newdesc = {newdesc{:}, save_order(tmpdesc){:}, desc{i}}; + else + newdesc{end+1} = desc{i}; + endif + endif + endfor + ## Eliminate the duplicates. + idx = []; + for i = 1 : length (newdesc) + for j = (i + 1) : length (newdesc) + if (strcmp (newdesc{i}.name, newdesc{j}.name)) + idx (end + 1) = j; + endif + endfor + endfor + newdesc(idx) = []; +endfunction + +function load_packages_and_dependencies (idx, handle_deps, installed_pkgs_lst, + global_install) + idx = load_package_dirs (idx, [], handle_deps, installed_pkgs_lst); + dirs = {}; + execpath = EXEC_PATH (); + for i = idx; + ndir = installed_pkgs_lst{i}.dir; + dirs{end+1} = ndir; + if (exist (fullfile (dirs{end}, "bin"), "dir")) + execpath = cstrcat (fullfile (dirs{end}, "bin"), ":", execpath); + endif + tmpdir = getarchdir (installed_pkgs_lst{i}); + if (exist (tmpdir, "dir")) + dirs{end + 1} = tmpdir; + if (exist (fullfile (dirs{end}, "bin"), "dir")) + execpath = cstrcat (fullfile (dirs{end}, "bin"), ":", execpath); + endif + endif + endfor + + ## Load the packages. + if (length (dirs) > 0) + addpath (dirs{:}); + endif + + ## Add the binaries to exec_path. + if (! strcmp (EXEC_PATH, execpath)) + EXEC_PATH (execpath); + endif +endfunction + +function idx = load_package_dirs (lidx, idx, handle_deps, installed_pkgs_lst) + for i = lidx + if (isfield (installed_pkgs_lst{i}, "loaded") && + installed_pkgs_lst{i}.loaded) + continue; + else + if (handle_deps) + deps = installed_pkgs_lst{i}.depends; + if ((length (deps) > 1) || (length (deps) == 1 && + ! strcmp(deps{1}.package, "octave"))) + tmplidx = []; + for k = 1 : length (deps) + for j = 1 : length (installed_pkgs_lst) + if (strcmp (installed_pkgs_lst{j}.name, deps{k}.package)) + tmplidx (end + 1) = j; + break; + endif + endfor + endfor + idx = load_package_dirs (tmplidx, idx, handle_deps, + installed_pkgs_lst); + endif + endif + if (isempty (find(idx == i))) + idx (end + 1) = i; + endif + endif + endfor +endfunction + +function dep = is_architecture_dependent (nm) + persistent archdepsuffix = {".oct",".mex",".a",".lib",".so",".so.*",".dll","dylib"}; + + dep = false; + for i = 1 : length (archdepsuffix) + ext = archdepsuffix{i}; + if (ext(end) == "*") + isglob = true; + ext(end) = []; + else + isglob = false; + endif + pos = findstr (nm, ext); + if (pos) + if (! isglob && (length(nm) - pos(end) != length(ext) - 1)) + continue; + endif + dep = true; + break; + endif + endfor +endfunction ------------------------------------------------------------ revno: 101224 committer: Eli Zaretskii branch nick: trunk timestamp: Mon 2010-08-30 21:11:34 +0300 message: Fix bug #6944. menu-bar.el (menu-bar-edit-menu) <"Paste">: Check selection in CLIPBOARD, not in PRIMARY. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-08-30 15:21:14 +0000 +++ lisp/ChangeLog 2010-08-30 18:11:34 +0000 @@ -1,3 +1,8 @@ +2010-08-30 Eli Zaretskii + + * menu-bar.el (menu-bar-edit-menu) <"Paste">: Check selection in + CLIPBOARD, not in PRIMARY. (Bug#6944) + 2010-08-30 Stefan Monnier * emacs-lisp/smie.el (smie-indent-offset-rule): Let :parent take === modified file 'lisp/menu-bar.el' --- lisp/menu-bar.el 2010-08-29 16:17:13 +0000 +++ lisp/menu-bar.el 2010-08-30 18:11:34 +0000 @@ -463,7 +463,7 @@ ;; Emacs compiled --without-x doesn't have ;; x-selection-exists-p. (and (fboundp 'x-selection-exists-p) - (x-selection-exists-p)) + (x-selection-exists-p 'CLIPBOARD)) kill-ring) (not buffer-read-only)) :help ,(purecopy "Paste (yank) text most recently cut/copied"))) ------------------------------------------------------------ revno: 101223 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2010-08-30 17:21:14 +0200 message: * lisp/emacs-lisp/smie.el (smie-indent-offset-rule): Let :parent take a list of parents. (smie-indent-column): Allow indirection through variables. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-08-30 13:57:42 +0000 +++ lisp/ChangeLog 2010-08-30 15:21:14 +0000 @@ -1,5 +1,9 @@ 2010-08-30 Stefan Monnier + * emacs-lisp/smie.el (smie-indent-offset-rule): Let :parent take + a list of parents. + (smie-indent-column): Allow indirection through variables. + * composite.el (save-buffer-state): Delete, unused. * font-lock.el (save-buffer-state): Use with-silent-modifications. (font-lock-default-fontify-region): Use with-syntax-table. === modified file 'lisp/emacs-lisp/smie.el' --- lisp/emacs-lisp/smie.el 2010-08-18 12:10:30 +0000 +++ lisp/emacs-lisp/smie.el 2010-08-30 15:21:14 +0000 @@ -593,20 +593,21 @@ \(:bolp . OFFSET-RULES) If TOK is first on a line, use OFFSET-RULES. OFFSET the offset to use. -PARENT can be either the name of the parent or `open' to mean any parent -which acts as an open-paren (i.e. has a nil left-precedence). +PARENT can be either the name of the parent or a list of such names. OFFSET can be of the form: `point' align with the token. `parent' align with the parent. NUMBER offset by NUMBER. \(+ OFFSETS...) use the sum of OFFSETS. +VARIABLE use the value of VARIABLE as offset. The precise meaning of `point' depends on various details: it can either mean the position of the token we're indenting, or the position of its parent, or the position right after its parent. -A nil offset for indentation after a token defaults to `smie-indent-basic'.") +A nil offset for indentation after an opening token defaults +to `smie-indent-basic'.") (defun smie-indent-hanging-p () ;; A hanging keyword is one that's at the end of a line except it's not at @@ -674,8 +675,9 @@ (save-excursion (if after (goto-char after)) (setq parent (smie-backward-sexp 'halfsexp)))) - (when (or (equal (nth 2 parent) (cadr rule)) - (and (eq (cadr rule) 'open) (null (car parent)))) + (when (if (listp (cadr rule)) + (member (nth 2 parent) (cadr rule)) + (equal (nth 2 parent) (cadr rule))) (setq rules (cddr rule)))) (t (error "Unknown rule %s for indentation of %s" rule (car tokinfo)))))) @@ -726,6 +728,8 @@ (if (consp parent) (goto-char (cadr parent))) (smie-indent-virtual)) ((eq offset nil) nil) + ((and (symbolp offset) (boundp 'offset)) + (smie-indent-column (symbol-value offset) base parent virtual-point)) (t (error "Unknown indentation offset %s" offset)))) (defun smie-indent-forward-token () @@ -1016,6 +1020,7 @@ (positions ;; We're the first arg. (goto-char (car positions)) + ;; FIXME: Use smie-indent-column. (+ (smie-indent-offset 'args) ;; We used to use (smie-indent-virtual), but that ;; doesn't seem right since it might then indent args less than ------------------------------------------------------------ revno: 101222 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2010-08-30 15:57:42 +0200 message: Use with-silent-modifications. * lisp/composite.el (save-buffer-state): Delete, unused. * lisp/font-lock.el (save-buffer-state): Use with-silent-modifications. (font-lock-default-fontify-region): Use with-syntax-table. * lisp/jit-lock.el (with-buffer-unmodified): Remove. (with-buffer-prepared-for-jit-lock): Use with-silent-modifications. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-08-30 13:03:05 +0000 +++ lisp/ChangeLog 2010-08-30 13:57:42 +0000 @@ -1,5 +1,11 @@ 2010-08-30 Stefan Monnier + * composite.el (save-buffer-state): Delete, unused. + * font-lock.el (save-buffer-state): Use with-silent-modifications. + (font-lock-default-fontify-region): Use with-syntax-table. + * jit-lock.el (with-buffer-unmodified): Remove. + (with-buffer-prepared-for-jit-lock): Use with-silent-modifications. + Use `declare' in defmacros. * window.el (save-selected-window): * subr.el (with-temp-file, with-temp-message, with-syntax-table): === modified file 'lisp/composite.el' --- lisp/composite.el 2010-08-29 16:17:13 +0000 +++ lisp/composite.el 2010-08-30 13:57:42 +0000 @@ -413,27 +413,6 @@ ;;; Automatic character composition. -;; Copied from font-lock.el. -(eval-when-compile - ;; Borrowed from lazy-lock.el. - ;; We use this to preserve or protect things when modifying text properties. - (defmacro save-buffer-state (varlist &rest body) - "Bind variables according to VARLIST and eval BODY restoring buffer state." - `(let* ,(append varlist - '((modified (buffer-modified-p)) (buffer-undo-list t) - (inhibit-read-only t) (inhibit-point-motion-hooks t) - (inhibit-modification-hooks t) - deactivate-mark buffer-file-name buffer-file-truename)) - ,@body - (unless modified - (restore-buffer-modified-p nil)))) - ;; Fixme: This makes bootstrapping fail with this error. - ;; Symbol's function definition is void: eval-defun - ;;(def-edebug-spec save-buffer-state let) - ) - -(put 'save-buffer-state 'lisp-indent-function 1) - ;; These macros must match with C macros LGSTRING_XXX and LGLYPH_XXX in font.h (defsubst lgstring-header (gstring) (aref gstring 0)) (defsubst lgstring-set-header (gstring header) (aset gstring 0 header)) === modified file 'lisp/font-lock.el' --- lisp/font-lock.el 2010-08-29 16:17:13 +0000 +++ lisp/font-lock.el 2010-08-30 13:57:42 +0000 @@ -615,21 +615,10 @@ (defmacro save-buffer-state (varlist &rest body) "Bind variables according to VARLIST and eval BODY restoring buffer state." (declare (indent 1) (debug let)) - (let ((modified (make-symbol "modified"))) - `(let* ,(append varlist - `((,modified (buffer-modified-p)) - (buffer-undo-list t) - (inhibit-read-only t) - (inhibit-point-motion-hooks t) - (inhibit-modification-hooks t) - deactivate-mark - buffer-file-name - buffer-file-truename)) - (unwind-protect - (progn - ,@body) - (unless ,modified - (restore-buffer-modified-p nil)))))) + `(let* ,(append varlist + `((inhibit-point-motion-hooks t))) + (with-silent-modifications + ,@body))) ;; ;; Shut up the byte compiler. (defvar font-lock-face-attributes)) ; Obsolete but respected if set. @@ -1125,38 +1114,33 @@ (defun font-lock-default-fontify-region (beg end loudly) (save-buffer-state ((parse-sexp-lookup-properties - (or parse-sexp-lookup-properties font-lock-syntactic-keywords)) - (old-syntax-table (syntax-table))) - (unwind-protect - (save-restriction - (unless font-lock-dont-widen (widen)) - ;; Use the fontification syntax table, if any. - (when font-lock-syntax-table - (set-syntax-table font-lock-syntax-table)) - ;; Extend the region to fontify so that it starts and ends at - ;; safe places. - (let ((funs font-lock-extend-region-functions) - (font-lock-beg beg) - (font-lock-end end)) - (while funs - (setq funs (if (or (not (funcall (car funs))) - (eq funs font-lock-extend-region-functions)) - (cdr funs) - ;; If there's been a change, we should go through - ;; the list again since this new position may - ;; warrant a different answer from one of the fun - ;; we've already seen. - font-lock-extend-region-functions))) - (setq beg font-lock-beg end font-lock-end)) - ;; Now do the fontification. - (font-lock-unfontify-region beg end) - (when font-lock-syntactic-keywords - (font-lock-fontify-syntactic-keywords-region beg end)) - (unless font-lock-keywords-only - (font-lock-fontify-syntactically-region beg end loudly)) - (font-lock-fontify-keywords-region beg end loudly)) - ;; Clean up. - (set-syntax-table old-syntax-table)))) + (or parse-sexp-lookup-properties font-lock-syntactic-keywords))) + ;; Use the fontification syntax table, if any. + (with-syntax-table (or font-lock-syntax-table (syntax-table)) + (save-restriction + (unless font-lock-dont-widen (widen)) + ;; Extend the region to fontify so that it starts and ends at + ;; safe places. + (let ((funs font-lock-extend-region-functions) + (font-lock-beg beg) + (font-lock-end end)) + (while funs + (setq funs (if (or (not (funcall (car funs))) + (eq funs font-lock-extend-region-functions)) + (cdr funs) + ;; If there's been a change, we should go through + ;; the list again since this new position may + ;; warrant a different answer from one of the fun + ;; we've already seen. + font-lock-extend-region-functions))) + (setq beg font-lock-beg end font-lock-end)) + ;; Now do the fontification. + (font-lock-unfontify-region beg end) + (when font-lock-syntactic-keywords + (font-lock-fontify-syntactic-keywords-region beg end)) + (unless font-lock-keywords-only + (font-lock-fontify-syntactically-region beg end loudly)) + (font-lock-fontify-keywords-region beg end loudly))))) ;; The following must be rethought, since keywords can override fontification. ;; ;; Now scan for keywords, but not if we are inside a comment now. === modified file 'lisp/jit-lock.el' --- lisp/jit-lock.el 2010-08-29 16:17:13 +0000 +++ lisp/jit-lock.el 2010-08-30 13:57:42 +0000 @@ -32,33 +32,13 @@ (eval-when-compile (require 'cl) - (defmacro with-buffer-unmodified (&rest body) - "Eval BODY, preserving the current buffer's modified state." - (declare (debug t)) - (let ((modified (make-symbol "modified"))) - `(let ((,modified (buffer-modified-p))) - (unwind-protect - (progn ,@body) - (unless ,modified - (restore-buffer-modified-p nil)))))) - (defmacro with-buffer-prepared-for-jit-lock (&rest body) "Execute BODY in current buffer, overriding several variables. Preserves the `buffer-modified-p' state of the current buffer." (declare (debug t)) - `(let ((buffer-undo-list t) - (inhibit-read-only t) - (inhibit-point-motion-hooks t) - (inhibit-modification-hooks t) - deactivate-mark - buffer-file-name - buffer-file-truename) - ;; Do reset the modification status from within the let, since - ;; otherwise set-buffer-modified-p may try to unlock the file. - (with-buffer-unmodified - ,@body)))) - - + `(let ((inhibit-point-motion-hooks t)) + (with-silent-modifications + ,@body)))) ;;; Customization. ------------------------------------------------------------ revno: 101221 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2010-08-30 15:03:05 +0200 message: Use `declare' in defmacros. * lisp/window.el (save-selected-window): * lisp/subr.el (with-temp-file, with-temp-message, with-syntax-table): * lisp/progmodes/python.el (def-python-skeleton): * lisp/net/dbus.el (dbus-ignore-errors): * lisp/jka-cmpr-hook.el (with-auto-compression-mode): * lisp/international/mule.el (with-category-table): * lisp/emacs-lisp/timer.el (with-timeout): * lisp/emacs-lisp/lisp-mnt.el (lm-with-file): * lisp/emacs-lisp/eieio.el (with-slots): * lisp/emacs-lisp/easymenu.el (easy-menu-define): * lisp/emacs-lisp/debug.el (debugger-env-macro): * lisp/emacs-lisp/cl-compat.el (Multiple-value-bind, Multiple-value-setq) (Multiple-value-call, Multiple-value-prog1): * lisp/emacs-lisp/cl-seq.el (cl-parsing-keywords, cl-check-key) (cl-check-test-nokey, cl-check-test, cl-check-match): Move indent and edebug rule to definition. * lisp/emacs-lisp/lisp-mode.el (save-selected-window) (with-current-buffer, combine-after-change-calls) (with-output-to-string, with-temp-file, with-temp-buffer) (with-temp-message, with-syntax-table, read-if, eval-after-load) (dolist, dotimes, when, unless): * lisp/emacs-lisp/byte-run.el (inline): Remove indent rule, redundant. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-08-29 22:15:09 +0000 +++ lisp/ChangeLog 2010-08-30 13:03:05 +0000 @@ -1,3 +1,29 @@ +2010-08-30 Stefan Monnier + + Use `declare' in defmacros. + * window.el (save-selected-window): + * subr.el (with-temp-file, with-temp-message, with-syntax-table): + * progmodes/python.el (def-python-skeleton): + * net/dbus.el (dbus-ignore-errors): + * jka-cmpr-hook.el (with-auto-compression-mode): + * international/mule.el (with-category-table): + * emacs-lisp/timer.el (with-timeout): + * emacs-lisp/lisp-mnt.el (lm-with-file): + * emacs-lisp/eieio.el (with-slots): + * emacs-lisp/easymenu.el (easy-menu-define): + * emacs-lisp/debug.el (debugger-env-macro): + * emacs-lisp/cl-compat.el (Multiple-value-bind, Multiple-value-setq) + (Multiple-value-call, Multiple-value-prog1): + * emacs-lisp/cl-seq.el (cl-parsing-keywords, cl-check-key) + (cl-check-test-nokey, cl-check-test, cl-check-match): Move indent and + edebug rule to definition. + * emacs-lisp/lisp-mode.el (save-selected-window) + (with-current-buffer, combine-after-change-calls) + (with-output-to-string, with-temp-file, with-temp-buffer) + (with-temp-message, with-syntax-table, read-if, eval-after-load) + (dolist, dotimes, when, unless): + * emacs-lisp/byte-run.el (inline): Remove indent rule, redundant. + 2010-08-29 Chong Yidong * finder.el: Require `package'. @@ -7,8 +33,8 @@ (finder-compile-keywords): Compute package--builtins and finder-keywords-hash instead of finder-keywords-hash, respecting the "Package" header. - (finder-unknown-keywords, finder-list-matches): Use - finder-keywords-hash and package--list-packages. + (finder-unknown-keywords, finder-list-matches): + Use finder-keywords-hash and package--list-packages. (finder-mode): Don't set font-lock-defaults. (finder-exit): We don't use "*Finder-package*" and "*Finder Category*" buffers anymore. === modified file 'lisp/emacs-lisp/byte-run.el' --- lisp/emacs-lisp/byte-run.el 2010-08-29 16:17:13 +0000 +++ lisp/emacs-lisp/byte-run.el 2010-08-30 13:03:05 +0000 @@ -66,7 +66,6 @@ ;; Redefined in byte-optimize.el. ;; This is not documented--it's not clear that we should promote it. (fset 'inline 'progn) -(put 'inline 'lisp-indent-function 0) ;;; Interface to inline functions. === modified file 'lisp/emacs-lisp/cl-compat.el' --- lisp/emacs-lisp/cl-compat.el 2010-08-29 16:17:13 +0000 +++ lisp/emacs-lisp/cl-compat.el 2010-08-30 13:03:05 +0000 @@ -71,11 +71,6 @@ ;;; by capitalizing the first letter: Values, Multiple-value-*, ;;; to avoid conflict with the new-style definitions in cl-macs. -(put 'Multiple-value-bind 'lisp-indent-function 2) -(put 'Multiple-value-setq 'lisp-indent-function 2) -(put 'Multiple-value-call 'lisp-indent-function 1) -(put 'Multiple-value-prog1 'lisp-indent-function 1) - (defvar *mvalues-values* nil) (defun Values (&rest val-forms) @@ -91,18 +86,22 @@ (list *mvalues-temp*)))) (defmacro Multiple-value-call (function &rest args) + (declare (indent 1)) (list 'apply function (cons 'append (mapcar (function (lambda (x) (list 'Multiple-value-list x))) args)))) (defmacro Multiple-value-bind (vars form &rest body) + (declare (indent 2)) (list* 'multiple-value-bind vars (list 'Multiple-value-list form) body)) (defmacro Multiple-value-setq (vars form) + (declare (indent 2)) (list 'multiple-value-setq vars (list 'Multiple-value-list form))) (defmacro Multiple-value-prog1 (form &rest body) + (declare (indent 1)) (list 'prog1 form (list* 'let '((*mvalues-values* nil)) body))) === modified file 'lisp/emacs-lisp/cl-seq.el' --- lisp/emacs-lisp/cl-seq.el 2010-08-29 16:17:13 +0000 +++ lisp/emacs-lisp/cl-seq.el 2010-08-30 13:03:05 +0000 @@ -48,6 +48,7 @@ ;;; this file independent from cl-macs. (defmacro cl-parsing-keywords (kwords other-keys &rest body) + (declare (indent 2) (debug (sexp sexp &rest form))) (cons 'let* (cons (mapcar @@ -84,13 +85,13 @@ (car cl-keys-temp))) '(setq cl-keys-temp (cdr (cdr cl-keys-temp))))))) body)))) -(put 'cl-parsing-keywords 'lisp-indent-function 2) -(put 'cl-parsing-keywords 'edebug-form-spec '(sexp sexp &rest form)) (defmacro cl-check-key (x) + (declare (debug edebug-forms)) (list 'if 'cl-key (list 'funcall 'cl-key x) x)) (defmacro cl-check-test-nokey (item x) + (declare (debug edebug-forms)) (list 'cond (list 'cl-test (list 'eq (list 'not (list 'funcall 'cl-test item x)) @@ -101,20 +102,17 @@ (list 'equal item x) (list 'eq item x))))) (defmacro cl-check-test (item x) + (declare (debug edebug-forms)) (list 'cl-check-test-nokey item (list 'cl-check-key x))) (defmacro cl-check-match (x y) + (declare (debug edebug-forms)) (setq x (list 'cl-check-key x) y (list 'cl-check-key y)) (list 'if 'cl-test (list 'eq (list 'not (list 'funcall 'cl-test x y)) 'cl-test-not) (list 'if (list 'numberp x) (list 'equal x y) (list 'eq x y)))) -(put 'cl-check-key 'edebug-form-spec 'edebug-forms) -(put 'cl-check-test 'edebug-form-spec 'edebug-forms) -(put 'cl-check-test-nokey 'edebug-form-spec 'edebug-forms) -(put 'cl-check-match 'edebug-form-spec 'edebug-forms) - (defvar cl-test) (defvar cl-test-not) (defvar cl-if) (defvar cl-if-not) (defvar cl-key) === modified file 'lisp/emacs-lisp/debug.el' --- lisp/emacs-lisp/debug.el 2010-01-13 08:35:10 +0000 +++ lisp/emacs-lisp/debug.el 2010-08-30 13:03:05 +0000 @@ -514,9 +514,9 @@ (insert ? ))) (beginning-of-line)) -(put 'debugger-env-macro 'lisp-indent-function 0) (defmacro debugger-env-macro (&rest body) "Run BODY in original environment." + (declare (indent 0)) `(save-excursion (if (null (buffer-name debugger-old-buffer)) ;; old buffer deleted === modified file 'lisp/emacs-lisp/easymenu.el' --- lisp/emacs-lisp/easymenu.el 2010-08-29 16:17:13 +0000 +++ lisp/emacs-lisp/easymenu.el 2010-08-30 13:03:05 +0000 @@ -44,8 +44,6 @@ (if (stringp s) (intern s) s)) ;;;###autoload -(put 'easy-menu-define 'lisp-indent-function 'defun) -;;;###autoload (defmacro easy-menu-define (symbol maps doc menu) "Define a menu bar submenu in maps MAPS, according to MENU. @@ -151,6 +149,7 @@ as a solid horizontal line. A menu item can be a list with the same format as MENU. This is a submenu." + (declare (indent defun)) `(progn ,(if symbol `(defvar ,symbol nil ,doc)) (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu))) === modified file 'lisp/emacs-lisp/eieio.el' --- lisp/emacs-lisp/eieio.el 2010-01-18 04:39:40 +0000 +++ lisp/emacs-lisp/eieio.el 2010-08-30 13:03:05 +0000 @@ -1610,6 +1610,7 @@ Where each VAR is the local variable given to the associated SLOT. A slot specified without a variable name is given a variable name of the same name as the slot." + (declare (indent 2)) ;; Transform the spec-list into a symbol-macrolet spec-list. (let ((mappings (mapcar (lambda (entry) (let ((var (if (listp entry) (car entry) entry)) @@ -1618,8 +1619,6 @@ spec-list))) (append (list 'symbol-macrolet mappings) body))) -(put 'with-slots 'lisp-indent-function 2) - ;;; Simple generators, and query functions. None of these would do ;; well embedded into an object. === modified file 'lisp/emacs-lisp/lisp-mnt.el' --- lisp/emacs-lisp/lisp-mnt.el 2010-03-14 21:15:02 +0000 +++ lisp/emacs-lisp/lisp-mnt.el 2010-08-30 13:03:05 +0000 @@ -298,6 +298,7 @@ (defmacro lm-with-file (file &rest body) "Execute BODY in a buffer containing the contents of FILE. If FILE is nil, execute BODY in the current buffer." + (declare (indent 1) (debug t)) (let ((filesym (make-symbol "file"))) `(let ((,filesym ,file)) (if ,filesym @@ -311,9 +312,6 @@ (with-syntax-table emacs-lisp-mode-syntax-table ,@body)))))) -(put 'lm-with-file 'lisp-indent-function 1) -(put 'lm-with-file 'edebug-form-spec t) - ;; Fixme: Probably this should be amalgamated with copyright.el; also ;; we need a check for ranges in copyright years. === modified file 'lisp/emacs-lisp/lisp-mode.el' --- lisp/emacs-lisp/lisp-mode.el 2010-08-29 16:17:13 +0000 +++ lisp/emacs-lisp/lisp-mode.el 2010-08-30 13:03:05 +0000 @@ -1210,31 +1210,17 @@ (put 'prog2 'lisp-indent-function 2) (put 'save-excursion 'lisp-indent-function 0) (put 'save-window-excursion 'lisp-indent-function 0) -(put 'save-selected-window 'lisp-indent-function 0) (put 'save-restriction 'lisp-indent-function 0) (put 'save-match-data 'lisp-indent-function 0) (put 'save-current-buffer 'lisp-indent-function 0) -(put 'with-current-buffer 'lisp-indent-function 1) -(put 'combine-after-change-calls 'lisp-indent-function 0) -(put 'with-output-to-string 'lisp-indent-function 0) -(put 'with-temp-file 'lisp-indent-function 1) -(put 'with-temp-buffer 'lisp-indent-function 0) -(put 'with-temp-message 'lisp-indent-function 1) -(put 'with-syntax-table 'lisp-indent-function 1) (put 'let 'lisp-indent-function 1) (put 'let* 'lisp-indent-function 1) (put 'while 'lisp-indent-function 1) (put 'if 'lisp-indent-function 2) -(put 'read-if 'lisp-indent-function 2) (put 'catch 'lisp-indent-function 1) (put 'condition-case 'lisp-indent-function 2) (put 'unwind-protect 'lisp-indent-function 1) (put 'with-output-to-temp-buffer 'lisp-indent-function 1) -(put 'eval-after-load 'lisp-indent-function 1) -(put 'dolist 'lisp-indent-function 1) -(put 'dotimes 'lisp-indent-function 1) -(put 'when 'lisp-indent-function 1) -(put 'unless 'lisp-indent-function 1) (defun indent-sexp (&optional endpos) "Indent each line of the list starting just after point. === modified file 'lisp/emacs-lisp/timer.el' --- lisp/emacs-lisp/timer.el 2010-08-29 16:17:13 +0000 +++ lisp/emacs-lisp/timer.el 2010-08-30 13:03:05 +0000 @@ -443,8 +443,6 @@ "This is the timer function used for the timer made by `with-timeout'." (throw tag 'timeout)) -(put 'with-timeout 'lisp-indent-function 1) - (defvar with-timeout-timers nil "List of all timers used by currently pending `with-timeout' calls.") @@ -456,6 +454,7 @@ if the program loops without waiting in any way, the timeout will not be detected. \n(fn (SECONDS TIMEOUT-FORMS...) BODY)" + (declare (indent 1)) (let ((seconds (car list)) (timeout-forms (cdr list))) `(let ((with-timeout-tag (cons nil nil)) === modified file 'lisp/international/mule.el' --- lisp/international/mule.el 2010-08-22 21:15:20 +0000 +++ lisp/international/mule.el 2010-08-30 13:03:05 +0000 @@ -2297,13 +2297,12 @@ (setq table val))) (translate-region-internal start end table)) -(put 'with-category-table 'lisp-indent-function 1) - (defmacro with-category-table (table &rest body) "Execute BODY like `progn' with TABLE the current category table. The category table of the current buffer is saved, BODY is evaluated, then the saved table is restored, even in case of an abnormal exit. Value is what BODY returns." + (declare (indent 1) (debug t)) (let ((old-table (make-symbol "old-table")) (old-buffer (make-symbol "old-buffer"))) `(let ((,old-table (category-table)) === modified file 'lisp/jka-cmpr-hook.el' --- lisp/jka-cmpr-hook.el 2010-08-29 16:17:13 +0000 +++ lisp/jka-cmpr-hook.el 2010-08-30 13:03:05 +0000 @@ -335,6 +335,7 @@ (defmacro with-auto-compression-mode (&rest body) "Evalute BODY with automatic file compression and uncompression enabled." + (declare (indent 0)) (let ((already-installed (make-symbol "already-installed"))) `(let ((,already-installed (jka-compr-installed-p))) (unwind-protect @@ -344,8 +345,6 @@ ,@body) (unless ,already-installed (jka-compr-uninstall)))))) -(put 'with-auto-compression-mode 'lisp-indent-function 0) - ;; This is what we need to know about jka-compr-handler ;; in order to decide when to call it. === modified file 'lisp/net/dbus.el' --- lisp/net/dbus.el 2010-08-23 13:08:54 +0000 +++ lisp/net/dbus.el 2010-08-30 13:03:05 +0000 @@ -92,12 +92,10 @@ (defmacro dbus-ignore-errors (&rest body) "Execute BODY; signal D-Bus error when `dbus-debug' is non-nil. Otherwise, return result of last form in BODY, or all other errors." + (declare (indent 0) (debug t)) `(condition-case err (progn ,@body) (dbus-error (when dbus-debug (signal (car err) (cdr err)))))) - -(put 'dbus-ignore-errors 'lisp-indent-function 0) -(put 'dbus-ignore-errors 'edebug-form-spec '(form body)) (font-lock-add-keywords 'emacs-lisp-mode '("\\")) (defvar dbus-event-error-hooks nil === modified file 'lisp/progmodes/python.el' --- lisp/progmodes/python.el 2010-08-24 20:20:21 +0000 +++ lisp/progmodes/python.el 2010-08-30 13:03:05 +0000 @@ -2285,6 +2285,7 @@ (eval-when-compile ;; Define a user-level skeleton and add it to the abbrev table. (defmacro def-python-skeleton (name &rest elements) + (declare (indent 2)) (let* ((name (symbol-name name)) (function (intern (concat "python-insert-" name)))) `(progn @@ -2297,7 +2298,6 @@ (define-skeleton ,function ,(format "Insert Python \"%s\" template." name) ,@elements))))) -(put 'def-python-skeleton 'lisp-indent-function 2) ;; From `skeleton-further-elements' set below: ;; `<': outdent a level; === modified file 'lisp/subr.el' --- lisp/subr.el 2010-08-29 16:17:13 +0000 +++ lisp/subr.el 2010-08-30 13:03:05 +0000 @@ -1630,6 +1630,7 @@ load-elt (and loads (car loads))))) load-elt)) +(put 'eval-after-load 'lisp-indent-function 1) (defun eval-after-load (file form) "Arrange that, if FILE is ever loaded, FORM will be run at that time. If FILE is already loaded, evaluate FORM right now. @@ -2713,7 +2714,7 @@ "Create a new buffer, evaluate BODY there, and write the buffer to FILE. The value returned is the value of the last form in BODY. See also `with-temp-buffer'." - (declare (debug t)) + (declare (indent 1) (debug t)) (let ((temp-file (make-symbol "temp-file")) (temp-buffer (make-symbol "temp-buffer"))) `(let ((,temp-file ,file) @@ -2735,7 +2736,7 @@ MESSAGE is written to the message log buffer if `message-log-max' is non-nil. If MESSAGE is nil, the echo area and message log buffer are unchanged. Use a MESSAGE of \"\" to temporarily clear the echo area." - (declare (debug t)) + (declare (debug t) (indent 1)) (let ((current-message (make-symbol "current-message")) (temp-message (make-symbol "with-temp-message"))) `(let ((,temp-message ,message) @@ -2765,7 +2766,7 @@ (kill-buffer ,temp-buffer))))))) (defmacro with-silent-modifications (&rest body) - "Execute BODY, pretending it does not modifies the buffer. + "Execute BODY, pretending it does not modify the buffer. If BODY performs real modifications to the buffer's text, other than cosmetic ones, undo data may become corrupted. Typically used around modifications of text-properties which do not really @@ -3227,7 +3228,7 @@ The syntax table of the current buffer is saved, BODY is evaluated, and the saved table is restored, even in case of an abnormal exit. Value is what BODY returns." - (declare (debug t)) + (declare (debug t) (indent 1)) (let ((old-table (make-symbol "table")) (old-buffer (make-symbol "buffer"))) `(let ((,old-table (syntax-table)) === modified file 'lisp/window.el' --- lisp/window.el 2010-08-29 16:17:13 +0000 +++ lisp/window.el 2010-08-30 13:03:05 +0000 @@ -55,6 +55,7 @@ its normal operation could make a different buffer current. The order of recently selected windows and the buffer list ordering are not altered by this macro (unless they are altered in BODY)." + (declare (indent 0) (debug t)) `(let ((save-selected-window-window (selected-window)) ;; It is necessary to save all of these, because calling ;; select-window changes frame-selected-window for whatever ------------------------------------------------------------ revno: 101220 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2010-08-30 14:47:49 +0200 message: * src/marker.c (Fcopy_marker): Make the first arg optional. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-08-30 00:32:29 +0000 +++ src/ChangeLog 2010-08-30 12:47:49 +0000 @@ -1,3 +1,7 @@ +2010-08-30 Stefan Monnier + + * marker.c (Fcopy_marker): Make the first arg optional. + 2010-08-30 Kenichi Handa * composite.c (composition_update_it): Fix computing of === modified file 'src/marker.c' --- src/marker.c 2010-07-08 21:25:08 +0000 +++ src/marker.c 2010-08-30 12:47:49 +0000 @@ -806,16 +806,18 @@ return i; } -DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 2, 0, +DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 0, 2, 0, doc: /* Return a new marker pointing at the same place as MARKER. If argument is a number, makes a new marker pointing at that position in the current buffer. +If MARKER is not specified, the new marker does not point anywhere. The optional argument TYPE specifies the insertion type of the new marker; see `marker-insertion-type'. */) (register Lisp_Object marker, Lisp_Object type) { register Lisp_Object new; + if (!NILP (marker)) CHECK_TYPE (INTEGERP (marker) || MARKERP (marker), Qinteger_or_marker_p, marker); new = Fmake_marker (); ------------------------------------------------------------ revno: 101219 committer: Katsumi Yamaoka branch nick: trunk timestamp: Mon 2010-08-30 06:44:58 +0000 message: gnus.texi (Drafts): Mention B DEL by Lars Magne Ingebrigtsen . 2010-08-29 Lars Magne Ingebrigtsen * gnus.texi (Drafts): Mention B DEL. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2010-08-30 06:40:00 +0000 +++ doc/misc/ChangeLog 2010-08-30 06:44:58 +0000 @@ -1,3 +1,7 @@ +2010-08-29 Lars Magne Ingebrigtsen + + * gnus.texi (Drafts): Mention B DEL. + 2010-08-29 Tim Landscheidt (tiny change) * gnus.texi (Delayed Articles): Mention that the Date header is the === modified file 'doc/misc/gnus.texi' --- doc/misc/gnus.texi 2010-08-30 06:40:00 +0000 +++ doc/misc/gnus.texi 2010-08-30 06:44:58 +0000 @@ -13623,6 +13623,9 @@ @kbd{D t} (@code{gnus-draft-toggle-sending}) command to mark the message as unsendable. This is a toggling command. +Finally, if you want to delete a draft, use the normal @kbd{B DEL} +command (@pxref{Mail Group Commands}). + @node Rejected Articles @section Rejected Articles ------------------------------------------------------------ Use --include-merges or -n0 to see merged revisions.