included commits to RCS files with non-trunk default branches.
| sparc-* | ns32k-* | fx80-* | arm-* | c[123]* \
| mips-* | pyramid-* | tron-* | a29k-* | romp-* | rs6000-* | power-* \
| none-* | 580-* | cray2-* | h8300-* | i960-* | xmp-* | ymp-* \
- | hppa1.0-* | hppa1.1-* | alpha-* | we32k-* | cydra-* | ns16k-* \
+ | hppa1.0-* | hppa1.1-* | alpha*-* | we32k-* | cydra-* | ns16k-* \
| pn-* | np1-* | xps100-* | clipper-* | orion-* | sparclite-* \
| pdp11-* | sh-* | powerpc-* | powerpcle-* | sparc64-* | mips64-* | mipsel-* \
| mips64el-* | mips64orion-* | mips64orionel-* | mab-*)
.B \-eval
options to specify files to execute and functions to call.
.TP
-.B \-nw\
+.B \-nw
Inhibit the use of any window-system-specific display code: use the
current TTY.
.TP
+1998-10-15 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 21.2-beta3 is released.
+
+1998-10-12 SL Baur <steve@altair.xemacs.org>
+
+ * lib-src/gnudepend.pl: Use /usr/bin/perl.
+ * Makefile.in.in (INSTALLABLE_SCRIPTS): Remove send-pr, install-sid.
+ (GEN_SCRIPTS): Ditto.
+ Delete TM_SCRIPTS.
+
+1998-10-11 SL Baur <steve@altair.xemacs.org>
+
+ * tm-au:
+ * tm-file:
+ * tm-html:
+ * tm-image:
+ * tm-mpeg:
+ * tm-plain:
+ * tm-ps:
+ * tmdecode: packaged.
+
+1998-10-10 SL Baur <steve@altair.xemacs.org>
+
+ * install-sid:
+ * send-pr: Packaged
+
+1998-10-01 Jan Vroonhof <vroonhof@math.ethz.ch>
+
+ * gnuclient.c (filename_expand): Don't forget to copy the
+ filename under UNIX.
+
1998-09-29 SL Baur <steve@altair.xemacs.org>
* XEmacs 21.2-beta2 is released.
## Things that a user might actually run,
## which should be installed in bindir.
INSTALLABLES_BASE = etags ctags b2m gnuclient ootags
-INSTALLABLE_SCRIPTS = rcs-checkin pstogif install-sid send-pr gnudoit gnuattach
+INSTALLABLE_SCRIPTS = rcs-checkin pstogif gnudoit gnuattach
#ifdef HAVE_MS_WINDOWS
INSTALLABLES = $(INSTALLABLES_BASE) runemacs
#else
## Like UTILITIES, but they are not system-dependent, and should not be
## deleted by the distclean target.
-GEN_SCRIPTS = rcs2log vcdiff gzip-el.sh install-sid send-pr
-TM_SCRIPTS = tm-au tm-file tm-html tm-image tm-mpeg tm-plain tm-ps tmdecode
+GEN_SCRIPTS = rcs2log vcdiff gzip-el.sh
PKG_SCRIPTS = add-big-package.sh
-SCRIPTS = $(GEN_SCRIPTS) $(TM_SCRIPTS) $(PKG_SCRIPTS)
+SCRIPTS = $(GEN_SCRIPTS) $(PKG_SCRIPTS)
EXECUTABLES= ${UTILITIES} ${INSTALLABLES} ${SCRIPTS} ${INSTALLABLE_SCRIPTS}
; /* yep */
else
strcat (fullpath, "/"); /* nope, append trailing slash */
+ /* Don't forget to add the filename! */
+ strcat (fullpath,filename);
}
} /* filename_expand */
-#!/usr/local/bin/perl
+#!/usr/bin/perl
while (<>)
{
\f
;;; Preparations to be done at load time
-(defvar auto-save-directory-fallback (expand-file-name "~/.autosave/")
+;; Do not call expand-file-name! This is evaluated at dump time now!
+(defvar auto-save-directory-fallback "~/.autosave/"
;; not user-variable-p, see above
"Directory used for local autosaving of remote files if
both `auto-save-directory' and `efs-auto-save-remotely' are nil.
auto-save-directory-fallback))
"If non-nil, directory used for hashed autosave filenames.")
-(defun auto-save-check-directory (var)
- (let ((dir (symbol-value var)))
- (if (null dir)
- nil
- ;; Expand and store back into the variable
- (set var (setq dir (expand-file-name dir)))
+(defun auto-save-checked-directory (dir)
+ "Make sure the directory DIR exists and return it expanded if non-nil."
+ (when dir
+ (setq dir (expand-file-name dir))
;; Make sure directory exists
- (if (file-directory-p dir)
- nil
+ (unless (file-directory-p dir)
;; Else we create and chmod 0700 the directory
(setq dir (directory-file-name dir)) ; some systems need this
(make-directory dir)
- (set-file-modes dir #o700)))))
+ (set-file-modes dir #o700))
+ dir))
-(mapc #'auto-save-check-directory
- '(auto-save-directory auto-save-directory-fallback))
+;; This make no sense at dump time
+;; (mapc #'auto-save-check-directory
+; '(auto-save-directory auto-save-directory-fallback))
-(and auto-save-hash-p
- (auto-save-check-directory 'auto-save-hash-directory))
+;(and auto-save-hash-p
+; (auto-save-check-directory 'auto-save-hash-directory))
\f
;;; Computing an autosave name for a file and vice versa
(string-match "^#%" basename))
nil)
;; now we know it looks like #...# thus substring is safe to use
- ((or (equal savedir auto-save-directory) ; 2nd arg may be nil
- (equal savedir auto-save-directory-fallback))
+ ((or (equal savedir
+ (and auto-save-directory
+ (expand-file-name auto-save-directory)))
+ ; 2nd arg may be nil
+ (equal savedir
+ (expand-file-name auto-save-directory-fallback)))
;; it is of the `-fixed-directory' type
(auto-save-slashify-name (substring basename 1 -1)))
(t
auto-save-hash-directory
(> (length base-name) 14))
(expand-file-name (auto-save-cyclic-hash-14 filename)
- auto-save-hash-directory)
+ (auto-save-checked-directory auto-save-hash-directory))
(expand-file-name base-name
- (or auto-save-directory
- auto-save-directory-fallback)))))
+ (auto-save-checked-directory
+ (or auto-save-directory
+ auto-save-directory-fallback))))))
(defun auto-save-name-in-same-directory (filename &optional prefix)
;; Enclose the non-directory part of FILENAME in `#' to make an auto
(let ((directory (file-name-directory filename)))
(or (null directory)
(file-writable-p directory)
- (setq directory auto-save-directory-fallback))
+ (setq directory (auto-save-checked-directory
+ auto-save-directory-fallback)))
(concat directory ; (concat nil) is ""
(or prefix "#")
(file-name-nondirectory filename)
file ; its original file
(total 0) ; # of files offered to recover
(count 0)) ; # of files actually recovered
- (or (equal auto-save-directory auto-save-directory-fallback)
+ (or (equal (expand-file-name auto-save-directory)
+ (expand-file-name auto-save-directory-fallback))
(setq savefiles
(nconc savefiles
(directory-files auto-save-directory-fallback
syn-tab exact-syntax-table)
(setq tag-target tagname
syn-tab normal-syntax-table))
- (with-caps-disable-folding tag-target
+ (with-search-caps-disable-folding tag-target t
(while tag-tables
(set-buffer (get-tag-table-buffer (car tag-tables)))
(bury-buffer (current-buffer))
See documentation of variable `tag-table-alist'."
(interactive "sTags search (regexp): ")
(if (and (equal regexp "")
- (eq (car tags-loop-scan) 'with-caps-disable-folding)
+ (eq (car tags-loop-scan) 'with-search-caps-disable-folding)
(null tags-loop-operate))
;; Continue last tags-search as if by `M-,'.
(tags-loop-continue nil)
- (setq tags-loop-scan `(with-caps-disable-folding ,regexp
+ (setq tags-loop-scan `(with-search-caps-disable-folding ,regexp t
(re-search-forward ,regexp nil t))
tags-loop-operate nil)
(tags-loop-continue (or file-list-form t))))
See documentation of variable `tag-table-alist'."
(interactive
"sTags query replace (regexp): \nsTags query replace %s by: \nP")
- (setq tags-loop-scan `(with-caps-disable-folding ,from
+ (setq tags-loop-scan `(with-search-caps-disable-folding ,from t
(if (re-search-forward ,from nil t)
;; When we find a match, move back
;; to the beginning of it so perform-replace
(while pairs
(puthash (pop pairs) (pop pairs) keyboard-translate-table)))
-(put 'backspace 'ascii-character ?\b)
-(put 'delete 'ascii-character ?\177)
(put 'tab 'ascii-character ?\t)
(put 'linefeed 'ascii-character ?\n)
(put 'clear 'ascii-character 12)
;; contain none or when it has become older than info files in the same
;; directory.
+;; Modified 1998-09-23 by Didier Verna <verna@inf.enst.fr>
+;;
+;; Use the new macro `with-search-caps-disable-folding'
+
;; Code:
(defgroup info nil
(if (equal regexp "")
(setq regexp Info-last-search)
(setq Info-last-search regexp))
- (with-caps-disable-folding regexp
+ (with-search-caps-disable-folding regexp t
(let ((found ())
(onode Info-current-node)
(ofile Info-current-file)
:type 'integer
:group 'isearch)
-(defcustom search-caps-disable-folding t
- "*If non-nil, upper case chars disable case fold searching.
-This does not apply to \"yanked\" strings."
- :type 'boolean
- :group 'isearch)
-
(defcustom search-nonincremental-instead t
"*If non-nil, do a nonincremental search instead if exiting immediately."
:type 'boolean
(cons isearch-string regexp-search-ring)
regexp-search-ring-yank-pointer regexp-search-ring)
(if (> (length regexp-search-ring) regexp-search-ring-max)
- (setcdr (nthcdr (1- search-ring-max) regexp-search-ring)
+ (setcdr (nthcdr (1- regexp-search-ring-max) regexp-search-ring)
nil))))
(if (not (setq search-ring-yank-pointer
;; really need equal test instead of eq.
(defun isearch-fix-case ()
(if (and isearch-case-fold-search search-caps-disable-folding)
- (setq isearch-case-fold-search (isearch-no-upper-case-p isearch-string)))
+ (setq isearch-case-fold-search
+ (no-upper-case-p isearch-string isearch-regexp)))
(setq isearch-mode (if case-fold-search
(if isearch-case-fold-search
" Isearch" ;As God Intended Mode
; ;; Go ahead and search.
; (if search-caps-disable-folding
; (setq isearch-case-fold-search
-; (isearch-no-upper-case-p isearch-string)))
+; (no-upper-case-p isearch-string isearch-regexp)))
; (let ((case-fold-search isearch-case-fold-search))
; (funcall function isearch-string))))
-
(defun isearch-no-upper-case-p (string)
"Return t if there are no upper case chars in string.
But upper case chars preceded by \\ do not count since they
;; this incorrectly returns t for "\\\\A"
(let ((case-fold-search nil))
(not (string-match "\\(^\\|[^\\]\\)[A-Z]" string))))
+(make-obsolete 'isearch-no-upper-case-p 'no-upper-case-p)
;; Used by etags.el and info.el
(defmacro with-caps-disable-folding (string &rest body) "\
(isearch-no-upper-case-p ,string)
case-fold-search)))
,@body))
+(make-obsolete 'with-caps-disable-folding 'with-search-caps-disable-folding)
(put 'with-caps-disable-folding 'lisp-indent-function 1)
(put 'with-caps-disable-folding 'edebug-form-spec '(form body))
(let ((commentary (lm-commentary-mark))
(change-log (lm-history-mark))
(code (lm-code-mark))
- )
+ end)
(cond
((and commentary change-log)
(buffer-substring commentary change-log))
(buffer-substring commentary code))
(t
;; XEmacs change (Infodock headers? -sb)
- (setq commentary (lm-section-mark "DESCRIPTION" t)
- code (lm-section-mark "DESCRIP-END"))
- (and commentary end (buffer-substring commentary code)))))
+ (setq commentary (lm-section-mark "DESCRIPTION" t))
+ (setq end (lm-section-mark "DESCRIP-END"))
+ (and commentary end (buffer-substring commentary end)))))
(if file
(kill-buffer (current-buffer)))
)))
(mail nil
(if addr
(concat (car addr) " <" (cdr addr) ">")
- bug-gnu-emacs)
+ (or (and (boundp 'report-emacs-bug-beta-address)
+ report-emacs-bug-beta-address)
+ "<xemacs-beta@xemacs.org>"))
topic)
(goto-char (point-max))
(insert "\nIn "
["Saved..." customize-saved]
["Set..." customize-customized]
["Apropos..." customize-apropos]
- ["Browse..." customize-browse]
- ["List Packages" pui-list-packages]
- ["Update Packages" package-get-custom])
+ ["Browse..." customize-browse])
+
+ ("Manage Packages"
+ ["List & Install" pui-list-packages]
+ ("Using Custom"
+ ("Select" :filter (lambda (&rest junk)
+ (cdr (custom-menu-create 'packages))))
+ ["Update" package-get-custom])
+ ["Help" (Info-goto-node "(xemacs)Packages")])
+
+ "---"
+
("Editing Options"
["Overstrike"
(progn
;; Decide what will be the SYMBOLP argument to
;; default-mouse-track-{beginning,end}-of-word, according to the
;; syntax of the current character and value of mouse-highlight-text.
-(defsubst default-mouse-symbolp (syntax)
+(defsubst default-mouse-track-symbolp (syntax)
(cond ((eq mouse-highlight-text 'context)
(eq syntax ?_))
((eq mouse-highlight-text 'symbol)
(t
nil)))
+;; Return t if point is at an opening quote character. This is
+;; determined by testing whether the syntax of the following character
+;; is `string', which will always be true for opening quotes and
+;; always false for closing quotes.
+(defun default-mouse-track-point-at-opening-quote-p ()
+ (save-excursion
+ (forward-char 1)
+ (eq (buffer-syntactic-context) 'string)))
+
(defun default-mouse-track-normalize-point (type forwardp)
(cond ((eq type 'word)
;; trap the beginning and end of buffer errors
(ignore-errors
(setq type (char-syntax (char-after (point))))
(if forwardp
- (if (= type ?\()
+ (if (or (= type ?\()
+ (and (= type ?\")
+ (default-mouse-track-point-at-opening-quote-p)))
(goto-char (scan-sexps (point) 1))
- (if (= type ?\))
- (forward-char 1)
- (default-mouse-track-end-of-word
- (default-mouse-symbolp type))))
- (if (= type ?\))
+ (default-mouse-track-end-of-word
+ (default-mouse-track-symbolp type)))
+ (if (or (= type ?\))
+ (and (= type ?\")
+ (not (default-mouse-track-point-at-opening-quote-p))))
(goto-char (scan-sexps (1+ (point)) -1))
(default-mouse-track-beginning-of-word
- (default-mouse-symbolp type))))))
+ (default-mouse-track-symbolp type))))))
((eq type 'line)
(if forwardp (end-of-line) (beginning-of-line)))
((eq type 'buffer)
; ;; rest of command line follows
; package-admin-xemacs file pkg-dir))
-(defun package-admin-get-install-dir (pkg-dir)
- (when (null pkg-dir)
- (when (or (not (listp late-packages))
- (not late-packages))
- (error "No package path"))
- (setq pkg-dir (car (last late-packages))))
- pkg-dir
- )
+(defun package-admin-get-install-dir (package pkg-dir &optional mule-related)
+ "If PKG-DIR is non-nil return that,
+else return the current location of the package if it is already installed
+or return a location appropriate for the package otherwise."
+ (if pkg-dir
+ pkg-dir
+ (let ((package-feature (intern-soft (concat
+ (symbol-name package) "-autoloads")))
+ autoload-dir)
+ (when (and (not (eq package 'unknown))
+ (featurep package-feature)
+ (setq autoload-dir (feature-file package-feature))
+ (setq autoload-dir (file-name-directory autoload-dir))
+ (member autoload-dir late-package-load-path))
+ ;; Find the corresonding entry in late-package
+ (setq pkg-dir
+ (car-safe (member-if (lambda (h)
+ (string-match (concat "^" (regexp-quote h))
+ autoload-dir))
+ late-packages))))
+ (if pkg-dir
+ pkg-dir
+ ;; Ok we need to guess
+ (if mule-related
+ (package-admin-get-install-dir 'mule-base nil nil)
+ (car (last late-packages)))))))
+
+
(defun package-admin-get-manifest-file (pkg-topdir package)
"Return the name of the MANIFEST file for package PACKAGE.
(status 1)
start err-list
)
- (setq pkg-dir (package-admin-get-install-dir pkg-dir))
+ (setq pkg-dir (package-admin-get-install-dir 'unknown pkg-dir))
;; Insure that the current directory doesn't change
(save-excursion
(set-buffer buf)
(defun package-admin-rmtree (directory)
"Delete a directory and all of its contents, recursively.
This is a feeble attempt at making a portable rmdir."
- (let ( (orig-default-directory default-directory) files dirs dir)
- (unwind-protect
- (progn
- (setq directory (file-name-as-directory directory))
- (setq files (directory-files directory nil nil nil t))
- (setq dirs (directory-files directory nil nil nil 'dirs))
- (while dirs
- (setq dir (car dirs))
- (if (file-symlink-p dir) ;; just in case, handle symlinks
- (delete-file dir)
- (if (not (or (string-equal dir ".") (string-equal dir "..")))
- (package-admin-rmtree (expand-file-name dir directory))))
- (setq dirs (cdr dirs))
- )
- (setq default-directory directory)
- (condition-case err
- (progn
- (while files
- (delete-file (car files))
- (setq files (cdr files))
- )
- (delete-directory directory)
- )
- (file-error
- (message "%s: %s: \"%s\"" (nth 1 err) (nth 2 err) (nth 3 err)))
- )
- )
- (progn
- (setq default-directory orig-default-directory)
- ))
- ))
+ (setq directory (file-name-as-directory directory))
+ (let ((files (directory-files directory nil nil nil t))
+ (dirs (directory-files directory nil nil nil 'dirs)))
+ (while dirs
+ (if (not (member (car dirs) '("." "..")))
+ (let ((dir (expand-file-name (car dirs) directory)))
+ (condition-case err
+ (if (file-symlink-p dir) ;; just in case, handle symlinks
+ (delete-file dir)
+ (package-admin-rmtree dir))
+ (file-error
+ (message "%s: %s: \"%s\"" (nth 1 err) (nth 2 err) (nth 3 err)))))
+ (setq dirs (cdr dirs))))
+ (while files
+ (condition-case err
+ (delete-file (expand-file-name (car files) directory))
+ (file-error
+ (message "%s: %s: \"%s\"" (nth 1 err) (nth 2 err) (nth 3 err))))
+ (setq files (cdr files)))
+ (condition-case err
+ (delete-directory directory)
+ (file-error
+ (message "%s: %s: \"%s\"" (nth 1 err) (nth 2 err) (nth 3 err))))))
(defun package-admin-get-lispdir (pkg-topdir package)
(let (package-lispdir)
"Delete a binary installation of PACKAGE below directory PKG-TOPDIR.
PACKAGE is a symbol, not a string."
(let ( (tmpbuf " *pkg-manifest*") manifest-file package-lispdir dirs file)
- (if (not pkg-topdir)
- (setq pkg-topdir (package-admin-get-install-dir nil)))
+ (setq pkg-topdir (package-admin-get-install-dir package pkg-topdir))
(setq manifest-file (package-admin-get-manifest-file pkg-topdir package))
(if (file-exists-p manifest-file)
(progn
(message "Removing old files for package \"%s\" ..." package)
(sit-for 0)
(setq tmpbuf (get-buffer-create tmpbuf))
- (save-excursion
- (set-buffer tmpbuf)
- (buffer-disable-undo tmpbuf)
- (erase-buffer tmpbuf)
+ (with-current-buffer tmpbuf
+ (buffer-disable-undo)
+ (erase-buffer)
(insert-file-contents manifest-file)
(goto-char (point-min))
+
;; For each entry in the MANIFEST ...
(while (< (point) (point-max))
(beginning-of-line)
(setq file (expand-file-name (buffer-substring
(point)
- (save-excursion (end-of-line)
- (point)))
+ (point-at-eol))
pkg-topdir))
(if (file-directory-p file)
;; Keep a record of each directory
(setq dirs (cons file dirs))
- (progn
;; Delete each file.
;; Make sure that the file is writable.
;; (This is important under MS Windows.)
- (set-file-modes file 438) ;; 438 -> #o666
- (delete-file file)
- ))
- (forward-line 1)
- )
+ ;; I do not know why it important under MS Windows but
+ ;; 1. It bombs out out when the file does not exist. This can be condition-cased
+ ;; 2. If I removed the write permissions, I do not want XEmacs to just ignore them.
+ ;; If it wants to, XEmacs may ask, but that is about all
+ ;; (set-file-modes file 438) ;; 438 -> #o666
+ ;; Note, user might have removed the file!
+ (condition-case ()
+ (delete-file file)
+ (error nil))) ;; We may want to turn the error into a Warning?
+ (forward-line 1))
+
;; Delete empty directories.
(if dirs
(let ( (orig-default-directory default-directory)
directory files file )
;; Make sure we preserve the existing `default-directory'.
+ ;; JV, why does this change the default directory? Does it indeed?
(unwind-protect
(progn
;; Warning: destructive sort!
(setq dirs (nreverse (sort dirs 'string<)))
- ;; For each directory ...
- (while dirs
- (setq directory (file-name-as-directory (car dirs)))
- (setq files (directory-files directory))
- ;; Delete the directory if it's empty.
- (if (catch 'done
- (while files
- (setq file (car files))
- (if (and (not (string= file "."))
- (not (string= file "..")))
- (throw 'done nil))
- (setq files (cdr files))
- )
- t)
- (delete-directory directory))
- (setq dirs (cdr dirs))
- )
- )
+; ;; For each directory ...
+; (while dirs
+; (setq directory (file-name-as-directory (car dirs)))
+; (setq files (directory-files directory))
+; ;; Delete the directory if it's empty.
+; (if (catch 'done
+; (while files
+; (setq file (car files))
+; (if (and (not (string= file "."))
+; (not (string= file "..")))
+; (throw 'done nil))
+; (setq files (cdr files))
+; )
+; t)
+; (
+; (delete-directory directory))
+; (setq dirs (cdr dirs))
+; )
+ ;; JV, On all OS's that I know of delete-directory fails on
+ ;; on non-empty dirs anyway
+ (mapc
+ (lambda (dir)
+ (condition-case ()
+ (delete-directory dir)))
+ dirs))
(setq default-directory orig-default-directory)
)))
)
(kill-buffer tmpbuf)
;; Delete the MANIFEST file
- (set-file-modes manifest-file 438) ;; 438 -> #o666
- (delete-file manifest-file)
- (message "Removing old files for package \"%s\" ... done" package)
- )
- (progn
+ ;; (set-file-modes manifest-file 438) ;; 438 -> #o666
+ ;; Note. Packages can have MANIFEST in MANIFEST.
+ (condition-case ()
+ (delete-file manifest-file)
+ (error nil)) ;; Do warning?
+ (message "Removing old files for package \"%s\" ... done" package))
;; The manifest file doesn't exist. Fallback to just deleting the
;; package-specific lisp directory, if it exists.
;;
;; Delete old lisp directory, if any
;; Gads, this is ugly. However, we're not supposed to use `concat'
;; in the name of portability.
- (if (setq package-lispdir (package-admin-get-lispdir pkg-topdir
+ (when (setq package-lispdir (package-admin-get-lispdir pkg-topdir
package))
- (progn
(message "Removing old lisp directory \"%s\" ..."
package-lispdir)
(sit-for 0)
(package-admin-rmtree package-lispdir)
(message "Removing old lisp directory \"%s\" ... done"
package-lispdir)
- ))
- ))
+ ))
;; Delete the package from the database of installed packages.
- (package-delete-name package)
- ))
+ (package-delete-name package)))
(provide 'package-admin)
;;; Code:
(require 'package-admin)
-(require 'package-get-base)
+;; (require 'package-get-base)
+(defgroup package-tools nil
+ "Tools to manipulate packages."
+ :group 'emacs)
+
+(defgroup package-get nil
+ "Automatic Package Fetcher and Installer."
+ :prefix "package-get"
+ :group 'package-tools)
+
(defvar package-get-base nil
"List of packages that are installed at this site.
For each element in the alist, car is the package name and the cdr is
be lexically ordered. It is debatable if it makes sense to have more than
one version of a package available.")
-(defvar package-get-dir (temp-directory)
- "*Where to store temporary files for staging.")
+(defcustom package-get-dir (temp-directory)
+ "*Where to store temporary files for staging."
+ :tag "Temporary directory"
+ :type 'directory
+ :group 'package-get)
-(defvar package-get-remote
+;; JV Any Custom expert know to get "Host" and "Dir" for the remote option
+(defcustom package-get-remote
'(("ftp.xemacs.org" "/pub/xemacs/packages"))
"*List of remote sites to contact for downloading packages.
List format is '(site-name directory-on-site). Each site is tried in
order until the package is found. As a special case, `site-name' can be
-`nil', in which case `directory-on-site' is treated as a local directory.")
+`nil', in which case `directory-on-site' is treated as a local directory."
+ :tag "Package repository"
+ :type '(repeat (choice (list :tag "Local" (const :tag "Local" nil) directory )
+ (list :tag "Remote" string string) ))
+ :group 'package-get)
-(defvar package-get-remove-copy nil
+(defcustom package-get-remove-copy nil
"*After copying and installing a package, if this is T, then remove the
-copy. Otherwise, keep it around.")
+copy. Otherwise, keep it around."
+ :type 'boolean
+ :group 'package-get)
+
+(defcustom package-get-base-filename
+ "/ftp.xemacs.org:/pub/xemacs/packages/package-index.LATEST"
+ "*Name of the default package database file, usually on ftp.xemacs.org."
+ :type 'file
+ :group 'package-get)
+
+;;;###autoload
+(defun package-get-require-base ()
+ "Require that a package-get database has been loaded."
+ (when (or (not (boundp 'package-get-base))
+ (not package-get-base))
+ (package-get-update-base))
+ (when (or (not (boundp 'package-get-base))
+ (not package-get-base))
+ (error "Package-get database not loaded")))
+
+(defconst package-get-pgp-signed-begin-line "^-----BEGIN PGP SIGNED MESSAGE-----"
+ "Text for start of PGP signed messages.")
+(defconst package-get-pgp-signature-begin-line "^-----BEGIN PGP SIGNATURE-----"
+ "Text for beginning of PGP signature.")
+(defconst package-get-pgp-signature-end-line "^-----END PGP SIGNATURE-----"
+ "Text for end of PGP signature.")
+
+;;;###autoload
+(defun package-get-update-base-entry (entry)
+ "Update an entry in `package-get-base'."
+ (let ((existing (assoc (car entry) package-get-base)))
+ (if existing
+ (setcdr existing (cdr entry))
+ (setq package-get-base (cons entry package-get-base)))))
+
+;;;###autoload
+(defun package-get-update-base (&optional db-file)
+ "Update the package-get database file with entries from DB-FILE."
+ (interactive (list
+ (read-file-name "Load package-get database: "
+ (file-name-directory package-get-base-filename)
+ package-get-base-filename
+ t
+ (file-name-nondirectory package-get-base-filename))))
+ (setq db-file (expand-file-name (or db-file package-get-base-filename)))
+ (if (not (file-exists-p db-file))
+ (error "Package-get database file `%s' does not exist" db-file))
+ (if (not (file-readable-p db-file))
+ (error "Package-get database file `%s' not readable" db-file))
+ (let ((buf (get-buffer-create "*package database*")))
+ (unwind-protect
+ (save-excursion
+ (set-buffer buf)
+ (erase-buffer buf)
+ (insert-file-contents-internal db-file)
+ (package-get-update-base-from-buffer buf))
+ (kill-buffer buf))))
+
+;;;###autoload
+(defun package-get-update-base-from-buffer (&optional buf)
+ "Update the package-get database with entries from BUFFER.
+BUFFER defaults to the current buffer. This command can be
+used interactively, for example from a mail or news buffer."
+ (interactive)
+ (setq buf (or buf (current-buffer)))
+ (let (content-beg content-end beg end)
+ (save-excursion
+ (set-buffer buf)
+ (goto-char (point-min))
+ (setq content-beg (point))
+ (setq content-end (save-excursion (goto-char (point-max)) (point)))
+ (when (re-search-forward package-get-pgp-signed-begin-line nil t)
+ (setq beg (match-beginning 0))
+ (setq content-beg (match-end 0)))
+ (when (re-search-forward package-get-pgp-signature-begin-line nil t)
+ (setq content-end (match-beginning 0)))
+ (when (re-search-forward package-get-pgp-signature-end-line nil t)
+ (setq end (point)))
+ (if (not (and content-beg content-end beg end))
+ (or (yes-or-no-p "Package-get entries not PGP signed, continue? ")
+ (error "Package-get database not updated")))
+ (if (and content-beg content-end beg end)
+ (if (not (condition-case nil
+ (or (fboundp 'mc-pgp-verify-region)
+ (load-library "mc-pgp")
+ (fboundp 'mc-pgp-verify-region))
+ (error nil)))
+ (or (yes-or-no-p
+ "No mailcrypt; can't verify package-get DB signature, continue? ")
+ (error "Package-get database not updated"))))
+ (if (and beg end
+ (fboundp 'mc-pgp-verify-region)
+ (or (not
+ (condition-case err
+ (mc-pgp-verify-region beg end)
+ (file-error
+ (and (string-match "No such file" (nth 2 err))
+ (yes-or-no-p
+ "Can't find PGP, continue without package-get DB verification? ")))
+ (t nil)))))
+ (error "Package-get PGP signature failed to verify"))
+ (package-get-update-base-entries content-beg content-end)
+ (message "Updated package-get database"))))
+
+(defun package-get-update-base-entries (beg end)
+ "Update the package-get database with the entries found between
+BEG and END in the current buffer."
+ (save-excursion
+ (goto-char beg)
+ (if (not (re-search-forward "^(package-get-update-base-entry" nil t))
+ (error "Buffer does not contain package-get database entries"))
+ (beginning-of-line)
+ (let ((count 0))
+ (while (and (< (point) end)
+ (re-search-forward "^(package-get-update-base-entry" nil t))
+ (beginning-of-line)
+ (let ((entry (read (current-buffer))))
+ (if (or (not (consp entry))
+ (not (eq (car entry) 'package-get-update-base-entry)))
+ (error "Invalid package-get database entry found"))
+ (package-get-update-base-entry
+ (car (cdr (car (cdr entry)))))
+ (setq count (1+ count))))
+ (message "Got %d package-get database entries" count))))
(defun package-get-interactive-package-query (get-version package-symbol)
"Perform interactive querying for package and optional version.
Query for a version if GET-VERSION is non-nil. Return package name as
a symbol instead of a string if PACKAGE-SYMBOL is non-nil.
The return value is suitable for direct passing to `interactive'."
+ (package-get-require-base)
(let ( (table (mapcar '(lambda (item)
(let ( (name (symbol-name (car item))) )
(cons name name)
(defun package-get-update-all ()
"Fetch and install the latest versions of all currently installed packages."
(interactive)
+ (package-get-require-base)
;; Load a fresh copy
(catch 'exit
(mapcar (lambda (pkg)
packages-package-list)))
;;;###autoload
-(defun package-get-all (package version &optional fetched-packages)
+(defun package-get-all (package version &optional fetched-packages install-dir)
"Fetch PACKAGE with VERSION and all other required packages.
Uses `package-get-base' to determine just what is required and what
package provides that functionality. If VERSION is nil, retrieves
latest version. Optional argument FETCHED-PACKAGES is used to keep
-track of packages already fetched.
+track of packages already fetched. Optional argument INSTALL-DIR,
+if non-nil, specifies the package directory where fetched packages
+should be installed.
Returns nil upon error."
(interactive (package-get-interactive-package-query t nil))
(catch 'exit
(setq version (package-get-info-prop this-package 'version))
(unless (package-get-installedp package version)
- (if (not (package-get package version))
+ (if (not (package-get package version nil install-dir))
(progn
(setq fetched-packages nil)
(throw 'exit nil))))
(car this-requires)))
(if (not (setq fetched-packages
(package-get-all reqd-name reqd-version
- fetched-packages)))
+ fetched-packages
+ install-dir)))
(throw 'exit nil)))
)
(setq this-requires (cdr this-requires)))
fetched-packages
))
+;;;###autoload
+(defun package-get-dependencies (packages)
+ "Compute dependencies for PACKAGES.
+Uses `package-get-base' to determine just what is required and what
+package provides that functionality. Returns the list of packages
+required by PACKAGES."
+ (package-get-require-base)
+ (let ((orig-packages packages)
+ dependencies provided)
+ (while packages
+ (let* ((package (car packages))
+ (the-package (package-get-info-find-package
+ package-get-base package))
+ (this-package (package-get-info-version
+ the-package nil))
+ (this-requires (package-get-info-prop this-package 'requires))
+ (new-depends (set-difference
+ (mapcar
+ #'(lambda (reqd)
+ (let* ((reqd-package (package-get-package-provider reqd))
+ (reqd-version (cadr reqd-package))
+ (reqd-name (car reqd-package)))
+ (if (null reqd-name)
+ (error "Unable to find a provider for %s" reqd))
+ reqd-name))
+ this-requires)
+ dependencies))
+ (this-provides (package-get-info-prop this-package 'provides)))
+ (setq dependencies
+ (union dependencies new-depends))
+ (setq provided
+ (union provided (union (list package) this-provides)))
+ (setq packages
+ (union new-depends (cdr packages)))))
+ (set-difference dependencies orig-packages)))
+
(defun package-get-load-package-file (lispdir file)
(let (pathname)
(setq pathname (expand-file-name file lispdir))
(package-get-info-version
(package-get-info-find-package package-get-base
package) version))
+ (this-requires (package-get-info-prop this-package 'requires))
(found nil)
(search-dirs package-get-remote)
(base-filename (package-get-info-prop this-package 'filename))
(if (null base-filename)
(error "No filename associated with package %s, version %s"
package version))
- (if (null install-dir)
- (setq install-dir (package-admin-get-install-dir nil)))
+ (setq install-dir
+ (package-admin-get-install-dir package install-dir
+ (or (eq package 'mule-base) (memq 'mule-base this-requires))))
;; Contrive a list of possible package filenames.
;; Ugly. Is there a better way to do this?
consp, then it must match a corresponding (provide (SYM VERSION)) from
the package."
(interactive "SSymbol: ")
+ (package-get-require-base)
(let ((packages package-get-base)
(done nil)
(found nil))
(defun package-get-custom ()
"Fetch and install the latest versions of all customized packages."
(interactive)
+ (package-get-require-base)
;; Load a fresh copy
(load "package-get-custom.el")
(mapcar (lambda (pkg)
(provide 'package-get)
;; potentially update the custom dependencies every time we load this
+(when nil ;; #### disable for now... -gk
+(unless noninteractive
(let ((custom-file (package-get-file-installed-p "package-get-custom.el"))
(package-file (package-get-file-installed-p "package-get-base.el")))
;; update custom file if it doesn't exist
(set-buffer (package-get-create-custom))
(save-buffer)
(message "generating package customizations...done")))
- (load "package-get-custom.el"))
+ (load "package-get-custom.el")))
+)
;;; package-get.el ends here
;; User-changeable variables:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar pui-up-to-date-package-face nil
- "The face to use for packages that are up-to-date.")
+(defgroup pui nil
+ "Conventient interface to the package system."
+ :group 'package-tools
+ :tag "Package User interface"
+ :prefix "pui-")
+
+(defcustom pui-package-install-dest-dir nil
+ "*If non-nil (Automatic) path to package tree to install packages in.
+Otherwise, use old path for installed packages and make a guess for
+new ones."
+ :group 'pui
+ :tag "Install Location"
+ :type '(choice (const :tag "Automatic" nil)
+ (directory)))
+
+(defcustom pui-list-verbose t
+ "*If non-nil, display verbose info in the package list buffer."
+ :group 'pui
+ :tag "Verbose Listing"
+ :type 'boolean)
+
+(defcustom pui-up-to-date-package-face nil
+ "*The face to use for packages that are up-to-date."
+ :group 'pui
+ :type 'face)
+
+(defcustom pui-selected-package-face 'bold
+ "*The face to use for selected packages.
+Set this to `nil' to use the `default' face."
+ :group 'pui
+ :type 'face)
+
+(defcustom pui-outdated-package-face 'red
+ "*The face to use for outdated packages.
+Set this to `nil' to use the `default' face."
+ :group 'pui
+ :type 'face)
+
+(defcustom pui-uninstalled-package-face 'italic
+ "*The face to use for uninstalled packages.
+Set this to `nil' to use the `default' face."
+ :group 'pui
+ :type 'face)
+
-(defvar pui-selected-package-face (get-face 'bold)
- "The face to use for selected packages.
-Set this to `nil' to use the `default' face.")
-(defvar pui-outdated-package-face (get-face 'red)
- "The face to use for outdated packages.
-Set this to `nil' to use the `default' face.")
-
-(defvar pui-uninstalled-package-face (get-face 'italic)
- "The face to use for uninstalled packages.
-Set this to `nil' to use the `default' face.")
-
-(defvar pui-list-verbose t
- "If non-nil, display verbose info in the package list buffer.")
(defvar pui-info-buffer "*Packages*"
"Buffer to use for displaying package information.")
(define-key m [return] 'pui-toggle-package-key)
(define-key m "x" 'pui-install-selected-packages)
(define-key m "I" 'pui-install-selected-packages)
+ (define-key m "r" 'pui-add-required-packages)
(define-key m "n" 'next-line)
(define-key m "+" 'next-line)
(define-key m "p" 'previous-line)
(let ((m (make-sparse-keymap)))
(set-keymap-name m 'pui-package-keymap)
(define-key m 'button2 'pui-toggle-package-event)
- (define-key m 'button3 'pui-toggle-package-event)
+;; We use a popup menu
+;; (define-key m 'button3 'pui-toggle-package-event)
m)
"Keymap to use over package names/descriptions.")
(progn
(setq disp (pui-package-symbol-char pkg-sym version))
(setq sym-char (car disp))
- (if (cdr disp)
- (set-extent-face extent (car (cdr disp)))
+ (if (car (cdr disp))
+ (set-extent-face extent (get-face (car (cdr disp))))
(set-extent-face extent (get-face 'default)))
))
(save-excursion
(message "Installing selected packages ...") (sit-for 0)
(if (catch 'done
(mapcar (lambda (pkg)
- (if (not (package-get-all pkg nil))
+ (if (not (package-get pkg
+ pui-package-install-dest-dir))
(throw 'done nil)))
pui-selected-packages)
t)
(error "No packages have been selected!"))
))
+(defun pui-add-required-packages ()
+ "Select packages required by those already selected for installation."
+ (interactive)
+ (let ((tmpbuf "*Required-Packages*") do-select)
+ (if pui-selected-packages
+ (let ((dependencies (package-get-dependencies pui-selected-packages)))
+ ;; Don't change window config when asking the user if he really
+ ;; wants to add the packages. We do this to avoid messing up
+ ;; the window configuration if errors occur (we don't want to
+ ;; display random buffers in addition to the error buffer, if
+ ;; errors occur, which would normally be caused by display-buffer).
+ (save-window-excursion
+ (with-output-to-temp-buffer tmpbuf
+ (display-completion-list (sort
+ (mapcar #'(lambda (pkg)
+ (symbol-name pkg))
+ dependencies)
+ 'string<)
+ :activate-callback nil
+ :help-string "Required packages:\n"
+ :completion-string t))
+ (setq tmpbuf (get-buffer-create tmpbuf))
+ (display-buffer tmpbuf)
+ (setq do-select (y-or-n-p "Select these packages? "))
+ (kill-buffer tmpbuf))
+ (if do-select
+ (progn
+ (setq pui-selected-packages
+ (union pui-selected-packages dependencies))
+ (map-extents #'(lambda (extent maparg)
+ (pui-update-package-display extent))
+ nil nil nil nil nil 'pui)
+ (message "added dependencies"))
+ (clear-message)))
+ (error "No packages have been selected!"))))
+
(defun pui-help-echo (extent &optional force-update)
"Display additional package info in the modeline.
EXTENT determines the package to display (the package information is
Useful keys:
`\\[pui-toggle-package-key]' to select/unselect the current package for installation.
+ `\\[pui-add-required-packages]' to add any packages required by those selected.
`\\[pui-install-selected-packages]' to install selected packages.
`\\[pui-display-info]' to display additional information about the package in the modeline.
`\\[pui-list-packages]' to refresh the package list.
")
))
+(defvar pui-menu
+ '("Packages"
+ ["Select" pui-toggle-package-key t]
+ ["Info" pui-display-info t]
+ "---"
+ ["Add Required" pui-add-required-packages t]
+ ["Install Selected" pui-install-selected-packages t]
+ "---"
+ ["Verbose" pui-toggle-verbosity-redisplay
+ :active t :style toggle :selected pui-list-verbose]
+ ["Refresh" pui-list-packages t]
+ ["Help" pui-help t]
+ ["Quit" pui-quit t]))
+
+
;;;###autoload
(defun pui-list-packages ()
"List all packages and package information.
which are out-of-date (a newer version is available). The user can then
select packages for installation via the keyboard or mouse."
(interactive)
+ (package-get-require-base)
(let ( (outbuf (get-buffer-create pui-info-buffer))
(sep-string "===============================================================================\n")
start )
(point)))
)
(setq extent (make-extent b e))
- (if (cdr disp)
- (set-extent-face extent (car (cdr disp)))
+ (if (car (cdr disp))
+ (set-extent-face extent (get-face (car (cdr disp))))
(set-extent-face extent (get-face 'default)))
(set-extent-property extent 'highlight t)
(set-extent-property extent 'pui t)
(delete-other-windows)
(goto-char start)
(setq pui-selected-packages nil) ; Reset list
+ (when (featurep 'menubar)
+ (set-buffer-menubar current-menubar)
+ (add-submenu '() pui-menu)
+ (setq mode-popup-menu pui-menu))
(clear-message)
; (message (substitute-command-keys "Press `\\[pui-help]' for help."))
))
+
(provide 'package-ui)
;;; package-ui.el ends here
;; XEmacs addition
(qr-case-fold-search
(if (and case-fold-search search-caps-disable-folding)
- (isearch-no-upper-case-p search-string)
+ (no-upper-case-p search-string regexp-flag)
case-fold-search))
(message
(if query-flag
:group 'minibuffer)
+(defcustom search-caps-disable-folding t
+ "*If non-nil, upper case chars disable case fold searching.
+This does not apply to \"yanked\" strings."
+ :type 'boolean
+ :group 'editing-basics)
+
+;; This is stolen (and slightly modified) from FSF emacs's
+;; `isearch-no-upper-case-p'.
+(defun no-upper-case-p (string &optional regexp-flag)
+ "Return t if there are no upper case chars in STRING.
+If REGEXP-FLAG is non-nil, disregard letters preceded by `\\' (but not `\\\\')
+since they have special meaning in a regexp."
+ (let ((case-fold-search nil))
+ (not (string-match (if regexp-flag
+ "\\(^\\|\\\\\\\\\\|[^\\]\\)[A-Z]"
+ "[A-Z]")
+ string))
+ ))
+
+(defmacro with-search-caps-disable-folding (string regexp-flag &rest body) "\
+Eval BODY with `case-fold-search' let to nil if `search-caps-disable-folding'
+is non-nil, and if STRING (either a string or a regular expression according
+to REGEXP-FLAG) contains uppercase letters."
+ `(let ((case-fold-search
+ (if (and case-fold-search search-caps-disable-folding)
+ (no-upper-case-p ,string ,regexp-flag)
+ case-fold-search)))
+ ,@body))
+(put 'with-search-caps-disable-folding 'lisp-indent-function 2)
+(put 'with-search-caps-disable-folding 'edebug-form-spec
+ '(sexp sexp &rest form))
+
+(defmacro with-interactive-search-caps-disable-folding (string regexp-flag
+ &rest body)
+ "Same as `with-search-caps-disable-folding', but only in the case of a
+function called interactively."
+ `(let ((case-fold-search
+ (if (and (interactive-p)
+ case-fold-search search-caps-disable-folding)
+ (no-upper-case-p ,string ,regexp-flag)
+ case-fold-search)))
+ ,@body))
+(put 'with-interactive-search-caps-disable-folding 'lisp-indent-function 2)
+(put 'with-interactive-search-caps-disable-folding 'edebug-form-spec
+ '(sexp sexp &rest form))
+
(defun newline (&optional arg)
"Insert a newline, and move to left margin of the new line if it's blank.
The newline is marked with the text-property `hard'.
"Kill up to and including ARG'th occurrence of CHAR.
Goes backward if ARG is negative; error if CHAR not found."
(interactive "*p\ncZap to char: ")
- (kill-region (point) (progn
+ (kill-region (point) (with-interactive-search-caps-disable-folding
+ (char-to-string char) nil
(search-forward (char-to-string char) nil nil arg)
-; (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
(point))))
(defun zap-up-to-char (arg char)
"Kill up to ARG'th occurrence of CHAR.
Goes backward if ARG is negative; error if CHAR not found."
(interactive "*p\ncZap up to char: ")
- (kill-region (point) (progn
- (search-forward (char-to-string char) nil nil arg)
- (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
- (point))))
+ (kill-region (point) (with-interactive-search-caps-disable-folding
+ (char-to-string char) nil
+ (search-forward (char-to-string char) nil nil arg)
+ (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
+ (point))))
(defun beginning-of-buffer (&optional arg)
"Move point to the beginning of the buffer; leave mark at previous position.
(signal 'error '("couldn't parse font name for default face")))
(when weight
(signal 'error '("Setting weight currently not supported")))
-; (setq new-default-face-font
-; (font-menu-load-font (or family from-family)
-; (or weight from-weight)
-; (or size from-size)
-; from-slant
-; font-menu-preferred-resolution))
+ (setq new-default-face-font
+ (font-menu-load-font (or family from-family)
+ (or weight from-weight)
+ (or size from-size)
+ from-slant
+ font-menu-preferred-resolution))
(dolist (face (delq 'default (face-list)))
(when (face-font-instance face)
(message "Changing font of `%s'..." face)
(sit-for 1)))))
;; Set the default face's font after hacking the other faces, so that
;; the frame size doesn't change until we are all done.
-
- (when (and family (not (equal family from-family)))
- (setq new-props (append (list :family family) new-props)))
- (when (and size (not (equal size from-size)))
- (setq new-props (append (list :size (concat (int-to-string
- (/ size 10)) "pt")) new-props)))
- (custom-set-face-update-spec 'default '((type x)) new-props)
- ;;; WMP - we need to honor font-menu-this-frame-only-p here!
-; (set-face-font 'default new-default-face-font
-; (and font-menu-this-frame-only-p (selected-frame)))
- (message "Font %s" (face-font-name 'default))))
+
+ ;; If we need to be frame local we do the changes ourselves.
+ (if font-menu-this-frame-only-p
+ ;;; WMP - we need to honor font-menu-this-frame-only-p here!
+ (set-face-font 'default new-default-face-font
+ (and font-menu-this-frame-only-p (selected-frame)))
+ ;; OK Let Customize do it.
+ (when (and family (not (equal family from-family)))
+ (setq new-props (append (list :family family) new-props)))
+ (when (and size (not (equal size from-size)))
+ (setq new-props (append
+ (list :size (concat (int-to-string (/ size 10)) "pt")) new-props)))
+ (custom-set-face-update-spec 'default '((type x)) new-props)
+ (message "Font %s" (face-font-name 'default)))))
(defun font-menu-change-face (face
+1998-10-15 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 21.2-beta3 is released.
+
+1998-10-09 SL Baur <steve@altair.xemacs.org>
+
+ * Makefile (MAKEINFO): Undo no-split change.
+
1998-09-29 SL Baur <steve@altair.xemacs.org>
* XEmacs 21.2-beta2 is released.
access it via the menus:
@example
- Options->Customize->List Packages
+ Options->Manage Packages->List & Install
@end example
Or, you can get to it via the keyboard:
If you're going to install over the network, you only have to insure
that EFS @ref{(EFS)} works, and that it can get outside a firewall, if
you happen to be behind one. You shouldn't have to do anything else;
-XEmacs already knows where to go.
+XEmacs already knows where to go. However you can add your own mirrors
+to this list. See @code{package-get-remote}.
The easiest way to install a package is to use the visual package
browser and installer, using the menu pick:
@example
- Options->Customize->List Packages
+ Options->Manage Packages->List & Install
+@end example
+or
+@example
+ Options->Manage Packages->Using Custom->Select-> ...
@end example
You can also access it using the keyboard:
installed and is up-to-date.
From here, you can select or unselect packages for installation using
-the @key{RET} key, or using the @kbd{Mouse-2} or @kbd{Mouse-3} buttons.
-Once you've finished selecting the packages, you can press the @kbd{x}
-key to actually install the packages. Note that you will have to
-restart XEmacs for XEmacs to recognize any new packages.
+the @key{RET} key, the @kbd{Mouse-2} button or selecting "Select" from
+the (Popup) Menu.
+Once you've finished selecting the packages, you can
+press the @kbd{x} key (or use the menu) to actually install the
+packages. Note that you will have to restart XEmacs for XEmacs to
+recognize any new packages.
Key summary:
Display simple help.
@item @key{RET}
@itemx @key{Mouse-2}
-@itemx @key{Mouse-3}
Toggle between selecting and unselecting a package for installation.
@item x
Install selected packages.
@example
Options->Customize->Emacs->Packages-> ...
@end example
+or
+@example
+ Options->Manage Packages->Using Custom->Select-> ...
+@end example
Set their state to on, and then do:
@example
- Options->Customize->Update Packages
+ Options->Manage Packages->Using Custom->Update Packages
@end example
This will automatically retrieve the packages you have selected from the
+1998-10-15 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 21.2-beta3 is released.
+
1998-09-29 SL Baur <steve@altair.xemacs.org>
* XEmacs 21.2-beta2 is released.
environ = env;
execvp (new_argv[0], new_argv);
- stdout_out ("Cant't exec program %s\n", new_argv[0]);
+ stdout_out ("Can't exec program %s\n", new_argv[0]);
_exit (1);
#endif /* not WINDOWSNT */
}
Vdragdrop_protocols = Qnil;
-#ifdef HAVE_MSWINDOWS
+#ifdef HAVE_MS_WINDOWS
Vdragdrop_protocols = Fcons ( Qmswindows , Vdragdrop_protocols );
#endif
#ifdef HAVE_CDE
x_delete_frame (struct frame *f)
{
Widget w = FRAME_X_SHELL_WIDGET (f);
+ Display *dpy = XtDisplay (w);
#ifndef HAVE_SESSION
if (FRAME_X_TOP_LEVEL_FRAME_P (f))
#endif /* HAVE_SESSION */
#ifdef EXTERNAL_WIDGET
- {
- Display *dpy = XtDisplay (w);
- expect_x_error (dpy);
- /* for obscure reasons having (I think) to do with the internal
- window-to-widget hierarchy maintained by Xt, we have to call
- XtUnrealizeWidget() here. Xt can really suck. */
- if (f->being_deleted)
- XtUnrealizeWidget (w);
- XtDestroyWidget (w);
- x_error_occurred_p (dpy);
- }
+ expect_x_error (dpy);
+ /* for obscure reasons having (I think) to do with the internal
+ window-to-widget hierarchy maintained by Xt, we have to call
+ XtUnrealizeWidget() here. Xt can really suck. */
+ if (f->being_deleted)
+ XtUnrealizeWidget (w);
+ XtDestroyWidget (w);
+ x_error_occurred_p (dpy);
#else
XtDestroyWidget (w);
- XFlush (XtDisplay(w)); /* make sure the windows are really gone! */
+ XFlush (dpy); /* make sure the windows are really gone! */
#endif /* EXTERNAL_WIDGET */
if (FRAME_X_GEOM_FREE_ME_PLEASE (f))
# define TEXT_START 0x120000000
# define DATA_START 0x140000000
/* The program to be used for unexec. */
-# define UNEXEC unexalpha.o
+# define UNEXEC "unexalpha.o"
#endif
#endif /* not emacs */
+#include <stddef.h>
+
/* Define getpagesize () if the system does not. */
#include "getpagesize.h"
* correct error facilities.
* 4/11/94, rjc Added wait_for_sounds to be called when user wants to
* be sure all play has finished.
+ * 1998-10-01 rlt Added support for WAVE files.
*/
#ifdef emacs
#include <audio/audiolib.h>
#include <audio/soundlib.h>
#include <audio/snd.h>
+#include <audio/wave.h>
#include <audio/fileutil.h>
#ifdef emacs
/* hack, hack */
offset = ((SndInfo *) (s->formatInfo))->h.dataOffset;
}
+ else if (SoundFileFormat (s) == SoundFileFormatWave)
+ {
+ offset = ((WaveInfo *) (s->formatInfo))->dataOffset;
+ }
else
{
- warn ("only understand snd files at the moment");
+ warn ("only understand snd and wave files at the moment");
SoundCloseFile (s);
#ifdef ROBUST_PLAY
signal (SIGPIPE, old_sigpipe);
longjmp (AuXtErrorJump, 1);
#endif /* XTEVENTS */
+ return 0;
}
SIGTYPE
return si;
}
+/* Stuff taken from wave.c from NAS. Just like snd files, NAS can't
+ read wave data from memory, so these functions do that for us. */
+
+#define Err() { return NULL; }
+#define readFourcc(_f) dread(_f, sizeof(RIFF_FOURCC), 1)
+#define cmpID(_x, _y) \
+ strncmp((char *) (_x), (char *) (_y), sizeof(RIFF_FOURCC))
+#define PAD2(_x) (((_x) + 1) & ~1)
+
+/* These functions here are for faking file I/O from buffer. */
+
+/* The "file" position */
+static int file_posn;
+/* The length of the "file" */
+static int file_len;
+/* The actual "file" data. */
+CONST static char* file_data;
+
+/* Like fopen, but for a buffer in memory */
+static void
+dopen(CONST char* data, int length)
+{
+ file_data = data;
+ file_len = length;
+ file_posn = 0;
+}
+
+/* Like fread, but for a buffer in memory */
+static int
+dread(char* buf, int size, int nitems)
+{
+ int nread;
+
+ nread = size * nitems;
+
+ if (file_posn + nread <= file_len)
+ {
+ memcpy(buf, file_data + file_posn, size * nitems);
+ file_posn += nread;
+ return nitems;
+ }
+ else
+ {
+ return EOF;
+ }
+}
+
+/* Like fgetc, but for a buffer in memory */
+static int
+dgetc()
+{
+ int ch;
+
+ if (file_posn < file_len)
+ return file_data[file_posn++];
+ else
+ return -1;
+}
+
+/* Like fseek, but for a buffer in memory */
+static int
+dseek(long offset, int from)
+{
+ if (from == 0)
+ file_posn = offset;
+ else if (from == 1)
+ file_posn += offset;
+ else if (from == 2)
+ file_posn = file_len + offset;
+
+ return 0;
+}
+
+/* Like ftell, but for a buffer in memory */
+static int
+dtell()
+{
+ return file_posn;
+}
+
+/* Data buffer analogs for FileReadS and FileReadL in NAS. */
+
+static unsigned short
+DataReadS(int swapit)
+{
+ unsigned short us;
+
+ dread(&us, 2, 1);
+ if (swapit)
+ us = FileSwapS(us);
+ return us;
+}
+
+static AuUint32
+DataReadL(int swapit)
+{
+ AuUint32 ul;
+
+ dread(&ul, 4, 1);
+ if (swapit)
+ ul = FileSwapL(ul);
+ return ul;
+}
+
+static int
+readChunk(RiffChunk *c)
+{
+ int status;
+ char n;
+
+ if ((status = dread(c, sizeof(RiffChunk), 1)))
+ if (BIG_ENDIAN)
+ swapl(&c->ckSize, n);
+
+ return status;
+}
+
+/* A very straight-forward translation of WaveOpenFileForReading to
+ read the wave data from a buffer in memory. */
+
+static WaveInfo *
+WaveOpenDataForReading(CONST char *data,
+ int length)
+{
+ RiffChunk ck;
+ RIFF_FOURCC fourcc;
+ AuInt32 fileSize;
+ WaveInfo *wi;
+
+
+ if (!(wi = (WaveInfo *) malloc(sizeof(WaveInfo))))
+ return NULL;
+
+ wi->comment = NULL;
+ wi->dataOffset = wi->format = wi->writing = 0;
+
+ dopen(data, length);
+
+ if (!readChunk(&ck) ||
+ cmpID(&ck.ckID, RIFF_RiffID) ||
+ !readFourcc(&fourcc) ||
+ cmpID(&fourcc, RIFF_WaveID))
+ Err();
+
+ fileSize = PAD2(ck.ckSize) - sizeof(RIFF_FOURCC);
+
+ while (fileSize >= sizeof(RiffChunk))
+ {
+ if (!readChunk(&ck))
+ Err();
+
+ fileSize -= sizeof(RiffChunk) + PAD2(ck.ckSize);
+
+ /* LIST chunk */
+ if (!cmpID(&ck.ckID, RIFF_ListID))
+ {
+ if (!readFourcc(&fourcc))
+ Err();
+
+ /* INFO chunk */
+ if (!cmpID(&fourcc, RIFF_ListInfoID))
+ {
+ ck.ckSize -= sizeof(RIFF_FOURCC);
+
+ while (ck.ckSize)
+ {
+ RiffChunk c;
+
+ if (!readChunk(&c))
+ Err();
+
+ /* ICMT chunk */
+ if (!cmpID(&c.ckID, RIFF_InfoIcmtID))
+ {
+ if (!(wi->comment = (char *) malloc(c.ckSize)) ||
+ !dread(wi->comment, c.ckSize, 1))
+ Err();
+
+ if (c.ckSize & 1)
+ dgetc(); /* eat the pad byte */
+ }
+ else
+ /* skip unknown chunk */
+ dseek(PAD2(c.ckSize), 1);
+
+ ck.ckSize -= sizeof(RiffChunk) + PAD2(c.ckSize);
+ }
+ }
+ else
+ /* skip unknown chunk */
+ dseek(PAD2(ck.ckSize) - sizeof(RIFF_FOURCC), 1);
+ }
+ /* wave format chunk */
+ else if (!cmpID(&ck.ckID, RIFF_WaveFmtID) && !wi->format)
+ {
+ AuInt32 dummy;
+
+ wi->format = DataReadS(BIG_ENDIAN);
+ wi->channels = DataReadS(BIG_ENDIAN);
+ wi->sampleRate = DataReadL(BIG_ENDIAN);
+
+ /* we don't care about the next two fields */
+ dummy = DataReadL(BIG_ENDIAN);
+ dummy = DataReadS(BIG_ENDIAN);
+
+ if (wi->format != RIFF_WAVE_FORMAT_PCM)
+ Err();
+
+ wi->bitsPerSample = DataReadS(BIG_ENDIAN);
+
+ /* skip any other format specific fields */
+ dseek(PAD2(ck.ckSize - 16), 1);
+ }
+ /* wave data chunk */
+ else if (!cmpID(&ck.ckID, RIFF_WaveDataID) && !wi->dataOffset)
+ {
+ long endOfFile;
+
+ wi->dataOffset = dtell();
+ wi->dataSize = ck.ckSize;
+ dseek(0, 2);
+ endOfFile = dtell();
+
+ /* seek past the data */
+ if (dseek(wi->dataOffset + PAD2(ck.ckSize), 0) ||
+ dtell() > endOfFile)
+ {
+ /* the seek failed, assume the size is bogus */
+ dseek(0, 2);
+ wi->dataSize = dtell() - wi->dataOffset;
+ }
+
+ wi->dataOffset -= sizeof(long);
+ }
+ else
+ /* skip unknown chunk */
+ dseek(PAD2(ck.ckSize), 1);
+ }
+
+ if (!wi->dataOffset)
+ Err();
+
+ wi->numSamples = wi->dataSize / wi->channels / (wi->bitsPerSample >> 3);
+
+ if (!wi->comment)
+ wi->comment = NameFromData (data + wi->dataOffset,
+ length - wi->dataOffset);
+
+ wi->fp = NULL;
+
+ return wi;
+}
+
+
static Sound
SoundOpenDataForReading (unsigned char *data,
int length)
if (!(s = (Sound) malloc (sizeof (SoundRec))))
return NULL;
- if ((s->formatInfo = SndOpenDataForReading (data, length))==NULL)
+ if ((s->formatInfo = SndOpenDataForReading (data, length)) != NULL)
{
- free (s);
- return NULL;
+ if (!(SoundFileInfo[SoundFileFormatSnd].toSound) (s))
+ {
+ SndCloseFile (s->formatInfo);
+ free (s);
+ return NULL;
+ }
}
-
-
- if (!(SoundFileInfo[SoundFileFormatSnd].toSound) (s))
+ else if ((s->formatInfo = WaveOpenDataForReading (data, length)) != NULL)
{
- SndCloseFile (s->formatInfo);
- free (s);
- return NULL;
+ if (!(SoundFileInfo[SoundFileFormatWave].toSound) (s))
+ {
+ WaveCloseFile (s->formatInfo);
+ free (s);
+ return NULL;
+ }
}
return s;
else
{ /* We got here from a longjmp() from the SIGPIPE handler */
signal (SIGPIPE, old_sigpipe);
+ /* Close the file lstream so we don't attempt to write to it further */
+ /* #### There is controversy over whether this might cause fd leakage */
+ /* my tests say no. -slb */
+ XLSTREAM (p->pipe_outstream)->flags &= ~LSTREAM_FL_IS_OPEN;
p->status_symbol = Qexit;
p->exit_code = 256; /* #### SIGPIPE ??? */
p->core_dumped = 0;
#define SND_FILENAME 0x2000L
#define VK_APPS 0x5D
#define SIF_TRACKPOS 0x0010
+#define ICC_BAR_CLASSES 4
+#define FW_BLACK FW_HEAVY
+#define FW_ULTRABOLD FW_EXTRABOLD
+#define FW_DEMIBOLD FW_SEMIBOLD
+#define FW_ULTRALIGHT FW_EXTRALIGHT
+#define APPCMD_FILTERINITS 0x20L
+#define CBF_FAIL_SELFCONNECTIONS 0x1000
+#define CBF_SKIP_ALLNOTIFICATIONS 0x3C0000
+#define CBF_FAIL_ADVISES 0x4000
+#define CBF_FAIL_POKES 0x10000
+#define CBF_FAIL_REQUESTS 0x20000
+#define SZDDESYS_TOPIC "System"
+#define JOHAB_CHARSET 130
+#define MAC_CHARSET 77
+
#endif
#endif
#define C_SWITCH_SYSTEM -Wno-sign-compare -fno-caller-saves
#define LIBS_SYSTEM -lwinmm
-#define ICC_BAR_CLASSES 4
-#define FW_BLACK FW_HEAVY
-#define FW_ULTRABOLD FW_EXTRABOLD
-#define FW_DEMIBOLD FW_SEMIBOLD
-#define FW_ULTRALIGHT FW_EXTRALIGHT
-#define APPCMD_FILTERINITS 0x20L
-#define CBF_FAIL_SELFCONNECTIONS 0x1000
-#define CBF_SKIP_ALLNOTIFICATIONS 0x3C0000
-#define CBF_FAIL_ADVISES 0x4000
-#define CBF_FAIL_POKES 0x10000
-#define CBF_FAIL_REQUESTS 0x20000
-#define SZDDESYS_TOPIC "System"
-#define JOHAB_CHARSET 130
-#define MAC_CHARSET 77
#define TEXT_START -1
#define TEXT_END -1
#include "specifier.h"
#include "window.h"
-/* This has really different semantics in Windows than in Motif.
- There's no corresponding method; we just do not change slider
- size while dragging. It makes the scrollbar look smother and
- prevents some weird behavior when scrolled near the bottom */
-static int inhibit_slider_size_change = 0;
+/* We use a similar sort of vertical scrollbar drag hack for mswindows
+ * scrollbars as is used for Motif or Lucid scrollbars under X.
+ * We do character-based instead of line-based scrolling, which can mean that
+ * without the hack it is impossible to drag to the end of a buffer. */
+#define VERTICAL_SCROLLBAR_DRAG_HACK
+
+static int vertical_drag_in_progress = 0;
static void
mswindows_create_scrollbar_instance (struct frame *f, int vertical,
CW_USEDEFAULT, CW_USEDEFAULT,
FRAME_MSWINDOWS_HANDLE (f),
NULL, NULL, NULL);
+ SCROLLBAR_MSW_INFO (sb).cbSize = sizeof(SCROLLINFO);
SCROLLBAR_MSW_INFO (sb).fMask = SIF_ALL;
GetScrollInfo(SCROLLBAR_MSW_HANDLE (sb), SB_CTL,
&SCROLLBAR_MSW_INFO (sb));
int new_scrollbar_x,
int new_scrollbar_y)
{
- struct frame *f;
int pos_changed = 0;
-
- f = XFRAME (w->frame);
+ int vert = GetWindowLong (SCROLLBAR_MSW_HANDLE (sb), GWL_STYLE) & SBS_VERT;
#if 0
stderr_out ("[%d, %d], page = %d, pos = %d, inhibit = %d\n", new_minimum, new_maximum,
/* These might be optimized, but since at least one will change at each
call, it's probably not worth it. */
- SCROLLBAR_MSW_INFO (sb).cbSize = sizeof(SCROLLINFO);
SCROLLBAR_MSW_INFO (sb).nMin = new_minimum;
SCROLLBAR_MSW_INFO (sb).nMax = new_maximum;
- SCROLLBAR_MSW_INFO (sb).nPage = new_slider_size + 1; /* for DISABLENOSCROLL */
+ SCROLLBAR_MSW_INFO (sb).nPage = new_slider_size + 1; /* +1 for DISABLENOSCROLL */
SCROLLBAR_MSW_INFO (sb).nPos = new_slider_position;
- SCROLLBAR_MSW_INFO (sb).fMask = (inhibit_slider_size_change
+#ifndef VERTICAL_SCROLLBAR_DRAG_HACK
+ SCROLLBAR_MSW_INFO (sb).fMask = ((vert && vertical_drag_in_progress)
? SIF_RANGE | SIF_POS
: SIF_ALL | SIF_DISABLENOSCROLL);
-
- SetScrollInfo(SCROLLBAR_MSW_HANDLE (sb), SB_CTL, &SCROLLBAR_MSW_INFO (sb),
- !pos_changed);
+#else
+ SCROLLBAR_MSW_INFO (sb).fMask = SIF_ALL | SIF_DISABLENOSCROLL;
+
+ /* Ignore XEmacs' requests to update the thumb position and size; they don't
+ * bear any relation to reality because we're reporting made-up positions */
+ if (!(vert && vertical_drag_in_progress))
+#endif
+ SetScrollInfo (SCROLLBAR_MSW_HANDLE (sb), SB_CTL, &SCROLLBAR_MSW_INFO (sb),
+ TRUE);
UPDATE_POS_FIELD (scrollbar_x);
UPDATE_POS_FIELD (scrollbar_y);
struct scrollbar_instance *sb;
SCROLLINFO scrollinfo;
int vert = GetWindowLong (hwnd, GWL_STYLE) & SBS_VERT;
+ int value;
sb = (struct scrollbar_instance *)GetWindowLong (hwnd, GWL_USERDATA);
win = real_window (sb->mirror, 1);
frame = XWINDOW (win)->frame;
f = XFRAME (frame);
- inhibit_slider_size_change = code == SB_THUMBTRACK;
-
/* SB_LINEDOWN == SB_CHARLEFT etc. This is the way they will
always be - any Windows is binary compatible backward with
old programs */
case SB_THUMBTRACK:
case SB_THUMBPOSITION:
scrollinfo.cbSize = sizeof(SCROLLINFO);
- scrollinfo.fMask = SIF_TRACKPOS;
+ scrollinfo.fMask = SIF_ALL;
GetScrollInfo (hwnd, SB_CTL, &scrollinfo);
+ vertical_drag_in_progress = vert;
+#ifdef VERTICAL_SCROLLBAR_DRAG_HACK
+ if (vert && (scrollinfo.nTrackPos > scrollinfo.nPos))
+ /* new buffer position =
+ * buffer position at start of drag +
+ * ((text remaining in buffer at start of drag) *
+ * (amount that the thumb has been moved) /
+ * (space that remained past end of the thumb at start of drag)) */
+ value = (int)
+ (scrollinfo.nPos
+ + (((double)
+ (scrollinfo.nMax - scrollinfo.nPos)
+ * (scrollinfo.nTrackPos - scrollinfo.nPos))
+ / (scrollinfo.nMax - scrollinfo.nPage - scrollinfo.nPos)))
+ - 2; /* ensure that the last line doesn't disappear off screen */
+ else
+#endif
+ value = scrollinfo.nTrackPos;
mswindows_enqueue_misc_user_event
(frame,
vert ? Qscrollbar_vertical_drag : Qscrollbar_horizontal_drag,
- Fcons (win, make_int (scrollinfo.nTrackPos)));
+ Fcons (win, make_int (value)));
+ break;
+
+ case SB_ENDSCROLL:
+#ifdef VERTICAL_SCROLLBAR_DRAG_HACK
+ if (vertical_drag_in_progress)
+ /* User has just dropped the thumb - finally update it */
+ SetScrollInfo (SCROLLBAR_MSW_HANDLE (sb), SB_CTL,
+ &SCROLLBAR_MSW_INFO (sb), TRUE);
+#endif
+ vertical_drag_in_progress = 0;
break;
}
}
# define __STDC_EXTENDED__ 1
# endif
+# include <stddef.h>
# include <stdlib.h>
# include <unistd.h>
# include <string.h>
/* this is not right, but much easier than doing what is right. */
/* w->start_at_line_beg = 0; */
/* WTF is the above supposed to mean? GE */
- w->start_at_line_beg = beginning_of_line_p (XBUFFER (w->buffer), XINT (pos));
+ w->start_at_line_beg = beginning_of_line_p (XBUFFER (w->buffer),
+ marker_position (w->start[CURRENT_DISP]));
if (NILP (noforce))
w->force_start = 1;
w->redo_modeline = 1;
Fset_marker (w->sb_point, w->start[CURRENT_DISP], buffer);
/* set start_at_line_beg correctly. GE */
w->start_at_line_beg = beginning_of_line_p (XBUFFER (buffer),
- XBUFFER (buffer)->last_window_start);
+ marker_position (w->start[CURRENT_DISP]));
w->force_start = 0; /* Lucid fix */
SET_LAST_MODIFIED (w, 1);
SET_LAST_FACECHANGE (w);
{
Lisp_Object fb = Qnil;
#ifdef HAVE_TTY
- fb = Fcons (Fcons (list1 (Qtty), Qzero), fb);
+ fb = Fcons (Fcons (list1 (Qtty), make_int (1)), fb);
#endif
#ifdef HAVE_X_WINDOWS
fb = Fcons (Fcons (list1 (Qx), make_int (3)), fb);
#!/bin/sh
emacs_major_version=21
emacs_minor_version=2
-emacs_beta_version=2
-xemacs_codename="Aether"
+emacs_beta_version=3
+xemacs_codename="Aglaia"
infodock_major_version=4
infodock_minor_version=0
infodock_build_version=1
projects / chise / xemacs-chise.git / commitdiff