45 |
With ARG, you are asked to choose which language." |
With ARG, you are asked to choose which language." |
46 |
(interactive "P") |
(interactive "P") |
47 |
(let ((lang (if arg |
(let ((lang (if arg |
48 |
(let ((minibuffer-setup-hook minibuffer-setup-hook)) |
(let ((minibuffer-setup-hook minibuffer-setup-hook)) |
49 |
(add-hook 'minibuffer-setup-hook |
(add-hook 'minibuffer-setup-hook |
50 |
'minibuffer-completion-help) |
'minibuffer-completion-help) |
51 |
(read-language-name 'tutorial "Language: " "English")) |
(read-language-name 'tutorial "Language: " "English")) |
52 |
(if (get-language-info current-language-environment 'tutorial) |
(if (get-language-info current-language-environment 'tutorial) |
53 |
current-language-environment |
current-language-environment |
54 |
"English"))) |
"English"))) |
63 |
(setq default-directory (expand-file-name "~/")) |
(setq default-directory (expand-file-name "~/")) |
64 |
(setq buffer-auto-save-file-name nil) |
(setq buffer-auto-save-file-name nil) |
65 |
(insert-file-contents (expand-file-name filename data-directory)) |
(insert-file-contents (expand-file-name filename data-directory)) |
66 |
|
(hack-local-variables) |
67 |
(goto-char (point-min)) |
(goto-char (point-min)) |
68 |
(search-forward "\n<<") |
(search-forward "\n<<") |
69 |
(beginning-of-line) |
(beginning-of-line) |
158 |
;; Return the text we displayed. |
;; Return the text we displayed. |
159 |
(buffer-string)))))) |
(buffer-string)))))) |
160 |
|
|
161 |
(defun help-split-fundoc (doc def) |
(defun help-split-fundoc (docstring def) |
162 |
"Split a function docstring DOC into the actual doc and the usage info. |
"Split a function DOCSTRING into the actual doc and the usage info. |
163 |
Return (USAGE . DOC) or nil if there's no usage info. |
Return (USAGE . DOC) or nil if there's no usage info. |
164 |
DEF is the function whose usage we're looking for in DOC." |
DEF is the function whose usage we're looking for in DOCSTRING." |
165 |
;; Functions can get the calling sequence at the end of the doc string. |
;; Functions can get the calling sequence at the end of the doc string. |
166 |
;; In cases where `function' has been fset to a subr we can't search for |
;; In cases where `function' has been fset to a subr we can't search for |
167 |
;; function's name in the doc string so we use `fn' as the anonymous |
;; function's name in the doc string so we use `fn' as the anonymous |
168 |
;; function name instead. |
;; function name instead. |
169 |
(when (and doc (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" doc)) |
(when (and docstring (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring)) |
170 |
(cons (format "(%s%s" |
(cons (format "(%s%s" |
171 |
;; Replace `fn' with the actual function name. |
;; Replace `fn' with the actual function name. |
172 |
(if (consp def) "anonymous" def) |
(if (consp def) "anonymous" def) |
173 |
(match-string 1 doc)) |
(match-string 1 docstring)) |
174 |
(substring doc 0 (match-beginning 0))))) |
(substring docstring 0 (match-beginning 0))))) |
175 |
|
|
176 |
(defun help-add-fundoc-usage (doc arglist) |
(defun help-add-fundoc-usage (docstring arglist) |
177 |
"Add the usage info to the docstring DOC. |
"Add the usage info to DOCSTRING. |
178 |
If DOC already has a usage info, then just return DOC unchanged. |
If DOCSTRING already has a usage info, then just return it unchanged. |
179 |
The usage info is built from ARGLIST. DOC can be nil. |
The usage info is built from ARGLIST. DOCSTRING can be nil. |
180 |
ARGLIST can also be t or a string of the form \"(fun ARG1 ARG2 ...)\"." |
ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"." |
181 |
(unless (stringp doc) (setq doc "Not documented")) |
(unless (stringp docstring) (setq docstring "Not documented")) |
182 |
(if (or (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" doc) (eq arglist t)) |
(if (or (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring) (eq arglist t)) |
183 |
doc |
docstring |
184 |
(format "%s%s%s" doc |
(concat docstring |
185 |
(if (string-match "\n?\n\\'" doc) |
(if (string-match "\n?\n\\'" docstring) |
186 |
(if (< (- (match-end 0) (match-beginning 0)) 2) "\n" "") |
(if (< (- (match-end 0) (match-beginning 0)) 2) "\n" "") |
187 |
"\n\n") |
"\n\n") |
188 |
(if (and (stringp arglist) |
(if (and (stringp arglist) |
189 |
(string-match "\\`([^ ]+\\(.*\\))\\'" arglist)) |
(string-match "\\`([^ ]+\\(.*\\))\\'" arglist)) |
190 |
(concat "(fn" (match-string 1 arglist) ")") |
(concat "(fn" (match-string 1 arglist) ")") |
191 |
(help-make-usage 'fn arglist))))) |
(format "%S" (help-make-usage 'fn arglist)))))) |
192 |
|
|
193 |
(defun help-function-arglist (def) |
(defun help-function-arglist (def) |
194 |
;; Handle symbols aliased to other symbols. |
;; Handle symbols aliased to other symbols. |
216 |
(intern (upcase name)))))) |
(intern (upcase name)))))) |
217 |
arglist))) |
arglist))) |
218 |
|
|
|
(defvar help-C-source-directory |
|
|
(let ((dir (expand-file-name "src" source-directory))) |
|
|
(when (and (file-directory-p dir) (file-readable-p dir)) |
|
|
dir)) |
|
|
"Directory where the C source files of Emacs can be found. |
|
|
If nil, do not try to find the source code of functions and variables |
|
|
defined in C.") |
|
|
|
|
|
(defun help-subr-name (subr) |
|
|
(let ((name (prin1-to-string subr))) |
|
|
(if (string-match "\\`#<subr \\(.*\\)>\\'" name) |
|
|
(match-string 1 name) |
|
|
(error "Unexpected subroutine print name: %s" name)))) |
|
|
|
|
219 |
(defun help-C-file-name (subr-or-var kind) |
(defun help-C-file-name (subr-or-var kind) |
220 |
"Return the name of the C file where SUBR-OR-VAR is defined. |
"Return the name of the C file where SUBR-OR-VAR is defined. |
221 |
KIND should be `var' for a variable or `subr' for a subroutine." |
KIND should be `var' for a variable or `subr' for a subroutine." |
222 |
(let ((docbuf (get-buffer-create " *DOC*")) |
(let ((docbuf (get-buffer-create " *DOC*")) |
223 |
(name (if (eq 'var kind) |
(name (if (eq 'var kind) |
224 |
(concat "V" (symbol-name subr-or-var)) |
(concat "V" (symbol-name subr-or-var)) |
225 |
(concat "F" (help-subr-name subr-or-var))))) |
(concat "F" (subr-name subr-or-var))))) |
226 |
(with-current-buffer docbuf |
(with-current-buffer docbuf |
227 |
(goto-char (point-min)) |
(goto-char (point-min)) |
228 |
(if (eobp) |
(if (eobp) |
232 |
(re-search-backward "S\\(.*\\)") |
(re-search-backward "S\\(.*\\)") |
233 |
(let ((file (match-string 1))) |
(let ((file (match-string 1))) |
234 |
(if (string-match "\\.\\(o\\|obj\\)\\'" file) |
(if (string-match "\\.\\(o\\|obj\\)\\'" file) |
235 |
(replace-match ".c" t t file) |
(setq file (replace-match ".c" t t file))) |
236 |
|
(if (string-match "\\.c\\'" file) |
237 |
|
(concat "src/" file) |
238 |
file))))) |
file))))) |
239 |
|
|
240 |
(defun help-find-C-source (fun-or-var file kind) |
;;;###autoload |
241 |
"Find the source location where SUBR-OR-VAR is defined in FILE. |
(defface help-argument-name '((((supports :slant italic)) :inherit italic)) |
242 |
KIND should be `var' for a variable or `subr' for a subroutine." |
"Face to highlight argument names in *Help* buffers." |
243 |
(setq file (expand-file-name file help-C-source-directory)) |
:group 'help) |
244 |
(unless (file-readable-p file) |
|
245 |
(error "The C source file %s is not available" |
(defun help-default-arg-highlight (arg) |
246 |
(file-name-nondirectory file))) |
"Default function to highlight arguments in *Help* buffers. |
247 |
(if (eq 'fun kind) |
It returns ARG in face `help-argument-name'; ARG is also |
248 |
(setq fun-or-var (indirect-function fun-or-var))) |
downcased if it displays differently than the default |
249 |
(with-current-buffer (find-file-noselect file) |
face (according to `face-differs-from-default-p')." |
250 |
(goto-char (point-min)) |
(propertize (if (face-differs-from-default-p 'help-argument-name) |
251 |
(unless (re-search-forward |
(downcase arg) |
252 |
(if (eq 'fun kind) |
arg) |
253 |
(concat "DEFUN[ \t\n]*([ \t\n]*\"" |
'face 'help-argument-name)) |
254 |
(regexp-quote (help-subr-name fun-or-var)) |
|
255 |
"\"") |
(defun help-do-arg-highlight (doc args) |
256 |
(concat "DEFVAR[A-Z_]*[ \t\n]*([ \t\n]*\"" |
(with-syntax-table (make-syntax-table emacs-lisp-mode-syntax-table) |
257 |
(regexp-quote (symbol-name fun-or-var)))) |
(modify-syntax-entry ?\- "w") |
258 |
nil t) |
(while args |
259 |
(error "Can't find source for %s" fun)) |
(let ((arg (prog1 (car args) (setq args (cdr args))))) |
260 |
(cons (current-buffer) (match-beginning 0)))) |
(setq doc (replace-regexp-in-string |
261 |
|
;; This is heuristic, but covers all common cases |
262 |
|
;; except ARG1-ARG2 |
263 |
|
(concat "\\<" ; beginning of word |
264 |
|
"\\(?:[a-z-]+-\\)?" ; for xxx-ARG |
265 |
|
"\\(" |
266 |
|
arg |
267 |
|
"\\)" |
268 |
|
"\\(?:es\\|s\\|th\\)?" ; for ARGth, ARGs |
269 |
|
"\\(?:-[a-z-]+\\)?" ; for ARG-xxx |
270 |
|
"\\>") ; end of word |
271 |
|
(help-default-arg-highlight arg) |
272 |
|
doc t t 1)))) |
273 |
|
doc)) |
274 |
|
|
275 |
|
(defun help-highlight-arguments (usage doc &rest args) |
276 |
|
(when usage |
277 |
|
(with-temp-buffer |
278 |
|
(insert usage) |
279 |
|
(goto-char (point-min)) |
280 |
|
(let ((case-fold-search nil) |
281 |
|
(next (not (or args (looking-at "\\[")))) |
282 |
|
(opt nil)) |
283 |
|
;; Make a list of all arguments |
284 |
|
(skip-chars-forward "^ ") |
285 |
|
(while next |
286 |
|
(or opt (not (looking-at " &")) (setq opt t)) |
287 |
|
(if (not (re-search-forward " \\([\\[(]*\\)\\([^] &)\.]+\\)" nil t)) |
288 |
|
(setq next nil) |
289 |
|
(setq args (cons (match-string 2) args)) |
290 |
|
(when (and opt (string= (match-string 1) "(")) |
291 |
|
;; A pesky CL-style optional argument with default value, |
292 |
|
;; so let's skip over it |
293 |
|
(search-backward "(") |
294 |
|
(goto-char (scan-sexps (point) 1))))) |
295 |
|
;; Highlight aguments in the USAGE string |
296 |
|
(setq usage (help-do-arg-highlight (buffer-string) args)) |
297 |
|
;; Highlight arguments in the DOC string |
298 |
|
(setq doc (and doc (help-do-arg-highlight doc args)))))) |
299 |
|
;; Return value is like the one from help-split-fundoc, but highlighted |
300 |
|
(cons usage doc)) |
301 |
|
|
302 |
;;;###autoload |
;;;###autoload |
303 |
(defun describe-function-1 (function) |
(defun describe-function-1 (function) |
364 |
(when (re-search-backward |
(when (re-search-backward |
365 |
"^;;; Generated autoloads from \\(.*\\)" nil t) |
"^;;; Generated autoloads from \\(.*\\)" nil t) |
366 |
(setq file-name (match-string 1))))))) |
(setq file-name (match-string 1))))))) |
367 |
(when (and (null file-name) (subrp def) help-C-source-directory) |
(when (and (null file-name) (subrp def)) |
368 |
;; Find the C source file name. |
;; Find the C source file name. |
369 |
(setq file-name (concat "src/" (help-C-file-name def 'subr)))) |
(setq file-name (if (get-buffer " *DOC*") |
370 |
|
(help-C-file-name def 'subr) |
371 |
|
'C-source))) |
372 |
(when file-name |
(when file-name |
373 |
(princ " in `") |
(princ " in `") |
374 |
;; We used to add .el to the file name, |
;; We used to add .el to the file name, |
375 |
;; but that's completely wrong when the user used load-file. |
;; but that's completely wrong when the user used load-file. |
376 |
(princ file-name) |
(princ (if (eq file-name 'C-source) "C source code" file-name)) |
377 |
(princ "'") |
(princ "'") |
378 |
;; Make a hyperlink to the library. |
;; Make a hyperlink to the library. |
379 |
(with-current-buffer standard-output |
(with-current-buffer standard-output |
385 |
(when (commandp function) |
(when (commandp function) |
386 |
(let* ((remapped (command-remapping function)) |
(let* ((remapped (command-remapping function)) |
387 |
(keys (where-is-internal |
(keys (where-is-internal |
388 |
(or remapped function) overriding-local-map nil nil))) |
(or remapped function) overriding-local-map nil nil)) |
389 |
|
non-modified-keys) |
390 |
|
;; Which non-control non-meta keys run this command? |
391 |
|
(dolist (key keys) |
392 |
|
(if (member (event-modifiers (aref key 0)) '(nil (shift))) |
393 |
|
(push key non-modified-keys))) |
394 |
(when remapped |
(when remapped |
395 |
(princ "It is remapped to `") |
(princ "It is remapped to `") |
396 |
(princ (symbol-name remapped)) |
(princ (symbol-name remapped)) |
397 |
(princ "'")) |
(princ "'")) |
398 |
|
|
399 |
(when keys |
(when keys |
400 |
(princ (if remapped " which is bound to " "It is bound to ")) |
(princ (if remapped " which is bound to " "It is bound to ")) |
401 |
;; FIXME: This list can be very long (f.ex. for self-insert-command). |
;; FIXME: This list can be very long (f.ex. for self-insert-command). |
402 |
(princ (mapconcat 'key-description keys ", "))) |
;; If there are many, remove them from KEYS. |
403 |
(when (or remapped keys) |
(if (< (length non-modified-keys) 10) |
404 |
|
(princ (mapconcat 'key-description keys ", ")) |
405 |
|
(dolist (key non-modified-keys) |
406 |
|
(setq keys (delq key keys))) |
407 |
|
(if keys |
408 |
|
(progn |
409 |
|
(princ (mapconcat 'key-description keys ", ")) |
410 |
|
(princ ", and many ordinary text characters")) |
411 |
|
(princ "many ordinary text characters")))) |
412 |
|
(when (or remapped keys non-modified-keys) |
413 |
(princ ".") |
(princ ".") |
414 |
(terpri)))) |
(terpri)))) |
415 |
(let* ((arglist (help-function-arglist def)) |
(let* ((arglist (help-function-arglist def)) |
416 |
(doc (documentation function)) |
(doc (documentation function)) |
417 |
(usage (help-split-fundoc doc function))) |
(usage (help-split-fundoc doc function))) |
418 |
;; If definition is a keymap, skip arglist note. |
(with-current-buffer standard-output |
419 |
(unless (keymapp def) |
;; If definition is a keymap, skip arglist note. |
420 |
(princ (cond |
(unless (keymapp def) |
421 |
(usage (setq doc (cdr usage)) (car usage)) |
(let* ((use (cond |
422 |
((listp arglist) (help-make-usage function arglist)) |
(usage (setq doc (cdr usage)) (car usage)) |
423 |
((stringp arglist) arglist) |
((listp arglist) |
424 |
;; Maybe the arglist is in the docstring of the alias. |
(format "%S" (help-make-usage function arglist))) |
425 |
((let ((fun function)) |
((stringp arglist) arglist) |
426 |
(while (and (symbolp fun) |
;; Maybe the arglist is in the docstring of the alias. |
427 |
(setq fun (symbol-function fun)) |
((let ((fun function)) |
428 |
(not (setq usage (help-split-fundoc |
(while (and (symbolp fun) |
429 |
(documentation fun) |
(setq fun (symbol-function fun)) |
430 |
function))))) |
(not (setq usage (help-split-fundoc |
431 |
usage) |
(documentation fun) |
432 |
(car usage)) |
function))))) |
433 |
((or (stringp def) |
usage) |
434 |
(vectorp def)) |
(car usage)) |
435 |
(format "\nMacro: %s" (format-kbd-macro def))) |
((or (stringp def) |
436 |
(t "[Missing arglist. Please make a bug report.]"))) |
(vectorp def)) |
437 |
(terpri)) |
(format "\nMacro: %s" (format-kbd-macro def))) |
438 |
(let ((obsolete (and |
(t "[Missing arglist. Please make a bug report.]"))) |
439 |
;; function might be a lambda construct. |
(high (help-highlight-arguments use doc))) |
440 |
(symbolp function) |
(insert (car high) "\n") |
441 |
(get function 'byte-obsolete-info)))) |
(setq doc (cdr high)))) |
442 |
(when obsolete |
(let ((obsolete (and |
443 |
(terpri) |
;; function might be a lambda construct. |
444 |
(princ "This function is obsolete") |
(symbolp function) |
445 |
(if (nth 2 obsolete) (princ (format " since %s" (nth 2 obsolete)))) |
(get function 'byte-obsolete-info)))) |
446 |
(princ ";") (terpri) |
(when obsolete |
447 |
(princ (if (stringp (car obsolete)) (car obsolete) |
(princ "\nThis function is obsolete") |
448 |
(format "use `%s' instead." (car obsolete)))) |
(when (nth 2 obsolete) |
449 |
(terpri))) |
(insert (format " since %s" (nth 2 obsolete)))) |
450 |
(terpri) |
(insert ";\n" |
451 |
(princ (or doc "Not documented."))))) |
(if (stringp (car obsolete)) (car obsolete) |
452 |
|
(format "use `%s' instead." (car obsolete))) |
453 |
|
"\n")) |
454 |
|
(insert "\n" |
455 |
|
(or doc "Not documented."))))))) |
456 |
|
|
457 |
|
|
458 |
;; Variables |
;; Variables |
610 |
(when (and (null file-name) |
(when (and (null file-name) |
611 |
(integerp (get variable 'variable-documentation))) |
(integerp (get variable 'variable-documentation))) |
612 |
;; It's a variable not defined in Elisp but in C. |
;; It's a variable not defined in Elisp but in C. |
613 |
(if help-C-source-directory |
(setq file-name |
614 |
(setq file-name |
(if (get-buffer " *DOC*") |
615 |
(concat "src/" (help-C-file-name variable 'var))) |
(help-C-file-name variable 'var) |
616 |
(princ "\n\nDefined in core C code."))) |
'C-source))) |
617 |
(when file-name |
(when file-name |
618 |
(princ "\n\nDefined in `") |
(princ "\n\nDefined in `") |
619 |
(princ file-name) |
(princ (if (eq file-name 'C-source) "C source code" file-name)) |
620 |
(princ "'.") |
(princ "'.") |
621 |
(with-current-buffer standard-output |
(with-current-buffer standard-output |
622 |
(save-excursion |
(save-excursion |