Mercurial > emacs
comparison lisp/completion.el @ 10638:f587ee9a25f6
Don't use cl. Eliminate use of when, unless,
dotimes, plusp, minusp, pusnhew, second.
(completion-dolist): New macro. Use instead of dolist.
(completion-gensym-counter, completion-gensym): New variable and fn.
(locate-completion-entry-retry): Bind cmpl-entry, then use it.
(locate-completion-entry): Use completion-string, not string.
(add-completion-to-head, delete-completion):
Rename arg to completion-string.
(completions-list-return-value): Defvar'd and renamed
from return-completions.
(cmpl-preceding-syntax, cdabbrev-stop-point): Add defvars.
(delete-completion, check-completion-length): Fix message format.
(complete, add-completions-from-buffer, add-completions-from-c-buffer)
(save-completions-to-file): Likewise.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Thu, 02 Feb 1995 23:04:54 +0000 |
parents | 00e1546cc687 |
children | dc32b19de050 |
comparison
equal
deleted
inserted
replaced
10637:6e25c10f6fe8 | 10638:f587ee9a25f6 |
---|---|
338 (defmacro eval-when-compile-load-eval (&rest body) | 338 (defmacro eval-when-compile-load-eval (&rest body) |
339 ;; eval everything before expanding | 339 ;; eval everything before expanding |
340 (mapcar 'eval body) | 340 (mapcar 'eval body) |
341 (cons 'progn body)) | 341 (cons 'progn body)) |
342 | 342 |
343 (eval-when-compile | |
344 (defvar completion-gensym-counter 0) | |
345 (defun completion-gensym (&optional arg) | |
346 "Generate a new uninterned symbol. | |
347 The name is made by appending a number to PREFIX, default \"G\"." | |
348 (let ((prefix (if (stringp arg) arg "G")) | |
349 (num (if (integerp arg) arg | |
350 (prog1 completion-gensym-counter | |
351 (setq completion-gensym-counter (1+ completion-gensym-counter)))))) | |
352 (make-symbol (format "%s%d" prefix num))))) | |
353 | |
354 (defmacro completion-dolist (spec &rest body) | |
355 "(completion-dolist (VAR LIST [RESULT]) BODY...): loop over a list. | |
356 Evaluate BODY with VAR bound to each `car' from LIST, in turn. | |
357 Then evaluate RESULT to get return value, default nil." | |
358 (let ((temp (completion-gensym "--dolist-temp--"))) | |
359 (append (list 'let (list (list temp (nth 1 spec)) (car spec)) | |
360 (append (list 'while temp | |
361 (list 'setq (car spec) (list 'car temp))) | |
362 body (list (list 'setq temp | |
363 (list 'cdr temp))))) | |
364 (if (cdr (cdr spec)) | |
365 (cons (list 'setq (car spec) nil) (cdr (cdr spec))) | |
366 '(nil))))) | |
367 | |
343 (defun completion-eval-when () | 368 (defun completion-eval-when () |
344 (eval-when-compile-load-eval | 369 (eval-when-compile-load-eval |
345 ;; These vars. are defined at both compile and load time. | 370 ;; These vars. are defined at both compile and load time. |
346 (setq completion-min-length 6) | 371 (setq completion-min-length 6) |
347 (setq completion-max-length 200) | 372 (setq completion-max-length 200) |
348 (setq completion-prefix-min-length 3))) | 373 (setq completion-prefix-min-length 3))) |
349 | 374 |
350 (completion-eval-when) | 375 (completion-eval-when) |
351 | |
352 ;; Need this file around too | |
353 (require 'cl) | |
354 | 376 |
355 ;;;--------------------------------------------------------------------------- | 377 ;;;--------------------------------------------------------------------------- |
356 ;;; Internal Variables | 378 ;;; Internal Variables |
357 ;;;--------------------------------------------------------------------------- | 379 ;;;--------------------------------------------------------------------------- |
358 | 380 |
362 | 384 |
363 (defvar cmpl-completions-accepted-p nil | 385 (defvar cmpl-completions-accepted-p nil |
364 "Set to t as soon as the first completion has been accepted. | 386 "Set to t as soon as the first completion has been accepted. |
365 Used to decide whether to save completions.") | 387 Used to decide whether to save completions.") |
366 | 388 |
389 (defvar cmpl-preceding-syntax) | |
367 | 390 |
368 ;;;--------------------------------------------------------------------------- | 391 ;;;--------------------------------------------------------------------------- |
369 ;;; Low level tools | 392 ;;; Low level tools |
370 ;;;--------------------------------------------------------------------------- | 393 ;;;--------------------------------------------------------------------------- |
371 | 394 |
500 ;;; Table definitions | 523 ;;; Table definitions |
501 ;;;----------------------------------------------- | 524 ;;;----------------------------------------------- |
502 | 525 |
503 (defun cmpl-make-standard-completion-syntax-table () | 526 (defun cmpl-make-standard-completion-syntax-table () |
504 (let ((table (make-vector 256 0)) ;; default syntax is whitespace | 527 (let ((table (make-vector 256 0)) ;; default syntax is whitespace |
505 ) | 528 i) |
506 ;; alpha chars | 529 ;; alpha chars |
507 (dotimes (i 26) | 530 (setq i 0) |
531 (while (< i 26) | |
508 (modify-syntax-entry (+ ?a i) "_" table) | 532 (modify-syntax-entry (+ ?a i) "_" table) |
509 (modify-syntax-entry (+ ?A i) "_" table)) | 533 (modify-syntax-entry (+ ?A i) "_" table) |
534 (setq i (1+ i))) | |
510 ;; digit chars. | 535 ;; digit chars. |
511 (dotimes (i 10) | 536 (setq i 0) |
512 (modify-syntax-entry (+ ?0 i) "_" table)) | 537 (while (< i 10) |
538 (modify-syntax-entry (+ ?0 i) "_" table) | |
539 (setq i (1+ i))) | |
513 ;; Other ones | 540 ;; Other ones |
514 (let ((symbol-chars '(?@ ?/ ?\\ ?* ?+ ?~ ?$ ?< ?> ?%)) | 541 (let ((symbol-chars '(?@ ?/ ?\\ ?* ?+ ?~ ?$ ?< ?> ?%)) |
515 (symbol-chars-ignore '(?_ ?- ?: ?.)) | 542 (symbol-chars-ignore '(?_ ?- ?: ?.)) |
516 ) | 543 ) |
517 (dolist (char symbol-chars) | 544 (completion-dolist (char symbol-chars) |
518 (modify-syntax-entry char "_" table)) | 545 (modify-syntax-entry char "_" table)) |
519 (dolist (char symbol-chars-ignore) | 546 (completion-dolist (char symbol-chars-ignore) |
520 (modify-syntax-entry char "w" table) | 547 (modify-syntax-entry char "w" table) |
521 ) | 548 ) |
522 ) | 549 ) |
523 table)) | 550 table)) |
524 | 551 |
526 | 553 |
527 (defun cmpl-make-lisp-completion-syntax-table () | 554 (defun cmpl-make-lisp-completion-syntax-table () |
528 (let ((table (copy-syntax-table cmpl-standard-syntax-table)) | 555 (let ((table (copy-syntax-table cmpl-standard-syntax-table)) |
529 (symbol-chars '(?! ?& ?? ?= ?^)) | 556 (symbol-chars '(?! ?& ?? ?= ?^)) |
530 ) | 557 ) |
531 (dolist (char symbol-chars) | 558 (completion-dolist (char symbol-chars) |
532 (modify-syntax-entry char "_" table)) | 559 (modify-syntax-entry char "_" table)) |
533 table)) | 560 table)) |
534 | 561 |
535 (defun cmpl-make-c-completion-syntax-table () | 562 (defun cmpl-make-c-completion-syntax-table () |
536 (let ((table (copy-syntax-table cmpl-standard-syntax-table)) | 563 (let ((table (copy-syntax-table cmpl-standard-syntax-table)) |
537 (separator-chars '(?+ ?* ?/ ?: ?%)) | 564 (separator-chars '(?+ ?* ?/ ?: ?%)) |
538 ) | 565 ) |
539 (dolist (char separator-chars) | 566 (completion-dolist (char separator-chars) |
540 (modify-syntax-entry char " " table)) | 567 (modify-syntax-entry char " " table)) |
541 table)) | 568 table)) |
542 | 569 |
543 (defun cmpl-make-fortran-completion-syntax-table () | 570 (defun cmpl-make-fortran-completion-syntax-table () |
544 (let ((table (copy-syntax-table cmpl-standard-syntax-table)) | 571 (let ((table (copy-syntax-table cmpl-standard-syntax-table)) |
545 (separator-chars '(?+ ?- ?* ?/ ?:)) | 572 (separator-chars '(?+ ?- ?* ?/ ?:)) |
546 ) | 573 ) |
547 (dolist (char separator-chars) | 574 (completion-dolist (char separator-chars) |
548 (modify-syntax-entry char " " table)) | 575 (modify-syntax-entry char " " table)) |
549 table)) | 576 table)) |
550 | 577 |
551 (defconst cmpl-lisp-syntax-table (cmpl-make-lisp-completion-syntax-table)) | 578 (defconst cmpl-lisp-syntax-table (cmpl-make-lisp-completion-syntax-table)) |
552 (defconst cmpl-c-syntax-table (cmpl-make-c-completion-syntax-table)) | 579 (defconst cmpl-c-syntax-table (cmpl-make-c-completion-syntax-table)) |
834 (defvar cdabbrev-wrapped-p nil) | 861 (defvar cdabbrev-wrapped-p nil) |
835 ;;; "T if the cdabbrev search has wrapped around the file.") | 862 ;;; "T if the cdabbrev search has wrapped around the file.") |
836 | 863 |
837 (defvar cdabbrev-abbrev-string "") | 864 (defvar cdabbrev-abbrev-string "") |
838 (defvar cdabbrev-start-point 0) | 865 (defvar cdabbrev-start-point 0) |
866 (defvar cdabbrev-stop-point) | |
839 | 867 |
840 ;;; Test strings for cdabbrev | 868 ;;; Test strings for cdabbrev |
841 ;;; cdat-upcase ;;same namestring | 869 ;;; cdat-upcase ;;same namestring |
842 ;;; CDAT-UPCASE ;;ok | 870 ;;; CDAT-UPCASE ;;ok |
843 ;;; cdat2 ;;too short | 871 ;;; cdat2 ;;too short |
878 (setq cdabbrev-current-window (next-window cdabbrev-current-window)) | 906 (setq cdabbrev-current-window (next-window cdabbrev-current-window)) |
879 (if (eq cdabbrev-current-window (selected-window)) | 907 (if (eq cdabbrev-current-window (selected-window)) |
880 ;; No more windows, try other buffer. | 908 ;; No more windows, try other buffer. |
881 (setq cdabbrev-current-window t))) | 909 (setq cdabbrev-current-window t))) |
882 ) | 910 ) |
883 (when cdabbrev-current-window | 911 (if cdabbrev-current-window |
884 (save-excursion | 912 (save-excursion |
885 (set-cdabbrev-buffer) | 913 (set-cdabbrev-buffer) |
886 (setq cdabbrev-current-point (point) | 914 (setq cdabbrev-current-point (point) |
887 cdabbrev-start-point cdabbrev-current-point | 915 cdabbrev-start-point cdabbrev-current-point |
888 cdabbrev-stop-point | 916 cdabbrev-stop-point |
889 (if completion-search-distance | 917 (if completion-search-distance |
890 (max (point-min) | 918 (max (point-min) |
891 (- cdabbrev-start-point completion-search-distance)) | 919 (- cdabbrev-start-point completion-search-distance)) |
892 (point-min)) | 920 (point-min)) |
893 cdabbrev-wrapped-p nil) | 921 cdabbrev-wrapped-p nil) |
894 ))) | 922 ))) |
895 | 923 |
896 (defun next-cdabbrev () | 924 (defun next-cdabbrev () |
897 "Return the next possible cdabbrev expansion or nil if there isn't one. | 925 "Return the next possible cdabbrev expansion or nil if there isn't one. |
898 `reset-cdabbrev' must've been called already. | 926 `reset-cdabbrev' must've been called already. |
899 This is sensitive to `case-fold-search'." | 927 This is sensitive to `case-fold-search'." |
900 ;; note that case-fold-search affects the behavior of this function | 928 ;; note that case-fold-search affects the behavior of this function |
901 ;; Bug: won't pick up an expansion that starts at the top of buffer | 929 ;; Bug: won't pick up an expansion that starts at the top of buffer |
902 (when cdabbrev-current-window | 930 (if cdabbrev-current-window |
903 (let (saved-point | 931 (let (saved-point |
904 saved-syntax | 932 saved-syntax |
905 (expansion nil) | 933 (expansion nil) |
906 downcase-expansion tried-list syntax saved-point-2) | 934 downcase-expansion tried-list syntax saved-point-2) |
907 (save-excursion | 935 (save-excursion |
908 (unwind-protect | 936 (unwind-protect |
909 (progn | 937 (progn |
910 ;; Switch to current completion buffer | 938 ;; Switch to current completion buffer |
911 (set-cdabbrev-buffer) | 939 (set-cdabbrev-buffer) |
912 ;; Save current buffer state | 940 ;; Save current buffer state |
913 (setq saved-point (point) | 941 (setq saved-point (point) |
914 saved-syntax (syntax-table)) | 942 saved-syntax (syntax-table)) |
915 ;; Restore completion state | 943 ;; Restore completion state |
916 (set-syntax-table cmpl-syntax-table) | 944 (set-syntax-table cmpl-syntax-table) |
917 (goto-char cdabbrev-current-point) | 945 (goto-char cdabbrev-current-point) |
918 ;; Loop looking for completions | 946 ;; Loop looking for completions |
919 (while | 947 (while |
920 ;; This code returns t if it should loop again | 948 ;; This code returns t if it should loop again |
921 (cond | 949 (cond |
922 (;; search for the string | 950 (;; search for the string |
923 (search-backward cdabbrev-abbrev-string cdabbrev-stop-point t) | 951 (search-backward cdabbrev-abbrev-string cdabbrev-stop-point t) |
924 ;; return nil if the completion is valid | 952 ;; return nil if the completion is valid |
925 (not | 953 (not |
926 (and | 954 (and |
927 ;; does it start with a separator char ? | 955 ;; does it start with a separator char ? |
928 (or (= (setq syntax (char-syntax (preceding-char))) ? ) | 956 (or (= (setq syntax (char-syntax (preceding-char))) ? ) |
929 (and (= syntax ?w) | 957 (and (= syntax ?w) |
930 ;; symbol char to ignore at end. Are we at end ? | 958 ;; symbol char to ignore at end. Are we at end ? |
931 (progn | 959 (progn |
932 (setq saved-point-2 (point)) | 960 (setq saved-point-2 (point)) |
933 (forward-word -1) | 961 (forward-word -1) |
934 (prog1 | 962 (prog1 |
935 (= (char-syntax (preceding-char)) ? ) | 963 (= (char-syntax (preceding-char)) ? ) |
936 (goto-char saved-point-2) | 964 (goto-char saved-point-2) |
937 )))) | 965 )))) |
938 ;; is the symbol long enough ? | 966 ;; is the symbol long enough ? |
939 (setq expansion (symbol-under-point)) | 967 (setq expansion (symbol-under-point)) |
940 ;; have we not tried this one before | 968 ;; have we not tried this one before |
941 (progn | 969 (progn |
942 ;; See if we've already used it | 970 ;; See if we've already used it |
943 (setq tried-list cdabbrev-completions-tried | 971 (setq tried-list cdabbrev-completions-tried |
944 downcase-expansion (downcase expansion)) | 972 downcase-expansion (downcase expansion)) |
945 (while (and tried-list | 973 (while (and tried-list |
946 (not (string-equal downcase-expansion | 974 (not (string-equal downcase-expansion |
947 (car tried-list)))) | 975 (car tried-list)))) |
948 ;; Already tried, don't choose this one | 976 ;; Already tried, don't choose this one |
949 (setq tried-list (cdr tried-list)) | 977 (setq tried-list (cdr tried-list)) |
950 ) | 978 ) |
951 ;; at this point tried-list will be nil if this | 979 ;; at this point tried-list will be nil if this |
952 ;; expansion has not yet been tried | 980 ;; expansion has not yet been tried |
953 (if tried-list | 981 (if tried-list |
954 (setq expansion nil) | 982 (setq expansion nil) |
955 t) | 983 t) |
956 )))) | 984 )))) |
957 ;; search failed | 985 ;; search failed |
958 (cdabbrev-wrapped-p | 986 (cdabbrev-wrapped-p |
959 ;; If already wrapped, then we've failed completely | 987 ;; If already wrapped, then we've failed completely |
960 nil) | 988 nil) |
961 (t | 989 (t |
962 ;; need to wrap | 990 ;; need to wrap |
963 (goto-char (setq cdabbrev-current-point | 991 (goto-char (setq cdabbrev-current-point |
964 (if completion-search-distance | 992 (if completion-search-distance |
965 (min (point-max) (+ cdabbrev-start-point completion-search-distance)) | 993 (min (point-max) (+ cdabbrev-start-point completion-search-distance)) |
966 (point-max)))) | 994 (point-max)))) |
967 | 995 |
968 (setq cdabbrev-wrapped-p t)) | 996 (setq cdabbrev-wrapped-p t)) |
969 )) | 997 )) |
970 ;; end of while loop | 998 ;; end of while loop |
971 (cond (expansion | 999 (cond (expansion |
972 ;; successful | 1000 ;; successful |
973 (setq cdabbrev-completions-tried | 1001 (setq cdabbrev-completions-tried |
974 (cons downcase-expansion cdabbrev-completions-tried) | 1002 (cons downcase-expansion cdabbrev-completions-tried) |
975 cdabbrev-current-point (point)))) | 1003 cdabbrev-current-point (point)))) |
976 ) | 1004 ) |
977 (set-syntax-table saved-syntax) | 1005 (set-syntax-table saved-syntax) |
978 (goto-char saved-point) | 1006 (goto-char saved-point) |
979 )) | 1007 )) |
980 ;; If no expansion, go to next window | 1008 ;; If no expansion, go to next window |
981 (cond (expansion) | 1009 (cond (expansion) |
982 (t (reset-cdabbrev-window) | 1010 (t (reset-cdabbrev-window) |
983 (next-cdabbrev))) | 1011 (next-cdabbrev)))))) |
984 ))) | |
985 | 1012 |
986 ;;; The following must be eval'd in the minibuffer :: | 1013 ;;; The following must be eval'd in the minibuffer :: |
987 ;;; (reset-cdabbrev "cdat") | 1014 ;;; (reset-cdabbrev "cdat") |
988 ;;; (next-cdabbrev) --> "cdat-simple" | 1015 ;;; (next-cdabbrev) --> "cdat-simple" |
989 ;;; (next-cdabbrev) --> "cdat-1-2-3-4" | 1016 ;;; (next-cdabbrev) --> "cdat-1-2-3-4" |
1111 (setq cmpl-obarray (make-vector cmpl-obarray-length 0)) | 1138 (setq cmpl-obarray (make-vector cmpl-obarray-length 0)) |
1112 (cmpl-statistics-block | 1139 (cmpl-statistics-block |
1113 (record-clear-all-completions)) | 1140 (record-clear-all-completions)) |
1114 ) | 1141 ) |
1115 | 1142 |
1143 (defvar completions-list-return-value) | |
1144 | |
1116 (defun list-all-completions () | 1145 (defun list-all-completions () |
1117 "Returns a list of all the known completion entries." | 1146 "Returns a list of all the known completion entries." |
1118 (let ((return-completions nil)) | 1147 (let ((completions-list-return-value nil)) |
1119 (mapatoms 'list-all-completions-1 cmpl-prefix-obarray) | 1148 (mapatoms 'list-all-completions-1 cmpl-prefix-obarray) |
1120 return-completions)) | 1149 completions-list-return-value)) |
1121 | 1150 |
1122 (defun list-all-completions-1 (prefix-symbol) | 1151 (defun list-all-completions-1 (prefix-symbol) |
1123 (if (boundp prefix-symbol) | 1152 (if (boundp prefix-symbol) |
1124 (setq return-completions | 1153 (setq completions-list-return-value |
1125 (append (cmpl-prefix-entry-head (symbol-value prefix-symbol)) | 1154 (append (cmpl-prefix-entry-head (symbol-value prefix-symbol)) |
1126 return-completions)))) | 1155 completions-list-return-value)))) |
1127 | 1156 |
1128 (defun list-all-completions-by-hash-bucket () | 1157 (defun list-all-completions-by-hash-bucket () |
1129 "Return list of lists of known completion entries, organized by hash bucket." | 1158 "Return list of lists of known completion entries, organized by hash bucket." |
1130 (let ((return-completions nil)) | 1159 (let ((completions-list-return-value nil)) |
1131 (mapatoms 'list-all-completions-by-hash-bucket-1 cmpl-prefix-obarray) | 1160 (mapatoms 'list-all-completions-by-hash-bucket-1 cmpl-prefix-obarray) |
1132 return-completions)) | 1161 completions-list-return-value)) |
1133 | 1162 |
1134 (defun list-all-completions-by-hash-bucket-1 (prefix-symbol) | 1163 (defun list-all-completions-by-hash-bucket-1 (prefix-symbol) |
1135 (if (boundp prefix-symbol) | 1164 (if (boundp prefix-symbol) |
1136 (setq return-completions | 1165 (setq completions-list-return-value |
1137 (cons (cmpl-prefix-entry-head (symbol-value prefix-symbol)) | 1166 (cons (cmpl-prefix-entry-head (symbol-value prefix-symbol)) |
1138 return-completions)))) | 1167 completions-list-return-value)))) |
1139 | 1168 |
1140 | 1169 |
1141 ;;;----------------------------------------------- | 1170 ;;;----------------------------------------------- |
1142 ;;; Updating the database | 1171 ;;; Updating the database |
1143 ;;;----------------------------------------------- | 1172 ;;;----------------------------------------------- |
1202 prefix-list) | 1231 prefix-list) |
1203 ;; Didn't find it. Database is messed up. | 1232 ;; Didn't find it. Database is messed up. |
1204 (cmpl-db-debug-p | 1233 (cmpl-db-debug-p |
1205 ;; not found, error if debug mode | 1234 ;; not found, error if debug mode |
1206 (error "Completion entry exists but not on prefix list - %s" | 1235 (error "Completion entry exists but not on prefix list - %s" |
1207 string)) | 1236 completion-string)) |
1208 (inside-locate-completion-entry | 1237 (inside-locate-completion-entry |
1209 ;; recursive error: really scrod | 1238 ;; recursive error: really scrod |
1210 (locate-completion-db-error)) | 1239 (locate-completion-db-error)) |
1211 (t | 1240 (t |
1212 ;; Patch out | 1241 ;; Patch out |
1218 (defun locate-completion-entry-retry (old-entry) | 1247 (defun locate-completion-entry-retry (old-entry) |
1219 (let ((inside-locate-completion-entry t)) | 1248 (let ((inside-locate-completion-entry t)) |
1220 (add-completion (completion-string old-entry) | 1249 (add-completion (completion-string old-entry) |
1221 (completion-num-uses old-entry) | 1250 (completion-num-uses old-entry) |
1222 (completion-last-use-time old-entry)) | 1251 (completion-last-use-time old-entry)) |
1223 (let ((cmpl-entry (find-exact-completion (completion-string old-entry))) | 1252 (let* ((cmpl-entry (find-exact-completion (completion-string old-entry))) |
1224 (pref-entry | 1253 (pref-entry |
1225 (if cmpl-entry | 1254 (if cmpl-entry |
1226 (find-cmpl-prefix-entry | 1255 (find-cmpl-prefix-entry |
1227 (substring cmpl-db-downcase-string | 1256 (substring cmpl-db-downcase-string |
1228 0 completion-prefix-min-length)))) | 1257 0 completion-prefix-min-length)))) |
1229 ) | 1258 ) |
1230 (if (and cmpl-entry pref-entry) | 1259 (if (and cmpl-entry pref-entry) |
1231 ;; try again | 1260 ;; try again |
1232 (locate-completion-entry cmpl-entry pref-entry) | 1261 (locate-completion-entry cmpl-entry pref-entry) |
1233 ;; still losing | 1262 ;; still losing |
1272 (note-added-completion)) | 1301 (note-added-completion)) |
1273 ;; set symbol | 1302 ;; set symbol |
1274 (set cmpl-db-symbol (car entry)) | 1303 (set cmpl-db-symbol (car entry)) |
1275 ))) | 1304 ))) |
1276 | 1305 |
1277 (defun add-completion-to-head (string) | 1306 (defun add-completion-to-head (completion-string) |
1278 "If STRING is not in the database, add it to prefix list. | 1307 "If COMPLETION-STRING is not in the database, add it to prefix list. |
1279 STRING is added to the head of the appropriate prefix list. Otherwise | 1308 We add COMPLETION-STRING to the head of the appropriate prefix list, |
1280 it is moved to the head of the list. | 1309 or it to the head of the list. |
1281 STRING must be longer than `completion-prefix-min-length'. | 1310 COMPLETION-STRING must be longer than `completion-prefix-min-length'. |
1282 Updates the saved string with the supplied string. | 1311 Updates the saved string with the supplied string. |
1283 This must be very fast. | 1312 This must be very fast. |
1284 Returns the completion entry." | 1313 Returns the completion entry." |
1285 ;; Handle pending acceptance | 1314 ;; Handle pending acceptance |
1286 (if completion-to-accept (accept-completion)) | 1315 (if completion-to-accept (accept-completion)) |
1287 ;; test if already in database | 1316 ;; test if already in database |
1288 (if (setq cmpl-db-entry (find-exact-completion string)) | 1317 (if (setq cmpl-db-entry (find-exact-completion completion-string)) |
1289 ;; found | 1318 ;; found |
1290 (let* ((prefix-entry (find-cmpl-prefix-entry | 1319 (let* ((prefix-entry (find-cmpl-prefix-entry |
1291 (substring cmpl-db-downcase-string 0 | 1320 (substring cmpl-db-downcase-string 0 |
1292 (cmpl-read-time-eval | 1321 (cmpl-read-time-eval |
1293 completion-prefix-min-length)))) | 1322 completion-prefix-min-length)))) |
1294 (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry)) | 1323 (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry)) |
1295 (cmpl-ptr (cdr splice-ptr)) | 1324 (cmpl-ptr (cdr splice-ptr)) |
1296 ) | 1325 ) |
1297 ;; update entry | 1326 ;; update entry |
1298 (set-completion-string cmpl-db-entry string) | 1327 (set-completion-string cmpl-db-entry completion-string) |
1299 ;; move to head (if necessary) | 1328 ;; move to head (if necessary) |
1300 (cond (splice-ptr | 1329 (cond (splice-ptr |
1301 ;; These should all execute atomically but it is not fatal if | 1330 ;; These should all execute atomically but it is not fatal if |
1302 ;; they don't. | 1331 ;; they don't. |
1303 ;; splice it out | 1332 ;; splice it out |
1309 (set-cmpl-prefix-entry-head prefix-entry cmpl-ptr) | 1338 (set-cmpl-prefix-entry-head prefix-entry cmpl-ptr) |
1310 )) | 1339 )) |
1311 cmpl-db-entry) | 1340 cmpl-db-entry) |
1312 ;; not there | 1341 ;; not there |
1313 (let (;; create an entry | 1342 (let (;; create an entry |
1314 (entry (make-completion string)) | 1343 (entry (make-completion completion-string)) |
1315 ;; setup the prefix | 1344 ;; setup the prefix |
1316 (prefix-entry (find-cmpl-prefix-entry | 1345 (prefix-entry (find-cmpl-prefix-entry |
1317 (substring cmpl-db-downcase-string 0 | 1346 (substring cmpl-db-downcase-string 0 |
1318 (cmpl-read-time-eval | 1347 (cmpl-read-time-eval |
1319 completion-prefix-min-length)))) | 1348 completion-prefix-min-length)))) |
1331 (note-added-completion)) | 1360 (note-added-completion)) |
1332 ;; Add it to the symbol | 1361 ;; Add it to the symbol |
1333 (set cmpl-db-symbol (car entry)) | 1362 (set cmpl-db-symbol (car entry)) |
1334 ))) | 1363 ))) |
1335 | 1364 |
1336 (defun delete-completion (string) | 1365 (defun delete-completion (completion-string) |
1337 "Deletes the completion from the database. | 1366 "Deletes the completion from the database. |
1338 String must be longer than `completion-prefix-min-length'." | 1367 String must be longer than `completion-prefix-min-length'." |
1339 ;; Handle pending acceptance | 1368 ;; Handle pending acceptance |
1340 (if completion-to-accept (accept-completion)) | 1369 (if completion-to-accept (accept-completion)) |
1341 (if (setq cmpl-db-entry (find-exact-completion string)) | 1370 (if (setq cmpl-db-entry (find-exact-completion completion-string)) |
1342 ;; found | 1371 ;; found |
1343 (let* ((prefix-entry (find-cmpl-prefix-entry | 1372 (let* ((prefix-entry (find-cmpl-prefix-entry |
1344 (substring cmpl-db-downcase-string 0 | 1373 (substring cmpl-db-downcase-string 0 |
1345 (cmpl-read-time-eval | 1374 (cmpl-read-time-eval |
1346 completion-prefix-min-length)))) | 1375 completion-prefix-min-length)))) |
1363 (set cmpl-db-prefix-symbol nil)) | 1392 (set cmpl-db-prefix-symbol nil)) |
1364 )) | 1393 )) |
1365 (cmpl-statistics-block | 1394 (cmpl-statistics-block |
1366 (note-completion-deleted)) | 1395 (note-completion-deleted)) |
1367 ) | 1396 ) |
1368 (error "Unknown completion: %s. Couldn't delete it." string) | 1397 (error "Unknown completion `%s'" completion-string) |
1369 )) | 1398 )) |
1370 | 1399 |
1371 ;;; Tests -- | 1400 ;;; Tests -- |
1372 ;;; - Add and Find - | 1401 ;;; - Add and Find - |
1373 ;;; (add-completion-to-head "banana") --> ("banana" 0 nil 0) | 1402 ;;; (add-completion-to-head "banana") --> ("banana" 0 nil 0) |
1429 (list read) | 1458 (list read) |
1430 )) | 1459 )) |
1431 | 1460 |
1432 (defun check-completion-length (string) | 1461 (defun check-completion-length (string) |
1433 (if (< (length string) completion-min-length) | 1462 (if (< (length string) completion-min-length) |
1434 (error "The string \"%s\" is too short to be saved as a completion." | 1463 (error "The string `%s' is too short to be saved as a completion" |
1435 string) | 1464 string) |
1436 (list string))) | 1465 (list string))) |
1437 | 1466 |
1438 (defun add-completion (string &optional num-uses last-use-time) | 1467 (defun add-completion (string &optional num-uses last-use-time) |
1439 "Add STRING to completion list, or move it to head of list. | 1468 "Add STRING to completion list, or move it to head of list. |
1511 (cmpl-statistics-block | 1540 (cmpl-statistics-block |
1512 (note-separator-character string) | 1541 (note-separator-character string) |
1513 ) | 1542 ) |
1514 (cond (string | 1543 (cond (string |
1515 (setq entry (add-completion-to-head string)) | 1544 (setq entry (add-completion-to-head string)) |
1516 (when (and completion-on-separator-character | 1545 (if (and completion-on-separator-character |
1517 (zerop (completion-num-uses entry))) | 1546 (zerop (completion-num-uses entry))) |
1518 (set-completion-num-uses entry 1) | 1547 (progn |
1519 (setq cmpl-completions-accepted-p t) | 1548 (set-completion-num-uses entry 1) |
1520 ))) | 1549 (setq cmpl-completions-accepted-p t))))) |
1521 )) | 1550 )) |
1522 | 1551 |
1523 ;;; Tests -- | 1552 ;;; Tests -- |
1524 ;;; - Add and Find - | 1553 ;;; - Add and Find - |
1525 ;;; (add-completion "banana" 5 10) | 1554 ;;; (add-completion "banana" 5 10) |
1599 If INDEX is out of sequence, reset and start from the top. | 1628 If INDEX is out of sequence, reset and start from the top. |
1600 If there are no more entries, try cdabbrev and returns only a string." | 1629 If there are no more entries, try cdabbrev and returns only a string." |
1601 (cond | 1630 (cond |
1602 ((= index (setq cmpl-last-index (1+ cmpl-last-index))) | 1631 ((= index (setq cmpl-last-index (1+ cmpl-last-index))) |
1603 (completion-search-peek t)) | 1632 (completion-search-peek t)) |
1604 ((minusp index) | 1633 ((< index 0) |
1605 (completion-search-reset-1) | 1634 (completion-search-reset-1) |
1606 (setq cmpl-last-index index) | 1635 (setq cmpl-last-index index) |
1607 ;; reverse the possibilities list | 1636 ;; reverse the possibilities list |
1608 (setq cmpl-next-possibilities (reverse cmpl-starting-possibilities)) | 1637 (setq cmpl-next-possibilities (reverse cmpl-starting-possibilities)) |
1609 ;; do a "normal" search | 1638 ;; do a "normal" search |
1610 (while (and (completion-search-peek nil) | 1639 (while (and (completion-search-peek nil) |
1611 (minusp (setq index (1+ index)))) | 1640 (< (setq index (1+ index)) 0)) |
1612 (setq cmpl-next-possibility nil) | 1641 (setq cmpl-next-possibility nil) |
1613 ) | 1642 ) |
1614 (cond ((not cmpl-next-possibilities)) | 1643 (cond ((not cmpl-next-possibilities)) |
1615 ;; If no more possibilities, leave it that way | 1644 ;; If no more possibilities, leave it that way |
1616 ((= -1 cmpl-last-index) | 1645 ((= -1 cmpl-last-index) |
1628 ;; non-negative index, reset and search | 1657 ;; non-negative index, reset and search |
1629 ;;(prin1 'reset) | 1658 ;;(prin1 'reset) |
1630 (completion-search-reset-1) | 1659 (completion-search-reset-1) |
1631 (setq cmpl-last-index index) | 1660 (setq cmpl-last-index index) |
1632 (while (and (completion-search-peek t) | 1661 (while (and (completion-search-peek t) |
1633 (not (minusp (setq index (1- index))))) | 1662 (not (< (setq index (1- index)) 0))) |
1634 (setq cmpl-next-possibility nil) | 1663 (setq cmpl-next-possibility nil) |
1635 )) | 1664 )) |
1636 ) | 1665 ) |
1637 (prog1 | 1666 (prog1 |
1638 cmpl-next-possibility | 1667 cmpl-next-possibility |
1762 )) | 1791 )) |
1763 ;; get string | 1792 ;; get string |
1764 (setq cmpl-original-string (symbol-before-point-for-complete)) | 1793 (setq cmpl-original-string (symbol-before-point-for-complete)) |
1765 (cond ((not cmpl-original-string) | 1794 (cond ((not cmpl-original-string) |
1766 (setq this-command 'failed-complete) | 1795 (setq this-command 'failed-complete) |
1767 (error "To complete, the point must be after a symbol at least %d character long." | 1796 (error "To complete, point must be after a symbol at least %d character long" |
1768 completion-prefix-min-length))) | 1797 completion-prefix-min-length))) |
1769 ;; get index | 1798 ;; get index |
1770 (setq cmpl-current-index (if current-prefix-arg arg 0)) | 1799 (setq cmpl-current-index (if current-prefix-arg arg 0)) |
1771 ;; statistics | 1800 ;; statistics |
1772 (cmpl-statistics-block | 1801 (cmpl-statistics-block |
1874 (interactive "fFile: ") | 1903 (interactive "fFile: ") |
1875 (setq file (expand-file-name file)) | 1904 (setq file (expand-file-name file)) |
1876 (let* ((buffer (get-file-buffer file)) | 1905 (let* ((buffer (get-file-buffer file)) |
1877 (buffer-already-there-p buffer) | 1906 (buffer-already-there-p buffer) |
1878 ) | 1907 ) |
1879 (when (not buffer-already-there-p) | 1908 (if (not buffer-already-there-p) |
1880 (let ((completions-merging-modes nil)) | 1909 (let ((completions-merging-modes nil)) |
1881 (setq buffer (find-file-noselect file)) | 1910 (setq buffer (find-file-noselect file)))) |
1882 )) | |
1883 (unwind-protect | 1911 (unwind-protect |
1884 (save-excursion | 1912 (save-excursion |
1885 (set-buffer buffer) | 1913 (set-buffer buffer) |
1886 (add-completions-from-buffer) | 1914 (add-completions-from-buffer) |
1887 ) | 1915 ) |
1888 (when (not buffer-already-there-p) | 1916 (if (not buffer-already-there-p) |
1889 (kill-buffer buffer)) | 1917 (kill-buffer buffer))))) |
1890 ))) | |
1891 | 1918 |
1892 (defun add-completions-from-buffer () | 1919 (defun add-completions-from-buffer () |
1893 (interactive) | 1920 (interactive) |
1894 (let ((current-completion-source cmpl-source-file-parsing) | 1921 (let ((current-completion-source cmpl-source-file-parsing) |
1895 (start-num | 1922 (start-num |
1904 ((memq major-mode '(c-mode)) | 1931 ((memq major-mode '(c-mode)) |
1905 (add-completions-from-c-buffer) | 1932 (add-completions-from-c-buffer) |
1906 (setq mode 'c) | 1933 (setq mode 'c) |
1907 ) | 1934 ) |
1908 (t | 1935 (t |
1909 (error "Do not know how to parse completions in %s buffers." | 1936 (error "Cannot parse completions in %s buffers" |
1910 major-mode) | 1937 major-mode) |
1911 )) | 1938 )) |
1912 (cmpl-statistics-block | 1939 (cmpl-statistics-block |
1913 (record-cmpl-parse-file | 1940 (record-cmpl-parse-file |
1914 mode (point-max) | 1941 mode (point-max) |
1928 ) | 1955 ) |
1929 (add-completions-from-buffer) | 1956 (add-completions-from-buffer) |
1930 ))) | 1957 ))) |
1931 )) | 1958 )) |
1932 | 1959 |
1933 (pushnew 'cmpl-find-file-hook find-file-hooks) | 1960 (add-hook 'find-file-hooks 'cmpl-find-file-hook) |
1934 | 1961 |
1935 ;;;----------------------------------------------- | 1962 ;;;----------------------------------------------- |
1936 ;;; Tags Table Completions | 1963 ;;; Tags Table Completions |
1937 ;;;----------------------------------------------- | 1964 ;;;----------------------------------------------- |
1938 | 1965 |
2015 (let ((table (make-vector 256 0)) | 2042 (let ((table (make-vector 256 0)) |
2016 (whitespace-chars '(? ?\n ?\t ?\f ?\v ?\r)) | 2043 (whitespace-chars '(? ?\n ?\t ?\f ?\v ?\r)) |
2017 ;; unfortunately the ?( causes the parens to appear unbalanced | 2044 ;; unfortunately the ?( causes the parens to appear unbalanced |
2018 (separator-chars '(?, ?* ?= ?\( ?\; | 2045 (separator-chars '(?, ?* ?= ?\( ?\; |
2019 )) | 2046 )) |
2020 ) | 2047 i) |
2021 ;; default syntax is whitespace | 2048 ;; default syntax is whitespace |
2022 (dotimes (i 256) | 2049 (setq i 0) |
2023 (modify-syntax-entry i "w" table)) | 2050 (while (< i 256) |
2024 (dolist (char whitespace-chars) | 2051 (modify-syntax-entry i "w" table) |
2052 (setq i (1+ i))) | |
2053 (completion-dolist (char whitespace-chars) | |
2025 (modify-syntax-entry char "_" table)) | 2054 (modify-syntax-entry char "_" table)) |
2026 (dolist (char separator-chars) | 2055 (completion-dolist (char separator-chars) |
2027 (modify-syntax-entry char " " table)) | 2056 (modify-syntax-entry char " " table)) |
2028 (modify-syntax-entry ?\[ "(]" table) | 2057 (modify-syntax-entry ?\[ "(]" table) |
2029 (modify-syntax-entry ?\{ "(}" table) | 2058 (modify-syntax-entry ?\{ "(}" table) |
2030 (modify-syntax-entry ?\] ")[" table) | 2059 (modify-syntax-entry ?\] ")[" table) |
2031 (modify-syntax-entry ?\} "){" table) | 2060 (modify-syntax-entry ?\} "){" table) |
2153 (search-failed ;;done | 2182 (search-failed ;;done |
2154 (throw 'finish-add-completions t) | 2183 (throw 'finish-add-completions t) |
2155 ) | 2184 ) |
2156 (error | 2185 (error |
2157 ;; Check for failure in scan-sexps | 2186 ;; Check for failure in scan-sexps |
2158 (if (or (string-equal (second e) | 2187 (if (or (string-equal (nth 1 e) |
2159 "Containing expression ends prematurely") | 2188 "Containing expression ends prematurely") |
2160 (string-equal (second e) "Unbalanced parentheses")) | 2189 (string-equal (nth 1 e) "Unbalanced parentheses")) |
2161 ;; unbalanced paren., keep going | 2190 ;; unbalanced paren., keep going |
2162 ;;(ding) | 2191 ;;(ding) |
2163 (forward-line 1) | 2192 (forward-line 1) |
2164 (message "Error parsing C buffer for completions. Please bug report.") | 2193 (message "Error parsing C buffer for completions--please send bug report") |
2165 (throw 'finish-add-completions t) | 2194 (throw 'finish-add-completions t) |
2166 )) | 2195 )) |
2167 )) | 2196 )) |
2168 (set-syntax-table saved-syntax) | 2197 (set-syntax-table saved-syntax) |
2169 ))))) | 2198 ))))) |
2173 ;;; Init files | 2202 ;;; Init files |
2174 ;;;--------------------------------------------------------------------------- | 2203 ;;;--------------------------------------------------------------------------- |
2175 | 2204 |
2176 ;;; The version of save-completions-to-file called at kill-emacs time. | 2205 ;;; The version of save-completions-to-file called at kill-emacs time. |
2177 (defun kill-emacs-save-completions () | 2206 (defun kill-emacs-save-completions () |
2178 (when (and save-completions-flag enable-completion cmpl-initialized-p) | 2207 (if (and save-completions-flag enable-completion cmpl-initialized-p) |
2179 (cond | 2208 (cond |
2180 ((not cmpl-completions-accepted-p) | 2209 ((not cmpl-completions-accepted-p) |
2181 (message "Completions database has not changed - not writing.")) | 2210 (message "Completions database has not changed - not writing.")) |
2182 (t | 2211 (t |
2183 (save-completions-to-file) | 2212 (save-completions-to-file))))) |
2184 )) | |
2185 )) | |
2186 | 2213 |
2187 ;; There is no point bothering to change this again | 2214 ;; There is no point bothering to change this again |
2188 ;; unless the package changes so much that it matters | 2215 ;; unless the package changes so much that it matters |
2189 ;; for people that have saved completions. | 2216 ;; for people that have saved completions. |
2190 (defconst completion-version "11") | 2217 (defconst completion-version "11") |
2205 (defun save-completions-to-file (&optional filename) | 2232 (defun save-completions-to-file (&optional filename) |
2206 "Save completions in init file FILENAME. | 2233 "Save completions in init file FILENAME. |
2207 If file name is not specified, use `save-completions-file-name'." | 2234 If file name is not specified, use `save-completions-file-name'." |
2208 (interactive) | 2235 (interactive) |
2209 (setq filename (expand-file-name (or filename save-completions-file-name))) | 2236 (setq filename (expand-file-name (or filename save-completions-file-name))) |
2210 (when (file-writable-p filename) | 2237 (if (file-writable-p filename) |
2211 (if (not cmpl-initialized-p) | 2238 (progn |
2212 (initialize-completions));; make sure everything's loaded | 2239 (if (not cmpl-initialized-p) |
2213 (message "Saving completions to file %s" filename) | 2240 (initialize-completions));; make sure everything's loaded |
2214 | 2241 (message "Saving completions to file %s" filename) |
2215 (let* ((delete-old-versions t) | 2242 |
2216 (kept-old-versions 0) | 2243 (let* ((delete-old-versions t) |
2217 (kept-new-versions completions-file-versions-kept) | 2244 (kept-old-versions 0) |
2218 last-use-time | 2245 (kept-new-versions completions-file-versions-kept) |
2219 (current-time (cmpl-hours-since-origin)) | 2246 last-use-time |
2220 (total-in-db 0) | 2247 (current-time (cmpl-hours-since-origin)) |
2221 (total-perm 0) | 2248 (total-in-db 0) |
2222 (total-saved 0) | 2249 (total-perm 0) |
2223 (backup-filename (completion-backup-filename filename)) | 2250 (total-saved 0) |
2224 ) | 2251 (backup-filename (completion-backup-filename filename)) |
2252 ) | |
2225 | 2253 |
2226 (save-excursion | 2254 (save-excursion |
2227 (get-buffer-create " *completion-save-buffer*") | 2255 (get-buffer-create " *completion-save-buffer*") |
2228 (set-buffer " *completion-save-buffer*") | 2256 (set-buffer " *completion-save-buffer*") |
2229 (setq buffer-file-name filename) | 2257 (setq buffer-file-name filename) |
2230 | 2258 |
2231 (when (not (verify-visited-file-modtime (current-buffer))) | 2259 (if (not (verify-visited-file-modtime (current-buffer))) |
2232 ;; file has changed on disk. Bring us up-to-date | 2260 (progn |
2233 (message "Completion file has changed. Merging. . .") | 2261 ;; file has changed on disk. Bring us up-to-date |
2234 (load-completions-from-file filename t) | 2262 (message "Completion file has changed. Merging. . .") |
2235 (message "Merging finished. Saving completions to file %s" filename) | 2263 (load-completions-from-file filename t) |
2236 ) | 2264 (message "Merging finished. Saving completions to file %s" filename))) |
2237 | 2265 |
2238 ;; prepare the buffer to be modified | 2266 ;; prepare the buffer to be modified |
2239 (clear-visited-file-modtime) | 2267 (clear-visited-file-modtime) |
2240 (erase-buffer) | 2268 (erase-buffer) |
2241 ;; (/ 1 0) | 2269 ;; (/ 1 0) |
2242 (insert (format saved-cmpl-file-header completion-version)) | 2270 (insert (format saved-cmpl-file-header completion-version)) |
2243 (dolist (completion (list-all-completions)) | 2271 (completion-dolist (completion (list-all-completions)) |
2244 (setq total-in-db (1+ total-in-db)) | 2272 (setq total-in-db (1+ total-in-db)) |
2245 (setq last-use-time (completion-last-use-time completion)) | 2273 (setq last-use-time (completion-last-use-time completion)) |
2246 ;; Update num uses and maybe write completion to a file | 2274 ;; Update num uses and maybe write completion to a file |
2247 (cond ((or;; Write to file if | 2275 (cond ((or;; Write to file if |
2248 ;; permanent | 2276 ;; permanent |
2249 (and (eq last-use-time t) | 2277 (and (eq last-use-time t) |
2250 (setq total-perm (1+ total-perm))) | 2278 (setq total-perm (1+ total-perm))) |
2251 ;; or if | 2279 ;; or if |
2252 (if (plusp (completion-num-uses completion)) | 2280 (if (> (completion-num-uses completion) 0) |
2253 ;; it's been used | 2281 ;; it's been used |
2254 (setq last-use-time current-time) | 2282 (setq last-use-time current-time) |
2255 ;; or it was saved before and | 2283 ;; or it was saved before and |
2256 (and last-use-time | 2284 (and last-use-time |
2257 ;; save-completions-retention-time is nil | 2285 ;; save-completions-retention-time is nil |
2258 (or (not save-completions-retention-time) | 2286 (or (not save-completions-retention-time) |
2259 ;; or time since last use is < ...retention-time* | 2287 ;; or time since last use is < ...retention-time* |
2260 (< (- current-time last-use-time) | 2288 (< (- current-time last-use-time) |
2261 save-completions-retention-time)) | 2289 save-completions-retention-time)) |
2262 ))) | 2290 ))) |
2263 ;; write to file | 2291 ;; write to file |
2264 (setq total-saved (1+ total-saved)) | 2292 (setq total-saved (1+ total-saved)) |
2265 (insert (prin1-to-string (cons (completion-string completion) | 2293 (insert (prin1-to-string (cons (completion-string completion) |
2266 last-use-time)) "\n") | 2294 last-use-time)) "\n") |
2267 ))) | 2295 ))) |
2268 | 2296 |
2269 ;; write the buffer | 2297 ;; write the buffer |
2270 (condition-case e | 2298 (condition-case e |
2271 (let ((file-exists-p (file-exists-p filename))) | 2299 (let ((file-exists-p (file-exists-p filename))) |
2272 (when file-exists-p | 2300 (if file-exists-p |
2273 ;; If file exists . . . | 2301 (progn |
2274 ;; Save a backup(so GNU doesn't screw us when we're out of disk) | 2302 ;; If file exists . . . |
2275 ;; (GNU leaves a 0 length file if it gets a disk full error!) | 2303 ;; Save a backup(so GNU doesn't screw us when we're out of disk) |
2304 ;; (GNU leaves a 0 length file if it gets a disk full error!) | |
2276 | 2305 |
2277 ;; If backup doesn't exit, Rename current to backup | 2306 ;; If backup doesn't exit, Rename current to backup |
2278 ;; {If backup exists the primary file is probably messed up} | 2307 ;; {If backup exists the primary file is probably messed up} |
2279 (unless (file-exists-p backup-filename) | 2308 (or (file-exists-p backup-filename) |
2280 (rename-file filename backup-filename)) | 2309 (rename-file filename backup-filename)) |
2281 ;; Copy the backup back to the current name | 2310 ;; Copy the backup back to the current name |
2282 ;; (so versioning works) | 2311 ;; (so versioning works) |
2283 (copy-file backup-filename filename t) | 2312 (copy-file backup-filename filename t))) |
2284 ) | 2313 ;; Save it |
2285 ;; Save it | 2314 (save-buffer) |
2286 (save-buffer) | 2315 (if file-exists-p |
2287 (when file-exists-p | 2316 ;; If successful, remove backup |
2288 ;; If successful, remove backup | 2317 (delete-file backup-filename))) |
2289 (delete-file backup-filename) | 2318 (error |
2290 )) | 2319 (set-buffer-modified-p nil) |
2291 (error | 2320 (message "Couldn't save completion file `%s'" filename) |
2292 (set-buffer-modified-p nil) | 2321 )) |
2293 (message "Couldn't save completion file %s." filename) | 2322 ;; Reset accepted-p flag |
2294 )) | 2323 (setq cmpl-completions-accepted-p nil) |
2295 ;; Reset accepted-p flag | 2324 ) |
2296 (setq cmpl-completions-accepted-p nil) | 2325 (cmpl-statistics-block |
2297 ) | 2326 (record-save-completions total-in-db total-perm total-saved)) |
2298 (cmpl-statistics-block | 2327 )))) |
2299 (record-save-completions total-in-db total-perm total-saved)) | |
2300 ))) | |
2301 | 2328 |
2302 ;;;(defun autosave-completions () | 2329 ;;;(defun autosave-completions () |
2303 ;;; (when (and save-completions-flag enable-completion cmpl-initialized-p | 2330 ;;; (if (and save-completions-flag enable-completion cmpl-initialized-p |
2304 ;;; *completion-auto-save-period* | 2331 ;;; *completion-auto-save-period* |
2305 ;;; (> cmpl-emacs-idle-time *completion-auto-save-period*) | 2332 ;;; (> cmpl-emacs-idle-time *completion-auto-save-period*) |
2306 ;;; cmpl-completions-accepted-p) | 2333 ;;; cmpl-completions-accepted-p) |
2307 ;;; (save-completions-to-file) | 2334 ;;; (save-completions-to-file))) |
2308 ;;; )) | 2335 |
2309 | 2336 ;;;(add-hook 'cmpl-emacs-idle-time-hooks 'autosave-completions) |
2310 ;;;(pushnew 'autosave-completions cmpl-emacs-idle-time-hooks) | |
2311 | 2337 |
2312 (defun load-completions-from-file (&optional filename no-message-p) | 2338 (defun load-completions-from-file (&optional filename no-message-p) |
2313 "Loads a completion init file FILENAME. | 2339 "Loads a completion init file FILENAME. |
2314 If file is not specified, then use `save-completions-file-name'." | 2340 If file is not specified, then use `save-completions-file-name'." |
2315 (interactive) | 2341 (interactive) |
2316 (setq filename (expand-file-name (or filename save-completions-file-name))) | 2342 (setq filename (expand-file-name (or filename save-completions-file-name))) |
2317 (let* ((backup-filename (completion-backup-filename filename)) | 2343 (let* ((backup-filename (completion-backup-filename filename)) |
2318 (backup-readable-p (file-readable-p backup-filename)) | 2344 (backup-readable-p (file-readable-p backup-filename)) |
2319 ) | 2345 ) |
2320 (when backup-readable-p (setq filename backup-filename)) | 2346 (if backup-readable-p (setq filename backup-filename)) |
2321 (when (file-readable-p filename) | 2347 (if (file-readable-p filename) |
2322 (if (not no-message-p) | 2348 (progn |
2323 (message "Loading completions from %sfile %s . . ." | 2349 (if (not no-message-p) |
2324 (if backup-readable-p "backup " "") filename)) | 2350 (message "Loading completions from %sfile %s . . ." |
2325 (save-excursion | 2351 (if backup-readable-p "backup " "") filename)) |
2326 (get-buffer-create " *completion-save-buffer*") | 2352 (save-excursion |
2327 (set-buffer " *completion-save-buffer*") | 2353 (get-buffer-create " *completion-save-buffer*") |
2328 (setq buffer-file-name filename) | 2354 (set-buffer " *completion-save-buffer*") |
2329 ;; prepare the buffer to be modified | 2355 (setq buffer-file-name filename) |
2330 (clear-visited-file-modtime) | 2356 ;; prepare the buffer to be modified |
2331 (erase-buffer) | 2357 (clear-visited-file-modtime) |
2358 (erase-buffer) | |
2332 | 2359 |
2333 (let ((insert-okay-p nil) | 2360 (let ((insert-okay-p nil) |
2334 (buffer (current-buffer)) | 2361 (buffer (current-buffer)) |
2335 (current-time (cmpl-hours-since-origin)) | 2362 (current-time (cmpl-hours-since-origin)) |
2336 string num-uses entry last-use-time | 2363 string num-uses entry last-use-time |
2337 cmpl-entry cmpl-last-use-time | 2364 cmpl-entry cmpl-last-use-time |
2338 (current-completion-source cmpl-source-init-file) | 2365 (current-completion-source cmpl-source-init-file) |
2339 (start-num | 2366 (start-num |
2340 (cmpl-statistics-block | 2367 (cmpl-statistics-block |
2341 (aref completion-add-count-vector cmpl-source-file-parsing))) | 2368 (aref completion-add-count-vector cmpl-source-file-parsing))) |
2342 (total-in-file 0) (total-perm 0) | 2369 (total-in-file 0) (total-perm 0) |
2343 ) | 2370 ) |
2344 ;; insert the file into a buffer | 2371 ;; insert the file into a buffer |
2345 (condition-case e | 2372 (condition-case e |
2346 (progn (insert-file-contents filename t) | 2373 (progn (insert-file-contents filename t) |
2347 (setq insert-okay-p t)) | 2374 (setq insert-okay-p t)) |
2348 | 2375 |
2349 (file-error | 2376 (file-error |
2350 (message "File error trying to load completion file %s." | 2377 (message "File error trying to load completion file %s." |
2351 filename))) | 2378 filename))) |
2352 ;; parse it | 2379 ;; parse it |
2353 (when insert-okay-p | 2380 (if insert-okay-p |
2354 (goto-char (point-min)) | 2381 (progn |
2355 | 2382 (goto-char (point-min)) |
2356 (condition-case e | 2383 |
2357 (while t | 2384 (condition-case e |
2358 (setq entry (read buffer)) | 2385 (while t |
2359 (setq total-in-file (1+ total-in-file)) | 2386 (setq entry (read buffer)) |
2360 (cond | 2387 (setq total-in-file (1+ total-in-file)) |
2361 ((and (consp entry) | 2388 (cond |
2362 (stringp (setq string (car entry))) | 2389 ((and (consp entry) |
2363 (cond | 2390 (stringp (setq string (car entry))) |
2364 ((eq (setq last-use-time (cdr entry)) 'T) | 2391 (cond |
2365 ;; handle case sensitivity | 2392 ((eq (setq last-use-time (cdr entry)) 'T) |
2366 (setq total-perm (1+ total-perm)) | 2393 ;; handle case sensitivity |
2367 (setq last-use-time t)) | 2394 (setq total-perm (1+ total-perm)) |
2368 ((eq last-use-time t) | 2395 (setq last-use-time t)) |
2369 (setq total-perm (1+ total-perm))) | 2396 ((eq last-use-time t) |
2370 ((integerp last-use-time)) | 2397 (setq total-perm (1+ total-perm))) |
2371 )) | 2398 ((integerp last-use-time)) |
2372 ;; Valid entry | 2399 )) |
2373 ;; add it in | 2400 ;; Valid entry |
2374 (setq cmpl-last-use-time | 2401 ;; add it in |
2375 (completion-last-use-time | 2402 (setq cmpl-last-use-time |
2376 (setq cmpl-entry | 2403 (completion-last-use-time |
2377 (add-completion-to-tail-if-new string)) | 2404 (setq cmpl-entry |
2378 )) | 2405 (add-completion-to-tail-if-new string)) |
2379 (if (or (eq last-use-time t) | |
2380 (and (> last-use-time 1000);;backcompatibility | |
2381 (not (eq cmpl-last-use-time t)) | |
2382 (or (not cmpl-last-use-time) | |
2383 ;; more recent | |
2384 (> last-use-time cmpl-last-use-time)) | |
2385 )) | 2406 )) |
2386 ;; update last-use-time | 2407 (if (or (eq last-use-time t) |
2387 (set-completion-last-use-time cmpl-entry last-use-time) | 2408 (and (> last-use-time 1000);;backcompatibility |
2388 )) | 2409 (not (eq cmpl-last-use-time t)) |
2389 (t | 2410 (or (not cmpl-last-use-time) |
2390 ;; Bad format | 2411 ;; more recent |
2391 (message "Error: invalid saved completion - %s" | 2412 (> last-use-time cmpl-last-use-time)) |
2392 (prin1-to-string entry)) | 2413 )) |
2393 ;; try to get back in sync | 2414 ;; update last-use-time |
2394 (search-forward "\n(") | 2415 (set-completion-last-use-time cmpl-entry last-use-time) |
2416 )) | |
2417 (t | |
2418 ;; Bad format | |
2419 (message "Error: invalid saved completion - %s" | |
2420 (prin1-to-string entry)) | |
2421 ;; try to get back in sync | |
2422 (search-forward "\n(") | |
2423 ))) | |
2424 (search-failed | |
2425 (message "End of file while reading completions.") | |
2426 ) | |
2427 (end-of-file | |
2428 (if (= (point) (point-max)) | |
2429 (if (not no-message-p) | |
2430 (message "Loading completions from file %s . . . Done." | |
2431 filename)) | |
2432 (message "End of file while reading completions.") | |
2433 )) | |
2395 ))) | 2434 ))) |
2396 (search-failed | 2435 |
2397 (message "End of file while reading completions.") | 2436 (cmpl-statistics-block |
2398 ) | 2437 (record-load-completions |
2399 (end-of-file | 2438 total-in-file total-perm |
2400 (if (= (point) (point-max)) | 2439 (- (aref completion-add-count-vector cmpl-source-init-file) |
2401 (if (not no-message-p) | 2440 start-num))) |
2402 (message "Loading completions from file %s . . . Done." | 2441 |
2403 filename)) | 2442 )))))) |
2404 (message "End of file while reading completions.") | |
2405 )) | |
2406 )) | |
2407 | |
2408 (cmpl-statistics-block | |
2409 (record-load-completions | |
2410 total-in-file total-perm | |
2411 (- (aref completion-add-count-vector cmpl-source-init-file) | |
2412 start-num))) | |
2413 | |
2414 ))))) | |
2415 | 2443 |
2416 (defun initialize-completions () | 2444 (defun initialize-completions () |
2417 "Load the default completions file. | 2445 "Load the default completions file. |
2418 Also sets up so that exiting emacs will automatically save the file." | 2446 Also sets up so that exiting emacs will automatically save the file." |
2419 (interactive) | 2447 (interactive) |