mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-25 10:47:00 +00:00
Merged from miles@gnu.org--gnu-2005 (patch 543)
Patches applied: * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-543 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-420
This commit is contained in:
Karoly Lorentey
commit
567c887847
@ -1,4 +1,4 @@
|
||||
2005-09-00 Kevin Ryde <user42@zip.com.au>
|
||||
2005-09-09 Kevin Ryde <user42@zip.com.au>
|
||||
|
||||
* MORE.STUFF: Update url for calculator.el.
|
||||
|
||||
|
||||
129
lisp/ChangeLog
129
lisp/ChangeLog
@ -1,3 +1,74 @@
|
||||
2005-09-13 Chong Yidong <cyd@stupidchicken.com>
|
||||
|
||||
* custom.el (custom-push-theme): Handle the case where a symbol is
|
||||
bound but face properties have not yet been assigned.
|
||||
|
||||
* mail/sendmail.el (mail): Use new buffer if `noerase' argument is
|
||||
`new'.
|
||||
|
||||
2005-09-12 Richard M. Stallman <rms@gnu.org>
|
||||
|
||||
* font-lock.el (font-lock-keywords): Add autoload.
|
||||
|
||||
* help-fns.el (describe-variable): Rearrange to put source link
|
||||
in a predictable place.
|
||||
|
||||
* net/newsticker.el: New file.
|
||||
|
||||
2005-09-12 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* calendar/calendar.el (calendar-for-loop): Add edebug info.
|
||||
(calendar-basic-setup): Use the new nil arg.
|
||||
(number-of-diary-entries): Move to diary-lib.el.
|
||||
|
||||
* calendar/diary-lib.el: Use with-current-buffer, match-string.
|
||||
(diary-list-entries): Use with-syntax-table and dolist.
|
||||
Rename from list-diary-entries.
|
||||
Use number-of-diary-entries if `number' is nil.
|
||||
(diary, diary-view-entries): Use this new name and new nil arg value.
|
||||
(number-of-diary-entries): Move from calendar.el.
|
||||
(diary-unhide-everything): New function.
|
||||
(include-other-diary-files, fancy-diary-display)
|
||||
(diary-show-all-entries, make-diary-entry): Use it.
|
||||
(diary-mail-entries): Use buffer-string.
|
||||
(mark-diary-entries): Fix long standing paren typo.
|
||||
(diary-sexp-entry): Use count-lines.
|
||||
(make-diary-entry): Avoid `previous-line'.
|
||||
(diary-mode-map): New var.
|
||||
(diary-mode): Redraw cal after saving. Setup header-line.
|
||||
(fancy-diary-display-mode): Use local-set-key.
|
||||
|
||||
* startup.el (command-line): Try calling various terminal-init-foo-bar
|
||||
functions by stripping hyphenated suffixes from $TERM.
|
||||
|
||||
* files.el (normal-mode): Check boundness of font-lock-keywords.
|
||||
|
||||
2005-09-12 Richard M. Stallman <rms@gnu.org>
|
||||
|
||||
* progmodes/compile.el: Don't decide a file's directory
|
||||
until the user actually tries to go there.
|
||||
(compilation-next-error-function):
|
||||
Pass compilation-find-file the directory from the file-struct.
|
||||
(compilation-internal-error-properties): Separate local FILE-STRUCT
|
||||
from FILE. Doc the args better. Rename arg FMT to FMTS.
|
||||
(compilation-find-file): Arg DIR renamed to DIRECTORY.
|
||||
Expand it, and if nil, use default-directory.
|
||||
(compilation-get-file-structure): Don't mix specified directory
|
||||
with default directory. Put specified directory into
|
||||
file-struct. Don't make the file name absolute.
|
||||
|
||||
* progmodes/compile.el (compilation-error-regexp-alist): Doc fix.
|
||||
(compile-command): Add autoload.
|
||||
(compilation-disable-input): Add autoload.
|
||||
|
||||
2005-09-11 Stephen Gildea <gildea@stop.mail-abuse.org>
|
||||
|
||||
* time-stamp.el: Mention variable `time-stamp-pattern' in doc
|
||||
strings of the variables it can override.
|
||||
|
||||
(time-stamp): New (as yet undocumented) time-stamp-format escapes
|
||||
%Q and %q, for fully-qualified domain name and unqualified host name.
|
||||
|
||||
2005-09-11 Kim F. Storm <storm@cua.dk>
|
||||
|
||||
* emacs-lisp/authors.el (authors-aliases): Update list.
|
||||
@ -15,14 +86,14 @@
|
||||
|
||||
2005-09-10 Pascal Dupuis <Pascal.Dupuis@esat.kuleuven.be> (tiny change)
|
||||
|
||||
* progmodes/octave-inf.el (inferior-octave-startup): Resync
|
||||
current dir at the end.
|
||||
* progmodes/octave-inf.el (inferior-octave-startup):
|
||||
Resync current dir at the end.
|
||||
|
||||
2005-09-10 Emilio C. Lopes <eclig@gmx.net>
|
||||
|
||||
* woman.el (woman-topic-at-point-default): Renamed to
|
||||
woman-use-topic-at-point-default.
|
||||
(woman-topic-at-point): Renamed to woman-use-topic-at-point.
|
||||
* woman.el (woman-topic-at-point-default):
|
||||
Rename to woman-use-topic-at-point-default.
|
||||
(woman-topic-at-point): Rename to woman-use-topic-at-point.
|
||||
(woman-file-name): Reflect renames above. Automatically use the
|
||||
word at point as topic if woman-use-topic-at-point is non-nil.
|
||||
Otherwise offer it as default but don't insert it in the
|
||||
@ -40,28 +111,26 @@
|
||||
(menu-bar-non-minibuffer-window-p): New functions.
|
||||
("Split Window", "Save As..."): Use them.
|
||||
("Postscript Print Buffer (B+W)", "Postscript Print Buffer")
|
||||
("Print Buffer", "Truncate Long Lines in this Buffer"): Use
|
||||
menu-bar-menu-frame-live-and-visible-p.
|
||||
("Print Buffer", "Truncate Long Lines in this Buffer"):
|
||||
Use menu-bar-menu-frame-live-and-visible-p.
|
||||
("Save Buffer", "Insert File", "Open Directory...")
|
||||
("Open File...", "Visit New File..."): Use
|
||||
menu-bar-non-minibuffer-window-p.
|
||||
(kill-this-buffer-enabled-p, dired <menu-enable>): Use
|
||||
menu-bar-non-minibuffer-window-p.
|
||||
("Open File...", "Visit New File..."):
|
||||
Use menu-bar-non-minibuffer-window-p.
|
||||
(kill-this-buffer-enabled-p, dired <menu-enable>):
|
||||
Use menu-bar-non-minibuffer-window-p.
|
||||
|
||||
2005-09-09 Eli Zaretskii <eliz@gnu.org>
|
||||
|
||||
* cus-start.el (all): Don't complain about fringe-related
|
||||
built-ins if fringes are not supported. Ditto about
|
||||
selection-related built-ins. Fix the test for GTK-related
|
||||
built-ins.
|
||||
selection-related built-ins. Fix the test for GTK-related built-ins.
|
||||
|
||||
* menu-bar.el ("Split Window", "Postscript Print Buffer (B+W)")
|
||||
("Postscript Print Buffer", "Print Region", "Save As...")
|
||||
("Save", "Insert File...", "Open Directory...")
|
||||
("Open File...", "Visit New File..."")
|
||||
("Truncate Long Lines in this Buffer"): Don't look at
|
||||
menu-updating-frame if this display does not support multiple
|
||||
frames.
|
||||
menu-updating-frame if this display does not support multiple frames.
|
||||
|
||||
2005-09-09 Frederik Fouvry <fouvry@CoLi.Uni-SB.DE>
|
||||
|
||||
@ -94,15 +163,6 @@
|
||||
|
||||
* descr-text.el (describe-property-list): Handle non-symbol prop names.
|
||||
|
||||
2005-09-06 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* net/ange-ftp.el (ange-ftp-process-filter): Revert to ^#+$.
|
||||
Use with-current-buffer.
|
||||
(ange-ftp-gwp-start): Remove unused var `gw-user'.
|
||||
(ange-ftp-guess-hash-mark-size): Remove unused var `result'.
|
||||
(ange-ftp-insert-directory): Remove unused var `short'.
|
||||
(ange-ftp-file-name-sans-versions): Remove unused var `host-type'.
|
||||
|
||||
2005-08-30 Richard M. Stallman <rms@gnu.org>
|
||||
|
||||
* simple.el (blink-matching-open): Get rid of text props from
|
||||
@ -138,6 +198,13 @@
|
||||
(recentf-open-files): Use it.
|
||||
(recentf-open-file-with-key): New command.
|
||||
|
||||
2005-09-08 Chong Yidong <cyd@stupidchicken.com>
|
||||
|
||||
* buff-menu.el (Buffer-menu-sort-by-column): New function.
|
||||
Suggested by Kim F. Storm.
|
||||
(Buffer-menu-sort-button-map): Global keymap for sort buttons.
|
||||
(Buffer-menu-make-sort-button): Use global keymap.
|
||||
|
||||
2005-09-07 Michael Albinus <michael.albinus@gmx.de>
|
||||
|
||||
* woman.el (top): Remap `man' command by `woman' in `woman-mode-map'.
|
||||
@ -163,15 +230,15 @@
|
||||
* calc/calc-poly.el (math-expand-term): Multiply out any powers
|
||||
when in matrix mode.
|
||||
|
||||
2005-09-08 Chong Yidong <cyd@stupidchicken.com>
|
||||
|
||||
* buff-menu.el (Buffer-menu-sort-by-column): New function.
|
||||
Suggested by Kim F. Storm.
|
||||
(Buffer-menu-sort-button-map): Global keymap for sort buttons.
|
||||
(Buffer-menu-make-sort-button): Use global keymap.
|
||||
|
||||
2005-09-06 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* net/ange-ftp.el (ange-ftp-process-filter): Revert to ^#+$.
|
||||
Use with-current-buffer.
|
||||
(ange-ftp-gwp-start): Remove unused var `gw-user'.
|
||||
(ange-ftp-guess-hash-mark-size): Remove unused var `result'.
|
||||
(ange-ftp-insert-directory): Remove unused var `short'.
|
||||
(ange-ftp-file-name-sans-versions): Remove unused var `host-type'.
|
||||
|
||||
* buff-menu.el (Buffer-menu-make-sort-button): Add docstrings, use
|
||||
non-anonymous functions.
|
||||
|
||||
|
||||
@ -163,35 +163,6 @@ be overridden by the value of `calendar-setup'."
|
||||
:type 'boolean
|
||||
:group 'diary)
|
||||
|
||||
;;;###autoload
|
||||
(defcustom number-of-diary-entries 1
|
||||
"*Specifies how many days of diary entries are to be displayed initially.
|
||||
This variable affects the diary display when the command \\[diary] is used,
|
||||
or if the value of the variable `view-diary-entries-initially' is t. For
|
||||
example, if the default value 1 is used, then only the current day's diary
|
||||
entries will be displayed. If the value 2 is used, then both the current
|
||||
day's and the next day's entries will be displayed.
|
||||
|
||||
The value can also be a vector such as [0 2 2 2 2 4 1]; this value
|
||||
says to display no diary entries on Sunday, the display the entries
|
||||
for the current date and the day after on Monday through Thursday,
|
||||
display Friday through Monday's entries on Friday, and display only
|
||||
Saturday's entries on Saturday.
|
||||
|
||||
This variable does not affect the diary display with the `d' command
|
||||
from the calendar; in that case, the prefix argument controls the
|
||||
number of days of diary entries displayed."
|
||||
:type '(choice (integer :tag "Entries")
|
||||
(vector :value [0 0 0 0 0 0 0]
|
||||
(integer :tag "Sunday")
|
||||
(integer :tag "Monday")
|
||||
(integer :tag "Tuesday")
|
||||
(integer :tag "Wednesday")
|
||||
(integer :tag "Thursday")
|
||||
(integer :tag "Friday")
|
||||
(integer :tag "Saturday")))
|
||||
:group 'diary)
|
||||
|
||||
;;;###autoload
|
||||
(defcustom mark-diary-entries-in-calendar nil
|
||||
"*Non-nil means mark dates with diary entries, in the calendar window.
|
||||
@ -393,7 +364,7 @@ functions that move by days and weeks."
|
||||
|
||||
For example,
|
||||
|
||||
(add-hook 'calendar-move-hook (lambda () (view-diary-entries 1)))
|
||||
(add-hook 'calendar-move-hook (lambda () (diary-view-entries 1)))
|
||||
|
||||
redisplays the diary for whatever date the cursor is moved to."
|
||||
:type 'hook
|
||||
@ -1335,6 +1306,7 @@ A negative YR is interpreted as BC; -1 being 1 BC, and so on."
|
||||
|
||||
(defmacro calendar-for-loop (var from init to final do &rest body)
|
||||
"Execute a for loop."
|
||||
(declare (debug (symbolp "from" form "to" form "do" body)))
|
||||
`(let ((,var (1- ,init)))
|
||||
(while (>= ,final (setq ,var (1+ ,var)))
|
||||
,@body)))
|
||||
@ -1651,10 +1623,7 @@ to be replaced by asterisks to highlight it whenever it is in the window."
|
||||
(increment-calendar-month month year (- calendar-offset))
|
||||
(generate-calendar-window month year)
|
||||
(if (and view-diary-entries-initially (calendar-date-is-visible-p date))
|
||||
(view-diary-entries
|
||||
(if (vectorp number-of-diary-entries)
|
||||
(aref number-of-diary-entries (calendar-day-of-week date))
|
||||
number-of-diary-entries))))
|
||||
(diary-view-entries)))
|
||||
(let* ((diary-buffer (get-file-buffer diary-file))
|
||||
(diary-window (if diary-buffer (get-buffer-window diary-buffer)))
|
||||
(split-height-threshold (if diary-window 2 1000)))
|
||||
@ -1662,7 +1631,7 @@ to be replaced by asterisks to highlight it whenever it is in the window."
|
||||
(list-calendar-holidays)))
|
||||
(run-hooks 'initial-calendar-window-hook))
|
||||
|
||||
(autoload 'view-diary-entries "diary-lib"
|
||||
(autoload 'diary-view-entries "diary-lib"
|
||||
"Prepare and display a buffer with diary entries.
|
||||
Searches your diary file for entries that match ARG days starting with
|
||||
the date indicated by the cursor position in the displayed three-month
|
||||
@ -2272,7 +2241,7 @@ movement commands will not work correctly."
|
||||
(define-key calendar-mode-map "x" 'mark-calendar-holidays)
|
||||
(define-key calendar-mode-map "u" 'calendar-unmark)
|
||||
(define-key calendar-mode-map "m" 'mark-diary-entries)
|
||||
(define-key calendar-mode-map "d" 'view-diary-entries)
|
||||
(define-key calendar-mode-map "d" 'diary-view-entries)
|
||||
(define-key calendar-mode-map "D" 'view-other-diary-entries)
|
||||
(define-key calendar-mode-map "s" 'show-all-diary-entries)
|
||||
(define-key calendar-mode-map "pd" 'calendar-print-day-of-year)
|
||||
@ -2493,8 +2462,7 @@ the STRINGS are just concatenated and the result truncated."
|
||||
(defun update-calendar-mode-line ()
|
||||
"Update the calendar mode line with the current date and date style."
|
||||
(if (bufferp (get-buffer calendar-buffer))
|
||||
(save-excursion
|
||||
(set-buffer calendar-buffer)
|
||||
(with-current-buffer calendar-buffer
|
||||
(setq mode-line-format
|
||||
(calendar-string-spread
|
||||
(let ((date (condition-case nil
|
||||
@ -2589,14 +2557,15 @@ ERROR is t, otherwise just returns nil."
|
||||
(list month
|
||||
(string-to-number (buffer-substring (1+ (point)) (+ 4 (point))))
|
||||
year))
|
||||
(if (looking-at "\\*")
|
||||
(save-excursion
|
||||
(re-search-backward "[^*]")
|
||||
(if (looking-at ".\\*\\*")
|
||||
(list month calendar-starred-day year)
|
||||
(if error (error "Not on a date!"))))
|
||||
(if (and (looking-at "\\*")
|
||||
(save-excursion
|
||||
(re-search-backward "[^*]")
|
||||
(looking-at ".\\*\\*")))
|
||||
(list month calendar-starred-day year)
|
||||
(if error (error "Not on a date!"))))))
|
||||
|
||||
(add-to-list 'debug-ignored-errors "Not on a date!")
|
||||
|
||||
;; The following version of calendar-gregorian-from-absolute is preferred for
|
||||
;; reasons of clarity, BUT it's much slower than the version that follows it.
|
||||
|
||||
@ -3071,8 +3040,7 @@ Defaults to today's date if DATE is not given."
|
||||
"Show dates on other calendars for date under the cursor."
|
||||
(interactive)
|
||||
(let* ((date (calendar-cursor-to-date t)))
|
||||
(save-excursion
|
||||
(set-buffer (get-buffer-create other-calendars-buffer))
|
||||
(with-current-buffer (get-buffer-create other-calendars-buffer)
|
||||
(setq buffer-read-only nil)
|
||||
(calendar-set-mode-line
|
||||
(concat (calendar-date-string date) " (Gregorian)"))
|
||||
@ -3138,9 +3106,9 @@ Defaults to today's date if DATE is not given."
|
||||
|
||||
(provide 'calendar)
|
||||
|
||||
;;; Local variables:
|
||||
;;; byte-compile-dynamic: t
|
||||
;;; End:
|
||||
;; Local variables:
|
||||
;; byte-compile-dynamic: t
|
||||
;; End:
|
||||
|
||||
;;; arch-tag: 19c61596-c8fb-4c69-bcf1-7dd739919cd8
|
||||
;; arch-tag: 19c61596-c8fb-4c69-bcf1-7dd739919cd8
|
||||
;;; calendar.el ends here
|
||||
|
||||
@ -58,21 +58,17 @@ does nothing. This function is suitable for execution in a `.emacs' file."
|
||||
(interactive "P")
|
||||
(diary-check-diary-file)
|
||||
(let ((date (calendar-current-date)))
|
||||
(list-diary-entries
|
||||
date
|
||||
(cond (arg (prefix-numeric-value arg))
|
||||
((vectorp number-of-diary-entries)
|
||||
(aref number-of-diary-entries (calendar-day-of-week date)))
|
||||
(t number-of-diary-entries)))))
|
||||
(diary-list-entries date (if arg (prefix-numeric-value arg)))))
|
||||
|
||||
(defun view-diary-entries (arg)
|
||||
(define-obsolete-function-alias 'view-diary-entries 'diary-view-entries)
|
||||
(defun diary-view-entries (&optional arg)
|
||||
"Prepare and display a buffer with diary entries.
|
||||
Searches the file named in `diary-file' for entries that
|
||||
match ARG days starting with the date indicated by the cursor position
|
||||
in the displayed three-month calendar."
|
||||
(interactive "p")
|
||||
(diary-check-diary-file)
|
||||
(list-diary-entries (calendar-cursor-to-date t) arg))
|
||||
(diary-list-entries (calendar-cursor-to-date t) arg))
|
||||
|
||||
(defun view-other-diary-entries (arg d-file)
|
||||
"Prepare and display buffer of diary entries from an alternative diary file.
|
||||
@ -182,14 +178,15 @@ The holidays are those in the list `calendar-holidays'.")
|
||||
"Local time of candle lighting diary entry--applies if date is a Friday.
|
||||
No diary entry if there is no sunset on that date.")
|
||||
|
||||
(defvar diary-syntax-table (copy-syntax-table (standard-syntax-table))
|
||||
(defvar diary-syntax-table
|
||||
(let ((st (copy-syntax-table (standard-syntax-table))))
|
||||
(modify-syntax-entry ?* "w" st)
|
||||
(modify-syntax-entry ?: "w" st)
|
||||
st)
|
||||
"The syntax table used when parsing dates in the diary file.
|
||||
It is the standard syntax table used in Fundamental mode, but with the
|
||||
syntax of `*' and `:' changed to be word constituents.")
|
||||
|
||||
(modify-syntax-entry ?* "w" diary-syntax-table)
|
||||
(modify-syntax-entry ?: "w" diary-syntax-table)
|
||||
|
||||
(defvar diary-entries-list)
|
||||
(defvar displayed-year)
|
||||
(defvar displayed-month)
|
||||
@ -243,9 +240,7 @@ search."
|
||||
regexp (concat diary-glob-file-regexp-prefix regexp))
|
||||
(setq attrvalue nil)
|
||||
(if (re-search-forward regexp (point-max) t)
|
||||
(setq attrvalue (buffer-substring-no-properties
|
||||
(match-beginning regnum)
|
||||
(match-end regnum))))
|
||||
(setq attrvalue (match-string-no-properties regnum)))
|
||||
(if (and attrvalue
|
||||
(setq attrvalue (diary-attrtype-convert attrvalue type)))
|
||||
(setq ret-attr (append ret-attr (list attrname attrvalue))))
|
||||
@ -264,9 +259,7 @@ search."
|
||||
(setq attrvalue nil)
|
||||
(if (string-match regexp entry)
|
||||
(progn
|
||||
(setq attrvalue (substring-no-properties entry
|
||||
(match-beginning regnum)
|
||||
(match-end regnum)))
|
||||
(setq attrvalue (match-string-no-properties regnum entry))
|
||||
(setq entry (replace-match "" t t entry))))
|
||||
(if (and attrvalue
|
||||
(setq attrvalue (diary-attrtype-convert attrvalue type)))
|
||||
@ -299,8 +292,38 @@ Only used if `diary-header-line-flag' is non-nil."
|
||||
|
||||
(defvar diary-saved-point) ; internal
|
||||
|
||||
(defun list-diary-entries (date number)
|
||||
"Create and display a buffer containing the relevant lines in diary-file.
|
||||
|
||||
(defcustom number-of-diary-entries 1
|
||||
"Specifies how many days of diary entries are to be displayed initially.
|
||||
This variable affects the diary display when the command \\[diary] is used,
|
||||
or if the value of the variable `view-diary-entries-initially' is t. For
|
||||
example, if the default value 1 is used, then only the current day's diary
|
||||
entries will be displayed. If the value 2 is used, then both the current
|
||||
day's and the next day's entries will be displayed.
|
||||
|
||||
The value can also be a vector such as [0 2 2 2 2 4 1]; this value
|
||||
says to display no diary entries on Sunday, the display the entries
|
||||
for the current date and the day after on Monday through Thursday,
|
||||
display Friday through Monday's entries on Friday, and display only
|
||||
Saturday's entries on Saturday.
|
||||
|
||||
This variable does not affect the diary display with the `d' command
|
||||
from the calendar; in that case, the prefix argument controls the
|
||||
number of days of diary entries displayed."
|
||||
:type '(choice (integer :tag "Entries")
|
||||
(vector :value [0 0 0 0 0 0 0]
|
||||
(integer :tag "Sunday")
|
||||
(integer :tag "Monday")
|
||||
(integer :tag "Tuesday")
|
||||
(integer :tag "Wednesday")
|
||||
(integer :tag "Thursday")
|
||||
(integer :tag "Friday")
|
||||
(integer :tag "Saturday")))
|
||||
:group 'diary)
|
||||
|
||||
(define-obsolete-function-alias 'list-diary-entries 'diary-list-entries)
|
||||
(defun diary-list-entries (date number)
|
||||
"Create and display a buffer containing the relevant lines in `diary-file'.
|
||||
The arguments are DATE and NUMBER; the entries selected are those
|
||||
for NUMBER days starting with date DATE. The other entries are hidden
|
||||
using selective display. If NUMBER is less than 1, this function does nothing.
|
||||
@ -332,10 +355,12 @@ These hooks have the following distinct roles:
|
||||
|
||||
`diary-hook' is run last. This can be used for an appointment
|
||||
notification function."
|
||||
|
||||
(unless number
|
||||
(setq number (if (vectorp number-of-diary-entries)
|
||||
(aref number-of-diary-entries (calendar-day-of-week date))
|
||||
number-of-diary-entries)))
|
||||
(when (> number 0)
|
||||
(let ((original-date date);; save for possible use in the hooks
|
||||
old-diary-syntax-table
|
||||
diary-entries-list
|
||||
file-glob-attrs
|
||||
(date-string (calendar-date-string date))
|
||||
@ -356,100 +381,94 @@ These hooks have the following distinct roles:
|
||||
(setq selective-display-ellipses nil)
|
||||
(if diary-header-line-flag
|
||||
(setq header-line-format diary-header-line-format))
|
||||
(setq old-diary-syntax-table (syntax-table))
|
||||
(set-syntax-table diary-syntax-table)
|
||||
(unwind-protect
|
||||
(let ((buffer-read-only nil)
|
||||
(diary-modified (buffer-modified-p))
|
||||
(mark (regexp-quote diary-nonmarking-symbol)))
|
||||
;; First and last characters must be ^M or \n for
|
||||
;; selective display to work properly
|
||||
(goto-char (1- (point-max)))
|
||||
(if (not (looking-at "\^M\\|\n"))
|
||||
(progn
|
||||
(goto-char (point-max))
|
||||
(insert "\^M")))
|
||||
(goto-char (point-min))
|
||||
(if (not (looking-at "\^M\\|\n"))
|
||||
(insert "\^M"))
|
||||
(subst-char-in-region (point-min) (point-max) ?\n ?\^M t)
|
||||
(calendar-for-loop
|
||||
i from 1 to number do
|
||||
(let ((d diary-date-forms)
|
||||
(month (extract-calendar-month date))
|
||||
(day (extract-calendar-day date))
|
||||
(year (extract-calendar-year date))
|
||||
(entry-found (list-sexp-diary-entries date)))
|
||||
(while d
|
||||
(let*
|
||||
((date-form (if (equal (car (car d)) 'backup)
|
||||
(cdr (car d))
|
||||
(car d)))
|
||||
(backup (equal (car (car d)) 'backup))
|
||||
(dayname
|
||||
(format "%s\\|%s\\.?"
|
||||
(calendar-day-name date)
|
||||
(calendar-day-name date 'abbrev)))
|
||||
(monthname
|
||||
(format "\\*\\|%s\\|%s\\.?"
|
||||
(calendar-month-name month)
|
||||
(calendar-month-name month 'abbrev)))
|
||||
(month (concat "\\*\\|0*" (int-to-string month)))
|
||||
(day (concat "\\*\\|0*" (int-to-string day)))
|
||||
(year
|
||||
(concat
|
||||
"\\*\\|0*" (int-to-string year)
|
||||
(if abbreviated-calendar-year
|
||||
(concat "\\|" (format "%02d" (% year 100)))
|
||||
"")))
|
||||
(regexp
|
||||
(concat
|
||||
"\\(\\`\\|\^M\\|\n\\)" mark "?\\("
|
||||
(mapconcat 'eval date-form "\\)\\(")
|
||||
"\\)"))
|
||||
(case-fold-search t))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward regexp nil t)
|
||||
(if backup (re-search-backward "\\<" nil t))
|
||||
(if (and (or (char-equal (preceding-char) ?\^M)
|
||||
(char-equal (preceding-char) ?\n))
|
||||
(not (looking-at " \\|\^I")))
|
||||
;; Diary entry that consists only of date.
|
||||
(backward-char 1)
|
||||
;; Found a nonempty diary entry--make it
|
||||
;; visible and add it to the list.
|
||||
(setq entry-found t)
|
||||
(let ((entry-start (point))
|
||||
date-start temp)
|
||||
(re-search-backward "\^M\\|\n\\|\\`")
|
||||
(setq date-start (point))
|
||||
(re-search-forward "\^M\\|\n" nil t 2)
|
||||
(while (looking-at " \\|\^I")
|
||||
(re-search-forward "\^M\\|\n" nil t))
|
||||
(backward-char 1)
|
||||
(subst-char-in-region date-start
|
||||
(point) ?\^M ?\n t)
|
||||
(setq entry (buffer-substring entry-start (point))
|
||||
temp (diary-pull-attrs entry file-glob-attrs)
|
||||
entry (nth 0 temp))
|
||||
(add-to-diary-list
|
||||
date
|
||||
entry
|
||||
(buffer-substring
|
||||
(1+ date-start) (1- entry-start))
|
||||
(copy-marker entry-start) (nth 1 temp))))))
|
||||
(setq d (cdr d)))
|
||||
(or entry-found
|
||||
(not diary-list-include-blanks)
|
||||
(setq diary-entries-list
|
||||
(append diary-entries-list
|
||||
(list (list date "" "" "" "")))))
|
||||
(setq date
|
||||
(calendar-gregorian-from-absolute
|
||||
(1+ (calendar-absolute-from-gregorian date))))
|
||||
(setq entry-found nil)))
|
||||
(set-buffer-modified-p diary-modified))
|
||||
(set-syntax-table old-diary-syntax-table))
|
||||
(with-syntax-table diary-syntax-table
|
||||
(let ((buffer-read-only nil)
|
||||
(diary-modified (buffer-modified-p))
|
||||
(mark (regexp-quote diary-nonmarking-symbol)))
|
||||
;; First and last characters must be ^M or \n for
|
||||
;; selective display to work properly
|
||||
(goto-char (1- (point-max)))
|
||||
(if (not (looking-at "\^M\\|\n"))
|
||||
(progn
|
||||
(goto-char (point-max))
|
||||
(insert "\^M")))
|
||||
(goto-char (point-min))
|
||||
(if (not (looking-at "\^M\\|\n"))
|
||||
(insert "\^M"))
|
||||
(subst-char-in-region (point-min) (point-max) ?\n ?\^M t)
|
||||
(calendar-for-loop
|
||||
i from 1 to number do
|
||||
(let ((month (extract-calendar-month date))
|
||||
(day (extract-calendar-day date))
|
||||
(year (extract-calendar-year date))
|
||||
(entry-found (list-sexp-diary-entries date)))
|
||||
(dolist (date-form diary-date-forms)
|
||||
(let*
|
||||
((backup (when (eq (car date-form) 'backup)
|
||||
(setq date-form (cdr date-form))
|
||||
t))
|
||||
(dayname
|
||||
(format "%s\\|%s\\.?"
|
||||
(calendar-day-name date)
|
||||
(calendar-day-name date 'abbrev)))
|
||||
(monthname
|
||||
(format "\\*\\|%s\\|%s\\.?"
|
||||
(calendar-month-name month)
|
||||
(calendar-month-name month 'abbrev)))
|
||||
(month (concat "\\*\\|0*" (int-to-string month)))
|
||||
(day (concat "\\*\\|0*" (int-to-string day)))
|
||||
(year
|
||||
(concat
|
||||
"\\*\\|0*" (int-to-string year)
|
||||
(if abbreviated-calendar-year
|
||||
(concat "\\|" (format "%02d" (% year 100)))
|
||||
"")))
|
||||
(regexp
|
||||
(concat
|
||||
"\\(\\`\\|\^M\\|\n\\)" mark "?\\("
|
||||
(mapconcat 'eval date-form "\\)\\(")
|
||||
"\\)"))
|
||||
(case-fold-search t))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward regexp nil t)
|
||||
(if backup (re-search-backward "\\<" nil t))
|
||||
(if (and (or (char-equal (preceding-char) ?\^M)
|
||||
(char-equal (preceding-char) ?\n))
|
||||
(not (looking-at " \\|\^I")))
|
||||
;; Diary entry that consists only of date.
|
||||
(backward-char 1)
|
||||
;; Found a nonempty diary entry--make it
|
||||
;; visible and add it to the list.
|
||||
(setq entry-found t)
|
||||
(let ((entry-start (point))
|
||||
date-start temp)
|
||||
(re-search-backward "\^M\\|\n\\|\\`")
|
||||
(setq date-start (point))
|
||||
(re-search-forward "\^M\\|\n" nil t 2)
|
||||
(while (looking-at " \\|\^I")
|
||||
(re-search-forward "\^M\\|\n" nil t))
|
||||
(backward-char 1)
|
||||
(subst-char-in-region date-start
|
||||
(point) ?\^M ?\n t)
|
||||
(setq entry (buffer-substring entry-start (point))
|
||||
temp (diary-pull-attrs entry file-glob-attrs)
|
||||
entry (nth 0 temp))
|
||||
(add-to-diary-list
|
||||
date
|
||||
entry
|
||||
(buffer-substring
|
||||
(1+ date-start) (1- entry-start))
|
||||
(copy-marker entry-start) (nth 1 temp)))))))
|
||||
(or entry-found
|
||||
(not diary-list-include-blanks)
|
||||
(setq diary-entries-list
|
||||
(append diary-entries-list
|
||||
(list (list date "" "" "" "")))))
|
||||
(setq date
|
||||
(calendar-gregorian-from-absolute
|
||||
(1+ (calendar-absolute-from-gregorian date))))
|
||||
(setq entry-found nil)))
|
||||
(set-buffer-modified-p diary-modified)))
|
||||
(goto-char (point-min))
|
||||
(run-hooks 'nongregorian-diary-listing-hook
|
||||
'list-diary-entries-hook)
|
||||
@ -459,6 +478,14 @@ These hooks have the following distinct roles:
|
||||
(run-hooks 'diary-hook)
|
||||
diary-entries-list))))))
|
||||
|
||||
(defun diary-unhide-everything ()
|
||||
(setq selective-display nil)
|
||||
(let ((inhibit-read-only t)
|
||||
(modified (buffer-modified-p)))
|
||||
(subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
|
||||
(set-buffer-modified-p modified))
|
||||
(kill-local-variable 'mode-line-format))
|
||||
|
||||
(defun include-other-diary-files ()
|
||||
"Include the diary entries from other diary files with those of diary-file.
|
||||
This function is suitable for use in `list-diary-entries-hook';
|
||||
@ -471,34 +498,24 @@ changing the variable `diary-include-string'."
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward
|
||||
(concat
|
||||
"\\(\\`\\|\^M\\|\n\\)"
|
||||
"\\(?:\\`\\|\^M\\|\n\\)"
|
||||
(regexp-quote diary-include-string)
|
||||
" \"\\([^\"]*\\)\"")
|
||||
nil t)
|
||||
(let* ((diary-file (substitute-in-file-name
|
||||
(buffer-substring-no-properties
|
||||
(match-beginning 2) (match-end 2))))
|
||||
(match-string-no-properties 1)))
|
||||
(diary-list-include-blanks nil)
|
||||
(list-diary-entries-hook 'include-other-diary-files)
|
||||
(diary-display-hook 'ignore)
|
||||
(diary-hook nil)
|
||||
(d-buffer (find-buffer-visiting diary-file))
|
||||
(diary-modified (if d-buffer
|
||||
(save-excursion
|
||||
(set-buffer d-buffer)
|
||||
(buffer-modified-p)))))
|
||||
(diary-hook nil))
|
||||
(if (file-exists-p diary-file)
|
||||
(if (file-readable-p diary-file)
|
||||
(unwind-protect
|
||||
(setq diary-entries-list
|
||||
(append diary-entries-list
|
||||
(list-diary-entries original-date number)))
|
||||
(save-excursion
|
||||
(set-buffer (find-buffer-visiting diary-file))
|
||||
(let ((inhibit-read-only t))
|
||||
(subst-char-in-region (point-min) (point-max) ?\^M ?\n t))
|
||||
(setq selective-display nil)
|
||||
(set-buffer-modified-p diary-modified)))
|
||||
(with-current-buffer (find-buffer-visiting diary-file)
|
||||
(diary-unhide-everything)))
|
||||
(beep)
|
||||
(message "Can't read included diary file %s" diary-file)
|
||||
(sleep-for 2))
|
||||
@ -564,13 +581,9 @@ changing the variable `diary-include-string'."
|
||||
(defun fancy-diary-display ()
|
||||
"Prepare a diary buffer with relevant entries in a fancy, noneditable form.
|
||||
This function is provided for optional use as the `diary-display-hook'."
|
||||
(save-excursion;; Turn off selective-display in the diary file's buffer.
|
||||
(set-buffer (find-buffer-visiting (substitute-in-file-name diary-file)))
|
||||
(let ((diary-modified (buffer-modified-p)))
|
||||
(subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
|
||||
(setq selective-display nil)
|
||||
(kill-local-variable 'mode-line-format)
|
||||
(set-buffer-modified-p diary-modified)))
|
||||
(with-current-buffer ;; Turn off selective-display in the diary file's buffer.
|
||||
(find-buffer-visiting (substitute-in-file-name diary-file))
|
||||
(diary-unhide-everything))
|
||||
(if (or (not diary-entries-list)
|
||||
(and (not (cdr diary-entries-list))
|
||||
(string-equal (car (cdr (car diary-entries-list))) "")))
|
||||
@ -740,7 +753,8 @@ the actual printing."
|
||||
(kill-buffer temp-buffer)))
|
||||
(error "You don't have a diary buffer!")))))
|
||||
|
||||
(defun show-all-diary-entries ()
|
||||
(define-obsolete-function-alias 'show-all-diary-entries 'diary-show-all-entries)
|
||||
(defun diary-show-all-entries ()
|
||||
"Show all of the diary entries in the diary file.
|
||||
This function gets rid of the selective display of the diary file so that
|
||||
all entries, not just some, are visible. If there is no diary buffer, one
|
||||
@ -748,16 +762,9 @@ is created."
|
||||
(interactive)
|
||||
(let ((d-file (diary-check-diary-file))
|
||||
(pop-up-frames (window-dedicated-p (selected-window))))
|
||||
(save-excursion
|
||||
(set-buffer (or (find-buffer-visiting d-file)
|
||||
(find-file-noselect d-file t)))
|
||||
(let ((buffer-read-only nil)
|
||||
(diary-modified (buffer-modified-p)))
|
||||
(subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
|
||||
(setq selective-display nil
|
||||
mode-line-format default-mode-line-format)
|
||||
(display-buffer (current-buffer))
|
||||
(set-buffer-modified-p diary-modified)))))
|
||||
(with-current-buffer (or (find-buffer-visiting d-file)
|
||||
(find-file-noselect d-file t))
|
||||
(diary-unhide-everything))))
|
||||
|
||||
(defcustom diary-mail-addr
|
||||
(if (boundp 'user-mail-address) user-mail-address "")
|
||||
@ -807,9 +814,7 @@ to run it every morning at 1am."
|
||||
(calendar-date-string (calendar-current-date))))
|
||||
(insert
|
||||
(if (get-buffer fancy-diary-buffer)
|
||||
(save-excursion
|
||||
(set-buffer fancy-diary-buffer)
|
||||
(buffer-substring (point-min) (point-max)))
|
||||
(with-current-buffer fancy-diary-buffer (buffer-string))
|
||||
"No entries found"))
|
||||
(call-interactively (get mail-user-agent 'sendfunc))))
|
||||
|
||||
@ -844,7 +849,7 @@ marked. After the entries are marked, the hooks
|
||||
`nongregorian-diary-marking-hook' and `mark-diary-entries-hook'
|
||||
are run. If the optional argument REDRAW is non-nil (which is
|
||||
the case interactively, for example) then any existing diary
|
||||
marks are first removed. This is intended to deal with deleted
|
||||
marks are first removed. This is intended to deal with deleted
|
||||
diary entries."
|
||||
(interactive "p")
|
||||
;; To remove any deleted diary entries. Do not redraw when:
|
||||
@ -858,8 +863,7 @@ diary entries."
|
||||
(redraw-calendar))
|
||||
(let ((marking-diary-entries t)
|
||||
file-glob-attrs marks)
|
||||
(save-excursion
|
||||
(set-buffer (find-file-noselect (diary-check-diary-file) t))
|
||||
(with-current-buffer (find-file-noselect (diary-check-diary-file) t)
|
||||
(setq mark-diary-entries-in-calendar t)
|
||||
(message "Marking diary entries...")
|
||||
(setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
|
||||
@ -902,30 +906,20 @@ diary entries."
|
||||
(while (re-search-forward regexp nil t)
|
||||
(let* ((dd-name
|
||||
(if d-name-pos
|
||||
(buffer-substring-no-properties
|
||||
(match-beginning d-name-pos)
|
||||
(match-end d-name-pos))))
|
||||
(match-string-no-properties d-name-pos)))
|
||||
(mm-name
|
||||
(if m-name-pos
|
||||
(buffer-substring-no-properties
|
||||
(match-beginning m-name-pos)
|
||||
(match-end m-name-pos))))
|
||||
(match-string-no-properties m-name-pos)))
|
||||
(mm (string-to-number
|
||||
(if m-pos
|
||||
(buffer-substring-no-properties
|
||||
(match-beginning m-pos)
|
||||
(match-end m-pos))
|
||||
(match-string-no-properties m-pos)
|
||||
"")))
|
||||
(dd (string-to-number
|
||||
(if d-pos
|
||||
(buffer-substring-no-properties
|
||||
(match-beginning d-pos)
|
||||
(match-end d-pos))
|
||||
(match-string-no-properties d-pos)
|
||||
"")))
|
||||
(y-str (if y-pos
|
||||
(buffer-substring-no-properties
|
||||
(match-beginning y-pos)
|
||||
(match-end y-pos))))
|
||||
(match-string-no-properties y-pos)))
|
||||
(yy (if (not y-str)
|
||||
0
|
||||
(if (and (= (length y-str) 2)
|
||||
@ -941,13 +935,13 @@ diary entries."
|
||||
(if (> (- current-y y) 50)
|
||||
(+ y 100)
|
||||
y)))
|
||||
(string-to-number y-str))))
|
||||
(save-excursion
|
||||
(setq entry (buffer-substring-no-properties
|
||||
(point) (line-end-position))
|
||||
temp (diary-pull-attrs entry file-glob-attrs)
|
||||
entry (nth 0 temp)
|
||||
marks (nth 1 temp))))
|
||||
(string-to-number y-str)))))
|
||||
(save-excursion
|
||||
(setq entry (buffer-substring-no-properties
|
||||
(point) (line-end-position))
|
||||
temp (diary-pull-attrs entry file-glob-attrs)
|
||||
entry (nth 0 temp)
|
||||
marks (nth 1 temp)))
|
||||
(if dd-name
|
||||
(mark-calendar-days-named
|
||||
(cdr (assoc-string
|
||||
@ -982,8 +976,7 @@ is marked. See the documentation for the function `list-sexp-diary-entries'."
|
||||
sexp-mark "(diary-remind\\)"))
|
||||
(file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
|
||||
m y first-date last-date mark file-glob-attrs)
|
||||
(save-excursion
|
||||
(set-buffer calendar-buffer)
|
||||
(with-current-buffer calendar-buffer
|
||||
(setq m displayed-month)
|
||||
(setq y displayed-year))
|
||||
(increment-calendar-month m y -1)
|
||||
@ -1048,12 +1041,12 @@ changing the variable `diary-include-string'."
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward
|
||||
(concat
|
||||
"\\(\\`\\|\^M\\|\n\\)"
|
||||
"\\(?:\\`\\|\^M\\|\n\\)"
|
||||
(regexp-quote diary-include-string)
|
||||
" \"\\([^\"]*\\)\"")
|
||||
nil t)
|
||||
(let* ((diary-file (substitute-in-file-name
|
||||
(match-string-no-properties 2)))
|
||||
(match-string-no-properties 1)))
|
||||
(mark-diary-entries-hook 'mark-included-diary-files)
|
||||
(dbuff (find-buffer-visiting diary-file)))
|
||||
(if (file-exists-p diary-file)
|
||||
@ -1073,8 +1066,7 @@ changing the variable `diary-include-string'."
|
||||
(defun mark-calendar-days-named (dayname &optional color)
|
||||
"Mark all dates in the calendar window that are day DAYNAME of the week.
|
||||
0 means all Sundays, 1 means all Mondays, and so on."
|
||||
(save-excursion
|
||||
(set-buffer calendar-buffer)
|
||||
(with-current-buffer calendar-buffer
|
||||
(let ((prev-month displayed-month)
|
||||
(prev-year displayed-year)
|
||||
(succ-month displayed-month)
|
||||
@ -1094,8 +1086,7 @@ changing the variable `diary-include-string'."
|
||||
(defun mark-calendar-date-pattern (month day year &optional color)
|
||||
"Mark all dates in the calendar window that conform to MONTH/DAY/YEAR.
|
||||
A value of 0 in any position is a wildcard."
|
||||
(save-excursion
|
||||
(set-buffer calendar-buffer)
|
||||
(with-current-buffer calendar-buffer
|
||||
(let ((m displayed-month)
|
||||
(y displayed-year))
|
||||
(increment-calendar-month m y -1)
|
||||
@ -1152,22 +1143,17 @@ be used instead of a colon (:) to separate the hour and minute parts."
|
||||
(cond ((string-match ; Military time
|
||||
"\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)"
|
||||
s)
|
||||
(+ (* 100 (string-to-number
|
||||
(substring s (match-beginning 1) (match-end 1))))
|
||||
(string-to-number (substring s (match-beginning 2) (match-end 2)))))
|
||||
(+ (* 100 (string-to-number (match-string 1 s)))
|
||||
(string-to-number (match-string 2 s))))
|
||||
((string-match ; Hour only XXam or XXpm
|
||||
"\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s)
|
||||
(+ (* 100 (% (string-to-number
|
||||
(substring s (match-beginning 1) (match-end 1)))
|
||||
12))
|
||||
(+ (* 100 (% (string-to-number (match-string 1 s)) 12))
|
||||
(if (equal ?a (downcase (aref s (match-beginning 2))))
|
||||
0 1200)))
|
||||
((string-match ; Hour and minute XX:XXam or XX:XXpm
|
||||
"\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
|
||||
(+ (* 100 (% (string-to-number
|
||||
(substring s (match-beginning 1) (match-end 1)))
|
||||
12))
|
||||
(string-to-number (substring s (match-beginning 2) (match-end 2)))
|
||||
(+ (* 100 (% (string-to-number (match-string 1 s)) 12))
|
||||
(string-to-number (match-string 2 s))
|
||||
(if (equal ?a (downcase (aref s (match-beginning 3))))
|
||||
0 1200)))
|
||||
(t diary-unknown-time)))) ; Unrecognizable
|
||||
@ -1404,14 +1390,7 @@ best if they are nonmarking."
|
||||
(error
|
||||
(beep)
|
||||
(message "Bad sexp at line %d in %s: %s"
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(narrow-to-region 1 (point))
|
||||
(goto-char (point-min))
|
||||
(let ((lines 1))
|
||||
(while (re-search-forward "\n\\|\^M" nil t)
|
||||
(setq lines (1+ lines)))
|
||||
lines)))
|
||||
(count-lines (point-min) (point))
|
||||
diary-file sexp)
|
||||
(sleep-for 2))))))
|
||||
(cond ((stringp result) result)
|
||||
@ -1688,12 +1667,9 @@ If omitted, NONMARKING defaults to nil and FILE defaults to
|
||||
redrawn with the new entry marked, if necessary."
|
||||
(let ((pop-up-frames (window-dedicated-p (selected-window))))
|
||||
(find-file-other-window (substitute-in-file-name (or file diary-file))))
|
||||
(add-hook 'write-contents-functions 'diary-redraw-calendar nil t)
|
||||
(when selective-display
|
||||
(subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
|
||||
(setq selective-display nil)
|
||||
(kill-local-variable 'mode-line-format))
|
||||
(add-hook 'after-save-hook 'diary-redraw-calendar nil t)
|
||||
(widen)
|
||||
(diary-unhide-everything)
|
||||
(goto-char (point-max))
|
||||
(when (let ((case-fold-search t))
|
||||
(search-backward "Local Variables:"
|
||||
@ -1701,7 +1677,7 @@ redrawn with the new entry marked, if necessary."
|
||||
t))
|
||||
(beginning-of-line)
|
||||
(insert "\n")
|
||||
(previous-line 1))
|
||||
(forward-line -1))
|
||||
(insert
|
||||
(if (bolp) "" "\n")
|
||||
(if nonmarking diary-nonmarking-symbol "")
|
||||
@ -1798,19 +1774,29 @@ Prefix arg will make the entry nonmarking."
|
||||
(calendar-date-string (calendar-cursor-to-date t) nil t))
|
||||
arg)))
|
||||
|
||||
(defvar diary-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map "\C-c\C-s" 'diary-show-all-entries)
|
||||
(define-key map "\C-c\C-q" 'quit-window)
|
||||
map)
|
||||
"Keymap for `diary-mode'.")
|
||||
|
||||
;;;###autoload
|
||||
(define-derived-mode diary-mode fundamental-mode
|
||||
"Diary"
|
||||
(define-derived-mode diary-mode fundamental-mode "Diary"
|
||||
"Major mode for editing the diary file."
|
||||
(set (make-local-variable 'font-lock-defaults)
|
||||
'(diary-font-lock-keywords t)))
|
||||
'(diary-font-lock-keywords t))
|
||||
(add-to-invisibility-spec '(diary . nil))
|
||||
(add-hook 'after-save-hook 'diary-redraw-calendar nil t)
|
||||
(if diary-header-line-flag
|
||||
(setq header-line-format diary-header-line-format)))
|
||||
|
||||
(define-derived-mode fancy-diary-display-mode fundamental-mode
|
||||
"Diary"
|
||||
"Major mode used while displaying diary entries using Fancy Display."
|
||||
(set (make-local-variable 'font-lock-defaults)
|
||||
'(fancy-diary-font-lock-keywords t))
|
||||
(define-key (current-local-map) "q" 'quit-window))
|
||||
(local-set-key "q" 'quit-window))
|
||||
|
||||
|
||||
(defvar fancy-diary-font-lock-keywords
|
||||
@ -1836,7 +1822,7 @@ Prefix arg will make the entry nonmarking."
|
||||
"Keywords to highlight in fancy diary display")
|
||||
|
||||
|
||||
(defun font-lock-diary-sexps (limit)
|
||||
(defun diary-font-lock-sexps (limit)
|
||||
"Recognize sexp diary entry for font-locking."
|
||||
(if (re-search-forward
|
||||
(concat "^" (regexp-quote diary-nonmarking-symbol)
|
||||
@ -1851,7 +1837,7 @@ Prefix arg will make the entry nonmarking."
|
||||
t))
|
||||
(error t))))
|
||||
|
||||
(defun font-lock-diary-date-forms (month-array &optional symbol abbrev-array)
|
||||
(defun diary-font-lock-date-forms (month-array &optional symbol abbrev-array)
|
||||
"Create font-lock patterns for `diary-date-forms' using MONTH-ARRAY.
|
||||
If given, optional SYMBOL must be a prefix to entries.
|
||||
If optional ABBREV-ARRAY is present, the abbreviations constructed
|
||||
@ -1865,7 +1851,7 @@ names."
|
||||
(month "\\([0-9]+\\|\\*\\)")
|
||||
(day "\\([0-9]+\\|\\*\\)")
|
||||
(year "-?\\([0-9]+\\|\\*\\)"))
|
||||
(mapcar '(lambda (x)
|
||||
(mapcar (lambda (x)
|
||||
(cons
|
||||
(concat "^" (regexp-quote diary-nonmarking-symbol) "?"
|
||||
(if symbol (regexp-quote symbol) "") "\\("
|
||||
@ -1873,7 +1859,7 @@ names."
|
||||
;; If backup, omit first item (backup)
|
||||
;; and last item (not part of date)
|
||||
(if (equal (car x) 'backup)
|
||||
(reverse (cdr (reverse (cdr x))))
|
||||
(nreverse (cdr (reverse (cdr x))))
|
||||
x)
|
||||
"")
|
||||
;; With backup, last item is not part of date
|
||||
@ -1888,14 +1874,14 @@ names."
|
||||
|
||||
(defvar diary-font-lock-keywords
|
||||
(append
|
||||
(font-lock-diary-date-forms calendar-month-name-array
|
||||
(diary-font-lock-date-forms calendar-month-name-array
|
||||
nil calendar-month-abbrev-array)
|
||||
(when (or (memq 'mark-hebrew-diary-entries
|
||||
nongregorian-diary-marking-hook)
|
||||
(memq 'list-hebrew-diary-entries
|
||||
nongregorian-diary-listing-hook))
|
||||
(require 'cal-hebrew)
|
||||
(font-lock-diary-date-forms
|
||||
(diary-font-lock-date-forms
|
||||
calendar-hebrew-month-name-array-leap-year
|
||||
hebrew-diary-entry-symbol))
|
||||
(when (or (memq 'mark-islamic-diary-entries
|
||||
@ -1903,7 +1889,7 @@ names."
|
||||
(memq 'list-islamic-diary-entries
|
||||
nongregorian-diary-listing-hook))
|
||||
(require 'cal-islam)
|
||||
(font-lock-diary-date-forms
|
||||
(diary-font-lock-date-forms
|
||||
calendar-islamic-month-name-array
|
||||
islamic-diary-entry-symbol))
|
||||
(list
|
||||
@ -1925,10 +1911,10 @@ names."
|
||||
(concat "^" (regexp-quote diary-nonmarking-symbol)
|
||||
"?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)")
|
||||
'(1 font-lock-reference-face))
|
||||
'(font-lock-diary-sexps . font-lock-keyword-face)
|
||||
'(diary-font-lock-sexps . font-lock-keyword-face)
|
||||
'("[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\(-[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\)?"
|
||||
. font-lock-function-name-face)))
|
||||
"Forms to highlight in diary-mode")
|
||||
"Forms to highlight in `diary-mode'.")
|
||||
|
||||
|
||||
;; Following code from Dave Love <fx@gnu.org>.
|
||||
@ -2087,5 +2073,5 @@ user is asked to confirm its addition."
|
||||
|
||||
(provide 'diary-lib)
|
||||
|
||||
;;; arch-tag: 22dd506e-2e33-410d-9ae1-095a0c1b2010
|
||||
;; arch-tag: 22dd506e-2e33-410d-9ae1-095a0c1b2010
|
||||
;;; diary-lib.el ends here
|
||||
|
||||
@ -649,17 +649,16 @@ See `custom-known-themes' for a list of known themes."
|
||||
(progn
|
||||
(setcar (cdr setting) mode)
|
||||
(setcar (cddr setting) value))
|
||||
(if (and (null old)
|
||||
(boundp symbol))
|
||||
(setq old
|
||||
(list
|
||||
(list 'standard 'set
|
||||
(if (eq prop 'theme-value)
|
||||
(symbol-value symbol)
|
||||
(list
|
||||
(append
|
||||
'(t)
|
||||
(custom-face-attributes-get symbol nil))))))))
|
||||
;; If no custom theme has been applied yet, first save the
|
||||
;; current values to the 'standard theme.
|
||||
(if (null old)
|
||||
(if (and (eq prop 'theme-value)
|
||||
(boundp symbol))
|
||||
(setq old
|
||||
(list (list 'standard 'set (symbol-value symbol))))
|
||||
(if (facep symbol)
|
||||
(setq old (list (list 'standard 'set (list
|
||||
(append '(t) (custom-face-attributes-get symbol nil)))))))))
|
||||
(put symbol prop (cons (list theme mode value) old)))
|
||||
;; Record, for each theme, all its settings.
|
||||
(put theme 'theme-settings
|
||||
|
||||
@ -1834,20 +1834,27 @@ created."
|
||||
;; User init file can set term-file-prefix to nil to prevent this.
|
||||
(with-selected-frame frame
|
||||
(unless (null term-file-prefix)
|
||||
(let ((term (frame-parameter frame 'tty-type))
|
||||
hyphend term-init-func)
|
||||
(let* ((term (frame-parameter frame 'tty-type))
|
||||
(term2 term)
|
||||
hyphend term-init-func)
|
||||
(while (and term
|
||||
(not (fboundp
|
||||
(setq term-init-func (intern (concat "terminal-init-" term)))))
|
||||
(not (load (concat term-file-prefix term) t t)))
|
||||
;; Strip off last hyphen and what follows, then try again
|
||||
(setq term
|
||||
(if (setq hyphend (string-match "[-_][^-_]+$" term))
|
||||
(substring term 0 hyphend)
|
||||
nil)))
|
||||
(when (and term (fboundp term-init-func))
|
||||
;; The terminal file has been loaded, now call the terminal
|
||||
;; specific initialization function.
|
||||
;; The terminal file has been loaded, now find and call the
|
||||
;; terminal specific initialization function.
|
||||
(while (and term2
|
||||
(not (fboundp
|
||||
(setq term-init-func (intern (concat "terminal-init-" term2))))))
|
||||
;; Strip off last hyphen and what follows, then try again
|
||||
(setq term2
|
||||
(if (setq hyphend (string-match "[-_][^-_]+$" term2))
|
||||
(substring term2 0 hyphend)
|
||||
nil)))
|
||||
(when (fboundp term-init-func)
|
||||
(funcall term-init-func))))))
|
||||
|
||||
;; Called from C function init_display to initialize faces of the
|
||||
|
||||
@ -1738,7 +1738,11 @@ in that case, this function acts as if `enable-local-variables' were t."
|
||||
(hack-local-variables)))
|
||||
;; Turn font lock off and on, to make sure it takes account of
|
||||
;; whatever file local variables are relevant to it.
|
||||
(when (and font-lock-mode (eq (car font-lock-keywords) t))
|
||||
(when (and font-lock-mode
|
||||
;; Font-lock-mode (now in font-core.el) can be ON when
|
||||
;; font-lock.el still hasn't been loaded.
|
||||
(boundp 'font-lock-keywords)
|
||||
(eq (car font-lock-keywords) t))
|
||||
(setq font-lock-keywords (cadr font-lock-keywords))
|
||||
(font-lock-mode 1))
|
||||
|
||||
|
||||
@ -340,6 +340,7 @@ This can be an \"!\" or the \"n\" in \"ifndef\".")
|
||||
|
||||
;; Fontification variables:
|
||||
|
||||
;;;###autoload
|
||||
(defvar font-lock-keywords nil
|
||||
"A list of the keywords to highlight.
|
||||
There are two kinds of values: user-level, and compiled.
|
||||
|
||||
219
lisp/help-fns.el
219
lisp/help-fns.el
@ -522,7 +522,7 @@ it is displayed along with the global value."
|
||||
(message "You did not specify a variable")
|
||||
(save-excursion
|
||||
(let ((valvoid (not (with-current-buffer buffer (boundp variable))))
|
||||
val locus)
|
||||
val val-start-pos locus)
|
||||
;; Extract the value before setting up the output buffer,
|
||||
;; in case `buffer' *is* the output buffer.
|
||||
(unless valvoid
|
||||
@ -535,104 +535,6 @@ it is displayed along with the global value."
|
||||
(with-output-to-temp-buffer (help-buffer)
|
||||
(with-current-buffer buffer
|
||||
(prin1 variable)
|
||||
(if valvoid
|
||||
(princ " is void")
|
||||
(with-current-buffer standard-output
|
||||
(princ "'s value is ")
|
||||
(terpri)
|
||||
(let ((from (point)))
|
||||
(pp val)
|
||||
;; Hyperlinks in variable's value are quite frequently
|
||||
;; inappropriate e.g C-h v <RET> features <RET>
|
||||
;; (help-xref-on-pp from (point))
|
||||
(if (< (point) (+ from 20))
|
||||
(delete-region (1- from) from)))))
|
||||
(terpri)
|
||||
(when locus
|
||||
(if (bufferp locus)
|
||||
(princ (format "%socal in buffer %s; "
|
||||
(if (get variable 'permanent-local)
|
||||
"Permanently l" "L")
|
||||
(buffer-name)))
|
||||
(princ (format "It is a frame-local variable; ")))
|
||||
(if (not (default-boundp variable))
|
||||
(princ "globally void")
|
||||
(let ((val (default-value variable)))
|
||||
(with-current-buffer standard-output
|
||||
(princ "global value is ")
|
||||
(terpri)
|
||||
;; Fixme: pp can take an age if you happen to
|
||||
;; ask for a very large expression. We should
|
||||
;; probably print it raw once and check it's a
|
||||
;; sensible size before prettyprinting. -- fx
|
||||
(let ((from (point)))
|
||||
(pp val)
|
||||
;; See previous comment for this function.
|
||||
;; (help-xref-on-pp from (point))
|
||||
(if (< (point) (+ from 20))
|
||||
(delete-region (1- from) from))))))
|
||||
(terpri))
|
||||
(terpri)
|
||||
(with-current-buffer standard-output
|
||||
(when (> (count-lines (point-min) (point-max)) 10)
|
||||
;; Note that setting the syntax table like below
|
||||
;; makes forward-sexp move over a `'s' at the end
|
||||
;; of a symbol.
|
||||
(set-syntax-table emacs-lisp-mode-syntax-table)
|
||||
(goto-char (point-min))
|
||||
(if valvoid
|
||||
(forward-line 1)
|
||||
(forward-sexp 1)
|
||||
(delete-region (point) (progn (end-of-line) (point)))
|
||||
(save-excursion
|
||||
(insert "\n\nValue:")
|
||||
(set (make-local-variable 'help-button-cache)
|
||||
(point-marker)))
|
||||
(insert " value is shown ")
|
||||
(insert-button "below"
|
||||
'action help-button-cache
|
||||
'follow-link t
|
||||
'help-echo "mouse-2, RET: show value")
|
||||
(insert ".\n\n")))
|
||||
;; Add a note for variables that have been make-var-buffer-local.
|
||||
(when (and (local-variable-if-set-p variable)
|
||||
(or (not (local-variable-p variable))
|
||||
(with-temp-buffer
|
||||
(local-variable-if-set-p variable))))
|
||||
(save-excursion
|
||||
(forward-line -1)
|
||||
(insert "Automatically becomes buffer-local when set in any fashion.\n"))))
|
||||
;; Mention if it's an alias
|
||||
(let* ((alias (condition-case nil
|
||||
(indirect-variable variable)
|
||||
(error variable)))
|
||||
(obsolete (get variable 'byte-obsolete-variable))
|
||||
(doc (or (documentation-property variable 'variable-documentation)
|
||||
(documentation-property alias 'variable-documentation))))
|
||||
(unless (eq alias variable)
|
||||
(princ (format "This variable is an alias for `%s'." alias))
|
||||
(terpri)
|
||||
(terpri))
|
||||
(when obsolete
|
||||
(princ "This variable is obsolete")
|
||||
(if (cdr obsolete) (princ (format " since %s" (cdr obsolete))))
|
||||
(princ ";") (terpri)
|
||||
(princ (if (stringp (car obsolete)) (car obsolete)
|
||||
(format "use `%s' instead." (car obsolete))))
|
||||
(terpri)
|
||||
(terpri))
|
||||
(princ (or doc "Not documented as a variable.")))
|
||||
;; Make a link to customize if this variable can be customized.
|
||||
(if (custom-variable-p variable)
|
||||
(let ((customize-label "customize"))
|
||||
(terpri)
|
||||
(terpri)
|
||||
(princ (concat "You can " customize-label " this variable."))
|
||||
(with-current-buffer standard-output
|
||||
(save-excursion
|
||||
(re-search-backward
|
||||
(concat "\\(" customize-label "\\)") nil t)
|
||||
(help-xref-button 1 'help-customize-variable variable)))))
|
||||
;; Make a hyperlink to the library if appropriate. (Don't
|
||||
;; change the format of the buffer's initial line in case
|
||||
;; anything expects the current format.)
|
||||
@ -656,16 +558,117 @@ it is displayed along with the global value."
|
||||
(if (get-buffer " *DOC*")
|
||||
(help-C-file-name variable 'var)
|
||||
'C-source)))
|
||||
(when file-name
|
||||
(princ "\n\nDefined in `")
|
||||
(princ (if (eq file-name 'C-source) "C source code" file-name))
|
||||
(princ "'.")
|
||||
(with-current-buffer standard-output
|
||||
(save-excursion
|
||||
(re-search-backward "`\\([^`']+\\)'" nil t)
|
||||
(help-xref-button 1 'help-variable-def
|
||||
variable file-name)))))
|
||||
(if file-name
|
||||
(progn
|
||||
(princ " is a variable defined in `")
|
||||
(princ (if (eq file-name 'C-source) "C source code" file-name))
|
||||
(princ "'.\n")
|
||||
(with-current-buffer standard-output
|
||||
(save-excursion
|
||||
(re-search-backward "`\\([^`']+\\)'" nil t)
|
||||
(help-xref-button 1 'help-variable-def
|
||||
variable file-name)))
|
||||
(if valvoid
|
||||
(princ "It is void as a variable.\n")
|
||||
(princ "Its ")))
|
||||
(if valvoid
|
||||
(princ " is void as a variable.\n")
|
||||
(princ "'s "))))
|
||||
(if valvoid
|
||||
nil
|
||||
(with-current-buffer standard-output
|
||||
(setq val-start-pos (point))
|
||||
(princ "value is ")
|
||||
(terpri)
|
||||
(let ((from (point)))
|
||||
(pp val)
|
||||
;; Hyperlinks in variable's value are quite frequently
|
||||
;; inappropriate e.g C-h v <RET> features <RET>
|
||||
;; (help-xref-on-pp from (point))
|
||||
(if (< (point) (+ from 20))
|
||||
(delete-region (1- from) from)))))
|
||||
(terpri)
|
||||
|
||||
(when locus
|
||||
(if (bufferp locus)
|
||||
(princ (format "%socal in buffer %s; "
|
||||
(if (get variable 'permanent-local)
|
||||
"Permanently l" "L")
|
||||
(buffer-name)))
|
||||
(princ (format "It is a frame-local variable; ")))
|
||||
(if (not (default-boundp variable))
|
||||
(princ "globally void")
|
||||
(let ((val (default-value variable)))
|
||||
(with-current-buffer standard-output
|
||||
(princ "global value is ")
|
||||
(terpri)
|
||||
;; Fixme: pp can take an age if you happen to
|
||||
;; ask for a very large expression. We should
|
||||
;; probably print it raw once and check it's a
|
||||
;; sensible size before prettyprinting. -- fx
|
||||
(let ((from (point)))
|
||||
(pp val)
|
||||
;; See previous comment for this function.
|
||||
;; (help-xref-on-pp from (point))
|
||||
(if (< (point) (+ from 20))
|
||||
(delete-region (1- from) from)))))))
|
||||
;; Add a note for variables that have been make-var-buffer-local.
|
||||
(when (and (local-variable-if-set-p variable)
|
||||
(or (not (local-variable-p variable))
|
||||
(with-temp-buffer
|
||||
(local-variable-if-set-p variable))))
|
||||
(princ "\nAutomatically becomes buffer-local when set in any fashion.\n"))
|
||||
(terpri)
|
||||
|
||||
;; If the value is large, move it to the end.
|
||||
(with-current-buffer standard-output
|
||||
(when (> (count-lines (point-min) (point-max)) 10)
|
||||
;; Note that setting the syntax table like below
|
||||
;; makes forward-sexp move over a `'s' at the end
|
||||
;; of a symbol.
|
||||
(set-syntax-table emacs-lisp-mode-syntax-table)
|
||||
(goto-char val-start-pos)
|
||||
(delete-region (point) (progn (end-of-line) (point)))
|
||||
(save-excursion
|
||||
(insert "\n\nValue:")
|
||||
(set (make-local-variable 'help-button-cache)
|
||||
(point-marker)))
|
||||
(insert "value is shown ")
|
||||
(insert-button "below"
|
||||
'action help-button-cache
|
||||
'follow-link t
|
||||
'help-echo "mouse-2, RET: show value")
|
||||
(insert ".\n\n")))
|
||||
|
||||
;; Mention if it's an alias
|
||||
(let* ((alias (condition-case nil
|
||||
(indirect-variable variable)
|
||||
(error variable)))
|
||||
(obsolete (get variable 'byte-obsolete-variable))
|
||||
(doc (or (documentation-property variable 'variable-documentation)
|
||||
(documentation-property alias 'variable-documentation))))
|
||||
(unless (eq alias variable)
|
||||
(princ (format "\nThis variable is an alias for `%s'.\n" alias)))
|
||||
(when obsolete
|
||||
(princ "\nThis variable is obsolete")
|
||||
(if (cdr obsolete) (princ (format " since %s" (cdr obsolete))))
|
||||
(princ ";") (terpri)
|
||||
(princ (if (stringp (car obsolete)) (car obsolete)
|
||||
(format "use `%s' instead." (car obsolete))))
|
||||
(terpri))
|
||||
(princ "Documentation:\n")
|
||||
(princ (or doc "Not documented as a variable.")))
|
||||
;; Make a link to customize if this variable can be customized.
|
||||
(if (custom-variable-p variable)
|
||||
(let ((customize-label "customize"))
|
||||
(terpri)
|
||||
(terpri)
|
||||
(princ (concat "You can " customize-label " this variable."))
|
||||
(with-current-buffer standard-output
|
||||
(save-excursion
|
||||
(re-search-backward
|
||||
(concat "\\(" customize-label "\\)") nil t)
|
||||
(help-xref-button 1 'help-customize-variable variable)))))
|
||||
(print-help-return-message)
|
||||
(save-excursion
|
||||
(set-buffer standard-output)
|
||||
|
||||
@ -1591,8 +1591,13 @@ is inserted.
|
||||
The normal hook `mail-setup-hook' is run after the message is
|
||||
initialized. It can add more default fields to the message.
|
||||
|
||||
When calling from a program, the first argument if non-nil says
|
||||
not to erase the existing contents of the `*mail*' buffer.
|
||||
The first argument, NOERASE, determines what to do when there is
|
||||
an existing modified `*mail*' buffer. If NOERASE is nil, the
|
||||
existing mail buffer is used, and the user is prompted whether to
|
||||
keep the old contents or to erase them. If NOERASE has the value
|
||||
`new', a new mail buffer will be created instead of using the old
|
||||
one. Any other non-nil value means to always select the old
|
||||
buffer without erasing the contents.
|
||||
|
||||
The second through fifth arguments,
|
||||
TO, SUBJECT, IN-REPLY-TO and CC, specify if non-nil
|
||||
@ -1649,7 +1654,11 @@ The seventh argument ACTIONS is a list of actions to take
|
||||
;;; (file-exists-p buffer-auto-save-file-name))
|
||||
;;; (message "Auto save file for draft message exists; consider M-x mail-recover"))
|
||||
;;; t))
|
||||
(pop-to-buffer "*mail*")
|
||||
|
||||
(if (eq noerase 'new)
|
||||
(pop-to-buffer (generate-new-buffer "*mail*"))
|
||||
(pop-to-buffer "*mail*"))
|
||||
|
||||
;; Avoid danger that the auto-save file can't be written.
|
||||
(let ((dir (expand-file-name
|
||||
(file-name-as-directory mail-default-directory))))
|
||||
@ -1664,7 +1673,8 @@ The seventh argument ACTIONS is a list of actions to take
|
||||
;; (in case the user has actually visited a file *mail*).
|
||||
; (set-visited-file-name nil)
|
||||
(let (initialized)
|
||||
(and (not noerase)
|
||||
(and (or (not noerase)
|
||||
(eq noerase 'new))
|
||||
(if buffer-file-name
|
||||
(if (buffer-modified-p)
|
||||
(when (y-or-n-p "Buffer has unsaved changes; reinitialize it and discard them? ")
|
||||
|
||||
4919
lisp/net/newsticker.el
Normal file
4919
lisp/net/newsticker.el
Normal file
File diff suppressed because it is too large
Load Diff
@ -307,7 +307,7 @@ File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?"
|
||||
(defcustom compilation-error-regexp-alist
|
||||
(mapcar 'car compilation-error-regexp-alist-alist)
|
||||
"Alist that specifies how to match errors in compiler output.
|
||||
Note that on Unix everything is a valid filename, so these
|
||||
On GNU and Unix, any string is a valid filename, so these
|
||||
matchers must make some common sense assumptions, which catch
|
||||
normal cases. A shorter list will be lighter on resource usage.
|
||||
|
||||
@ -436,6 +436,7 @@ nil as an element means to try the default directory."
|
||||
(string :tag "Directory")))
|
||||
:group 'compilation)
|
||||
|
||||
;;;###autoload
|
||||
(defcustom compile-command "make -k "
|
||||
"*Last shell command used to do a compilation; default for next compilation.
|
||||
|
||||
@ -452,6 +453,7 @@ You might also use mode hooks to specify it in certain modes, like this:
|
||||
:type 'string
|
||||
:group 'compilation)
|
||||
|
||||
;;;###autoload
|
||||
(defcustom compilation-disable-input nil
|
||||
"*If non-nil, send end-of-file as compilation process input.
|
||||
This only affects platforms that support asynchronous processes (see
|
||||
@ -664,24 +666,26 @@ just char-counts."
|
||||
(move-to-column col)
|
||||
(goto-char (min (+ (line-beginning-position) col) (line-end-position)))))
|
||||
|
||||
(defun compilation-internal-error-properties (file line end-line col end-col type fmt)
|
||||
(defun compilation-internal-error-properties (file line end-line col end-col type fmts)
|
||||
"Get the meta-info that will be added as text-properties.
|
||||
LINE, END-LINE, COL, END-COL are integers or nil.
|
||||
TYPE can be 0, 1, or 2.
|
||||
FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil."
|
||||
TYPE can be 0, 1, or 2, meaning error, warning, or just info.
|
||||
FILE should be (FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil.
|
||||
FMTS is a list of format specs for transforming the file name.
|
||||
(See `compilation-error-regexp-alist'.)"
|
||||
(unless file (setq file '("*unknown*")))
|
||||
(setq file (compilation-get-file-structure file fmt))
|
||||
;; Get first already existing marker (if any has one, all have one).
|
||||
;; Do this first, as the compilation-assq`s may create new nodes.
|
||||
(let* ((marker-line (car (cddr file))) ; a line structure
|
||||
(let* ((file-struct (compilation-get-file-structure file fmts))
|
||||
;; Get first already existing marker (if any has one, all have one).
|
||||
;; Do this first, as the compilation-assq`s may create new nodes.
|
||||
(marker-line (car (cddr file-struct))) ; a line structure
|
||||
(marker (nth 3 (cadr marker-line))) ; its marker
|
||||
(compilation-error-screen-columns compilation-error-screen-columns)
|
||||
end-marker loc end-loc)
|
||||
(if (not (and marker (marker-buffer marker)))
|
||||
(setq marker) ; no valid marker for this file
|
||||
(setq marker nil) ; no valid marker for this file
|
||||
(setq loc (or line 1)) ; normalize no linenumber to line 1
|
||||
(catch 'marker ; find nearest loc, at least one exists
|
||||
(dolist (x (nthcdr 3 file)) ; loop over remaining lines
|
||||
(dolist (x (nthcdr 3 file-struct)) ; loop over remaining lines
|
||||
(if (> (car x) loc) ; still bigger
|
||||
(setq marker-line x)
|
||||
(if (> (- (or (car marker-line) 1) loc)
|
||||
@ -710,17 +714,18 @@ FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil."
|
||||
(forward-to-indentation 0))
|
||||
(setq marker (list (point-marker))))))
|
||||
|
||||
(setq loc (compilation-assq line (cdr file)))
|
||||
(setq loc (compilation-assq line (cdr file-struct)))
|
||||
(if end-line
|
||||
(setq end-loc (compilation-assq end-line (cdr file))
|
||||
(setq end-loc (compilation-assq end-line (cdr file-struct))
|
||||
end-loc (compilation-assq end-col end-loc))
|
||||
(if end-col ; use same line element
|
||||
(setq end-loc (compilation-assq end-col loc))))
|
||||
(setq loc (compilation-assq col loc))
|
||||
;; If they are new, make the loc(s) reference the file they point to.
|
||||
(or (cdr loc) (setcdr loc `(,line ,file ,@marker)))
|
||||
(or (cdr loc) (setcdr loc `(,line ,file-struct ,@marker)))
|
||||
(if end-loc
|
||||
(or (cdr end-loc) (setcdr end-loc `(,(or end-line line) ,file ,@end-marker))))
|
||||
(or (cdr end-loc)
|
||||
(setcdr end-loc `(,(or end-line line) ,file-struct ,@end-marker))))
|
||||
|
||||
;; Must start with face
|
||||
`(face ,compilation-message-face
|
||||
@ -1570,8 +1575,7 @@ This is the value of `next-error-function' in Compilation buffers."
|
||||
;; markers for that file.
|
||||
(unless (and (nth 3 loc) (marker-buffer (nth 3 loc)))
|
||||
(with-current-buffer (compilation-find-file marker (caar (nth 2 loc))
|
||||
(or (cdar (nth 2 loc))
|
||||
default-directory))
|
||||
(cadr (car (nth 2 loc))))
|
||||
(save-restriction
|
||||
(widen)
|
||||
(goto-char (point-min))
|
||||
@ -1734,16 +1738,21 @@ and overlay is highlighted between MK and END-MK."
|
||||
(copy-marker (line-beginning-position))))))
|
||||
|
||||
|
||||
(defun compilation-find-file (marker filename dir &rest formats)
|
||||
(defun compilation-find-file (marker filename directory &rest formats)
|
||||
"Find a buffer for file FILENAME.
|
||||
Search the directories in `compilation-search-path'.
|
||||
A nil in `compilation-search-path' means to try the
|
||||
current directory, which is passed in DIR.
|
||||
\"current\" directory, which is passed in DIRECTORY.
|
||||
If DIRECTORY. is relative, it is combined with `default-directory'.
|
||||
If DIRECTORY. is nil, that means use `default-directory'.
|
||||
If FILENAME is not found at all, ask the user where to find it.
|
||||
Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
|
||||
(or formats (setq formats '("%s")))
|
||||
(save-excursion
|
||||
(let ((dirs compilation-search-path)
|
||||
(spec-dir (if directory
|
||||
(expand-file-name directory)
|
||||
default-directory))
|
||||
buffer thisdir fmts name)
|
||||
(if (file-name-absolute-p filename)
|
||||
;; The file name is absolute. Use its explicit directory as
|
||||
@ -1753,7 +1762,7 @@ Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
|
||||
filename (file-name-nondirectory filename)))
|
||||
;; Now search the path.
|
||||
(while (and dirs (null buffer))
|
||||
(setq thisdir (or (car dirs) dir)
|
||||
(setq thisdir (or (car dirs) spec-dir)
|
||||
fmts formats)
|
||||
;; For each directory, try each format string.
|
||||
(while (and fmts (null buffer))
|
||||
@ -1771,7 +1780,7 @@ Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
|
||||
(read-file-name
|
||||
(format "Find this %s in: (default %s) "
|
||||
compilation-error filename)
|
||||
dir filename t))))
|
||||
spec-dir filename t))))
|
||||
(if (file-directory-p name)
|
||||
(setq name (expand-file-name filename name)))
|
||||
(setq buffer (and (file-exists-p name)
|
||||
@ -1785,26 +1794,32 @@ Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
|
||||
|
||||
(defun compilation-get-file-structure (file &optional fmt)
|
||||
"Retrieve FILE's file-structure or create a new one.
|
||||
FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME)."
|
||||
FILE should be (FILENAME) or (RELATIVE-FILENAME . DIRNAME).
|
||||
In the former case, FILENAME may be relative or absolute.
|
||||
|
||||
The file-structure looks like this:
|
||||
(list (list FILENAME [DIR-FROM-PREV-MSG]) FMT LINE-STRUCT...)
|
||||
"
|
||||
(or (gethash file compilation-locs)
|
||||
;; File was not previously encountered, at least not in the form passed.
|
||||
;; Let's normalize it and look again.
|
||||
(let ((filename (car file))
|
||||
(default-directory (if (cdr file)
|
||||
(file-truename (cdr file))
|
||||
default-directory)))
|
||||
;; Get the specified directory from FILE.
|
||||
(spec-directory (if (cdr file)
|
||||
(file-truename (cdr file)))))
|
||||
|
||||
;; Check for a comint-file-name-prefix and prepend it if appropriate.
|
||||
;; (This is very useful for compilation-minor-mode in an rlogin-mode
|
||||
;; buffer.)
|
||||
(if (boundp 'comint-file-name-prefix)
|
||||
(if (file-name-absolute-p filename)
|
||||
(setq filename
|
||||
(concat (with-no-warnings comint-file-name-prefix) filename))
|
||||
(setq default-directory
|
||||
(file-truename
|
||||
(concat (with-no-warnings comint-file-name-prefix) default-directory)))))
|
||||
(when (and (boundp 'comint-file-name-prefix)
|
||||
(not (equal comint-file-name-prefix "")))
|
||||
(if (file-name-absolute-p filename)
|
||||
(setq filename
|
||||
(concat comint-file-name-prefix filename))
|
||||
(if spec-directory
|
||||
(setq spec-directory
|
||||
(file-truename
|
||||
(concat comint-file-name-prefix spec-directory))))))
|
||||
|
||||
;; If compilation-parse-errors-filename-function is
|
||||
;; defined, use it to process the filename.
|
||||
@ -1820,20 +1835,13 @@ FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME)."
|
||||
;; name and fix them.
|
||||
(setq filename (command-line-normalize-file-name filename))
|
||||
|
||||
;; Now eliminate any "..", because find-file would get them wrong.
|
||||
;; Make relative and absolute filenames, with or without links, the
|
||||
;; same.
|
||||
(setq filename
|
||||
(list (abbreviate-file-name
|
||||
(file-truename (if (cdr file)
|
||||
(expand-file-name filename)
|
||||
filename)))))
|
||||
|
||||
;; Store it for the possibly unnormalized name
|
||||
(puthash file
|
||||
;; Retrieve or create file-structure for normalized name
|
||||
(or (gethash filename compilation-locs)
|
||||
(puthash filename (list filename fmt) compilation-locs))
|
||||
(or (gethash (list filename) compilation-locs)
|
||||
(puthash (list filename)
|
||||
(list (list filename spec-directory) fmt)
|
||||
compilation-locs))
|
||||
compilation-locs))))
|
||||
|
||||
(add-to-list 'debug-ignored-errors "^No more [-a-z ]+s yet$")
|
||||
|
||||
@ -5,7 +5,7 @@
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; Maintainer's Time-stamp: <2004-06-13 19:04:36 teirllm>
|
||||
;; Maintainer's Time-stamp: <2004-09-25 20:55:35 gildea>
|
||||
;; Maintainer: Stephen Gildea <gildea@stop.mail-abuse.org>
|
||||
;; Keywords: tools
|
||||
|
||||
@ -143,20 +143,26 @@ the first (last) `time-stamp-line-limit' lines of the file for the
|
||||
file to be time-stamped by \\[time-stamp]. A value of 0 searches the
|
||||
entire buffer (use with care).
|
||||
|
||||
Do not change `time-stamp-line-limit', `time-stamp-start', or
|
||||
`time-stamp-end' for yourself or you will be incompatible
|
||||
with other people's files! If you must change them for some application,
|
||||
do so in the local variables section of the time-stamped file itself.")
|
||||
This value can also be set with the variable `time-stamp-pattern'.
|
||||
|
||||
Do not change `time-stamp-line-limit', `time-stamp-start',
|
||||
`time-stamp-end', or `time-stamp-pattern' for yourself or you will be
|
||||
incompatible with other people's files! If you must change them for some
|
||||
application, do so in the local variables section of the time-stamped file
|
||||
itself.")
|
||||
|
||||
|
||||
(defvar time-stamp-start "Time-stamp:[ \t]+\\\\?[\"<]+" ;Do not change!
|
||||
"Regexp after which the time stamp is written by \\[time-stamp].
|
||||
See also the variables `time-stamp-end' and `time-stamp-line-limit'.
|
||||
|
||||
Do not change `time-stamp-line-limit', `time-stamp-start', or
|
||||
`time-stamp-end' for yourself or you will be incompatible
|
||||
with other people's files! If you must change them for some application,
|
||||
do so in the local variables section of the time-stamped file itself.")
|
||||
This value can also be set with the variable `time-stamp-pattern'.
|
||||
|
||||
Do not change `time-stamp-line-limit', `time-stamp-start',
|
||||
`time-stamp-end', or `time-stamp-pattern' for yourself or you will be
|
||||
incompatible with other people's files! If you must change them for some
|
||||
application, do so in the local variables section of the time-stamped file
|
||||
itself.")
|
||||
|
||||
|
||||
(defvar time-stamp-end "\\\\?[\">]" ;Do not change!
|
||||
@ -165,13 +171,15 @@ do so in the local variables section of the time-stamped file itself.")
|
||||
and the following match of `time-stamp-end', then writes the
|
||||
time stamp specified by `time-stamp-format' between them.
|
||||
|
||||
This value can also be set with the variable `time-stamp-pattern'.
|
||||
|
||||
The end text normally starts on the same line as the start text ends,
|
||||
but if there are any newlines in `time-stamp-format', the same number
|
||||
of newlines must separate the start and end. \\[time-stamp] tries
|
||||
to not change the number of lines in the buffer. `time-stamp-inserts-lines'
|
||||
controls this behavior.
|
||||
|
||||
Do not change `time-stamp-line-limit', `time-stamp-start', `time-stamp-end',
|
||||
Do not change `time-stamp-start', `time-stamp-end', `time-stamp-pattern',
|
||||
or `time-stamp-inserts-lines' for yourself or you will be incompatible
|
||||
with other people's files! If you must change them for some application,
|
||||
do so in the local variables section of the time-stamped file itself.")
|
||||
@ -231,9 +239,11 @@ Examples:
|
||||
\"@set Time-stamp: %:b %:d, %:y$\"
|
||||
\"newcommand{\\\\\\\\timestamp}{%%}\"
|
||||
|
||||
Do not change `time-stamp-pattern' for yourself or you will be incompatible
|
||||
with other people's files! Set it only in the local variables section
|
||||
of the time-stamped file itself.")
|
||||
Do not change `time-stamp-pattern' `time-stamp-line-limit',
|
||||
`time-stamp-start', or `time-stamp-end' for yourself or you will be
|
||||
incompatible with other people's files! If you must change them for
|
||||
some application, do so only in the local variables section of the
|
||||
time-stamped file itself.")
|
||||
|
||||
|
||||
|
||||
@ -251,10 +261,11 @@ look like one of the following:
|
||||
The time stamp is written between the brackets or quotes:
|
||||
Time-stamp: <2001-02-18 10:20:51 gildea>
|
||||
The time stamp is updated only if the variable `time-stamp-active' is non-nil.
|
||||
The format of the time stamp is set by the variable `time-stamp-format'.
|
||||
The variables `time-stamp-line-limit', `time-stamp-start', `time-stamp-end',
|
||||
`time-stamp-count', and `time-stamp-inserts-lines' control finding the
|
||||
template."
|
||||
The format of the time stamp is set by the variable `time-stamp-pattern' or
|
||||
`time-stamp-format'. The variables `time-stamp-pattern',
|
||||
`time-stamp-line-limit', `time-stamp-start', `time-stamp-end',
|
||||
`time-stamp-count', and `time-stamp-inserts-lines' control finding
|
||||
the template."
|
||||
(interactive)
|
||||
(let ((line-limit time-stamp-line-limit)
|
||||
(ts-start time-stamp-start)
|
||||
@ -588,6 +599,13 @@ and all `time-stamp-format' compatibility."
|
||||
(user-full-name))
|
||||
((eq cur-char ?h) ;mail host name
|
||||
(time-stamp-mail-host-name))
|
||||
((eq cur-char ?q) ;(undocumented unqual hostname)
|
||||
(let ((qualname (system-name)))
|
||||
(if (string-match "\\." qualname)
|
||||
(substring qualname 0 (match-beginning 0))
|
||||
qualname)))
|
||||
((eq cur-char ?Q) ;(undocumented fully-qualified host)
|
||||
(system-name))
|
||||
))
|
||||
(let ((padded-result
|
||||
(format (format "%%%s%c"
|
||||
|
||||
@ -1,3 +1,40 @@
|
||||
2005-09-12 Kim F. Storm <storm@cua.dk>
|
||||
|
||||
* composite.c (compose_chars_in_text): Fix setup of `pend'.
|
||||
Unconditionally reload `ptr' and `pend' after eval.
|
||||
|
||||
* xdisp.c (message3): Pass copy of lisp string to message_dolog.
|
||||
|
||||
* print.c (print_error_message): Pass copy of caller name to
|
||||
message_dolog.
|
||||
|
||||
* fileio.c (auto_save_error): Pass copy of lisp string to message2.
|
||||
|
||||
2005-09-12 Kenichi Handa <handa@m17n.org>
|
||||
|
||||
* xdisp.c (display_mode_element): Be sure to make variables THIS
|
||||
and LISP_STRING point into a string data of ELT.
|
||||
|
||||
2005-09-12 Kim F. Storm <storm@cua.dk>
|
||||
|
||||
* editfns.c (Ftranslate_region_internal): Reload `tt' after
|
||||
signal_after_change that may have GC'ed.
|
||||
(Fmessage, Fmessage_box, Fmessage_or_box): Doc fix.
|
||||
|
||||
* keymap.c (Fdescribe_buffer_bindings): Reload `translate'
|
||||
after insert while runs signal_after_change.
|
||||
|
||||
* minibuf.c (Fminibuffer_complete_word): Move `completion_string'
|
||||
declaration to where it is used.
|
||||
|
||||
* w32.c (check_windows_init_file): Fix allocation of error buffer.
|
||||
|
||||
* xfns.c (x_encode_text): Declare static. Add FREEP arg.
|
||||
(x_set_name_internal): Call x_encode_text with new FREEP arg to
|
||||
know if xfree is needed instead of guessing.
|
||||
|
||||
* xterm.h (x_encode_text): Remove prototype.
|
||||
|
||||
2005-09-11 Chris Prince <cprince@gmail.com> (tiny change)
|
||||
|
||||
* w32term.c (x_bitmap_icon): Load small icons too.
|
||||
|
||||
@ -616,7 +616,7 @@ compose_chars_in_text (start, end, string)
|
||||
GCPRO1 (string);
|
||||
stop = end;
|
||||
ptr = SDATA (string) + string_char_to_byte (string, start);
|
||||
pend = ptr + SBYTES (string);
|
||||
pend = SDATA (string) + SBYTES (string);
|
||||
}
|
||||
else
|
||||
{
|
||||
@ -680,10 +680,19 @@ compose_chars_in_text (start, end, string)
|
||||
{
|
||||
start += XINT (val);
|
||||
if (STRINGP (string))
|
||||
ptr = SDATA (string) + string_char_to_byte (string, start);
|
||||
{
|
||||
ptr = SDATA (string) + string_char_to_byte (string, start);
|
||||
pend = SDATA (string) + SBYTES (string);
|
||||
}
|
||||
else
|
||||
ptr = CHAR_POS_ADDR (start);
|
||||
}
|
||||
else if (STRINGP (string))
|
||||
{
|
||||
start++;
|
||||
ptr = SDATA (string) + string_char_to_byte (string, start);
|
||||
pend = SDATA (string) + SBYTES (string);
|
||||
}
|
||||
else
|
||||
{
|
||||
start++;
|
||||
|
||||
@ -2857,6 +2857,8 @@ It returns the number of characters changed. */)
|
||||
{
|
||||
if (tt)
|
||||
{
|
||||
/* Reload as signal_after_change in last iteration may GC. */
|
||||
tt = SDATA (table);
|
||||
if (string_multibyte)
|
||||
{
|
||||
str = tt + string_char_to_byte (table, oc);
|
||||
@ -3118,8 +3120,9 @@ The message also goes into the `*Messages*' buffer.
|
||||
The first argument is a format control string, and the rest are data
|
||||
to be formatted under control of the string. See `format' for details.
|
||||
|
||||
If the first argument is nil, the function clears any existing message;
|
||||
this lets the minibuffer contents show. See also `current-message'.
|
||||
If the first argument is nil or the empty string, the function clears
|
||||
any existing message; this lets the minibuffer contents show. See
|
||||
also `current-message'.
|
||||
|
||||
usage: (message STRING &rest ARGS) */)
|
||||
(nargs, args)
|
||||
@ -3148,8 +3151,8 @@ If a dialog box is not available, use the echo area.
|
||||
The first argument is a format control string, and the rest are data
|
||||
to be formatted under control of the string. See `format' for details.
|
||||
|
||||
If the first argument is nil, clear any existing message; let the
|
||||
minibuffer contents show.
|
||||
If the first argument is nil or the empty string, clear any existing
|
||||
message; let the minibuffer contents show.
|
||||
|
||||
usage: (message-box STRING &rest ARGS) */)
|
||||
(nargs, args)
|
||||
@ -3210,8 +3213,8 @@ Otherwise, use the echo area.
|
||||
The first argument is a format control string, and the rest are data
|
||||
to be formatted under control of the string. See `format' for details.
|
||||
|
||||
If the first argument is nil, clear any existing message; let the
|
||||
minibuffer contents show.
|
||||
If the first argument is nil or the empty string, clear any existing
|
||||
message; let the minibuffer contents show.
|
||||
|
||||
usage: (message-or-box STRING &rest ARGS) */)
|
||||
(nargs, args)
|
||||
|
||||
@ -5771,6 +5771,8 @@ auto_save_error (error)
|
||||
Lisp_Object args[3], msg;
|
||||
int i, nbytes;
|
||||
struct gcpro gcpro1;
|
||||
char *msgbuf;
|
||||
USE_SAFE_ALLOCA;
|
||||
|
||||
ring_bell (XFRAME (selected_frame));
|
||||
|
||||
@ -5780,13 +5782,15 @@ auto_save_error (error)
|
||||
msg = Fformat (3, args);
|
||||
GCPRO1 (msg);
|
||||
nbytes = SBYTES (msg);
|
||||
SAFE_ALLOCA (msgbuf, char *, nbytes);
|
||||
bcopy (SDATA (msg), msgbuf, nbytes);
|
||||
|
||||
for (i = 0; i < 3; ++i)
|
||||
{
|
||||
if (i == 0)
|
||||
message2 (SDATA (msg), nbytes, STRING_MULTIBYTE (msg));
|
||||
message2 (msgbuf, nbytes, STRING_MULTIBYTE (msg));
|
||||
else
|
||||
message2_nolog (SDATA (msg), nbytes, STRING_MULTIBYTE (msg));
|
||||
message2_nolog (msgbuf, nbytes, STRING_MULTIBYTE (msg));
|
||||
Fsleep_for (make_number (1), Qnil);
|
||||
}
|
||||
|
||||
|
||||
@ -743,7 +743,7 @@ usage: (map-keymap FUNCTION KEYMAP) */)
|
||||
Fsignal (Qinvalid_function, Fcons (function, Qnil));
|
||||
if (! NILP (sort_first))
|
||||
return call3 (intern ("map-keymap-internal"), function, keymap, Qt);
|
||||
|
||||
|
||||
map_keymap (keymap, map_keymap_call, function, NULL, 1);
|
||||
return Qnil;
|
||||
}
|
||||
@ -2837,6 +2837,9 @@ You type Translation\n\
|
||||
insert (buf, bufend - buf);
|
||||
|
||||
insert ("\n", 1);
|
||||
|
||||
/* Insert calls signal_after_change which may GC. */
|
||||
translate = SDATA (Vkeyboard_translate_table);
|
||||
}
|
||||
|
||||
insert ("\n", 1);
|
||||
|
||||
@ -2164,7 +2164,6 @@ Return nil if there is no valid completion, else t. */)
|
||||
{
|
||||
Lisp_Object completion, tem, tem1;
|
||||
register int i, i_byte;
|
||||
register const unsigned char *completion_string;
|
||||
struct gcpro gcpro1, gcpro2;
|
||||
int prompt_end_charpos = XINT (Fminibuffer_prompt_end ());
|
||||
|
||||
@ -2295,7 +2294,7 @@ Return nil if there is no valid completion, else t. */)
|
||||
{
|
||||
int len, c;
|
||||
int bytes = SBYTES (completion);
|
||||
completion_string = SDATA (completion);
|
||||
register const unsigned char *completion_string = SDATA (completion);
|
||||
for (; i_byte < SBYTES (completion); i_byte += len, i++)
|
||||
{
|
||||
c = STRING_CHAR_AND_LENGTH (completion_string + i_byte,
|
||||
|
||||
@ -1025,7 +1025,9 @@ print_error_message (data, stream, context, caller)
|
||||
*Messages*. */
|
||||
if (!NILP (caller) && SYMBOLP (caller))
|
||||
{
|
||||
const char *name = SDATA (SYMBOL_NAME (caller));
|
||||
Lisp_Object cname = SYMBOL_NAME (caller);
|
||||
char *name = alloca (SBYTES (cname));
|
||||
bcopy (SDATA (cname), name, SBYTES (cname));
|
||||
message_dolog (name, strlen (name), 0, 0);
|
||||
message_dolog (": ", 2, 0, 0);
|
||||
}
|
||||
|
||||
@ -3894,7 +3894,9 @@ check_windows_init_file ()
|
||||
Lisp_Object load_path_print = Fprin1_to_string (full_load_path, Qnil);
|
||||
char *init_file_name = SDATA (init_file);
|
||||
char *load_path = SDATA (load_path_print);
|
||||
char *buffer = alloca (1024);
|
||||
char *buffer = alloca (1024
|
||||
+ strlen (init_file_name)
|
||||
+ strlen (load_path));
|
||||
|
||||
sprintf (buffer,
|
||||
"The Emacs Windows initialization file \"%s.el\" "
|
||||
|
||||
12
src/xdisp.c
12
src/xdisp.c
@ -7048,7 +7048,15 @@ message3 (m, nbytes, multibyte)
|
||||
/* First flush out any partial line written with print. */
|
||||
message_log_maybe_newline ();
|
||||
if (STRINGP (m))
|
||||
message_dolog (SDATA (m), nbytes, 1, multibyte);
|
||||
{
|
||||
char *buffer;
|
||||
USE_SAFE_ALLOCA;
|
||||
|
||||
SAFE_ALLOCA (buffer, char *, nbytes);
|
||||
bcopy (SDATA (m), buffer, nbytes);
|
||||
message_dolog (buffer, nbytes, 1, multibyte);
|
||||
SAFE_FREE ();
|
||||
}
|
||||
message3_nolog (m, nbytes, multibyte);
|
||||
|
||||
UNGCPRO;
|
||||
@ -16183,6 +16191,8 @@ display_mode_element (it, depth, field_width, precision, elt, props, risky)
|
||||
else /* c == 0 */
|
||||
break;
|
||||
}
|
||||
this += SDATA (elt) - lisp_string;
|
||||
lisp_string = SDATA (elt);
|
||||
}
|
||||
}
|
||||
break;
|
||||
|
||||
21
src/xfns.c
21
src/xfns.c
@ -1524,11 +1524,12 @@ x_set_scroll_bar_background (f, value, oldval)
|
||||
Otherwise store 0 in *STRINGP, which means that the `encoding' of
|
||||
the result should be `COMPOUND_TEXT'. */
|
||||
|
||||
unsigned char *
|
||||
x_encode_text (string, coding_system, selectionp, text_bytes, stringp)
|
||||
static unsigned char *
|
||||
x_encode_text (string, coding_system, selectionp, text_bytes, stringp, freep)
|
||||
Lisp_Object string, coding_system;
|
||||
int *text_bytes, *stringp;
|
||||
int selectionp;
|
||||
int *freep;
|
||||
{
|
||||
unsigned char *str = SDATA (string);
|
||||
int chars = SCHARS (string);
|
||||
@ -1545,6 +1546,7 @@ x_encode_text (string, coding_system, selectionp, text_bytes, stringp)
|
||||
/* No multibyte character in OBJ. We need not encode it. */
|
||||
*text_bytes = bytes;
|
||||
*stringp = 1;
|
||||
*freep = 0;
|
||||
return str;
|
||||
}
|
||||
|
||||
@ -1572,6 +1574,7 @@ x_encode_text (string, coding_system, selectionp, text_bytes, stringp)
|
||||
*stringp = (charset_info == 1
|
||||
|| (!EQ (coding_system, Qcompound_text)
|
||||
&& !EQ (coding_system, Qcompound_text_with_extensions)));
|
||||
*freep = 1;
|
||||
return buf;
|
||||
}
|
||||
|
||||
@ -1610,16 +1613,13 @@ x_set_name_internal (f, name)
|
||||
in the future which can encode all Unicode characters.
|
||||
But, for the moment, there's no way to know that the
|
||||
current window manager supports it or not. */
|
||||
text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp);
|
||||
text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp,
|
||||
&do_free_text_value);
|
||||
text.encoding = (stringp ? XA_STRING
|
||||
: FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
|
||||
text.format = 8;
|
||||
text.nitems = bytes;
|
||||
|
||||
/* Check early, because ENCODE_UTF_8 below may GC and name may be
|
||||
relocated. */
|
||||
do_free_text_value = text.value != SDATA (name);
|
||||
|
||||
if (NILP (f->icon_name))
|
||||
{
|
||||
icon = text;
|
||||
@ -1628,12 +1628,11 @@ x_set_name_internal (f, name)
|
||||
{
|
||||
/* See the above comment "Note: Encoding strategy". */
|
||||
icon.value = x_encode_text (f->icon_name, coding_system, 0,
|
||||
&bytes, &stringp);
|
||||
&bytes, &stringp, &do_free_icon_value);
|
||||
icon.encoding = (stringp ? XA_STRING
|
||||
: FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
|
||||
icon.format = 8;
|
||||
icon.nitems = bytes;
|
||||
do_free_icon_value = icon.value != SDATA (f->icon_name);
|
||||
}
|
||||
|
||||
#ifdef USE_GTK
|
||||
@ -1996,7 +1995,7 @@ xic_create_fontsetname (base_fontname, motif)
|
||||
- the same but with the family also replaced with -*-*-. */
|
||||
char *p = base_fontname;
|
||||
int i;
|
||||
|
||||
|
||||
for (i = 0; *p; p++)
|
||||
if (*p == '-') i++;
|
||||
if (i != 14)
|
||||
@ -2020,7 +2019,7 @@ xic_create_fontsetname (base_fontname, motif)
|
||||
char *allcs = "*-*-*-*-*-*-*";
|
||||
char *allfamilies = "-*-*-";
|
||||
char *all = "*-*-*-*-";
|
||||
|
||||
|
||||
for (i = 0, p = base_fontname; i < 8; p++)
|
||||
{
|
||||
if (*p == '-')
|
||||
|
||||
@ -1041,8 +1041,6 @@ extern void x_real_positions P_ ((struct frame *, int *, int *));
|
||||
extern int defined_color P_ ((struct frame *, char *, XColor *, int));
|
||||
extern void x_set_border_pixel P_ ((struct frame *, int));
|
||||
extern void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
|
||||
extern unsigned char * x_encode_text P_ ((Lisp_Object, Lisp_Object, int,
|
||||
int *, int *));
|
||||
extern void x_implicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
|
||||
extern void xic_free_xfontset P_ ((struct frame *));
|
||||
extern void create_frame_xic P_ ((struct frame *));
|
||||
|
||||
Loading…
Reference in New Issue
Block a user