diff options
| author | Karoly Lorentey <lorentey@elte.hu> | 2006-05-10 15:04:01 +0000 |
|---|---|---|
| committer | Karoly Lorentey <lorentey@elte.hu> | 2006-05-10 15:04:01 +0000 |
| commit | 8dadeb1e1f78c7be07db5ae78aa9eed58d272a4e (patch) | |
| tree | 6262988e87d6b347a8c90fcc3c5b49f9bb5b36e1 /lisp | |
| parent | f6cf85ac95e469835a2643024f995b471a4c5d52 (diff) | |
| parent | 9a4d87c8d5f4503d67d5155eae6d543cc31f86d0 (diff) | |
| download | emacs-8dadeb1e1f78c7be07db5ae78aa9eed58d272a4e.tar.gz | |
Merged from emacs@sv.gnu.org
Patches applied:
* emacs@sv.gnu.org/emacs--devo--0--patch-266
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-267
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-268
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-269
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-270
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-271
Rename "field-at-point" to "field-at-pos"
* emacs@sv.gnu.org/emacs--devo--0--patch-272
(comint-insert-input): Remove redundant calls to setq and goto-char
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-556
Diffstat (limited to 'lisp')
40 files changed, 983 insertions, 489 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5c3c58767f7..4b3f30e9692 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,242 @@ +2006-05-09 Miles Bader <miles@gnu.org> + + * comint.el (comint-insert-input): Remove redundant calls to setq + and goto-char. + +2006-05-10 Nick Roberts <nickrob@snap.net.nz> + + * comint.el (comint-insert-input): Make it work when + comint-use-prompt-regexp is t. + +2006-05-10 Miles Bader <miles@gnu.org> + + * subr.el (field-at-pos): New function. + + * comint.el (comint-insert-input): Use it. + +2006-05-09 Juri Linkov <juri@jurta.org> + + * battery.el (battery-linux-proc-acpi): Also try + `/proc/acpi/thermal_zone/THR2/temperature'. + + * files.el <safe-local-variable>: Remove `eval' and `let' binding + for now unused lambda `string-or-null'. + + * add-log.el (change-log-default-name): Put `string-or-null-p' + instead of lambda on `safe-local-variable' property. + + * diff-mode.el (diff-context->unified): Use `region-beginning' and + `region-end' instead of `mark' and `point'. + (diff-unified->context, diff-reverse-direction, diff-fixup-modifs): + Operate on region in Transient Mark mode when the mark is active. + Use `region-beginning' and `region-end' instead of `mark' and + `point'. + (diff-hunk-text, diff-goto-source): Doc fix. + + * startup.el (fancy-splash-screens, normal-splash-screen): Use + face `mode-line-buffer-id' for mode-line buffer face instead of + hard-coded `(:weight bold)'. + + * arc-mode.el (archive-set-buffer-as-visiting-file): Bind + buffer-undo-list to t (undo-ask is reproducible by visiting + nested archives). + +2006-05-09 Kim F. Storm <storm@cua.dk> + + * progmodes/grep.el (rgrep): Set default directory of *grep* + buffer if we start M-x rgrep in the *grep* buffer and choose + a different base directory. + +2006-05-09 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-register-file-name-handlers): Enable Tramp + completion also when ido is loaded. + +2006-05-09 Masatake YAMATO <jet@gyve.org> + + * font-lock.el (cpp-font-lock-keywords-source-directives): Addded + "warning" and "import". + (cpp-font-lock-keywords): Added "warning". + +2006-05-08 Dan Nicolaescu <dann@ics.uci.edu> + + * term/xterm.el (terminal-init-xterm): Add more key bindings. + +2006-05-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * mwheel.el (mwheel-scroll): Make sure that when scrolling multiple + pages at a time, if we signal the end, we should indeed reach that end. + +2006-05-08 David Reitter <david.reitter@gmail.com> + + * emacs-lisp/easy-mmode.el (define-minor-mode): Only preserve messages + output during execution of the body. + +2006-05-08 Kim F. Storm <storm@cua.dk> + + * progmodes/grep.el (lgrep, rgrep): Doc fixes. + +2006-05-08 Thien-Thi Nguyen <ttn@gnu.org> + + * emacs-lisp/ewoc.el (ewoc--set-buffer-bind-dll-let*): + Use with-current-buffer. + +2006-05-07 Kim F. Storm <storm@cua.dk> + + * subr.el (add-to-history): Remove keep-dups arg. + + * kmacro.el (kmacro-push-ring): Let-bind history-delete-duplicates + to nil around call to add-to-history. + +2006-05-07 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/syntax.el (syntax-ppss): Flush the cache before rather + than after a buffer modification. + +2006-05-08 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-ui.el (gdb-var-create-handler): Move speedbar + call to... + (gud-watch): ...here so speedbar is raised for already watched + expressions. + (gdb-speedbar-refresh): Delete function. + (gdb-speedbar-update, gdb-speedbar-timer-fn): New functions. + Use speedbar-timer-fn instead of speedbar-refresh (reverting + earlier change). + (gdb-var-evaluate-expression-handler) + (gdb-var-list-children-handler-1, gdb-var-update-handler-1): Use it. + + * speedbar.el (speedbar-timer-fn): Remove save-window-excursion. + Update localized contents for all buffers except ignored modes. + +2006-05-07 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * term/mac-win.el (mac-utxt-to-string): Use `eq' instead of `='. + (mac-atsu-font-table, mac-font-panel-mode): Add defvars. + (mac-bytes-to-digits, mac-handle-toolbar-switch-mode) + (mac-handle-font-panel-closed, mac-handle-font-selection): + New functions. + (mac-font-panel-mode): New minor mode. + (mac-apple-event-map): Add bindings for toolbar toggle button and + font panel. + (menu-bar-showhide-menu): Add mac-font-panel-mode. + +2006-05-07 John Paul Wallington <jpw@pobox.com> + + * ibuffer.el (ibuffer-compressed-file-name-regexp): + Avoid `regexp-opt'; simplify regexp for readability. + +2006-05-06 Eli Zaretskii <eliz@gnu.org> + + * ldefs-boot.el (dired-do-redisplay, dired-maybe-insert-subdir): + * files.el (buffer-stale-function): + * dired-aux.el (dired-do-redisplay, dired-maybe-insert-subdir): + * autorevert.el (global-auto-revert-non-file-buffers): Point Info + links to the main manual, not to emacs-xtra. + +2006-05-06 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * term/mac-win.el: (mac-utxt-to-string): Don't make adjustment for + MacJapanese if text is ASCII-only. + +2006-05-06 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-ui.el (gdb-goto-breakpoint): Use or instead of + unless so nil isn't returned. + (gdb-setup-windows, gdb-restore-windows): Reset gdb-source-window. + +2006-05-06 Kim F. Storm <storm@cua.dk> + + * subr.el (add-to-history): New function. + + * ediff.el (ediff-files, ediff-files3, ediff-merge-files) + (ediff-merge-files-with-ancestor): + * env.el (setenv): + * isearch.el (isearch-update-ring): + * server.el (server-visit-files): + * progmodes/grep.el (lgrep, rgrep): + * progmodes/vhdl-mode.el (vhdl-generate-makefile-1): + * progmodes/xscheme.el (xscheme-insert-expression): + Use add-to-history. + + * kmacro.el (kmacro-push-ring): Use add-to-history. + (kmacro-ring-length): Remove unused defun. + (kmacro-start-macro): Use kmacro-push-ring. + +2006-05-06 Thien-Thi Nguyen <ttn@gnu.org> + + * emacs-lisp/ewoc.el (ewoc-create, ewoc-set-hf): Use `insert' + directly instead of a lambda expression that calls it. + +2006-05-06 Kim F. Storm <storm@cua.dk> + + * avoid.el (mouse-avoidance-point-position): Use posn-at-point + instead of compute-motion. + +2006-05-05 Dan Nicolaescu <dann@ics.uci.edu> + + * ibuffer.el (ibuffer-compressed-file-name-regexp): Undo previous + change. + +2006-05-05 Reiner Steib <Reiner.Steib@gmx.de> + + * startup.el (command-line-1): Refer to "Pure Storage" on + pure-space-overflow. + +2006-05-05 Martin Rudalics <rudalics@gmx.at> + + * emacs-lisp/re-builder.el (reb-update-overlays): Cycle through + provided faces once they all have been used up. + +2006-05-05 Eli Zaretskii <eliz@gnu.org> + + * startup.el (normal-splash-screen, fancy-splash-screens-1): Add a + reference to the Lisp manual to the warning about pure space + overflow. + +2006-05-05 Micha,Ak(Bl Cadilhac <michael.cadilhac@lrde.org> + + * textmodes/ispell.el (ispell-buffer-local-dict): Add a `no-reload' + argument to avoid the call to `ispell-internal-change-dictionary' + when not needed. + (ispell-change-dictionary): Use this argument and call + `ispell-internal-change-dictionary' after the possible change + to `ispell-local-dictionary'. + (ispell-internal-change-dictionary): Check for a change in + personal dictionary use too. + Cosmetic changes from Agustin Martin + <agustin.martin@hispalinux.es>. + +2006-05-05 Eli Zaretskii <eliz@gnu.org> + + * startup.el (command-line): On MS-Windows, probe "~", not + "~USER", for warning about non-existent home directory + + * arc-mode.el (archive-l-e): New optional argument `float' means + generate a float value. + (archive-arc-summarize, archive-lzh-summarize) + (archive-zip-summarize, archive-zoo-summarize): Invoke archive-l-e + with 3rd argument non-nil when file's size is being computed. + Format the file sizes with %8.0f instead of %8d. + +2006-05-05 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * cus-start.el (all): Add mac-dnd-known-types. + + * term/mac-win.el: (mac-utxt-to-string, mac-string-to-utxt) + (mac-TEXT-to-string, mac-string-to-TEXT, mac-furl-to-string) + (mac-TIFF-to-string): New functions. + (x-get-selection, x-selection-value) + (mac-select-convert-to-string): Use them. + (mac-text-encoding-mac-japanese-basic-variant): New constant. + (mac-dnd-types-alist): New customization variable. + (mac-dnd-handle-furl, mac-dnd-handle-hfs, mac-dnd-insert-utxt) + (mac-dnd-insert-TEXT, mac-dnd-insert-TIFF, mac-dnd-drop-data) + (mac-dnd-handle-drag-n-drop-event): New functions. + (mac-drag-n-drop): Remove function. + (global-map): Bind drag-n-drop and M-drag-n-drop to + mac-dnd-handle-drag-n-drop-event. + 2006-05-04 Karl Chen <quarl@NOSPAM.quarl.org> * progmodes/perl-mode.el (perl-beginning-of-function): diff --git a/lisp/add-log.el b/lisp/add-log.el index 47a839d539d..393a696d3f1 100644 --- a/lisp/add-log.el +++ b/lisp/add-log.el @@ -45,8 +45,7 @@ :type '(choice (const :tag "default" nil) string) :group 'change-log) -(put 'change-log-default-name 'safe-local-variable - (lambda (a) (or (stringp a) (null a)))) +(put 'change-log-default-name 'safe-local-variable 'string-or-null-p) (defcustom change-log-mode-hook nil "Normal hook run by `change-log-mode'." diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index abf38994235..96b41eca88d 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -464,10 +464,12 @@ Each descriptor is a vector of the form (defsubst archive-name (suffix) (intern (concat "archive-" (symbol-name archive-subtype) "-" suffix))) -(defun archive-l-e (str &optional len) +(defun archive-l-e (str &optional len float) "Convert little endian string/vector STR to integer. Alternatively, STR may be a buffer position in the current buffer -in which case a second argument, length LEN, should be supplied." +in which case a second argument, length LEN, should be supplied. +FLOAT, if non-nil, means generate and return a float instead of an integer +\(use this for numbers that can overflow the Emacs integer)." (if (stringp str) (setq len (length str)) (setq str (buffer-substring str (+ str len)))) @@ -475,7 +477,8 @@ in which case a second argument, length LEN, should be supplied." (i 0)) (while (< i len) (setq i (1+ i) - result (+ (ash result 8) (aref str (- len i))))) + result (+ (if float (* result 256.0) (ash result 8)) + (aref str (- len i))))) result)) (defun archive-int-to-mode (mode) @@ -860,7 +863,8 @@ using `make-temp-file', and the generated name is returned." "Set the current buffer as if it were visiting FILENAME." (save-excursion (goto-char (point-min)) - (let ((coding + (let ((buffer-undo-list t) + (coding (or coding-system-for-read (and set-auto-coding-function (save-excursion @@ -1331,13 +1335,14 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (let* ((namefld (buffer-substring (+ p 2) (+ p 2 13))) (fnlen (or (string-match "\0" namefld) 13)) (efnname (substring namefld 0 fnlen)) - (csize (archive-l-e (+ p 15) 4)) + ;; Convert to float to avoid overflow for very large files. + (csize (archive-l-e (+ p 15) 4 'float)) (moddate (archive-l-e (+ p 19) 2)) (modtime (archive-l-e (+ p 21) 2)) - (ucsize (archive-l-e (+ p 25) 4)) + (ucsize (archive-l-e (+ p 25) 4 'float)) (fiddle (string= efnname (upcase efnname))) (ifnname (if fiddle (downcase efnname) efnname)) - (text (format " %8d %-11s %-8s %s" + (text (format " %8.0f %-11s %-8s %s" ucsize (archive-dosdate moddate) (archive-dostime modtime) @@ -1359,7 +1364,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." dash) (archive-summarize-files (nreverse visual)) (insert dash - (format " %8d %d file%s" + (format " %8.0f %d file%s" totalsize (length files) (if (= 1 (length files)) "" "s")) @@ -1393,9 +1398,10 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (while (progn (goto-char p) ;beginning of a base header. (looking-at "\\(.\\|\n\\)\\(.\\|\n\\)-l[hz][0-9ds]-")) (let* ((hsize (char-after p)) ;size of the base header (level 0 and 1) - (csize (archive-l-e (+ p 7) 4)) ;size of a compressed file to follow (level 0 and 2), + ;; Convert to float to avoid overflow for very large files. + (csize (archive-l-e (+ p 7) 4 'float)) ;size of a compressed file to follow (level 0 and 2), ;size of extended headers + the compressed file to follow (level 1). - (ucsize (archive-l-e (+ p 11) 4)) ;size of an uncompressed file. + (ucsize (archive-l-e (+ p 11) 4 'float)) ;size of an uncompressed file. (time1 (archive-l-e (+ p 15) 2)) ;date/time (MSDOS format in level 0, 1 headers (time2 (archive-l-e (+ p 17) 2)) ;and UNIX format in level 2 header.) (hdrlvl (char-after (+ p 20))) ;header level @@ -1471,12 +1477,12 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (archive-unixtime time1 time2) (archive-dostime time1))) (setq text (if archive-alternate-display - (format " %8d %5S %5S %s" + (format " %8.0f %5S %5S %s" ucsize (or uid "?") (or gid "?") ifnname) - (format " %10s %8d %-11s %-8s %s" + (format " %10s %8.0f %-11s %-8s %s" modestr ucsize moddate @@ -1506,8 +1512,8 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." "M Length Uid Gid File\n" "M Filemode Length Date Time File\n")) (sumline (if archive-alternate-display - " %8d %d file%s" - " %8d %d file%s"))) + " %8.0f %d file%s" + " %8.0f %d file%s"))) (insert header dash) (archive-summarize-files (nreverse visual)) (insert dash @@ -1603,7 +1609,8 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; (method (archive-l-e (+ p 10) 2)) (modtime (archive-l-e (+ p 12) 2)) (moddate (archive-l-e (+ p 14) 2)) - (ucsize (archive-l-e (+ p 24) 4)) + ;; Convert to float to avoid overflow for very large files. + (ucsize (archive-l-e (+ p 24) 4 'float)) (fnlen (archive-l-e (+ p 28) 2)) (exlen (archive-l-e (+ p 30) 2)) (fclen (archive-l-e (+ p 32) 2)) @@ -1629,7 +1636,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (string= (upcase efnname) efnname))) (ifnname (if fiddle (downcase efnname) efnname)) (width (string-width ifnname)) - (text (format " %10s %8d %-11s %-8s %s" + (text (format " %10s %8.0f %-11s %-8s %s" modestr ucsize (archive-dosdate moddate) @@ -1655,7 +1662,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." dash) (archive-summarize-files (nreverse visual)) (insert dash - (format " %8d %d file%s" + (format " %8.0f %d file%s" totalsize (length files) (if (= 1 (length files)) "" "s")) @@ -1709,7 +1716,8 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (let* ((next (1+ (archive-l-e (+ p 6) 4))) (moddate (archive-l-e (+ p 14) 2)) (modtime (archive-l-e (+ p 16) 2)) - (ucsize (archive-l-e (+ p 20) 4)) + ;; Convert to float to avoid overflow for very large files. + (ucsize (archive-l-e (+ p 20) 4 'float)) (namefld (buffer-substring (+ p 38) (+ p 38 13))) (dirtype (char-after (+ p 4))) (lfnlen (if (= dirtype 2) (char-after (+ p 56)) 0)) @@ -1733,7 +1741,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (fiddle (and (= lfnlen 0) (string= efnname (upcase efnname)))) (ifnname (if fiddle (downcase efnname) efnname)) (width (string-width ifnname)) - (text (format " %8d %-11s %-8s %s" + (text (format " %8.0f %-11s %-8s %s" ucsize (archive-dosdate moddate) (archive-dostime modtime) @@ -1755,7 +1763,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." dash) (archive-summarize-files (nreverse visual)) (insert dash - (format " %8d %d file%s" + (format " %8.0f %d file%s" totalsize (length files) (if (= 1 (length files)) "" "s")) diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 4119dba5755..9d189e027c0 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -215,10 +215,10 @@ changes in subdirectories or in the contents, size, modes, etc., of files. You may still sometimes want to revert them manually. Use this option with care since it could lead to excessive auto-reverts. -For more information, see Info node `(emacs-xtra)Autorevert'." +For more information, see Info node `(emacs)Autorevert'." :group 'auto-revert :type 'boolean - :link '(info-link "(emacs-xtra)Autorevert")) + :link '(info-link "(emacs)Autorevert")) (defcustom global-auto-revert-ignore-modes () "List of major modes Global Auto-Revert Mode should not check." diff --git a/lisp/avoid.el b/lisp/avoid.el index 1d97dd306db..1868707720e 100644 --- a/lisp/avoid.el +++ b/lisp/avoid.el @@ -139,23 +139,13 @@ Only applies in mouse-avoidance-modes `animate' and `jump'." (defun mouse-avoidance-point-position () "Return the position of point as (FRAME X . Y). Analogous to `mouse-position'." - (let* ((w (selected-window)) - (edges (window-inside-edges w)) - (list - (compute-motion (max (window-start w) (point-min)) ; start pos - ;; window-start can be < point-min if the - ;; latter has changed since the last redisplay - '(0 . 0) ; start XY - (point) ; stop pos - nil ; stop XY: none - nil ; width - (cons (window-hscroll w) 0) ; 0 may not be right? - (selected-window)))) - ;; compute-motion returns (pos HPOS VPOS prevhpos contin) - ;; we want: (frame hpos . vpos) + (let ((edges (window-inside-edges)) + (x-y (posn-x-y (posn-at-point)))) (cons (selected-frame) - (cons (+ (car edges) (car (cdr list))) - (+ (car (cdr edges)) (car (cdr (cdr list)))))))) + (cons (+ (car edges) + (/ (car x-y) (frame-char-width))) + (+ (car (cdr edges)) + (/ (cdr x-y) (frame-char-height))))))) ;(defun mouse-avoidance-point-position-test () ; (interactive) diff --git a/lisp/battery.el b/lisp/battery.el index 34f74aa9932..50edc8dde8a 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -386,6 +386,14 @@ The following %-sequences are provided: (when (re-search-forward "temperature: +\\([0-9]+\\) C$" nil t) (match-string 1)))) + (when (file-exists-p + "/proc/acpi/thermal_zone/THR2/temperature") + (with-temp-buffer + (insert-file-contents + "/proc/acpi/thermal_zone/THR2/temperature") + (when (re-search-forward + "temperature: +\\([0-9]+\\) C$" nil t) + (match-string 1)))) "N/A")) (cons ?r (or (and rate (concat (number-to-string rate) " " rate-type)) "N/A")) diff --git a/lisp/comint.el b/lisp/comint.el index 946085661fc..c7e5b3bdddd 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -802,27 +802,31 @@ buffer. The hook `comint-exec-hook' is run after each exec." ;; This doesn't use "e" because it is supposed to work ;; for events without parameters. (interactive (list last-input-event)) - (let ((pos (point))) - (if event (posn-set-point (event-end event))) - (if (not (eq (get-char-property (point) 'field) 'input)) - ;; No input at POS, fall back to the global definition. - (let* ((keys (this-command-keys)) - (last-key (and (vectorp keys) (aref keys (1- (length keys))))) - (fun (and last-key (lookup-key global-map (vector last-key))))) - (goto-char pos) - (and fun (call-interactively fun))) - (setq pos (point)) - ;; There's previous input at POS, insert it at the end of the buffer. - (goto-char (point-max)) - ;; First delete any old unsent input at the end - (delete-region - (or (marker-position comint-accum-marker) - (process-mark (get-buffer-process (current-buffer)))) - (point)) - ;; Insert the input at point - (insert (buffer-substring-no-properties - (previous-single-char-property-change (1+ pos) 'field) - (next-single-char-property-change pos 'field)))))) + (when event + (posn-set-point (event-end event))) + (if comint-use-prompt-regexp + (let ((input (funcall comint-get-old-input)) + (process (get-buffer-process (current-buffer)))) + (if (not process) + (error "Current buffer has no process") + (goto-char (process-mark process)) + (insert input))) + (let ((pos (point))) + (if (not (eq (field-at-pos pos) 'input)) + ;; No input at POS, fall back to the global definition. + (let* ((keys (this-command-keys)) + (last-key (and (vectorp keys) (aref keys (1- (length keys))))) + (fun (and last-key (lookup-key global-map (vector last-key))))) + (and fun (call-interactively fun))) + ;; There's previous input at POS, insert it at the end of the buffer. + (goto-char (point-max)) + ;; First delete any old unsent input at the end + (delete-region + (or (marker-position comint-accum-marker) + (process-mark (get-buffer-process (current-buffer)))) + (point)) + ;; Insert the input at point + (insert (field-string-no-properties pos)))))) ;; Input history processing in a buffer diff --git a/lisp/cus-start.el b/lisp/cus-start.el index f15dc3f7a4c..3110252288b 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -193,6 +193,8 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (suggest-key-bindings keyboard (choice (const :tag "off" nil) (integer :tag "time" 2) (other :tag "on"))) + ;; macselect.c + (mac-dnd-known-types mac (repeat string) "22.1") ;; macterm.c (mac-control-modifier mac (choice (const :tag "No modifier" nil) (const control) (const meta) diff --git a/lisp/diff-mode.el b/lisp/diff-mode.el index cc89aad6ca3..1a8402e06c4 100644 --- a/lisp/diff-mode.el +++ b/lisp/diff-mode.el @@ -633,8 +633,8 @@ Non-nil OLD means that we want the old file." "Convert unified diffs to context diffs. START and END are either taken from the region (if a prefix arg is given) or else cover the whole bufer." - (interactive (if current-prefix-arg - (list (mark) (point)) + (interactive (if (or current-prefix-arg (and transient-mark-mode mark-active)) + (list (region-beginning) (region-end)) (list (point-min) (point-max)))) (unless (markerp end) (setq end (copy-marker end))) (let (;;(diff-inhibit-after-change t) @@ -722,7 +722,7 @@ START and END are either taken from the region \(when it is highlighted) or else cover the whole buffer. With a prefix argument, convert unified format to context format." (interactive (if (and transient-mark-mode mark-active) - (list (mark) (point) current-prefix-arg) + (list (region-beginning) (region-end) current-prefix-arg) (list (point-min) (point-max) current-prefix-arg))) (if to-context (diff-unified->context start end) @@ -795,8 +795,8 @@ With a prefix argument, convert unified format to context format." "Reverse the direction of the diffs. START and END are either taken from the region (if a prefix arg is given) or else cover the whole bufer." - (interactive (if current-prefix-arg - (list (mark) (point)) + (interactive (if (or current-prefix-arg (and transient-mark-mode mark-active)) + (list (region-beginning) (region-end)) (list (point-min) (point-max)))) (unless (markerp end) (setq end (copy-marker end))) (let (;;(diff-inhibit-after-change t) @@ -857,8 +857,8 @@ else cover the whole bufer." "Fixup the hunk headers (in case the buffer was modified). START and END are either taken from the region (if a prefix arg is given) or else cover the whole bufer." - (interactive (if current-prefix-arg - (list (mark) (point)) + (interactive (if (or current-prefix-arg (and transient-mark-mode mark-active)) + (list (region-beginning) (region-end)) (list (point-min) (point-max)))) (let ((inhibit-read-only t)) (save-excursion @@ -1069,7 +1069,7 @@ Only works for unified diffs." (defun diff-hunk-text (hunk destp char-offset) "Return the literal source text from HUNK as (TEXT . OFFSET). -if DESTP is nil TEXT is the source, otherwise the destination text. +If DESTP is nil, TEXT is the source, otherwise the destination text. CHAR-OFFSET is a char-offset in HUNK, and OFFSET is the corresponding char-offset in TEXT." (with-temp-buffer @@ -1302,7 +1302,7 @@ With a prefix argument, try to REVERSE the hunk." `diff-jump-to-old-file' (or its opposite if the OTHER-FILE prefix arg is given) determines whether to jump to the old or the new file. If the prefix arg is bigger than 8 (for example with \\[universal-argument] \\[universal-argument]) - then `diff-jump-to-old-file' is also set, for the next invocations." +then `diff-jump-to-old-file' is also set, for the next invocations." (interactive (list current-prefix-arg last-input-event)) ;; When pointing at a removal line, we probably want to jump to ;; the old location, and else to the new (i.e. as if reverting). diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 20b0037ab7e..e07689973e4 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -918,7 +918,7 @@ or delete subdirectories can bypass this machinery. Hence, you sometimes may have to reset some subdirectory switches after a `dired-undo'. You can reset all subdirectory switches to the default using \\<dired-mode-map>\\[dired-reset-subdir-switches]. -See Info node `(emacs-xtra)Subdir switches' for more details." +See Info node `(emacs)Subdir switches' for more details." ;; Moves point if the next ARG files are redisplayed. (interactive "P\np") (if (and test-for-subdir (dired-get-subdir)) @@ -1761,7 +1761,7 @@ or delete subdirectories can bypass this machinery. Hence, you sometimes may have to reset some subdirectory switches after a `dired-undo'. You can reset all subdirectory switches to the default using \\<dired-mode-map>\\[dired-reset-subdir-switches]. -See Info node `(emacs-xtra)Subdir switches' for more details." +See Info node `(emacs)Subdir switches' for more details." (interactive (list (dired-get-filename) (if current-prefix-arg diff --git a/lisp/ediff.el b/lisp/ediff.el index bb6cfc6b72e..14f634f0cd2 100644 --- a/lisp/ediff.el +++ b/lisp/ediff.el @@ -210,12 +210,11 @@ ediff-last-dir-B (file-name-directory f))) (progn - (setq file-name-history - (cons (ediff-abbreviate-file-name - (expand-file-name - (file-name-nondirectory f) - dir-B)) - file-name-history)) + (add-to-history 'file-name-history + (ediff-abbreviate-file-name + (expand-file-name + (file-name-nondirectory f) + dir-B))) (ediff-get-default-file-name f 1))) ))) (ediff-files-internal file-A @@ -246,25 +245,22 @@ ediff-last-dir-B (file-name-directory f))) (progn - (setq file-name-history - (cons - (ediff-abbreviate-file-name - (expand-file-name - (file-name-nondirectory f) - dir-B)) - file-name-history)) + (add-to-history 'file-name-history + (ediff-abbreviate-file-name + (expand-file-name + (file-name-nondirectory f) + dir-B))) (ediff-get-default-file-name f 1)))) (ediff-read-file-name "File C to compare" (setq dir-C (if ediff-use-last-dir ediff-last-dir-C (file-name-directory ff))) (progn - (setq file-name-history - (cons (ediff-abbreviate-file-name - (expand-file-name - (file-name-nondirectory ff) - dir-C)) - file-name-history)) + (add-to-history 'file-name-history + (ediff-abbreviate-file-name + (expand-file-name + (file-name-nondirectory ff) + dir-C))) (ediff-get-default-file-name ff 2))) ))) (ediff-files-internal file-A @@ -1109,12 +1105,11 @@ lines. For small regions, use `ediff-regions-wordwise'." ediff-last-dir-B (file-name-directory f))) (progn - (setq file-name-history - (cons (ediff-abbreviate-file-name - (expand-file-name - (file-name-nondirectory f) - dir-B)) - file-name-history)) + (add-to-history 'file-name-history + (ediff-abbreviate-file-name + (expand-file-name + (file-name-nondirectory f) + dir-B))) (ediff-get-default-file-name f 1))) ))) (setq startup-hooks (cons 'ediff-merge-on-startup startup-hooks)) @@ -1153,13 +1148,11 @@ lines. For small regions, use `ediff-regions-wordwise'." ediff-last-dir-B (file-name-directory f))) (progn - (setq file-name-history - (cons - (ediff-abbreviate-file-name - (expand-file-name - (file-name-nondirectory f) - dir-B)) - file-name-history)) + (add-to-history 'file-name-history + (ediff-abbreviate-file-name + (expand-file-name + (file-name-nondirectory f) + dir-B))) (ediff-get-default-file-name f 1)))) (ediff-read-file-name "Ancestor file" (setq dir-ancestor @@ -1167,12 +1160,11 @@ lines. For small regions, use `ediff-regions-wordwise'." ediff-last-dir-ancestor (file-name-directory ff))) (progn - (setq file-name-history - (cons (ediff-abbreviate-file-name - (expand-file-name - (file-name-nondirectory ff) - dir-ancestor)) - file-name-history)) + (add-to-history 'file-name-history + (ediff-abbreviate-file-name + (expand-file-name + (file-name-nondirectory ff) + dir-ancestor))) (ediff-get-default-file-name ff 2))) ))) (setq startup-hooks (cons 'ediff-merge-on-startup startup-hooks)) diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index caac02c2ee3..5475ed530d3 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -139,7 +139,8 @@ For example, you could write (setq body (list* lighter keymap body) lighter nil keymap nil)) ((keywordp keymap) (push keymap body) (setq keymap nil))) - (let* ((mode-name (symbol-name mode)) + (let* ((last-message (current-message)) + (mode-name (symbol-name mode)) (pretty-name (easy-mmode-pretty-mode-name mode lighter)) (globalp nil) (set nil) @@ -236,7 +237,10 @@ With zero or negative ARG turn mode off. (if (called-interactively-p) (progn ,(if globalp `(customize-mark-as-set ',mode)) - (unless (current-message) + ;; Avoid overwriting a message shown by the body, + ;; but do overwrite previous messages. + (unless ,(and (current-message) + (not (equal last-message (current-message)))) (message ,(format "%s %%sabled" pretty-name) (if ,mode "en" "dis"))))) (force-mode-line-update) diff --git a/lisp/emacs-lisp/ewoc.el b/lisp/emacs-lisp/ewoc.el index 085ae532a63..278ffe6e7ca 100644 --- a/lisp/emacs-lisp/ewoc.el +++ b/lisp/emacs-lisp/ewoc.el @@ -221,16 +221,12 @@ dll bound to ewoc--dll, and VARLIST bound as in a let*. dll will be bound when VARLIST is initialized, but the current buffer will *not* have been changed. Return value of last form in FORMS." - (let ((old-buffer (make-symbol "old-buffer")) - (hnd (make-symbol "ewoc"))) - `(let* ((,old-buffer (current-buffer)) - (,hnd ,ewoc) + (let ((hnd (make-symbol "ewoc"))) + `(let* ((,hnd ,ewoc) (dll (ewoc--dll ,hnd)) ,@varlist) - (set-buffer (ewoc--buffer ,hnd)) - (unwind-protect - (progn ,@forms) - (set-buffer ,old-buffer))))) + (with-current-buffer (ewoc--buffer ,hnd) + ,@forms)))) (defmacro ewoc--set-buffer-bind-dll (ewoc &rest forms) `(ewoc--set-buffer-bind-dll-let* ,ewoc nil ,@forms)) @@ -322,8 +318,8 @@ be inserted at the bottom of the ewoc." (unless header (setq header "")) (unless footer (setq footer "")) (setf (ewoc--node-start-marker dll) (copy-marker pos)) - (let ((foot (ewoc--create-node footer (lambda (x) (insert footer)) pos)) - (head (ewoc--create-node header (lambda (x) (insert header)) pos))) + (let ((foot (ewoc--create-node footer 'insert pos)) + (head (ewoc--create-node header 'insert pos))) (ewoc--node-enter-first dll head) (ewoc--node-enter-last dll foot) (setf (ewoc--header new-ewoc) head) @@ -601,8 +597,8 @@ Return nil if the buffer has been deleted." "Set the HEADER and FOOTER of EWOC." (setf (ewoc--node-data (ewoc--header ewoc)) header) (setf (ewoc--node-data (ewoc--footer ewoc)) footer) - (ewoc--refresh-node (lambda (x) (insert header)) (ewoc--header ewoc)) - (ewoc--refresh-node (lambda (x) (insert footer)) (ewoc--footer ewoc))) + (ewoc--refresh-node 'insert (ewoc--header ewoc)) + (ewoc--refresh-node 'insert (ewoc--footer ewoc))) (provide 'ewoc) diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index 827578f694c..5dc67e4ac21 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -112,7 +112,7 @@ (if (not (fboundp 'make-overlay)) (require 'overlay)) -;; User costomizable variables +;; User customizable variables (defgroup re-builder nil "Options for the RE Builder." :group 'lisp @@ -627,11 +627,9 @@ Return t if the (cooked) expression changed." beg (match-end 0))) i)) - (defun reb-update-overlays (&optional subexp) "Switch to `reb-target-buffer' and mark all matches of `reb-regexp'. If SUBEXP is non-nil mark only the corresponding sub-expressions." - (let* ((re (reb-target-binding reb-regexp)) (subexps (reb-count-subexps re)) (matches 0) @@ -645,24 +643,35 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions." (or (not reb-auto-match-limit) (< matches reb-auto-match-limit))) (if (= 0 (length (match-string 0))) - (error "Empty regular expression!")) - (let ((i 0)) + (error "Empty regular expression!")) + (let ((i 0) + suffix max-suffix) (setq matches (1+ matches)) (while (<= i subexps) (if (and (or (not subexp) (= subexp i)) (match-beginning i)) (let ((overlay (make-overlay (match-beginning i) (match-end i))) - (face-name (format "reb-match-%d" i))) - (if (not firstmatch) - (setq firstmatch (match-data))) + ;; When we have exceeded the number of provided faces, + ;; cycle thru them where `max-suffix' denotes the maximum + ;; suffix for `reb-match-*' that has been defined and + ;; `suffix' the suffix calculated for the current match. + (face + (cond + (max-suffix + (if (= suffix max-suffix) + (setq suffix 1) + (setq suffix (1+ suffix))) + (intern-soft (format "reb-match-%d" suffix))) + ((intern-soft (format "reb-match-%d" i))) + ((setq max-suffix (1- i)) + (setq suffix 1) + ;; `reb-match-1' must exist. + 'reb-match-1)))) + (unless firstmatch (setq firstmatch (match-data))) (setq reb-overlays (cons overlay reb-overlays) submatches (1+ submatches)) - (overlay-put - overlay 'face - (or (intern-soft face-name) - (error "Too many subexpressions - face `%s' not defined" - face-name ))) + (overlay-put overlay 'face face) (overlay-put overlay 'priority i))) (setq i (1+ i)))))) (let ((count (if subexp submatches matches))) diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index 1484c38a403..695d7877b38 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -27,9 +27,9 @@ ;; The main exported function is `syntax-ppss'. You might also need ;; to call `syntax-ppss-flush-cache' or to add it to -;; after-change-functions'(although this is automatically done by +;; before-change-functions'(although this is automatically done by ;; syntax-ppss when needed, but that might fail if syntax-ppss is -;; called in a context where after-change-functions is temporarily +;; called in a context where before-change-functions is temporarily ;; let-bound to nil). ;;; Todo: @@ -94,10 +94,9 @@ point (where the PPSS is equivalent to nil).") (setq syntax-ppss-last nil) (setcar syntax-ppss-last nil))) ;; Unregister if there's no cache left. Sadly this doesn't work - ;; because `after-change-functions' is temporarily bound to nil here. + ;; because `before-change-functions' is temporarily bound to nil here. ;; (unless syntax-ppss-cache - ;; (remove-hook 'after-change-functions - ;; 'syntax-ppss-after-change-function t)) + ;; (remove-hook 'before-change-functions 'syntax-ppss-flush-cache t)) ) (defvar syntax-ppss-stats @@ -148,7 +147,7 @@ Point is at POS when this function returns." ;; too far from `pos', we could try to use other positions ;; in (nth 9 old-ppss), but that doesn't seem to happen in ;; practice and it would complicate this code (and the - ;; after-change-function code even more). But maybe it + ;; before-change-function code even more). But maybe it ;; would be useful in "degenerate" cases such as when the ;; whole file is wrapped in a set of parenthesis. (setq pt-min (or (car (nth 9 old-ppss)) @@ -176,10 +175,10 @@ Point is at POS when this function returns." (setq cache (cdr cache))) (if cache (setq pt-min (caar cache) ppss (cdar cache))) - ;; Setup the after-change function if necessary. + ;; Setup the before-change function if necessary. (unless (or syntax-ppss-cache syntax-ppss-last) - (add-hook 'after-change-functions - 'syntax-ppss-flush-cache nil t)) + (add-hook 'before-change-functions + 'syntax-ppss-flush-cache t t)) ;; Use the best of OLD-POS and CACHE. (if (or (not old-pos) (< old-pos pt-min)) diff --git a/lisp/env.el b/lisp/env.el index 66d505ee011..d0c2208fc6f 100644 --- a/lisp/env.el +++ b/lisp/env.el @@ -133,7 +133,7 @@ a side-effect." (let* ((var (read-envvar-name "Set environment variable: " nil)) (value (getenv var))) (when value - (push value setenv-history)) + (add-to-history 'setenv-history value)) ;; Here finally we specify the args to give call setenv with. (list var (read-from-minibuffer (format "Set %s to value: " var) diff --git a/lisp/files.el b/lisp/files.el index 16c0f1288a1..c79365a6926 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2350,31 +2350,29 @@ asking you for confirmation." ;; For variables defined in the C source code the declaration should go here: ;; FIXME: Some variables should be moved according to the rules above. -(let ((string-or-null (lambda (a) (or (stringp a) (null a))))) - (eval - `(mapc (lambda (pair) - (put (car pair) 'safe-local-variable (cdr pair))) - '((byte-compile-dynamic . booleanp) - (byte-compile-dynamic-docstrings . booleanp) - (byte-compile-warnings . booleanp) - (c-basic-offset . integerp) - (c-file-style . stringp) - (c-indent-level . integerp) - (comment-column . integerp) - (compile-command . string-or-null-p) - (find-file-visit-truename . booleanp) - (fill-column . integerp) - (fill-prefix . string-or-null-p) - (indent-tabs-mode . booleanp) ;; C source code - (kept-old-versions . integerp) - (kept-new-versions . integerp) - (left-margin . integerp) - (no-byte-compile . booleanp) - (no-update-autoloads . booleanp) - (outline-regexp . string-or-null-p) - (tab-width . integerp) ;; C source code - (truncate-lines . booleanp) ;; C source code - (version-control . symbolp))))) +(mapc (lambda (pair) + (put (car pair) 'safe-local-variable (cdr pair))) + '((byte-compile-dynamic . booleanp) + (byte-compile-dynamic-docstrings . booleanp) + (byte-compile-warnings . booleanp) + (c-basic-offset . integerp) + (c-file-style . stringp) + (c-indent-level . integerp) + (comment-column . integerp) + (compile-command . string-or-null-p) + (find-file-visit-truename . booleanp) + (fill-column . integerp) + (fill-prefix . string-or-null-p) + (indent-tabs-mode . booleanp) ;; C source code + (kept-old-versions . integerp) + (kept-new-versions . integerp) + (left-margin . integerp) + (no-byte-compile . booleanp) + (no-update-autoloads . booleanp) + (outline-regexp . string-or-null-p) + (tab-width . integerp) ;; C source code + (truncate-lines . booleanp) ;; C source code + (version-control . symbolp))) (put 'c-set-style 'safe-local-eval-function t) @@ -3932,7 +3930,7 @@ user. In such situations, one has to be careful with potentially time consuming operations. For more information on how this variable is used by Auto Revert mode, -see Info node `(emacs-xtra)Supporting additional buffers'.") +see Info node `(emacs)Supporting additional buffers'.") (defvar before-revert-hook nil "Normal hook for `revert-buffer' to run before reverting. diff --git a/lisp/font-lock.el b/lisp/font-lock.el index c2b8d7200da..f001a0bfaac 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1974,17 +1974,17 @@ This function could be MATCHER in a MATCH-ANCHORED `font-lock-keywords' item." ;; ;; (regexp-opt ;; '("define" "elif" "else" "endif" "error" "file" "if" "ifdef" -;; "ifndef" "include" "line" "pragma" "undef")) +;; "ifndef" "import" "include" "line" "pragma" "undef" "warning")) ;; (defconst cpp-font-lock-keywords-source-directives - "define\\|e\\(?:l\\(?:if\\|se\\)\\|ndif\\|rror\\)\\|file\\|i\\(?:f\\(?:n?def\\)?\\|nclude\\)\\|line\\|pragma\\|undef" + "define\\|e\\(?:l\\(?:if\\|se\\)\\|ndif\\|rror\\)\\|file\\|i\\(?:f\\(?:n?def\\)?\\|mport\\|nclude\\)\\|line\\|pragma\\|undef\\|warning" "Regular expressoin used in `cpp-font-lock-keywords'.") ;; `cpp-font-lock-keywords-source-depth' is calculated from: ;; ;; (regexp-opt-depth (regexp-opt ;; '("define" "elif" "else" "endif" "error" "file" "if" "ifdef" -;; "ifndef" "include" "line" "pragma" "undef"))) +;; "ifndef" "import" "include" "line" "pragma" "undef" "warning"))) ;; (defconst cpp-font-lock-keywords-source-depth 0 "An integer representing regular expression depth of `cpp-font-lock-keywords-source-directives'. @@ -1996,7 +1996,7 @@ Used in `cpp-font-lock-keywords'.") (list ;; ;; Fontify error directives. - '("^#[ \t]*error[ \t]+\\(.+\\)" 1 font-lock-warning-face prepend) + '("^#[ \t]*\\(?:error\\|warning\\)[ \t]+\\(.+\\)" 1 font-lock-warning-face prepend) ;; ;; Fontify filenames in #include <...> preprocessor directives as strings. '("^#[ \t]*\\(?:import\\|include\\)[ \t]*\\(<[^>\"\n]*>?\\)" diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 4b1069b26c1..6264d2e56b5 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -324,14 +324,11 @@ directory, like `default-directory'." :type '(repeat function) :group 'ibuffer) -(eval-when-compile (defcustom ibuffer-compressed-file-name-regexp - (concat "\\.\\(" - (regexp-opt '("arj" "bgz" "bz2" "gz" "lzh" "taz" "tgz" "zip" "z")) - "\\)$") + "\\.\\(arj\\|bgz\\|bz2\\|gz\\|lzh\\|taz\\|tgz\\|zip\\|z\\)$" "Regexp to match compressed file names." :type 'regexp - :group 'ibuffer)) + :group 'ibuffer) (defcustom ibuffer-hook nil "Hook run when `ibuffer' is called." diff --git a/lisp/isearch.el b/lisp/isearch.el index 78b523f3845..840af2a9b81 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -831,21 +831,10 @@ NOPUSH is t and EDIT is t." (defun isearch-update-ring (string &optional regexp) "Add STRING to the beginning of the search ring. REGEXP if non-nil says use the regexp search ring." - (if regexp - (when (or (null regexp-search-ring) - (not (string= string (car regexp-search-ring)))) - (when history-delete-duplicates - (setq regexp-search-ring (delete string regexp-search-ring))) - (push string regexp-search-ring) - (when (> (length regexp-search-ring) regexp-search-ring-max) - (setcdr (nthcdr (1- search-ring-max) regexp-search-ring) nil))) - (when (or (null search-ring) - (not (string= string (car search-ring)))) - (when history-delete-duplicates - (setq search-ring (delete string search-ring))) - (push string search-ring) - (when (> (length search-ring) search-ring-max) - (setcdr (nthcdr (1- search-ring-max) search-ring) nil))))) + (add-to-history + (if regexp 'regexp-search-ring 'search-ring) + string + (if regexp regexp-search-ring-max search-ring-max))) ;; Switching buffers should first terminate isearch-mode. ;; ;; For Emacs 19, the frame switch event is handled. diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 4566d4c32c3..d3db76fcc8a 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -349,10 +349,8 @@ and `kmacro-counter-format'.") (defun kmacro-push-ring (&optional elt) "Push ELT or current macro onto `kmacro-ring'." (when (setq elt (or elt (kmacro-ring-head))) - (let ((len (length kmacro-ring))) - (setq kmacro-ring (cons elt kmacro-ring)) - (if (>= len kmacro-ring-max) - (setcdr (nthcdr len kmacro-ring) nil))))) + (let ((history-delete-duplicates nil)) + (add-to-history 'kmacro-ring elt kmacro-ring-max)))) (defun kmacro-split-ring-element (elt) @@ -377,11 +375,6 @@ Non-nil arg RAW means just return raw first element." (kmacro-pop-ring1 raw))) -(defun kmacro-ring-length () - "Return length of macro ring, including pseudo head." - (+ (if last-kbd-macro 1 0) (length kmacro-ring))) - - (defun kmacro-ring-empty-p (&optional none) "Tell user and return t if `last-kbd-macro' is nil or `kmacro-ring' is empty. Check only `last-kbd-macro' if optional arg NONE is non-nil." @@ -577,13 +570,8 @@ Use \\[kmacro-bind-to-key] to bind it to a key sequence." (let ((append (and arg (listp arg)))) (unless append (if last-kbd-macro - (let ((len (length kmacro-ring))) - (setq kmacro-ring - (cons - (list last-kbd-macro kmacro-counter kmacro-counter-format-start) - kmacro-ring)) - (if (>= len kmacro-ring-max) - (setcdr (nthcdr len kmacro-ring) nil)))) + (kmacro-push-ring + (list last-kbd-macro kmacro-counter kmacro-counter-format-start))) (setq kmacro-counter (or (if arg (prefix-numeric-value arg)) kmacro-initial-counter-value 0) diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 402278489bf..6d6c03823d3 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -7037,7 +7037,7 @@ or delete subdirectories can bypass this machinery. Hence, you sometimes may have to reset some subdirectory switches after a `dired-undo'. You can reset all subdirectory switches to the default using \\<dired-mode-map>\\[dired-reset-subdir-switches]. -See Info node `(emacs-xtra)Subdir switches' for more details. +See Info node `(emacs)Subdir switches' for more details. \(fn &optional ARG TEST-FOR-SUBDIR)" t nil) @@ -7175,7 +7175,7 @@ or delete subdirectories can bypass this machinery. Hence, you sometimes may have to reset some subdirectory switches after a `dired-undo'. You can reset all subdirectory switches to the default using \\<dired-mode-map>\\[dired-reset-subdir-switches]. -See Info node `(emacs-xtra)Subdir switches' for more details. +See Info node `(emacs)Subdir switches' for more details. \(fn DIRNAME &optional SWITCHES NO-ERROR-IF-NOT-DIR-P)" t nil) diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog index f7846394638..94632f8c38d 100644 --- a/lisp/mh-e/ChangeLog +++ b/lisp/mh-e/ChangeLog @@ -1,3 +1,13 @@ +2006-05-06 Bill Wohler <wohler@newt.com> + + Release MH-E version 8.0. + + * mh-e.el (Version, mh-version): Update for release 8.0. + +2006-05-05 Bill Wohler <wohler@newt.com> + + * mh-e.el: Update commentary. + 2006-04-28 Bill Wohler <wohler@newt.com> Release MH-E version 7.95. diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 88b8c5bac09..28fff81e93b 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -6,7 +6,7 @@ ;; Author: Bill Wohler <wohler@newt.com> ;; Maintainer: Bill Wohler <wohler@newt.com> -;; Version: 7.95 +;; Version: 8.0 ;; Keywords: mail ;; This file is part of GNU Emacs. @@ -28,6 +28,20 @@ ;;; Commentary: +;; MH-E is an Emacs interface to the MH mail system. + +;; MH-E is supported by GNU Emacs 21 and 22, as well as XEmacs 21 +;; (except for versions 21.5.9-21.5.16). It is compatible with MH +;; versions 6.8.4 and higher, all versions of nmh, and GNU mailutils +;; 0.4 and higher. + +;; MH (Message Handler) is a powerful mail reader. See +;; http://rand-mh.sourceforge.net/. + +;; N.B. MH must have been compiled with the MHE compiler flag or several +;; features necessary for MH-E will be missing from MH commands, specifically +;; the -build switch to repl and forw. + ;; How to use: ;; M-x mh-rmail to read mail. Type C-h m there for a list of commands. ;; C-u M-x mh-rmail to visit any folder. @@ -44,23 +58,6 @@ ;; If you want to customize MH-E before explicitly loading it, add this: ;; (require 'mh-cus-load) -;; MH (Message Handler) is a powerful mail reader. - -;; The MH newsgroup is comp.mail.mh; the mailing list is mh-users@ics.uci.edu -;; (send to mh-users-request to be added). See the monthly Frequently Asked -;; Questions posting there for information on getting MH and MH-E: -;; http://www.faqs.org/faqs/mail/mh-faq/part1/preamble.html - -;; N.B. MH must have been compiled with the MHE compiler flag or several -;; features necessary for MH-E will be missing from MH commands, specifically -;; the -build switch to repl and forw. - -;; MH-E is an Emacs interface to the MH mail system. - -;; MH-E is supported in GNU Emacs 21 and 22 as well as XEmacs 21 -;; (except for versions 21.5.9-21.5.16), with MH 6.8.4 on, nmh 1.0.4 -;; on, and GNU mailutils 0.4 on. - ;; Mailing Lists: ;; mh-e-users@lists.sourceforge.net ;; mh-e-announce@lists.sourceforge.net @@ -136,7 +133,7 @@ ;; Try to keep variables local to a single file. Provide accessors if ;; variables are shared. Use this section as a last resort. -(defconst mh-version "7.95" "Version number of MH-E.") +(defconst mh-version "8.0" "Version number of MH-E.") ;; Variants diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 662b992b343..b61971c7ea5 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -204,8 +204,25 @@ This should only be bound to mouse buttons 4 and 5." (setq amt (* amt (event-click-count event)))) (unwind-protect (let ((button (mwheel-event-button event))) - (cond ((eq button mouse-wheel-down-event) (scroll-down amt)) - ((eq button mouse-wheel-up-event) (scroll-up amt)) + (cond ((eq button mouse-wheel-down-event) + (condition-case nil (scroll-down amt) + ;; Make sure we do indeed scroll to the beginning of + ;; the buffer. + (beginning-of-buffer + (unwind-protect + (scroll-down) + ;; If the first scroll succeeded, then some scrolling + ;; is possible: keep scrolling til the beginning but + ;; do not signal an error. For some reason, we have + ;; to do it even if the first scroll signalled an + ;; error, because otherwise the window is recentered + ;; for a reason that escapes me. This problem seems + ;; to only affect scroll-down. --Stef + (set-window-start (selected-window) (point-min)))))) + ((eq button mouse-wheel-up-event) + (condition-case nil (scroll-up amt) + ;; Make sure we do indeed scroll to the end of the buffer. + (end-of-buffer (while t (scroll-up))))) (t (error "Bad binding in mwheel-scroll")))) (if curwin (select-window curwin)))) (when (and mouse-wheel-click-event mouse-wheel-inhibit-click-time) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 6e166aa2393..2ebc4d0b45e 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4331,7 +4331,7 @@ Falls back to normal file name handler if no tramp file name handler exists." "Add tramp file name handlers to `file-name-handler-alist'." (add-to-list 'file-name-handler-alist (cons tramp-file-name-regexp 'tramp-file-name-handler)) - (when partial-completion-mode + (when (or partial-completion-mode (featurep 'ido)) (add-to-list 'file-name-handler-alist (cons tramp-completion-file-name-regexp 'tramp-completion-file-name-handler)) diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el index 28fcb70bb8b..a20f11e0aa2 100644 --- a/lisp/progmodes/gdb-ui.el +++ b/lisp/progmodes/gdb-ui.el @@ -694,6 +694,7 @@ With arg, enter name of variable to be watched in the minibuffer." (if (and transient-mark-mode mark-active) (buffer-substring (region-beginning) (region-end)) (tooltip-identifier-from-point (point)))))) + (speedbar 1) (catch 'already-watched (dolist (var gdb-var-list) (unless (string-match "\\." (car var)) @@ -725,7 +726,6 @@ With arg, enter name of variable to be watched in the minibuffer." (match-string 3) nil nil gdb-frame-address))) (push var gdb-var-list) - (speedbar 1) (unless (string-equal speedbar-initial-expansion-list-name "GUD") (speedbar-change-initial-expansion-list "GUD")) @@ -741,13 +741,26 @@ With arg, enter name of variable to be watched in the minibuffer." (message-box "Watching expressions requires gdb 6.0 onwards") (message-box "No symbol \"%s\" in current context." expr)))) +(defun gdb-speedbar-update () + (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) + ;; Dummy command to update speedbar even when idle. + (gdb-enqueue-input (list "server pwd\n" 'gdb-speedbar-timer-fn)) + ;; Keep gdb-pending-triggers non-nil till end. + (push 'gdb-speedbar-timer gdb-pending-triggers))) + +(defun gdb-speedbar-timer-fn () + (setq gdb-pending-triggers + (delq 'gdb-speedbar-timer gdb-pending-triggers)) + (speedbar-timer-fn)) + (defun gdb-var-evaluate-expression-handler (varnum changed) (goto-char (point-min)) (re-search-forward ".*value=\\(\".*\"\\)" nil t) (let ((var (assoc varnum gdb-var-list))) (when var (if changed (setcar (nthcdr 5 var) 'changed)) - (setcar (nthcdr 4 var) (read (match-string 1)))))) + (setcar (nthcdr 4 var) (read (match-string 1))))) + (gdb-speedbar-update)) (defun gdb-var-list-children (varnum) (gdb-enqueue-input @@ -811,21 +824,7 @@ type_changed=\".*?\".*?}") varnum "\"\n") `(lambda () (gdb-var-evaluate-expression-handler ,varnum t))))))) (setq gdb-pending-triggers - (delq 'gdb-var-update gdb-pending-triggers)) - (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) - ;; Dummy command to update speedbar at right time. - (gdb-enqueue-input (list "server pwd\n" 'gdb-speedbar-refresh)) - ;; Keep gdb-pending-triggers non-nil till end. - (push 'gdb-speedbar-refresh gdb-pending-triggers))) - -(defun gdb-speedbar-refresh () - (setq gdb-pending-triggers - (delq 'gdb-speedbar-refresh gdb-pending-triggers)) - (with-current-buffer gud-comint-buffer - (let ((speedbar-verbosity-level 0) - (speedbar-shown-directories nil)) - (save-excursion - (speedbar-refresh))))) + (delq 'gdb-var-update gdb-pending-triggers))) (defun gdb-var-delete () "Delete watch expression at point from the speedbar." @@ -1912,7 +1911,7 @@ static char *magick[] = { (let* ((buffer (find-file-noselect (if (file-exists-p file) file (cdr (assoc bptno gdb-location-alist))))) - (window (unless (gdb-display-source-buffer buffer) + (window (or (gdb-display-source-buffer buffer) (display-buffer buffer)))) (setq gdb-source-window window) (with-current-buffer buffer @@ -2754,6 +2753,7 @@ corresponding to the mode line clicked." ;; Put buffer list in window if we ;; can't find a source file. (list-buffers-noselect)))) + (setq gdb-source-window (selected-window)) (when gdb-use-separate-io-buffer (split-window-horizontally) (other-window 1) @@ -2781,6 +2781,7 @@ This arrangement depends on the value of `gdb-many-windows'." (if gud-last-last-frame (gud-find-file (car gud-last-last-frame)) (gud-find-file gdb-main-file))) + (setq gdb-source-window (selected-window)) (other-window 1)))) (defun gdb-reset () @@ -2802,8 +2803,6 @@ Kills the gdb buffers, and resets variables and the source buffers." (setq overlay-arrow-variable-list (delq 'gdb-overlay-arrow-position overlay-arrow-variable-list)) (setq fringe-indicator-alist '((overlay-arrow . right-triangle))) - (if (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) - (speedbar-refresh)) (setq gud-running nil) (setq gdb-active-process nil) (setq gdb-var-list nil) @@ -3231,7 +3230,8 @@ numchild=\"\\(.+?\\)\",.*?value=\\(\".*?\"\\),.*?type=\"\\(.+?\\)\".*?}") (throw 'child-already-watched nil)) (push varchild var-list)))) (push var var-list))) - (setq gdb-var-list (nreverse var-list))))) + (setq gdb-var-list (nreverse var-list)))) + (gdb-speedbar-update)) ; Uses "-var-update --all-values". Needs GDB 6.4 onwards. (defun gdb-var-update-1 () @@ -3264,11 +3264,7 @@ in_scope=\"\\(.*?\\)\".*?}") (read (match-string 2))))))) (setq gdb-pending-triggers (delq 'gdb-var-update gdb-pending-triggers)) - (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) - ;; dummy command to update speedbar at right time - (gdb-enqueue-input (list "server pwd\n" 'gdb-speedbar-refresh)) - ;; keep gdb-pending-triggers non-nil till end - (push 'gdb-speedbar-refresh gdb-pending-triggers))) + (gdb-speedbar-update)) ;; Registers buffer. ;; diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index c695272e92b..410a973d1b4 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -639,9 +639,9 @@ The search is limited to file names matching shell pattern FILES. FILES may use abbreviations defined in `grep-files-aliases', e.g. entering `ch' is equivalent to `*.[ch]'. -With \\[universal-argument] prefix, allow user to edit the constructed -shell command line before it is executed. -With two \\[universal-argument] prefixes, edit and run grep shell command. +With \\[universal-argument] prefix, you can edit the constructed shell command line +before it is executed. +With two \\[universal-argument] prefixes, directly edit and run `grep-command'. Collect output in a buffer. While grep runs asynchronously, you can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] @@ -676,7 +676,7 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (setq command (read-from-minibuffer "Confirm: " command nil nil 'grep-history)) - (push command grep-history)))) + (add-to-history 'grep-history command)))) (when command ;; Setting process-setup-function makes exit-message-function work ;; even when async processes aren't supported. @@ -687,14 +687,14 @@ This command shares argument histories with \\[rgrep] and \\[grep]." ;;;###autoload (defun rgrep (regexp &optional files dir) - "Recusively grep for REGEXP in FILES in directory tree rooted at DIR. + "Recursively grep for REGEXP in FILES in directory tree rooted at DIR. The search is limited to file names matching shell pattern FILES. FILES may use abbreviations defined in `grep-files-aliases', e.g. entering `ch' is equivalent to `*.[ch]'. -With \\[universal-argument] prefix, allow user to edit the constructed -shell command line before it is executed. -With two \\[universal-argument] prefixes, edit and run grep-find shell command. +With \\[universal-argument] prefix, you can edit the constructed shell command line +before it is executed. +With two \\[universal-argument] prefixes, directly edit and run `grep-find-command'. Collect output in a buffer. While find runs asynchronously, you can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] @@ -721,16 +721,16 @@ This command shares argument histories with \\[lgrep] and \\[grep-find]." (if (null files) (if (not (string= regexp grep-find-command)) (compilation-start regexp 'grep-mode)) - (let* ((default-directory (file-name-as-directory (expand-file-name dir))) - (command (grep-expand-template - grep-find-template - regexp - (concat "\\( -name " - (mapconcat #'shell-quote-argument - (split-string files) - " -o -name ") - " \\)") - default-directory + (setq dir (file-name-as-directory (expand-file-name dir))) + (let ((command (grep-expand-template + grep-find-template + regexp + (concat "\\( -name " + (mapconcat #'shell-quote-argument + (split-string files) + " -o -name ") + " \\)") + dir (and grep-find-ignored-directories (concat "\\( -path '*/" (mapconcat #'identity @@ -742,8 +742,12 @@ This command shares argument histories with \\[lgrep] and \\[grep-find]." (setq command (read-from-minibuffer "Confirm: " command nil nil 'grep-find-history)) - (push command grep-find-history)) - (compilation-start command 'grep-mode)))))) + (add-to-history 'grep-find-history command)) + (let ((default-directory dir)) + (compilation-start command 'grep-mode)) + ;; Set default-directory if we started rgrep in the *grep* buffer. + (if (eq next-error-last-buffer (current-buffer)) + (setq default-directory dir))))))) (provide 'grep) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index d81a5fcf47b..987b37cf2c2 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -16723,8 +16723,7 @@ specified by a target." (progn (save-buffer) (kill-buffer (current-buffer)) (set-buffer orig-buffer) - (setq file-name-history - (cons makefile-path-name file-name-history))) + (add-to-history 'file-name-history makefile-path-name)) (vhdl-warning-when-idle (format "File not writable: \"%s\"" (abbreviate-file-name makefile-path-name))) diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el index 4f1cd37a9f7..0f55c71ac70 100644 --- a/lisp/progmodes/xscheme.el +++ b/lisp/progmodes/xscheme.el @@ -580,12 +580,9 @@ The strings are concatenated and terminated by a newline." ;;;; Scheme expressions ring (defun xscheme-insert-expression (string) - (setq xscheme-expressions-ring (cons string xscheme-expressions-ring)) - (if (> (length xscheme-expressions-ring) xscheme-expressions-ring-max) - (setcdr (nthcdr (1- xscheme-expressions-ring-max) - xscheme-expressions-ring) - nil)) - (setq xscheme-expressions-ring-yank-pointer xscheme-expressions-ring)) + (setq xscheme-expressions-ring-yank-pointer + (add-to-history 'xscheme-expressions-ring string + xscheme-expressions-ring-max))) (defun xscheme-rotate-yank-pointer (arg) "Rotate the yanking point in the kill ring." diff --git a/lisp/server.el b/lisp/server.el index 015c4c6f171..7835c56c3e2 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -858,7 +858,7 @@ so don't mark these buffers specially, just visit them normally." ;; deleted file, offer to write it. (let* ((filen (car file)) (obuf (get-file-buffer filen))) - (push filen file-name-history) + (add-to-history 'file-name-history filen) (if (and obuf (set-buffer obuf)) (progn (cond ((file-exists-p filen) diff --git a/lisp/simple.el b/lisp/simple.el index bd8a9d1a284..57e716e4683 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1144,7 +1144,7 @@ they are expressions; otherwise they are strings. \(That convention is designed to do the right thing for recursive uses of the minibuffer.)") (setq minibuffer-history-variable 'minibuffer-history) -(setq minibuffer-history-position nil) +(setq minibuffer-history-position nil) ;; Defvar is in C code. (defvar minibuffer-history-search-history nil) (defvar minibuffer-text-before-history nil diff --git a/lisp/speedbar.el b/lisp/speedbar.el index 4b83f08d89d..b3913f6f6c6 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -2529,8 +2529,7 @@ name will have the function FIND-FUN and not token." default-directory) (speedbar-message nil)))) ;; Else, we can do a short cut. No text cache. - (let ((cbd (expand-file-name default-directory)) - ) + (let ((cbd (expand-file-name default-directory))) (set-buffer speedbar-buffer) (speedbar-with-writable (let* ((window (get-buffer-window speedbar-buffer 0)) @@ -2542,8 +2541,7 @@ name will have the function FIND-FUN and not token." (funcall func cbd 0)) (speedbar-reconfigure-keymaps) (set-window-point window p) - (set-window-start window start))) - )))) + (set-window-start window start))))))) (defun speedbar-update-directory-contents () "Update the contents of the speedbar buffer based on the current directory." @@ -2677,7 +2675,6 @@ Also resets scanner functions." (frame-visible-p (speedbar-current-frame)) (not (eq (frame-visible-p (speedbar-current-frame)) 'icon))) (let ((af (selected-frame))) - (save-window-excursion (dframe-select-attached-frame speedbar-frame) ;; make sure we at least choose a window to ;; get a good directory from @@ -2704,14 +2701,8 @@ Also resets scanner functions." "Updating speedbar to special mode: %s...done" major-mode) (speedbar-message nil)))) - ;; Update all the contents if directories change! - (if (or (member major-mode speedbar-ignored-modes) - (eq af (speedbar-current-frame)) - (not (buffer-file-name))) - nil - (speedbar-update-localized-contents) - )) - (select-frame af))) + (speedbar-update-localized-contents)) + (select-frame af)) ;; Now run stealthy updates of time-consuming items (speedbar-stealthy-updates))))) (run-hooks 'speedbar-timer-hook)) diff --git a/lisp/startup.el b/lisp/startup.el index 07039fa8c18..12a53113f0a 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -827,7 +827,16 @@ opening the first frame (e.g. open a connection to an X server).") (format "Invalid user name %s" init-file-user) :error) - (if (file-directory-p (expand-file-name (concat "~" init-file-user))) + (if (file-directory-p (expand-file-name + ;; We don't support ~USER on MS-Windows except + ;; for the current user, and always load .emacs + ;; from the current user's home directory (see + ;; below). So always check "~", even if invoked + ;; with "-u USER", or if $USER or $LOGNAME are + ;; set to something different. + (if (eq system-type 'windows-nt) + "~" + (concat "~" init-file-user)))) nil (display-warning 'initialization (format "User %s has no home directory" @@ -1282,7 +1291,9 @@ where FACE is a valid face specification, as it can be used with (set-buffer buffer) (erase-buffer) (if pure-space-overflow - (insert "Warning Warning Pure space overflow Warning Warning\n")) + (insert "\ +Warning Warning!!! Pure space overflow !!!Warning Warning +\(See the node Pure Storage in the Lisp manual for details.)\n")) (fancy-splash-head) (apply #'fancy-splash-insert text) (fancy-splash-tail) @@ -1354,7 +1365,7 @@ mouse." emulation-mode-map-alists nil buffer-undo-list t mode-line-format (propertize "---- %b %-" - 'face '(:weight bold)) + 'face 'mode-line-buffer-id) fancy-splash-stop-time (+ (float-time) fancy-splash-max-time) timer (run-with-timer 0 fancy-splash-delay @@ -1406,10 +1417,12 @@ we put it on this frame." (with-current-buffer (get-buffer-create "GNU Emacs") (set (make-local-variable 'tab-width) 8) (set (make-local-variable 'mode-line-format) - (propertize "---- %b %-" 'face '(:weight bold))) + (propertize "---- %b %-" 'face 'mode-line-buffer-id)) (if pure-space-overflow - (insert "Warning Warning Pure space overflow Warning Warning\n")) + (insert "\ +Warning Warning!!! Pure space overflow !!!Warning Warning +\(See the node Pure Storage in the Lisp manual for details.)\n")) ;; The convention for this piece of code is that ;; each piece of output starts with one or two newlines @@ -1623,9 +1636,7 @@ normal otherwise." (not noninteractive)) (display-warning 'initialization - "Building Emacs overflowed pure space. See \"(elisp)Building Emacs\" for more information." - ;; FIXME: Tell the user what kind of problems are possible and how to fix - ;; the overflow. + "Building Emacs overflowed pure space. (See the node Pure Storage in the Lisp manual for details.)" :warning)) (when command-line-args-left diff --git a/lisp/subr.el b/lisp/subr.el index 43f1d5e57b1..bc7789f3384 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1122,6 +1122,31 @@ The return value is the new value of LIST-VAR." (if (and oa ob) (< oa ob) oa))))))) + +(defun add-to-history (history-var newelt &optional maxelt) + "Add NEWELT to the history list stored in the variable HISTORY-VAR. +Return the new history list. +If MAXELT is non-nil, it specifies the maximum length of the history. +Otherwise, the maximum history length is the value of the `history-length' +property on symbol HISTORY-VAR, if set, or the value of the `history-length' +variable. +Remove duplicates of NEWELT unless `history-delete-duplicates' is nil." + (unless maxelt + (setq maxelt (or (get history-var 'history-length) + history-length))) + (let ((history (symbol-value history-var)) + tail) + (if history-delete-duplicates + (setq history (delete newelt history))) + (setq history (cons newelt history)) + (when (integerp maxelt) + (if (= 0 maxelt) + (setq history nil) + (setq tail (nthcdr (1- maxelt) history)) + (when (consp tail) + (setcdr tail nil)))) + (set history-var history))) + ;;;; Mode hooks. @@ -1931,6 +1956,13 @@ Otherwise, return nil." "Return non-nil if OBJECT is one of the two canonical boolean values: t or nil." (memq object '(nil t))) +(defun field-at-pos (pos) + "Return the field at position POS, taking stickiness etc into account" + (let ((raw-field (get-char-property (field-beginning pos) 'field))) + (if (eq raw-field 'boundary) + (get-char-property (1- (field-end pos)) 'field) + raw-field))) + ;;;; Support for yanking and text properties. diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el index 4ab0606c18a..6931f796e5c 100644 --- a/lisp/term/mac-win.el +++ b/lisp/term/mac-win.el @@ -82,6 +82,8 @@ (defvar mac-services-selection) (defvar mac-system-script-code) (defvar mac-apple-event-map) +(defvar mac-atsu-font-table) +(defvar mac-font-panel-mode) (defvar x-invocation-args) (defvar x-command-line-resources nil) @@ -1128,6 +1130,107 @@ correspoinding TextEncodingBase value." (mac-add-charset-info "mac-dingbats" 34) (mac-add-charset-info "iso10646-1" 126) ; for ATSUI +(cp-make-coding-system + mac-centraleurroman + [?\,AD(B ?\$,1 (B ?\$,1 !(B ?\,AI(B ?\$,1 $(B ?\,AV(B ?\,A\(B ?\,Aa(B ?\$,1 %(B ?\$,1 ,(B ?\,Ad(B ?\$,1 -(B ?\$,1 &(B ?\$,1 '(B ?\,Ai(B ?\$,1!9(B + ?\$,1!:(B ?\$,1 .(B ?\,Am(B ?\$,1 /(B ?\$,1 2(B ?\$,1 3(B ?\$,1 6(B ?\,As(B ?\$,1 7(B ?\,At(B ?\,Av(B ?\,Au(B ?\,Az(B ?\$,1 :(B ?\$,1 ;(B ?\,A|(B + ?\$,1s (B ?\,A0(B ?\$,1 8(B ?\,A#(B ?\,A'(B ?\$,1s"(B ?\,A6(B ?\,A_(B ?\,A.(B ?\,A)(B ?\$,1ub(B ?\$,1 9(B ?\,A((B ?\$,1y (B ?\$,1 C(B ?\$,1 N(B + ?\$,1 O(B ?\$,1 J(B ?\$,1y$(B ?\$,1y%(B ?\$,1 K(B ?\$,1 V(B ?\$,1x"(B ?\$,1x1(B ?\$,1 b(B ?\$,1 [(B ?\$,1 \(B ?\$,1 ](B ?\$,1 ^(B ?\$,1 Y(B ?\$,1 Z(B ?\$,1 e(B + ?\$,1 f(B ?\$,1 c(B ?\,A,(B ?\$,1x:(B ?\$,1 d(B ?\$,1 g(B ?\$,1x&(B ?\,A+(B ?\,A;(B ?\$,1s&(B ?\,A (B ?\$,1 h(B ?\$,1 p(B ?\,AU(B ?\$,1 q(B ?\$,1 l(B + ?\$,1rs(B ?\$,1rt(B ?\$,1r|(B ?\$,1r}(B ?\$,1rx(B ?\$,1ry(B ?\,Aw(B ?\$,2"*(B ?\$,1 m(B ?\$,1 t(B ?\$,1 u(B ?\$,1 x(B ?\$,1s9(B ?\$,1s:(B ?\$,1 y(B ?\$,1 v(B + ?\$,1 w(B ?\$,1! (B ?\$,1rz(B ?\$,1r~(B ?\$,1!!(B ?\$,1 z(B ?\$,1 {(B ?\,AA(B ?\$,1!$(B ?\$,1!%(B ?\,AM(B ?\$,1!=(B ?\$,1!>(B ?\$,1!*(B ?\,AS(B ?\,AT(B + ?\$,1!+(B ?\$,1!.(B ?\,AZ(B ?\$,1!/(B ?\$,1!0(B ?\$,1!1(B ?\$,1!2(B ?\$,1!3(B ?\,A](B ?\,A}(B ?\$,1 W(B ?\$,1!;(B ?\$,1 a(B ?\$,1!<(B ?\$,1 B(B ?\$,1$g(B] + "Mac Central European Roman Encoding (MIME:x-mac-centraleurroman).") +(coding-system-put 'mac-centraleurroman 'mime-charset 'x-mac-centraleurroman) + +(cp-make-coding-system + mac-cyrillic + [?\$,1(0(B ?\$,1(1(B ?\$,1(2(B ?\$,1(3(B ?\$,1(4(B ?\$,1(5(B ?\$,1(6(B ?\$,1(7(B ?\$,1(8(B ?\$,1(9(B ?\$,1(:(B ?\$,1(;(B ?\$,1(<(B ?\$,1(=(B ?\$,1(>(B ?\$,1(?(B + ?\$,1(@(B ?\$,1(A(B ?\$,1(B(B ?\$,1(C(B ?\$,1(D(B ?\$,1(E(B ?\$,1(F(B ?\$,1(G(B ?\$,1(H(B ?\$,1(I(B ?\$,1(J(B ?\$,1(K(B ?\$,1(L(B ?\$,1(M(B ?\$,1(N(B ?\$,1(O(B + ?\$,1s (B ?\,A0(B ?\$,1)P(B ?\,A#(B ?\,A'(B ?\$,1s"(B ?\,A6(B ?\$,1(&(B ?\,A.(B ?\,A)(B ?\$,1ub(B ?\$,1("(B ?\$,1(r(B ?\$,1y (B ?\$,1(#(B ?\$,1(s(B + ?\$,1x>(B ?\,A1(B ?\$,1y$(B ?\$,1y%(B ?\$,1(v(B ?\,A5(B ?\$,1)Q(B ?\$,1(((B ?\$,1($(B ?\$,1(t(B ?\$,1('(B ?\$,1(w(B ?\$,1()(B ?\$,1(y(B ?\$,1(*(B ?\$,1(z(B + ?\$,1(x(B ?\$,1(%(B ?\,A,(B ?\$,1x:(B ?\$,1!R(B ?\$,1xh(B ?\$,1x&(B ?\,A+(B ?\,A;(B ?\$,1s&(B ?\,A (B ?\$,1(+(B ?\$,1({(B ?\$,1(,(B ?\$,1(|(B ?\$,1(u(B + ?\$,1rs(B ?\$,1rt(B ?\$,1r|(B ?\$,1r}(B ?\$,1rx(B ?\$,1ry(B ?\,Aw(B ?\$,1r~(B ?\$,1(.(B ?\$,1(~(B ?\$,1(/(B ?\$,1((B ?\$,1uV(B ?\$,1(!(B ?\$,1(q(B ?\$,1(o(B + ?\$,1(P(B ?\$,1(Q(B ?\$,1(R(B ?\$,1(S(B ?\$,1(T(B ?\$,1(U(B ?\$,1(V(B ?\$,1(W(B ?\$,1(X(B ?\$,1(Y(B ?\$,1(Z(B ?\$,1([(B ?\$,1(\(B ?\$,1(](B ?\$,1(^(B ?\$,1(_(B + ?\$,1(`(B ?\$,1(a(B ?\$,1(b(B ?\$,1(c(B ?\$,1(d(B ?\$,1(e(B ?\$,1(f(B ?\$,1(g(B ?\$,1(h(B ?\$,1(i(B ?\$,1(j(B ?\$,1(k(B ?\$,1(l(B ?\$,1(m(B ?\$,1(n(B ?\$,1tL(B] + "Mac Cyrillic Encoding (MIME:x-mac-cyrillic).") +(coding-system-put 'mac-cyrillic 'mime-charset 'x-mac-cyrillic) + +(let + ((encoding-vector + (vconcat + (make-vector 32 nil) + ;; mac-symbol (32..126) -> emacs-mule mapping + [?\ ?\! ?\$,1x (B ?\# ?\$,1x#(B ?\% ?\& ?\$,1x-(B ?\( ?\) ?\$,1x7(B ?\+ ?\, ?\$,1x2(B ?\. ?\/ + ?\0 ?\1 ?\2 ?\3 ?\4 ?\5 ?\6 ?\7 ?\8 ?\9 ?\: ?\; ?\< ?\= ?\> ?\? + ?\$,1xe(B ?\$,1&q(B ?\$,1&r(B ?\$,1''(B ?\$,1&t(B ?\$,1&u(B ?\$,1'&(B ?\$,1&s(B ?\$,1&w(B ?\$,1&y(B ?\$,1'Q(B ?\$,1&z(B ?\$,1&{(B ?\$,1&|(B ?\$,1&}(B ?\$,1&(B + ?\$,1' (B ?\$,1&x(B ?\$,1'!(B ?\$,1'#(B ?\$,1'$(B ?\$,1'%(B ?\$,1'B(B ?\$,1')(B ?\$,1&~(B ?\$,1'((B ?\$,1&v(B ?\[ ?\$,1xT(B ?\] ?\$,1ye(B ?\_ + ?\$,3bE(B ?\$,1'1(B ?\$,1'2(B ?\$,1'G(B ?\$,1'4(B ?\$,1'5(B ?\$,1'F(B ?\$,1'3(B ?\$,1'7(B ?\$,1'9(B ?\$,1'U(B ?\$,1':(B ?\$,1';(B ?\$,1'<(B ?\$,1'=(B ?\$,1'?(B + ?\$,1'@(B ?\$,1'8(B ?\$,1'A(B ?\$,1'C(B ?\$,1'D(B ?\$,1'E(B ?\$,1'V(B ?\$,1'I(B ?\$,1'>(B ?\$,1'H(B ?\$,1'6(B ?\{ ?\| ?\} ?\$,1x\(B] + (make-vector (- 160 127) nil) + ;; mac-symbol (160..254) -> emacs-mule mapping + ;; Mapping of the following characters are changed from the + ;; original one: + ;; 0xE2 0x00AE+0xF87F -> 0x00AE # REGISTERED SIGN, alternate: sans serif + ;; 0xE3 0x00A9+0xF87F -> 0x00A9 # COPYRIGHT SIGN, alternate: sans serif + ;; 0xE4 0x2122+0xF87F -> 0x2122 # TRADE MARK SIGN, alternate: sans serif + [?\$,1tL(B ?\$,1'R(B ?\$,1s2(B ?\$,1y$(B ?\$,1sD(B ?\$,1x>(B ?\$,1!R(B ?\$,2#c(B ?\$,2#f(B ?\$,2#e(B ?\$,2#`(B ?\$,1vt(B ?\$,1vp(B ?\$,1vq(B ?\$,1vr(B ?\$,1vs(B + ?\,A0(B ?\,A1(B ?\$,1s3(B ?\$,1y%(B ?\,AW(B ?\$,1x=(B ?\$,1x"(B ?\$,1s"(B ?\,Aw(B ?\$,1y (B ?\$,1y!(B ?\$,1xh(B ?\$,1s&(B ?\$,1|p(B ?\$,1|O(B ?\$,1w5(B + ?\$,1uu(B ?\$,1uQ(B ?\$,1u\(B ?\$,1uX(B ?\$,1yW(B ?\$,1yU(B ?\$,1x%(B ?\$,1xI(B ?\$,1xJ(B ?\$,1yC(B ?\$,1yG(B ?\$,1yD(B ?\$,1yB(B ?\$,1yF(B ?\$,1x((B ?\$,1x)(B + ?\$,1x@(B ?\$,1x'(B ?\,A.(B ?\,A)(B ?\$,1ub(B ?\$,1x/(B ?\$,1x:(B ?\$,1z%(B ?\,A,(B ?\$,1xG(B ?\$,1xH(B ?\$,1wT(B ?\$,1wP(B ?\$,1wQ(B ?\$,1wR(B ?\$,1wS(B + ?\$,2"*(B ?\$,2=H(B ?\,A.(B ?\,A)(B ?\$,1ub(B ?\$,1x1(B ?\$,1|;(B ?\$,1|<(B ?\$,1|=(B ?\$,1|A(B ?\$,1|B(B ?\$,1|C(B ?\$,1|G(B ?\$,1|H(B ?\$,1|I(B ?\$,1|J(B + ?\$,3b_(B ?\$,2=I(B ?\$,1xK(B ?\$,1{ (B ?\$,1|N(B ?\$,1{!(B ?\$,1|>(B ?\$,1|?(B ?\$,1|@(B ?\$,1|D(B ?\$,1|E(B ?\$,1|F(B ?\$,1|K(B ?\$,1|L(B ?\$,1|M(B + nil])) + translation-table) + (setq translation-table + (make-translation-table-from-vector encoding-vector)) +;; (define-translation-table 'mac-symbol-decoder translation-table) + (define-translation-table 'mac-symbol-encoder + (char-table-extra-slot translation-table 0))) + +(let + ((encoding-vector + (vconcat + (make-vector 32 nil) + ;; mac-dingbats (32..126) -> emacs-mule mapping + [?\ ?\$,2%A(B ?\$,2%B(B ?\$,2%C(B ?\$,2%D(B ?\$,2"n(B ?\$,2%F(B ?\$,2%G(B ?\$,2%H(B ?\$,2%I(B ?\$,2"{(B ?\$,2"~(B ?\$,2%L(B ?\$,2%M(B ?\$,2%N(B ?\$,2%O(B + ?\$,2%P(B ?\$,2%Q(B ?\$,2%R(B ?\$,2%S(B ?\$,2%T(B ?\$,2%U(B ?\$,2%V(B ?\$,2%W(B ?\$,2%X(B ?\$,2%Y(B ?\$,2%Z(B ?\$,2%[(B ?\$,2%\(B ?\$,2%](B ?\$,2%^(B ?\$,2%_(B + ?\$,2%`(B ?\$,2%a(B ?\$,2%b(B ?\$,2%c(B ?\$,2%d(B ?\$,2%e(B ?\$,2%f(B ?\$,2%g(B ?\$,2"e(B ?\$,2%i(B ?\$,2%j(B ?\$,2%k(B ?\$,2%l(B ?\$,2%m(B ?\$,2%n(B ?\$,2%o(B + ?\$,2%p(B ?\$,2%q(B ?\$,2%r(B ?\$,2%s(B ?\$,2%t(B ?\$,2%u(B ?\$,2%v(B ?\$,2%w(B ?\$,2%x(B ?\$,2%y(B ?\$,2%z(B ?\$,2%{(B ?\$,2%|(B ?\$,2%}(B ?\$,2%~(B ?\$,2%(B + ?\$,2& (B ?\$,2&!(B ?\$,2&"(B ?\$,2&#(B ?\$,2&$(B ?\$,2&%(B ?\$,2&&(B ?\$,2&'(B ?\$,2&((B ?\$,2&)(B ?\$,2&*(B ?\$,2&+(B ?\$,2"/(B ?\$,2&-(B ?\$,2!`(B ?\$,2&/(B + ?\$,2&0(B ?\$,2&1(B ?\$,2&2(B ?\$,2!r(B ?\$,2!|(B ?\$,2"&(B ?\$,2&6(B ?\$,2"7(B ?\$,2&8(B ?\$,2&9(B ?\$,2&:(B ?\$,2&;(B ?\$,2&<(B ?\$,2&=(B ?\$,2&>(B + nil + ;; mac-dingbats (128..141) -> emacs-mule mapping + ?\$,2&H(B ?\$,2&I(B ?\$,2&J(B ?\$,2&K(B ?\$,2&L(B ?\$,2&M(B ?\$,2&N(B ?\$,2&O(B ?\$,2&P(B ?\$,2&Q(B ?\$,2&R(B ?\$,2&S(B ?\$,2&T(B ?\$,2&U(B] + (make-vector (- 161 142) nil) + ;; mac-dingbats (161..239) -> emacs-mule mapping + [?\$,2&A(B ?\$,2&B(B ?\$,2&C(B ?\$,2&D(B ?\$,2&E(B ?\$,2&F(B ?\$,2&G(B ?\$,2#c(B ?\$,2#f(B ?\$,2#e(B ?\$,2#`(B ?\$,1~@(B ?\$,1~A(B ?\$,1~B(B ?\$,1~C(B + ?\$,1~D(B ?\$,1~E(B ?\$,1~F(B ?\$,1~G(B ?\$,1~H(B ?\$,1~I(B ?\$,2&V(B ?\$,2&W(B ?\$,2&X(B ?\$,2&Y(B ?\$,2&Z(B ?\$,2&[(B ?\$,2&\(B ?\$,2&](B ?\$,2&^(B ?\$,2&_(B + ?\$,2&`(B ?\$,2&a(B ?\$,2&b(B ?\$,2&c(B ?\$,2&d(B ?\$,2&e(B ?\$,2&f(B ?\$,2&g(B ?\$,2&h(B ?\$,2&i(B ?\$,2&j(B ?\$,2&k(B ?\$,2&l(B ?\$,2&m(B ?\$,2&n(B ?\$,2&o(B + ?\$,2&p(B ?\$,2&q(B ?\$,2&r(B ?\$,2&s(B ?\$,2&t(B ?\$,1vr(B ?\$,1vt(B ?\$,1vu(B ?\$,2&x(B ?\$,2&y(B ?\$,2&z(B ?\$,2&{(B ?\$,2&|(B ?\$,2&}(B ?\$,2&~(B ?\$,2&(B + ?\$,2' (B ?\$,2'!(B ?\$,2'"(B ?\$,2'#(B ?\$,2'$(B ?\$,2'%(B ?\$,2'&(B ?\$,2''(B ?\$,2'((B ?\$,2')(B ?\$,2'*(B ?\$,2'+(B ?\$,2',(B ?\$,2'-(B ?\$,2'.(B ?\$,2'/(B + nil + ;; mac-dingbats (241..254) -> emacs-mule mapping + ?\$,2'1(B ?\$,2'2(B ?\$,2'3(B ?\$,2'4(B ?\$,2'5(B ?\$,2'6(B ?\$,2'7(B ?\$,2'8(B ?\$,2'9(B ?\$,2':(B ?\$,2';(B ?\$,2'<(B ?\$,2'=(B ?\$,2'>(B + nil])) + translation-table) + (setq translation-table + (make-translation-table-from-vector encoding-vector)) +;; (define-translation-table 'mac-dingbats-decoder translation-table) + (define-translation-table 'mac-dingbats-encoder + (char-table-extra-slot translation-table 0))) + +(defconst mac-system-coding-system + (let ((base (or (cdr (assq mac-system-script-code + mac-script-code-coding-systems)) + 'mac-roman))) + (if (eq system-type 'darwin) + base + (coding-system-change-eol-conversion base 'mac))) + "Coding system derived from the system script code.") + +(set-selection-coding-system mac-system-coding-system) + ;;;; Keyboard layout/language change events (defun mac-handle-language-change (event) @@ -1141,6 +1244,91 @@ correspoinding TextEncodingBase value." (define-key key-translation-map [?\x80] "\\")))) (define-key special-event-map [language-change] 'mac-handle-language-change) + + +;;;; Conversion between common flavors and Lisp string. + +(defconst mac-text-encoding-mac-japanese-basic-variant #x20001 + "MacJapanese text encoding without Apple double-byte extensions.") + +(defun mac-utxt-to-string (data &optional coding-system) + (or coding-system (setq coding-system mac-system-coding-system)) + (let* ((encoding + (and (eq system-type 'darwin) + (eq (coding-system-base coding-system) 'japanese-shift-jis) + mac-text-encoding-mac-japanese-basic-variant)) + (str (and (fboundp 'mac-code-convert-string) + (mac-code-convert-string data nil + (or encoding coding-system))))) + (when str + (setq str (decode-coding-string str coding-system)) + (if (eq encoding mac-text-encoding-mac-japanese-basic-variant) + ;; Does it contain Apple one-byte extensions other than + ;; reverse solidus? + (if (string-match "[\xa0\xfd-\xff]" str) + (setq str nil) + ;; ASCII-only? + (unless (string-match "\\`[[:ascii:]]*\\'" str) + (subst-char-in-string ?\x5c ?\(J\(B str t) + (subst-char-in-string ?\x80 ?\\ str t))))) + (or str + (decode-coding-string data + (if (eq (byteorder) ?B) 'utf-16be 'utf-16le))))) + +(defun mac-string-to-utxt (string &optional coding-system) + (or coding-system (setq coding-system mac-system-coding-system)) + (let (data encoding) + (when (and (fboundp 'mac-code-convert-string) + (memq (coding-system-base coding-system) + (find-coding-systems-string string))) + (setq coding-system + (coding-system-change-eol-conversion coding-system 'mac)) + (when (and (eq system-type 'darwin) + (eq coding-system 'japanese-shift-jis-mac)) + (setq encoding mac-text-encoding-mac-japanese-basic-variant) + (setq string (subst-char-in-string ?\\ ?\x80 string)) + (subst-char-in-string ?\(J\(B ?\x5c string t)) + (setq data (mac-code-convert-string + (encode-coding-string string coding-system) + (or encoding coding-system) nil))) + (or data (encode-coding-string string (if (eq (byteorder) ?B) + 'utf-16be-mac + 'utf-16le-mac))))) + +(defun mac-TEXT-to-string (data &optional coding-system) + (or coding-system (setq coding-system mac-system-coding-system)) + (prog1 (setq data (decode-coding-string data coding-system)) + (when (eq (coding-system-base coding-system) 'japanese-shift-jis) + ;; (subst-char-in-string ?\x5c ?\(J\(B data t) + (subst-char-in-string ?\x80 ?\\ data t)))) + +(defun mac-string-to-TEXT (string &optional coding-system) + (or coding-system (setq coding-system mac-system-coding-system)) + (let ((encodables (find-coding-systems-string string)) + (rest mac-script-code-coding-systems)) + (unless (memq (coding-system-base coding-system) encodables) + (while (and rest (not (memq (cdar rest) encodables))) + (setq rest (cdr rest))) + (if rest + (setq coding-system (cdar rest))))) + (setq coding-system + (coding-system-change-eol-conversion coding-system 'mac)) + (when (eq coding-system 'japanese-shift-jis-mac) + ;; (setq string (subst-char-in-string ?\\ ?\x80 string)) + (setq string (subst-char-in-string ?\(J\(B ?\x5c string))) + (encode-coding-string string coding-system)) + +(defun mac-furl-to-string (data) + ;; Remove a trailing nul character. + (let ((len (length data))) + (if (and (> len 0) (= (aref data (1- len)) ?\0)) + (substring data 0 (1- len)) + data))) + +(defun mac-TIFF-to-string (data &optional text) + (prog1 (or text (setq text (copy-sequence " "))) + (put-text-property 0 (length text) 'display (create-image data 'tiff t) + text))) ;;;; Selections @@ -1190,22 +1378,11 @@ in `selection-converter-alist', which see." (when (and (stringp data) (setq data-type (get-text-property 0 'foreign-selection data))) (cond ((eq data-type 'public.utf16-plain-text) - (let ((encoded (and (fboundp 'mac-code-convert-string) - (mac-code-convert-string data nil coding)))) - (if encoded - (setq data (decode-coding-string encoded coding)) - (setq data - (decode-coding-string data - (if (eq (byteorder) ?B) - 'utf-16be 'utf-16le)))))) + (setq data (mac-utxt-to-string data coding))) ((eq data-type 'com.apple.traditional-mac-plain-text) - (setq data (decode-coding-string data coding))) + (setq data (mac-TEXT-to-string data coding))) ((eq data-type 'public.file-url) - (setq data (decode-coding-string data 'utf-8)) - ;; Remove a trailing nul character. - (let ((len (length data))) - (if (and (> len 0) (= (aref data (1- len)) ?\0)) - (setq data (substring data 0 (1- len))))))) + (setq data (mac-furl-to-string data)))) (put-text-property 0 (length data) 'foreign-selection data-type data)) data)) @@ -1227,9 +1404,7 @@ in `selection-converter-alist', which see." (when tiff-image (remove-text-properties 0 (length tiff-image) '(foreign-selection nil) tiff-image) - (setq tiff-image (create-image tiff-image 'tiff t)) - (or text (setq text " ")) - (put-text-property 0 (length text) 'display tiff-image text)) + (setq text (mac-TIFF-to-string tiff-image text))) text)) ;;; Return the value of the current selection. @@ -1300,11 +1475,7 @@ in `selection-converter-alist', which see." (defun mac-select-convert-to-string (selection type value) (let ((str (cdr (xselect-convert-to-string selection nil value))) - coding) - (setq coding (or next-selection-coding-system selection-coding-system)) - (if coding - (setq coding (coding-system-base coding)) - (setq coding 'raw-text)) + (coding (or next-selection-coding-system selection-coding-system))) (when str ;; If TYPE is nil, this is a local request, thus return STR as ;; is. Otherwise, encode STR. @@ -1314,28 +1485,9 @@ in `selection-converter-alist', which see." (remove-text-properties 0 (length str) '(composition nil) str) (cond ((eq type 'public.utf16-plain-text) - (let (s) - (when (and (fboundp 'mac-code-convert-string) - (memq coding (find-coding-systems-string str))) - (setq coding (coding-system-change-eol-conversion coding 'mac)) - (setq s (mac-code-convert-string - (encode-coding-string str coding) - coding nil))) - (setq str (or s - (encode-coding-string str - (if (eq (byteorder) ?B) - 'utf-16be-mac - 'utf-16le-mac)))))) + (setq str (mac-string-to-utxt str coding))) ((eq type 'com.apple.traditional-mac-plain-text) - (let ((encodables (find-coding-systems-string str)) - (rest mac-script-code-coding-systems)) - (unless (memq coding encodables) - (while (and rest (not (memq (cdar rest) encodables))) - (setq rest (cdr rest))) - (if rest - (setq coding (cdar rest))))) - (setq coding (coding-system-change-eol-conversion coding 'mac)) - (setq str (encode-coding-string str coding))) + (setq str (mac-string-to-TEXT str coding))) (t (error "Unknown selection type: %S" type)) ))) @@ -1433,6 +1585,17 @@ in `selection-converter-alist', which see." (ash (lsh result extended-sign-len) (- extended-sign-len)) result))) +(defun mac-bytes-to-digits (bytes &optional from to) + (or from (setq from 0)) + (or to (setq to (length bytes))) + (let ((len (- to from)) + (val 0.0)) + (dotimes (i len) + (setq val (+ (* val 256.0) + (aref bytes (+ from (if (eq (byteorder) ?B) i + (- len i 1))))))) + (format "%.0f" val))) + (defun mac-ae-selection-range (ae) ;; #pragma options align=mac68k ;; typedef struct SelectionRange { @@ -1518,6 +1681,78 @@ Currently the `mailto' scheme is supported." (define-key mac-apple-event-map [hicommand about] 'display-splash-screen) +;;; Converted Carbon Events +(defun mac-handle-toolbar-switch-mode (event) + "Toggle visibility of tool-bars in response to EVENT. +With no keyboard modifiers, it toggles the visibility of the +frame where the tool-bar toggle button was pressed. With some +modifiers, it changes global tool-bar visibility setting." + (interactive "e") + (let* ((ae (mac-event-ae event)) + (modifiers (cdr (mac-ae-parameter ae "kmod")))) + (if (and modifiers (not (string= modifiers "\000\000\000\000"))) + ;; Globally toggle tool-bar-mode if some modifier key is pressed. + (tool-bar-mode) + (let ((window-id (mac-bytes-to-digits (cdr (mac-ae-parameter ae)))) + (rest (frame-list)) + frame) + (while (and (null frame) rest) + (if (string= (frame-parameter (car rest) 'window-id) window-id) + (setq frame (car rest))) + (setq rest (cdr rest))) + (set-frame-parameter frame 'tool-bar-lines + (if (= (frame-parameter frame 'tool-bar-lines) 0) + 1 0)))))) + +;; kEventClassWindow/kEventWindowToolbarSwitchMode +(define-key mac-apple-event-map [window toolbar-switch-mode] + 'mac-handle-toolbar-switch-mode) + +;;; Font panel +(when (fboundp 'mac-set-font-panel-visibility) + +(define-minor-mode mac-font-panel-mode + "Toggle use of the font panel. +With numeric ARG, display the panel bar if and only if ARG is positive." + :init-value nil + :global t + :group 'mac + (mac-set-font-panel-visibility mac-font-panel-mode)) + +(defun mac-handle-font-panel-closed (event) + "Update internal status in response to font panel closed EVENT." + (interactive "e") + ;; Synchronize with the minor mode variable. + (mac-font-panel-mode 0)) + +(defun mac-handle-font-selection (event) + "Change default face attributes according to font selection EVENT." + (interactive "e") + (let* ((ae (mac-event-ae event)) + (fm-font-size (cdr (mac-ae-parameter ae "fmsz"))) + (atsu-font-id (cdr (mac-ae-parameter ae "auid"))) + (attribute-values (gethash atsu-font-id mac-atsu-font-table))) + (if fm-font-size + (setq attribute-values + `(:height ,(* 10 (mac-bytes-to-integer fm-font-size)) + ,@attribute-values))) + (apply 'set-face-attribute 'default (selected-frame) attribute-values))) + +;; kEventClassFont/kEventFontPanelClosed +(define-key mac-apple-event-map [font panel-closed] + 'mac-handle-font-panel-closed) +;; kEventClassFont/kEventFontSelection +(define-key mac-apple-event-map [font selection] 'mac-handle-font-selection) + +(define-key-after menu-bar-showhide-menu [mac-font-panel-mode] + (menu-bar-make-mm-toggle mac-font-panel-mode + "Font Panel" + "Show the font panel as a floating dialog") + 'showhide-speedbar) + +) ;; (fboundp 'mac-set-font-panel-visibility) + +;;; Services (defun mac-services-open-file () "Open the file specified by the selection value for Services." (interactive) @@ -1589,6 +1824,83 @@ Currently the `mailto' scheme is supported." ;; processed when the initial frame has been created: this is where ;; the files should be opened. (add-hook 'after-init-hook 'mac-process-deferred-apple-events) + + +;;;; Drag and drop + +(defcustom mac-dnd-types-alist + '(("furl" . mac-dnd-handle-furl) + ("hfs " . mac-dnd-handle-hfs) + ("utxt" . mac-dnd-insert-utxt) + ("TEXT" . mac-dnd-insert-TEXT) + ("TIFF" . mac-dnd-insert-TIFF)) + "Which function to call to handle a drop of that type. +The function takes three arguments, WINDOW, ACTION and DATA. +WINDOW is where the drop occured, ACTION is always `private' on +Mac. DATA is the drop data. Unlike the x-dnd counterpart, the +return value of the function is not significant. + +See also `mac-dnd-known-types'." + :version "22.1" + :type 'alist + :group 'mac) + +(defun mac-dnd-handle-furl (window action data) + (dnd-handle-one-url window action (mac-furl-to-string data))) + +(defun mac-dnd-handle-hfs (window action data) +;; struct HFSFlavor { +;; OSType fileType; +;; OSType fileCreator; +;; UInt16 fdFlags; +;; FSSpec fileSpec; +;; }; + (let* ((file-name (mac-coerce-ae-data "fss " (substring data 10) + 'undecoded-file-name)) + (url (concat "file://" + (mapconcat 'url-hexify-string + (split-string file-name "/") "/")))) + (dnd-handle-one-url window action url))) + +(defun mac-dnd-insert-utxt (window action data) + (dnd-insert-text window action (mac-utxt-to-string data))) + +(defun mac-dnd-insert-TEXT (window action data) + (dnd-insert-text window action (mac-TEXT-to-string data))) + +(defun mac-dnd-insert-TIFF (window action data) + (dnd-insert-text window action (mac-TIFF-to-string data))) + +(defun mac-dnd-drop-data (event frame window data type) + (let* ((type-info (assoc type mac-dnd-types-alist)) + (handler (cdr type-info)) + (action 'private) + (w (posn-window (event-start event)))) + (when handler + (if (and (windowp w) (window-live-p w) + (not (window-minibuffer-p w)) + (not (window-dedicated-p w))) + ;; If dropping in an ordinary window which we could use, + ;; let dnd-open-file-other-window specify what to do. + (progn + (goto-char (posn-point (event-start event))) + (funcall handler window action data)) + ;; If we can't display the file here, + ;; make a new window for it. + (let ((dnd-open-file-other-window t)) + (select-frame frame) + (funcall handler window action data)))))) + +(defun mac-dnd-handle-drag-n-drop-event (event) + "Receive drag and drop events." + (interactive "e") + (let ((window (posn-window (event-start event)))) + (when (windowp window) (select-window window)) + (dolist (item (mac-ae-list (mac-event-ae event))) + (if (not (equal (car item) "null")) + (mac-dnd-drop-data event (selected-frame) window + (cdr item) (car item))))) + (select-frame-set-input-focus (selected-frame))) ;;; Do the actual Windows setup here; the above code just defines ;;; functions and variables that we use now. @@ -1618,96 +1930,6 @@ Currently the `mailto' scheme is supported." (setq frame-creation-function 'x-create-frame-with-faces) -(cp-make-coding-system - mac-centraleurroman - [?\,AD(B ?\$,1 (B ?\$,1 !(B ?\,AI(B ?\$,1 $(B ?\,AV(B ?\,A\(B ?\,Aa(B ?\$,1 %(B ?\$,1 ,(B ?\,Ad(B ?\$,1 -(B ?\$,1 &(B ?\$,1 '(B ?\,Ai(B ?\$,1!9(B - ?\$,1!:(B ?\$,1 .(B ?\,Am(B ?\$,1 /(B ?\$,1 2(B ?\$,1 3(B ?\$,1 6(B ?\,As(B ?\$,1 7(B ?\,At(B ?\,Av(B ?\,Au(B ?\,Az(B ?\$,1 :(B ?\$,1 ;(B ?\,A|(B - ?\$,1s (B ?\,A0(B ?\$,1 8(B ?\,A#(B ?\,A'(B ?\$,1s"(B ?\,A6(B ?\,A_(B ?\,A.(B ?\,A)(B ?\$,1ub(B ?\$,1 9(B ?\,A((B ?\$,1y (B ?\$,1 C(B ?\$,1 N(B - ?\$,1 O(B ?\$,1 J(B ?\$,1y$(B ?\$,1y%(B ?\$,1 K(B ?\$,1 V(B ?\$,1x"(B ?\$,1x1(B ?\$,1 b(B ?\$,1 [(B ?\$,1 \(B ?\$,1 ](B ?\$,1 ^(B ?\$,1 Y(B ?\$,1 Z(B ?\$,1 e(B - ?\$,1 f(B ?\$,1 c(B ?\,A,(B ?\$,1x:(B ?\$,1 d(B ?\$,1 g(B ?\$,1x&(B ?\,A+(B ?\,A;(B ?\$,1s&(B ?\,A (B ?\$,1 h(B ?\$,1 p(B ?\,AU(B ?\$,1 q(B ?\$,1 l(B - ?\$,1rs(B ?\$,1rt(B ?\$,1r|(B ?\$,1r}(B ?\$,1rx(B ?\$,1ry(B ?\,Aw(B ?\$,2"*(B ?\$,1 m(B ?\$,1 t(B ?\$,1 u(B ?\$,1 x(B ?\$,1s9(B ?\$,1s:(B ?\$,1 y(B ?\$,1 v(B - ?\$,1 w(B ?\$,1! (B ?\$,1rz(B ?\$,1r~(B ?\$,1!!(B ?\$,1 z(B ?\$,1 {(B ?\,AA(B ?\$,1!$(B ?\$,1!%(B ?\,AM(B ?\$,1!=(B ?\$,1!>(B ?\$,1!*(B ?\,AS(B ?\,AT(B - ?\$,1!+(B ?\$,1!.(B ?\,AZ(B ?\$,1!/(B ?\$,1!0(B ?\$,1!1(B ?\$,1!2(B ?\$,1!3(B ?\,A](B ?\,A}(B ?\$,1 W(B ?\$,1!;(B ?\$,1 a(B ?\$,1!<(B ?\$,1 B(B ?\$,1$g(B] - "Mac Central European Roman Encoding (MIME:x-mac-centraleurroman).") -(coding-system-put 'mac-centraleurroman 'mime-charset 'x-mac-centraleurroman) - -(cp-make-coding-system - mac-cyrillic - [?\$,1(0(B ?\$,1(1(B ?\$,1(2(B ?\$,1(3(B ?\$,1(4(B ?\$,1(5(B ?\$,1(6(B ?\$,1(7(B ?\$,1(8(B ?\$,1(9(B ?\$,1(:(B ?\$,1(;(B ?\$,1(<(B ?\$,1(=(B ?\$,1(>(B ?\$,1(?(B - ?\$,1(@(B ?\$,1(A(B ?\$,1(B(B ?\$,1(C(B ?\$,1(D(B ?\$,1(E(B ?\$,1(F(B ?\$,1(G(B ?\$,1(H(B ?\$,1(I(B ?\$,1(J(B ?\$,1(K(B ?\$,1(L(B ?\$,1(M(B ?\$,1(N(B ?\$,1(O(B - ?\$,1s (B ?\,A0(B ?\$,1)P(B ?\,A#(B ?\,A'(B ?\$,1s"(B ?\,A6(B ?\$,1(&(B ?\,A.(B ?\,A)(B ?\$,1ub(B ?\$,1("(B ?\$,1(r(B ?\$,1y (B ?\$,1(#(B ?\$,1(s(B - ?\$,1x>(B ?\,A1(B ?\$,1y$(B ?\$,1y%(B ?\$,1(v(B ?\,A5(B ?\$,1)Q(B ?\$,1(((B ?\$,1($(B ?\$,1(t(B ?\$,1('(B ?\$,1(w(B ?\$,1()(B ?\$,1(y(B ?\$,1(*(B ?\$,1(z(B - ?\$,1(x(B ?\$,1(%(B ?\,A,(B ?\$,1x:(B ?\$,1!R(B ?\$,1xh(B ?\$,1x&(B ?\,A+(B ?\,A;(B ?\$,1s&(B ?\,A (B ?\$,1(+(B ?\$,1({(B ?\$,1(,(B ?\$,1(|(B ?\$,1(u(B - ?\$,1rs(B ?\$,1rt(B ?\$,1r|(B ?\$,1r}(B ?\$,1rx(B ?\$,1ry(B ?\,Aw(B ?\$,1r~(B ?\$,1(.(B ?\$,1(~(B ?\$,1(/(B ?\$,1((B ?\$,1uV(B ?\$,1(!(B ?\$,1(q(B ?\$,1(o(B - ?\$,1(P(B ?\$,1(Q(B ?\$,1(R(B ?\$,1(S(B ?\$,1(T(B ?\$,1(U(B ?\$,1(V(B ?\$,1(W(B ?\$,1(X(B ?\$,1(Y(B ?\$,1(Z(B ?\$,1([(B ?\$,1(\(B ?\$,1(](B ?\$,1(^(B ?\$,1(_(B - ?\$,1(`(B ?\$,1(a(B ?\$,1(b(B ?\$,1(c(B ?\$,1(d(B ?\$,1(e(B ?\$,1(f(B ?\$,1(g(B ?\$,1(h(B ?\$,1(i(B ?\$,1(j(B ?\$,1(k(B ?\$,1(l(B ?\$,1(m(B ?\$,1(n(B ?\$,1tL(B] - "Mac Cyrillic Encoding (MIME:x-mac-cyrillic).") -(coding-system-put 'mac-cyrillic 'mime-charset 'x-mac-cyrillic) - -(let - ((encoding-vector - (vconcat - (make-vector 32 nil) - ;; mac-symbol (32..126) -> emacs-mule mapping - [?\ ?\! ?\$,1x (B ?\# ?\$,1x#(B ?\% ?\& ?\$,1x-(B ?\( ?\) ?\$,1x7(B ?\+ ?\, ?\$,1x2(B ?\. ?\/ - ?\0 ?\1 ?\2 ?\3 ?\4 ?\5 ?\6 ?\7 ?\8 ?\9 ?\: ?\; ?\< ?\= ?\> ?\? - ?\$,1xe(B ?\$,1&q(B ?\$,1&r(B ?\$,1''(B ?\$,1&t(B ?\$,1&u(B ?\$,1'&(B ?\$,1&s(B ?\$,1&w(B ?\$,1&y(B ?\$,1'Q(B ?\$,1&z(B ?\$,1&{(B ?\$,1&|(B ?\$,1&}(B ?\$,1&(B - ?\$,1' (B ?\$,1&x(B ?\$,1'!(B ?\$,1'#(B ?\$,1'$(B ?\$,1'%(B ?\$,1'B(B ?\$,1')(B ?\$,1&~(B ?\$,1'((B ?\$,1&v(B ?\[ ?\$,1xT(B ?\] ?\$,1ye(B ?\_ - ?\$,3bE(B ?\$,1'1(B ?\$,1'2(B ?\$,1'G(B ?\$,1'4(B ?\$,1'5(B ?\$,1'F(B ?\$,1'3(B ?\$,1'7(B ?\$,1'9(B ?\$,1'U(B ?\$,1':(B ?\$,1';(B ?\$,1'<(B ?\$,1'=(B ?\$,1'?(B - ?\$,1'@(B ?\$,1'8(B ?\$,1'A(B ?\$,1'C(B ?\$,1'D(B ?\$,1'E(B ?\$,1'V(B ?\$,1'I(B ?\$,1'>(B ?\$,1'H(B ?\$,1'6(B ?\{ ?\| ?\} ?\$,1x\(B] - (make-vector (- 160 127) nil) - ;; mac-symbol (160..254) -> emacs-mule mapping - ;; Mapping of the following characters are changed from the - ;; original one: - ;; 0xE2 0x00AE+0xF87F -> 0x00AE # REGISTERED SIGN, alternate: sans serif - ;; 0xE3 0x00A9+0xF87F -> 0x00A9 # COPYRIGHT SIGN, alternate: sans serif - ;; 0xE4 0x2122+0xF87F -> 0x2122 # TRADE MARK SIGN, alternate: sans serif - [?\$,1tL(B ?\$,1'R(B ?\$,1s2(B ?\$,1y$(B ?\$,1sD(B ?\$,1x>(B ?\$,1!R(B ?\$,2#c(B ?\$,2#f(B ?\$,2#e(B ?\$,2#`(B ?\$,1vt(B ?\$,1vp(B ?\$,1vq(B ?\$,1vr(B ?\$,1vs(B - ?\,A0(B ?\,A1(B ?\$,1s3(B ?\$,1y%(B ?\,AW(B ?\$,1x=(B ?\$,1x"(B ?\$,1s"(B ?\,Aw(B ?\$,1y (B ?\$,1y!(B ?\$,1xh(B ?\$,1s&(B ?\$,1|p(B ?\$,1|O(B ?\$,1w5(B - ?\$,1uu(B ?\$,1uQ(B ?\$,1u\(B ?\$,1uX(B ?\$,1yW(B ?\$,1yU(B ?\$,1x%(B ?\$,1xI(B ?\$,1xJ(B ?\$,1yC(B ?\$,1yG(B ?\$,1yD(B ?\$,1yB(B ?\$,1yF(B ?\$,1x((B ?\$,1x)(B - ?\$,1x@(B ?\$,1x'(B ?\,A.(B ?\,A)(B ?\$,1ub(B ?\$,1x/(B ?\$,1x:(B ?\$,1z%(B ?\,A,(B ?\$,1xG(B ?\$,1xH(B ?\$,1wT(B ?\$,1wP(B ?\$,1wQ(B ?\$,1wR(B ?\$,1wS(B - ?\$,2"*(B ?\$,2=H(B ?\,A.(B ?\,A)(B ?\$,1ub(B ?\$,1x1(B ?\$,1|;(B ?\$,1|<(B ?\$,1|=(B ?\$,1|A(B ?\$,1|B(B ?\$,1|C(B ?\$,1|G(B ?\$,1|H(B ?\$,1|I(B ?\$,1|J(B - ?\$,3b_(B ?\$,2=I(B ?\$,1xK(B ?\$,1{ (B ?\$,1|N(B ?\$,1{!(B ?\$,1|>(B ?\$,1|?(B ?\$,1|@(B ?\$,1|D(B ?\$,1|E(B ?\$,1|F(B ?\$,1|K(B ?\$,1|L(B ?\$,1|M(B - nil])) - translation-table) - (setq translation-table - (make-translation-table-from-vector encoding-vector)) -;; (define-translation-table 'mac-symbol-decoder translation-table) - (define-translation-table 'mac-symbol-encoder - (char-table-extra-slot translation-table 0))) - -(let - ((encoding-vector - (vconcat - (make-vector 32 nil) - ;; mac-dingbats (32..126) -> emacs-mule mapping - [?\ ?\$,2%A(B ?\$,2%B(B ?\$,2%C(B ?\$,2%D(B ?\$,2"n(B ?\$,2%F(B ?\$,2%G(B ?\$,2%H(B ?\$,2%I(B ?\$,2"{(B ?\$,2"~(B ?\$,2%L(B ?\$,2%M(B ?\$,2%N(B ?\$,2%O(B - ?\$,2%P(B ?\$,2%Q(B ?\$,2%R(B ?\$,2%S(B ?\$,2%T(B ?\$,2%U(B ?\$,2%V(B ?\$,2%W(B ?\$,2%X(B ?\$,2%Y(B ?\$,2%Z(B ?\$,2%[(B ?\$,2%\(B ?\$,2%](B ?\$,2%^(B ?\$,2%_(B - ?\$,2%`(B ?\$,2%a(B ?\$,2%b(B ?\$,2%c(B ?\$,2%d(B ?\$,2%e(B ?\$,2%f(B ?\$,2%g(B ?\$,2"e(B ?\$,2%i(B ?\$,2%j(B ?\$,2%k(B ?\$,2%l(B ?\$,2%m(B ?\$,2%n(B ?\$,2%o(B - ?\$,2%p(B ?\$,2%q(B ?\$,2%r(B ?\$,2%s(B ?\$,2%t(B ?\$,2%u(B ?\$,2%v(B ?\$,2%w(B ?\$,2%x(B ?\$,2%y(B ?\$,2%z(B ?\$,2%{(B ?\$,2%|(B ?\$,2%}(B ?\$,2%~(B ?\$,2%(B - ?\$,2& (B ?\$,2&!(B ?\$,2&"(B ?\$,2&#(B ?\$,2&$(B ?\$,2&%(B ?\$,2&&(B ?\$,2&'(B ?\$,2&((B ?\$,2&)(B ?\$,2&*(B ?\$,2&+(B ?\$,2"/(B ?\$,2&-(B ?\$,2!`(B ?\$,2&/(B - ?\$,2&0(B ?\$,2&1(B ?\$,2&2(B ?\$,2!r(B ?\$,2!|(B ?\$,2"&(B ?\$,2&6(B ?\$,2"7(B ?\$,2&8(B ?\$,2&9(B ?\$,2&:(B ?\$,2&;(B ?\$,2&<(B ?\$,2&=(B ?\$,2&>(B - nil - ;; mac-dingbats (128..141) -> emacs-mule mapping - ?\$,2&H(B ?\$,2&I(B ?\$,2&J(B ?\$,2&K(B ?\$,2&L(B ?\$,2&M(B ?\$,2&N(B ?\$,2&O(B ?\$,2&P(B ?\$,2&Q(B ?\$,2&R(B ?\$,2&S(B ?\$,2&T(B ?\$,2&U(B] - (make-vector (- 161 142) nil) - ;; mac-dingbats (161..239) -> emacs-mule mapping - [?\$,2&A(B ?\$,2&B(B ?\$,2&C(B ?\$,2&D(B ?\$,2&E(B ?\$,2&F(B ?\$,2&G(B ?\$,2#c(B ?\$,2#f(B ?\$,2#e(B ?\$,2#`(B ?\$,1~@(B ?\$,1~A(B ?\$,1~B(B ?\$,1~C(B - ?\$,1~D(B ?\$,1~E(B ?\$,1~F(B ?\$,1~G(B ?\$,1~H(B ?\$,1~I(B ?\$,2&V(B ?\$,2&W(B ?\$,2&X(B ?\$,2&Y(B ?\$,2&Z(B ?\$,2&[(B ?\$,2&\(B ?\$,2&](B ?\$,2&^(B ?\$,2&_(B - ?\$,2&`(B ?\$,2&a(B ?\$,2&b(B ?\$,2&c(B ?\$,2&d(B ?\$,2&e(B ?\$,2&f(B ?\$,2&g(B ?\$,2&h(B ?\$,2&i(B ?\$,2&j(B ?\$,2&k(B ?\$,2&l(B ?\$,2&m(B ?\$,2&n(B ?\$,2&o(B - ?\$,2&p(B ?\$,2&q(B ?\$,2&r(B ?\$,2&s(B ?\$,2&t(B ?\$,1vr(B ?\$,1vt(B ?\$,1vu(B ?\$,2&x(B ?\$,2&y(B ?\$,2&z(B ?\$,2&{(B ?\$,2&|(B ?\$,2&}(B ?\$,2&~(B ?\$,2&(B - ?\$,2' (B ?\$,2'!(B ?\$,2'"(B ?\$,2'#(B ?\$,2'$(B ?\$,2'%(B ?\$,2'&(B ?\$,2''(B ?\$,2'((B ?\$,2')(B ?\$,2'*(B ?\$,2'+(B ?\$,2',(B ?\$,2'-(B ?\$,2'.(B ?\$,2'/(B - nil - ;; mac-dingbats (241..254) -> emacs-mule mapping - ?\$,2'1(B ?\$,2'2(B ?\$,2'3(B ?\$,2'4(B ?\$,2'5(B ?\$,2'6(B ?\$,2'7(B ?\$,2'8(B ?\$,2'9(B ?\$,2':(B ?\$,2';(B ?\$,2'<(B ?\$,2'=(B ?\$,2'>(B - nil])) - translation-table) - (setq translation-table - (make-translation-table-from-vector encoding-vector)) -;; (define-translation-table 'mac-dingbats-decoder translation-table) - (define-translation-table 'mac-dingbats-encoder - (char-table-extra-slot translation-table 0))) - (defvar mac-font-encoder-list '(("mac-roman" mac-roman-encoder ccl-encode-mac-roman-font "%s") @@ -2012,37 +2234,11 @@ ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman") ;; Enable CLIPBOARD copy/paste through menu bar commands. (menu-bar-enable-clipboard) -(defconst mac-system-coding-system - (let ((base (or (cdr (assq mac-system-script-code - mac-script-code-coding-systems)) - 'mac-roman))) - (if (eq system-type 'darwin) - base - (coding-system-change-eol-conversion base 'mac))) - "Coding system derived from the system script code.") - -(set-selection-coding-system mac-system-coding-system) +;; Initiate drag and drop -(defun mac-drag-n-drop (event) - "Edit the files listed in the drag-n-drop EVENT. -Switch to a buffer editing the last file dropped." - (interactive "e") - ;; Make sure the drop target has positive co-ords - ;; before setting the selected frame - otherwise it - ;; won't work. <skx@tardis.ed.ac.uk> - (let* ((window (posn-window (event-start event))) - (coords (posn-x-y (event-start event))) - (x (car coords)) - (y (cdr coords))) - (if (and (> x 0) (> y 0)) - (set-frame-selected-window nil window)) - (dolist (file-name (nth 2 event)) - (dnd-handle-one-url window 'private - (concat "file:" file-name)))) - (select-frame-set-input-focus (selected-frame))) +(global-set-key [drag-n-drop] 'mac-dnd-handle-drag-n-drop-event) +(global-set-key [M-drag-n-drop] 'mac-dnd-handle-drag-n-drop-event) -(global-set-key [drag-n-drop] 'mac-drag-n-drop) -(global-set-key [M-drag-n-drop] 'mac-drag-n-drop) ;;;; Non-toolkit Scroll bars @@ -2107,6 +2303,7 @@ Switch to a buffer editing the last file dropped." (scroll-up 1))) ) + ;;;; Others diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index 049d65c62fa..2bf36283983 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -162,6 +162,14 @@ (define-key xterm-function-map "\e[4~" [select]) (define-key xterm-function-map "\e[29~" [print]) + ;; These keys will be available xterm starting probably from + ;; version 214. + (define-key xterm-function-map "\e[27;5;8~" [(control ?\t)]) + (define-key xterm-function-map "\e[27;5;44~" [(control ?\,)]) + (define-key xterm-function-map "\e[27;5;46~" [(control ?\.)]) + (define-key xterm-function-map "\e[27;5;47~" [(control ?\/)]) + (define-key xterm-function-map "\e[27;5;92~" [(control ?\\)]) + ;; Other versions of xterm might emit these. (define-key xterm-function-map "\e[A" [up]) (define-key xterm-function-map "\e[B" [down]) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index da77508dce3..fed06a572bb 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -2607,15 +2607,18 @@ By just answering RET you can find out what the current dictionary is." (mapcar 'list (ispell-valid-dictionary-list))) nil t) current-prefix-arg)) - (unless arg (ispell-buffer-local-dict)) + (unless arg (ispell-buffer-local-dict 'no-reload)) (if (equal dict "default") (setq dict nil)) ;; This relies on completing-read's bug of returning "" for no match (cond ((equal dict "") + (ispell-internal-change-dictionary) (message "Using %s dictionary" (or ispell-local-dictionary ispell-dictionary "default"))) ((equal dict (or ispell-local-dictionary ispell-dictionary "default")) - ;; Specified dictionary is the default already. No-op + ;; Specified dictionary is the default already. Could reload + ;; the dictionaries if needed. + (ispell-internal-change-dictionary) (and (interactive-p) (message "No change, using %s dictionary" dict))) (t ; reset dictionary! @@ -2634,13 +2637,16 @@ By just answering RET you can find out what the current dictionary is." dict)))) (defun ispell-internal-change-dictionary () - "Update the dictionary actually used by Ispell. + "Update the dictionary and the personal dictionary used by Ispell. This may kill the Ispell process; if so, a new one will be started when needed." - (let ((dict (or ispell-local-dictionary ispell-dictionary))) - (unless (equal ispell-current-dictionary dict) + (let ((dict (or ispell-local-dictionary ispell-dictionary)) + (pdict (or ispell-local-pdict ispell-personal-dictionary))) + (unless (and (equal ispell-current-dictionary dict) + (equal ispell-current-personal-dictionary pdict)) (ispell-kill-ispell t) - (setq ispell-current-dictionary dict)))) + (setq ispell-current-dictionary dict + ispell-current-personal-dictionary pdict)))) ;;; Spelling of comments are checked when ispell-check-comments is non-nil. @@ -3667,8 +3673,9 @@ Includes Latex/Nroff modes and extended character mode." ;;; Can kill the current ispell process -(defun ispell-buffer-local-dict () +(defun ispell-buffer-local-dict (&optional no-reload) "Initializes local dictionary and local personal dictionary. +If optional NO-RELOAD is non-nil, do not make any dictionary reloading. When a dictionary is defined in the buffer (see variable `ispell-dictionary-keyword'), it will override the local setting from \\[ispell-change-dictionary]. @@ -3695,12 +3702,9 @@ Both should not be used to define a buffer-local dictionary." (if (re-search-forward " *\\([^ \"]+\\)" end t) (setq ispell-local-pdict (match-string-no-properties 1))))))) - ;; Reload if new personal dictionary defined. - (if (not (equal ispell-current-personal-dictionary - (or ispell-local-pdict ispell-personal-dictionary))) - (ispell-kill-ispell t)) - ;; Reload if new dictionary defined. - (ispell-internal-change-dictionary)) + (unless no-reload + ;; Reload if new dictionary (maybe the personal one) defined. + (ispell-internal-change-dictionary))) (defun ispell-buffer-local-words () diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 92bdf480e06..1c3e383c9fb 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,8 @@ +2006-05-05 Andreas Seltenreich <seltenreich@gmx.de> (tiny change) + + * url-http.el (url-http-parse-headers): Don't reuse connection if + "Connection: close" header was seen. + 2006-04-26 Stefan Monnier <monnier@iro.umontreal.ca> * url-gw.el (url-open-stream): Don't hide errors. diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index c401094593e..45bf97ec6b6 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -386,6 +386,10 @@ should be shown to the user." (url-http-parse-response) (mail-narrow-to-head) ;;(narrow-to-region (point-min) url-http-end-of-headers) + (let ((connection (mail-fetch-field "Connection"))) + (if (and connection + (string= (downcase connection) "close")) + (delete-process url-http-process))) (let ((class nil) (success nil)) (setq class (/ url-http-response-status 100)) |